{-# LANGUAGE OverlappingInstances #-}

-- |This module provides an open union of functors.
module Data.Union 
( Union
, Member
, inj
, prj
, decomp
, trivial
) where

import Data.Maybe
import Data.Typeable
import Unsafe.Coerce (unsafeCoerce)

-- |`Union` is an open sum of functors
-- A value of type `Union` r a is a value f a for some f that is a member of the r list
-- Since direct construction is not safe you have to use `inj` to create a value.
data Union (r :: [* -> *]) (a :: *) where
  Union :: (Functor f, Typeable f) => f a -> Union r a

instance Functor (Union r) where
  fmap f (Union fa) = Union (fmap f fa)

-- |The `Member` type clas denotes that f is a member of type list r
class Member (f :: * -> *) (r :: [* -> *]) where
instance Member h (h ': t)
instance (Member x t) => Member x (h ': t)

-- |Smart constructor for `Union`. Injects the functor into any union
-- of which the said functor is a member. Please note that only the 
-- type constructor need be a `Typeable`.
inj :: (Typeable f, Functor f, Member f r) => f a -> Union r a
inj = Union 

-- |Project a `Union` into a specific functor.
prj :: (Typeable f, Member f r) => Union r a -> Maybe (f a)
prj (Union d) = res where
  availableType = typeOf1 d
  wantedType = typeOf1 $ fromJust res
  res = if availableType == wantedType
        then Just $ unsafeCoerce d
        else Nothing

-- |Decompose a `Union`. Similar to `prj` but gives you a
-- `Union` instance without the functor f in type if projection fails.
decomp :: (Typeable f) => Union (f ': r) a -> Either (f a) (Union r a)
decomp u@(Union d) = maybe (Right $ Union d) Left $ prj u

-- |A `Union` of one functor can only be that. Safe cast.
trivial :: (Typeable f) => Union '[f] a -> f a
trivial = fromJust . prj