{-# OPTIONS -fglasgow-exts #-}
{-# OPTIONS -fallow-overlapping-instances #-}
{-# OPTIONS -fallow-undecidable-instances #-}
module Union where

infixr :|:
data a :|: b = West a | East b

instance (Show a, Show b) => Show (a :|: b) where
    showsPrec p (West a) = showsPrec p a
    showsPrec p (East a) = showsPrec p a

class Union u a where
    inj          :: a -> u
    prj          :: u -> Maybe a
instance Union (a :|: u) a where
    inj           = West
    prj (West a)  = Just a
    prj _         = Nothing
instance Union u a => Union (c :|: u) a where
    inj           = East . inj
    prj (East a)  = prj a
    prj _         = Nothing

-- interesting base case -- allowed re-injection from subtypes:
instance Union (u :|: a) a where
    inj           = East
    prj (East a)  = Just a
    prj _         = Nothing

type Foo = Char :|: String :|: ()

a, b :: Foo
a     = inj 'a'
b     = inj "b"

type BoolT a = (Maybe Bool) :|: Bool :|: a

c, d, e :: BoolT Foo
c        = inj 'c'
d        = inj True
e        = inj (Just False)

mapU f l = map f' l where
  f' x = case prj x of
    Nothing -> x
    Just a  -> inj (f a)

l1 = [c, d, e, inj b, inj a]
l2 = mapU (++"oo") l1
l3 = mapU not l2
l4 = mapU (:"oo") l3