{-# LANGUAGE UndecidableInstances #-}
module Data.TypedStruct where
import Control.Monad.Identity
data Struct pred con a
where
Single :: pred a => con a -> Struct pred con a
Two :: Struct pred con a -> Struct pred con b -> Struct pred con (a,b)
toStruct :: Struct p c a -> a -> Struct p Identity a
toStruct rep = go rep . Identity
where
go :: Struct p c a -> Identity a -> Struct p Identity a
go (Single _) i = Single i
go (Two ra rb) (Identity (a,b)) =
Two (go ra (Identity a)) (go rb (Identity b))
extractSingle :: pred a => Struct pred c a -> c a
extractSingle (Single a) = a
mapStruct :: forall pred c1 c2 b
. (forall a . pred a => c1 a -> c2 a)
-> Struct pred c1 b
-> Struct pred c2 b
mapStruct f = go
where
go :: Struct pred c1 a -> Struct pred c2 a
go (Single a) = Single (f a)
go (Two a b) = Two (go a) (go b)
mapStructA :: forall m pred c1 c2 b . Applicative m
=> (forall a . pred a => c1 a -> m (c2 a))
-> Struct pred c1 b -> m (Struct pred c2 b)
mapStructA f = go
where
go :: Struct pred c1 a -> m (Struct pred c2 a)
go (Single a) = Single <$> (f a)
go (Two a b) = Two <$> go a <*> go b
mapStructA_ :: forall m pred cont b . Applicative m =>
(forall a . pred a => cont a -> m ()) -> Struct pred cont b -> m ()
mapStructA_ f = go
where
go :: Struct pred cont a -> m ()
go (Single a) = f a
go (Two a b) = go a *> go b
listStruct :: forall pred cont b c .
(forall y . pred y => cont y -> c) -> Struct pred cont b -> [c]
listStruct f = go
where
go :: Struct pred cont a -> [c]
go (Single a) = [f a]
go (Two a b) = go a ++ go b
zipStruct :: forall pred c1 c2 c3 b
. (forall a . pred a => c1 a -> c2 a -> c3 a)
-> Struct pred c1 b
-> Struct pred c2 b
-> Struct pred c3 b
zipStruct f = go
where
go :: Struct pred c1 a -> Struct pred c2 a -> Struct pred c3 a
go (Single a) (Single b) = Single (f a b)
go (Two a b) (Two c d) = Two (go a c) (go b d)
zipListStruct :: forall pred c1 c2 b r
. (forall a . pred a => c1 a -> c2 a -> r)
-> Struct pred c1 b
-> Struct pred c2 b
-> [r]
zipListStruct f = go
where
go :: Struct pred c1 a -> Struct pred c2 a -> [r]
go (Single a) (Single b) = [f a b]
go (Two a b) (Two c d) = go a c ++ go b d
compareStruct :: forall pred c1 c2 c d
. (forall a b . (pred a, pred b) => c1 a -> c2 b -> Bool)
-> Struct pred c1 c
-> Struct pred c2 d
-> Bool
compareStruct f = go
where
go :: Struct pred c1 a -> Struct pred c2 b -> Bool
go (Single a) (Single b) = f a b
go (Two a b) (Two c d) = go a c && go b d
liftStruct :: (pred a, pred b) =>
(con a -> con b) -> Struct pred con a -> Struct pred con b
liftStruct f (Single a) = Single (f a)
liftStruct2 :: (pred a, pred b, pred c)
=> (con a -> con b -> con c)
-> Struct pred con a -> Struct pred con b -> Struct pred con c
liftStruct2 f (Single a) (Single b) = Single (f a b)