module Data.OpenUnion1.Clean (Union(..), Nil, List(..), (|>)(..), (||>), exhaust, simply, (∈)(), Member, liftU, (⊆)(..), Include) where
import Data.Proxy
data List a = Empty | a :> List a
infixr 5 :>
infixr 5 |>
type family (f :: * -> *) |> (s :: * -> *) :: * -> *
type instance f |> Union s = Union (f :> s)
type Nil = Union Empty
data family Union (s :: List (* -> *)) a
data instance Union (f :> s) a = Single (f a) | Union (Union s a)
data instance Union Empty a = Exhausted (Union Empty a)
instance Functor (Union Empty) where
fmap _ = exhaust
instance (Functor f, Functor (Union s)) => Functor (Union (f :> s)) where
fmap f (Single m) = Single (fmap f m)
fmap f (Union u) = Union (fmap f u)
(||>) :: (f x -> r)
-> (Union s x -> r)
-> (Union (f :> s) x -> r)
(||>) run _ (Single f) = run f
(||>) _ cont (Union r) = cont r
infixr 0 ||>
exhaust :: Nil x -> r
exhaust (Exhausted a) = exhaust a
simply :: (f a -> r) -> ((f |> Nil) a -> r)
simply f = f ||> exhaust
data MemberInfo f s where
Head :: MemberInfo f (f :> s)
Tail :: (f ∈ s) => MemberInfo f (g :> s)
class f ∈ s | s -> f where
query :: Proxy f -> Proxy s -> MemberInfo f s
infix 4 ∈
infix 4 ⊆
instance f ∈ (f :> s) where query _ _ = Head
instance (f ∈ s) => f ∈ (g :> s) where query _ _ = Tail
liftU :: forall s f a. (f ∈ s) => f a -> Union s a
liftU f = case query (Proxy :: Proxy f) (Proxy :: Proxy s) of
Head -> Single f
Tail -> Union (liftU f)
class s ⊆ t where
reunion :: Union s a -> Union t a
instance (f ∈ t, s ⊆ t) => (f :> s) ⊆ t where
reunion (Single f) = liftU f
reunion (Union s) = reunion s
instance Empty ⊆ t where
reunion = exhaust
type Member f s = f ∈ s
type Include s t = s ⊆ t