git.iko.soy/compaREST
on dcaeb7b help sign in
compaREST/src/Data/OpenUnion/Extra.hs
43 lines 1.2 kB history raw
1module Data.OpenUnion.Extra
2 ( (@@>)
3 , TryLiftUnion (..)
4 , pattern SingletonUnion
5 )
6where
8import Control.Applicative
9import Data.Dynamic
10import Data.OpenUnion.Internal
11import Data.Typeable
12import TypeFun.Data.List hiding (Union)
14class TryLiftUnion xs where
15 tryLiftUnion :: (Alternative m, Typeable x) => x -> m (Union xs)
17instance TryLiftUnion '[] where
18 tryLiftUnion _ = empty
20instance
21 (Typeable y, SubList ys (y : ys), TryLiftUnion ys)
22 => TryLiftUnion (y ': ys)
23 where
24 tryLiftUnion (x :: x) = case eqT @x @y of
25 Nothing -> reUnion <$> tryLiftUnion @ys x
26 Just Refl -> pure $ liftUnion x
28-- | Like '@>', but enforces a specific type list order.
29-- (Useful for deconstruction-directed type inference.)
30(@@>) :: Typeable a => (a -> b) -> (Union xs -> b) -> Union (a ': xs) -> b
31r @@> l = either l r . restrict'
32 where
33 restrict' :: Typeable a => Union (a ': aa) -> Either (Union aa) a
34 restrict' (Union d) = maybe (Left $ Union d) Right $ fromDynamic d
35{-# INLINE (@@>) #-}
37infixr 2 @@>
39pattern SingletonUnion :: (Typeable a, Elem a s) => a -> Union s
40pattern SingletonUnion x <-
41 ((\(Union y) -> fromDynamic y) -> Just x)
42 where
43 SingletonUnion x = liftUnion x