Skip to content

Switch to visible type applications #56

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
wants to merge 1 commit into
base: master
Choose a base branch
from
Open

Switch to visible type applications #56

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
41 changes: 15 additions & 26 deletions README.md
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -83,24 +83,17 @@ This library just uses the same structural row system that we use with records
We lift values into `Variant` with `inj` by specifying a _tag_.

```purescript
import Type.Proxy (Proxy(..))

someFoo :: forall v. Variant (foo :: Int | v)
someFoo = inj (Proxy :: Proxy "foo") 42
someFoo = inj @"foo" 42
```

`Proxy` is just a way to tell the compiler what our tag is at the type level.
I can stamp out a bunch of these with different labels:

```purescript
someFoo :: forall v. Variant (foo :: Int | v)
someFoo = inj (Proxy :: Proxy "foo") 42

someBar :: forall v. Variant (bar :: Boolean | v)
someBar = inj (Proxy :: Proxy "bar") true

someBaz :: forall v. Variant (baz :: String | v)
someBaz = inj (Proxy :: Proxy "baz") "Baz"
someFoo = inj @"foo" 42
someBar = inj @"bar" true
someBaz = inj @"baz" "Baz"
```

We can try to extract a value from this via `on`, which takes a function to
Expand All @@ -109,7 +102,7 @@ case of failure.

```purescript
fooToString :: forall v. Variant (foo :: Int | v) -> String
fooToString = on (Proxy :: Proxy "foo") show (\_ -> "not foo")
fooToString = on @"foo" show (\_ -> "not foo")

fooToString someFoo == "42"
fooToString someBar == "not foo"
Expand All @@ -119,22 +112,18 @@ We can chain usages of `on` and terminate it with `case_` (for compiler-checked
exhaustivity) or `default` (to provide a default value in case of failure).

```purescript
_foo = Proxy :: Proxy "foo"
_bar = Proxy :: Proxy "bar"
_baz = Proxy :: Proxy "baz"

allToString :: Variant (foo :: Int, bar :: Boolean, baz :: String) -> String
allToString =
case_
# on _foo show
# on _bar (if _ then "true" else "false")
# on _baz (\str -> str)
# on @"foo" show
# on @"bar" (if _ then "true" else "false")
# on @"baz" (\str -> str)

someToString :: forall v. Variant (foo :: Int, bar :: Boolean | v) -> String
someToString =
default "unknown"
# on _foo show
# on _bar (if _ then "true" else "false")
# on @"foo" show
# on @"bar" (if _ then "true" else "false")

allToString someBaz == "Baz"
someToString someBaz == "unknown"
Expand All @@ -145,13 +134,13 @@ function composition and reuse them in different contexts.

```purescript
onFooOrBar :: forall v. (Variant v -> String) -> Variant (foo :: Int, bar :: Boolean | v) -> String
onFooOrBar = on _foo show >>> on _bar (if _ then "true" else "false")
onFooOrBar = on @"foo" show >>> on @"bar" (if _ then "true" else "false")

allToString :: Variant (foo :: Int, bar :: Boolean, baz :: String) -> String
allToString =
case_
# onFooOrBar
# on _baz (\str -> str)
# on @"baz" (\str -> str)
```

Instead of chaining with just `on`, there is `onMatch` which adds record sugar.
Expand Down Expand Up @@ -185,13 +174,13 @@ except it's indexed by things of kind `Type -> Type`.

```purescript
someFoo :: forall v. VariantF (foo :: Maybe | v) Int
someFoo = inj (Proxy :: Proxy "foo") (Just 42)
someFoo = inj @"foo" (Just 42)

someBar :: forall v. VariantF (bar :: Tuple String | v) Int
someBar = inj (Proxy :: Proxy "bar") (Tuple "bar" 42)
someBar = inj @"bar" (Tuple "bar" 42)

someBaz :: forall v a. VariantF (baz :: Either String | v) a
someBaz = inj (Proxy :: Proxy "baz") (Left "Baz")
someBaz = inj @"baz" (Left "Baz")
```

`VariantF` supports all the same combinators as `Variant`.
121 changes: 64 additions & 57 deletions src/Data/Functor/Variant.purs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -19,8 +19,11 @@ module Data.Functor.Variant
, UnvariantF'
, unvariantF
, revariantF
, class VariantFShows, variantFShows
, class VariantFMaps, variantFMaps, Mapper
, class VariantFShows
, variantFShows
, class VariantFMaps
, variantFMaps
, Mapper
, class TraversableVFRL
, class FoldableVFRL
, traverseVFRL
Expand Down Expand Up @@ -58,7 +61,7 @@ data UnknownF a
data VariantF :: Row (Type -> Type) -> Type -> Type
data VariantF f a

instance functorVariantF ∷ Functor (VariantF r) where
instance Functor (VariantF r) where
map f a =
case coerceY a of
VariantFRep v → coerceV $ VariantFRep
Expand All @@ -79,69 +82,70 @@ class FoldableVFRL rl row | rl -> row where
foldlVFRL :: forall a b. Proxy rl -> (b -> a -> b) -> b -> VariantF row a -> b
foldMapVFRL :: forall a m. Monoid m => Proxy rl -> (a -> m) -> VariantF row a -> m

instance foldableNil :: FoldableVFRL RL.Nil () where
instance FoldableVFRL RL.Nil () where
foldrVFRL _ _ _ = case_
foldlVFRL _ _ _ = case_
foldMapVFRL _ _ = case_

instance foldableCons ::
instance
( IsSymbol k
, TF.Foldable f
, FoldableVFRL rl r
, R.Cons k f r r'
) => FoldableVFRL (RL.Cons k f rl) r' where
foldrVFRL _ f b = on k (TF.foldr f b) (foldrVFRL (Proxy :: Proxy rl) f b)
where k = Proxy :: Proxy k
foldlVFRL _ f b = on k (TF.foldl f b) (foldlVFRL (Proxy :: Proxy rl) f b)
where k = Proxy :: Proxy k
foldMapVFRL _ f = on k (TF.foldMap f) (foldMapVFRL (Proxy :: Proxy rl) f)
where k = Proxy :: Proxy k
) =>
FoldableVFRL (RL.Cons k f rl) r' where
foldrVFRL _ f b = on @k (TF.foldr f b) (foldrVFRL (Proxy :: Proxy rl) f b)
foldlVFRL _ f b = on @k (TF.foldl f b) (foldlVFRL (Proxy :: Proxy rl) f b)
foldMapVFRL _ f = on @k (TF.foldMap f) (foldMapVFRL (Proxy :: Proxy rl) f)

class TraversableVFRL :: RL.RowList (Type -> Type) -> Row (Type -> Type) -> Constraint
class FoldableVFRL rl row <= TraversableVFRL rl row | rl -> row where
traverseVFRL :: forall f a b. Applicative f => Proxy rl -> (a -> f b) -> VariantF row a -> f (VariantF row b)

instance traversableNil :: TraversableVFRL RL.Nil () where
instance TraversableVFRL RL.Nil () where
traverseVFRL _ _ = case_

instance traversableCons ::
instance
( IsSymbol k
, TF.Traversable f
, TraversableVFRL rl r
, R.Cons k f r r'
, R.Union r rx r'
) => TraversableVFRL (RL.Cons k f rl) r' where
traverseVFRL _ f = on k (TF.traverse f >>> map (inj k))
) =>
TraversableVFRL (RL.Cons k f rl) r' where
traverseVFRL _ f = on @k (TF.traverse f >>> map (inj @k))
(traverseVFRL (Proxy :: Proxy rl) f >>> map expand)
where k = Proxy :: Proxy k

instance foldableVariantF ::
(RL.RowToList row rl, FoldableVFRL rl row) =>
instance
( RL.RowToList row rl
, FoldableVFRL rl row
) =>
TF.Foldable (VariantF row) where
foldr = foldrVFRL (Proxy :: Proxy rl)
foldl = foldlVFRL (Proxy :: Proxy rl)
foldMap = foldMapVFRL (Proxy :: Proxy rl)

instance traversableVariantF ::
(RL.RowToList row rl, TraversableVFRL rl row) =>
foldr = foldrVFRL (Proxy :: Proxy rl)
foldl = foldlVFRL (Proxy :: Proxy rl)
foldMap = foldMapVFRL (Proxy :: Proxy rl)

instance
( RL.RowToList row rl
, TraversableVFRL rl row
) =>
TF.Traversable (VariantF row) where
traverse = traverseVFRL (Proxy :: Proxy rl)
sequence = TF.sequenceDefault
traverse = traverseVFRL (Proxy :: Proxy rl)
sequence = TF.sequenceDefault

-- | Inject into the variant at a given label.
-- | ```purescript
-- | maybeAtFoo :: forall r. VariantF (foo :: Maybe | r) Int
-- | maybeAtFoo = inj (Proxy :: Proxy "foo") (Just 42)
-- | ```
inj
∷ ∀ sym f a r1 r2
∷ ∀ @sym f a r1 r2
. R.Cons sym f r1 r2
⇒ IsSymbol sym
⇒ Functor f
⇒ Proxy sym
→ f a
⇒ f a
→ VariantF r2 a
inj p value = coerceV $ VariantFRep { type: reflectSymbol p, value, map: Mapper map }
inj value = coerceV $ VariantFRep { type: reflectSymbol (Proxy :: Proxy sym), value, map: Mapper map }
where
coerceV ∷ VariantFRep f a → VariantF r2 a
coerceV = unsafeCoerce
Expand All @@ -153,30 +157,28 @@ inj p value = coerceV $ VariantFRep { type: reflectSymbol p, value, map: Mapper
-- | _ -> 0
-- | ```
prj
∷ ∀ sym f a r1 r2 g
∷ ∀ @sym f a r1 r2 g
. R.Cons sym f r1 r2
⇒ Alternative g
⇒ IsSymbol sym
⇒ Proxy sym
→ VariantF r2 a
⇒ VariantF r2 a
→ g (f a)
prj p = on p pure (const empty)
prj = on @sym pure (const empty)

-- | Attempt to read a variant at a given label by providing branches.
-- | The failure branch receives the provided variant, but with the label
-- | removed.
on
∷ ∀ sym f a b r1 r2
∷ ∀ @sym f a b r1 r2
. R.Cons sym f r1 r2
⇒ IsSymbol sym
⇒ Proxy sym
→ (f a → b)
⇒ (f a → b)
→ (VariantF r1 a → b)
→ VariantF r2 a
→ b
on p f g r =
on f g r =
case coerceY r of
VariantFRep v | v.type == reflectSymbol p → f v.value
VariantFRep v | v.type == reflectSymbol (Proxy :: Proxy sym) → f v.value
_ → g (coerceR r)
where
coerceY ∷ VariantF r2 a → VariantFRep f a
Expand Down Expand Up @@ -230,12 +232,11 @@ overOne
⇒ R.Cons sym g r4 r3
⇒ IsSymbol sym
⇒ Functor g
⇒ Proxy sym
→ (f a → g b)
⇒ (f a → g b)
→ (VariantF r1 a → VariantF r3 b)
→ VariantF r2 a
→ VariantF r3 b
overOne p f = on p (inj p <<< f)
overOne f = on @sym (inj @sym <<< f)

-- | Map over several cases of a variant using a `Record` containing functions
-- | for each case. Each case gets put back at the same label it was matched
Expand All @@ -261,7 +262,8 @@ overSome r k v =
tags = variantTags (Proxy ∷ Proxy rlo)
maps = variantFMaps (Proxy ∷ Proxy rlo)
map = lookup "map" v'.type tags maps
in coerceV' (VariantFRep { type: v'.type, map, value: unsafeGet v'.type r v'.value })
in
coerceV' (VariantFRep { type: v'.type, map, value: unsafeGet v'.type r v'.value })
_ → k (coerceR v)

where
Expand Down Expand Up @@ -300,7 +302,8 @@ over
→ (a → b)
→ VariantF r1 a
→ VariantF r3 b
over r f = overSome r (map f >>> unsafeExpand) where
over r f = overSome r (map f >>> unsafeExpand)
where
unsafeExpand = unsafeCoerce ∷ VariantF r2 b → VariantF r3 b

-- | Traverse over one case of a variant (in a functorial/monadic context `m`),
Expand All @@ -312,12 +315,11 @@ traverseOne
⇒ IsSymbol sym
⇒ Functor g
⇒ Functor m
⇒ Proxy sym
→ (f a → m (g b))
⇒ (f a → m (g b))
→ (VariantF r1 a → m (VariantF r3 b))
→ VariantF r2 a
→ m (VariantF r3 b)
traverseOne p f = on p (map (inj p) <<< f)
traverseOne f = on @sym (map (inj @sym) <<< f)

-- | Traverse over several cases of a variant using a `Record` containing
-- | traversals. Each case gets put back at the same label it was matched
Expand All @@ -344,7 +346,8 @@ traverseSome r k v =
tags = variantTags (Proxy ∷ Proxy rlo)
maps = variantFMaps (Proxy ∷ Proxy rlo)
map = lookup "map" v'.type tags maps
in unsafeGet v'.type r v'.value <#> \value ->
in
unsafeGet v'.type r v'.value <#> \value ->
coerceV' (VariantFRep { type: v'.type, map, value })
_ → k (coerceR v)

Expand Down Expand Up @@ -379,7 +382,8 @@ traverse
→ (a → m b)
→ VariantF r1 a
→ m (VariantF r3 b)
traverse r f = traverseSome r (TF.traverse f >>> map unsafeExpand) where
traverse r f = traverseSome r (TF.traverse f >>> map unsafeExpand)
where
unsafeExpand = unsafeCoerce ∷ VariantF r2 b → VariantF r3 b

-- | Combinator for exhaustive pattern matching.
Expand Down Expand Up @@ -496,23 +500,26 @@ unvariantF v = case (unsafeCoerce v ∷ VariantFRep UnknownF Unit) of

-- | Reconstructs a VariantF given an UnvariantF eliminator.
revariantF ∷ ∀ r a. UnvariantF r a -> VariantF r a
revariantF (UnvariantF f) = f inj
revariantF (UnvariantF f) = f inj'
where
inj' ∷ ∀ @sym f r1 r2. R.Cons sym f r1 r2 ⇒ IsSymbol sym ⇒ Functor f ⇒ Proxy sym -> f a → VariantF r2 a
inj' _ = inj @sym

class VariantFShows :: RL.RowList (Type -> Type) -> Type -> Constraint
class VariantFShows rl x where
variantFShows ∷ forall proxy1 proxy2. proxy1 rl → proxy2 x → L.List (VariantCase → String)
variantFShows ∷ Proxy rl → Proxy x → L.List (VariantCase → String)

instance showVariantFNil ∷ VariantFShows RL.Nil x where
instance VariantFShows RL.Nil x where
variantFShows _ _ = L.Nil

instance showVariantFCons ∷ (VariantFShows rs x, Show (f x), Show x) ⇒ VariantFShows (RL.Cons sym f rs) x where
instance (VariantFShows rs x, Show (f x), Show x) ⇒ VariantFShows (RL.Cons sym f rs) x where
variantFShows _ p =
L.Cons (coerceShow show) (variantFShows (Proxy ∷ Proxy rs) p)
where
coerceShow ∷ (f x → String) → VariantCase → String
coerceShow = unsafeCoerce

instance showVariantF ∷ (RL.RowToList r rl, VariantTags rl, VariantFShows rl a, Show a) ⇒ Show (VariantF r a) where
instance (RL.RowToList r rl, VariantTags rl, VariantFShows rl a, Show a) ⇒ Show (VariantF r a) where
show v1 =
let
VariantFRep v = unsafeCoerce v1 ∷ VariantFRep VariantFCase a
Expand All @@ -525,10 +532,10 @@ instance showVariantF ∷ (RL.RowToList r rl, VariantTags rl, VariantFShows rl a
class VariantFMaps (rl ∷ RL.RowList (Type → Type)) where
variantFMaps ∷ Proxy rl → L.List (Mapper VariantFCase)

instance mapVariantFNil ∷ VariantFMaps RL.Nil where
instance VariantFMaps RL.Nil where
variantFMaps _ = L.Nil

instance mapVariantFCons ∷ (VariantFMaps rs, Functor f) ⇒ VariantFMaps (RL.Cons sym f rs) where
instance (VariantFMaps rs, Functor f) ⇒ VariantFMaps (RL.Cons sym f rs) where
variantFMaps _ =
L.Cons (coerceMap (Mapper map)) (variantFMaps (Proxy ∷ Proxy rs))
where
Expand Down
Loading