module Data.Expression
    ( Expression(..)
    , expressionSym
    , runValueExpression
    , runMatchExpression
    ) where

data Expression a g f r
    = ClosedExpression (f r)
    | OpenExpression a
                     (Expression a g f (g r))

instance (Functor f, Functor g) => Functor (Expression a g f) where
    fmap :: forall a b. (a -> b) -> Expression a g f a -> Expression a g f b
fmap a -> b
pq (ClosedExpression f a
fp) = f b -> Expression a g f b
forall a (g :: * -> *) (f :: * -> *) r. f r -> Expression a g f r
ClosedExpression ((a -> b) -> f a -> f b
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
pq f a
fp)
    fmap a -> b
pq (OpenExpression a
a Expression a g f (g a)
egp) = a -> Expression a g f (g b) -> Expression a g f b
forall a (g :: * -> *) (f :: * -> *) r.
a -> Expression a g f (g r) -> Expression a g f r
OpenExpression a
a ((g a -> g b) -> Expression a g f (g a) -> Expression a g f (g b)
forall a b. (a -> b) -> Expression a g f a -> Expression a g f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> g a -> g b
forall a b. (a -> b) -> g a -> g b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
pq) Expression a g f (g a)
egp)

ffmap :: (Applicative f, Functor g) => f (p -> q) -> Expression a g f p -> Expression a g f q
ffmap :: forall (f :: * -> *) (g :: * -> *) p q a.
(Applicative f, Functor g) =>
f (p -> q) -> Expression a g f p -> Expression a g f q
ffmap f (p -> q)
fpq (ClosedExpression f p
fp) = f q -> Expression a g f q
forall a (g :: * -> *) (f :: * -> *) r. f r -> Expression a g f r
ClosedExpression (f (p -> q)
fpq f (p -> q) -> f p -> f q
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f p
fp)
ffmap f (p -> q)
fpq (OpenExpression a
a Expression a g f (g p)
ebp) = a -> Expression a g f (g q) -> Expression a g f q
forall a (g :: * -> *) (f :: * -> *) r.
a -> Expression a g f (g r) -> Expression a g f r
OpenExpression a
a (f (g p -> g q) -> Expression a g f (g p) -> Expression a g f (g q)
forall (f :: * -> *) (g :: * -> *) p q a.
(Applicative f, Functor g) =>
f (p -> q) -> Expression a g f p -> Expression a g f q
ffmap (((p -> q) -> g p -> g q) -> f (p -> q) -> f (g p -> g q)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (p -> q) -> g p -> g q
forall a b. (a -> b) -> g a -> g b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f (p -> q)
fpq) Expression a g f (g p)
ebp)

instance (Applicative f, Functor g) => Applicative (Expression a g f) where
    pure :: forall a. a -> Expression a g f a
pure a
t = f a -> Expression a g f a
forall a (g :: * -> *) (f :: * -> *) r. f r -> Expression a g f r
ClosedExpression (a -> f a
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
t)
    (ClosedExpression f (a -> b)
fpq) <*> :: forall a b.
Expression a g f (a -> b)
-> Expression a g f a -> Expression a g f b
<*> Expression a g f a
ep = f (a -> b) -> Expression a g f a -> Expression a g f b
forall (f :: * -> *) (g :: * -> *) p q a.
(Applicative f, Functor g) =>
f (p -> q) -> Expression a g f p -> Expression a g f q
ffmap f (a -> b)
fpq Expression a g f a
ep
    (OpenExpression a
a Expression a g f (g (a -> b))
egpq) <*> Expression a g f a
ep = a -> Expression a g f (g b) -> Expression a g f b
forall a (g :: * -> *) (f :: * -> *) r.
a -> Expression a g f (g r) -> Expression a g f r
OpenExpression a
a ((\a
p -> ((a -> b) -> b) -> g (a -> b) -> g b
forall a b. (a -> b) -> g a -> g b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a -> b
pq -> a -> b
pq a
p)) (a -> g (a -> b) -> g b)
-> Expression a g f a -> Expression a g f (g (a -> b) -> g b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expression a g f a
ep Expression a g f (g (a -> b) -> g b)
-> Expression a g f (g (a -> b)) -> Expression a g f (g b)
forall a b.
Expression a g f (a -> b)
-> Expression a g f a -> Expression a g f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expression a g f (g (a -> b))
egpq)

expressionSym :: a -> f (g r) -> Expression a g f r
expressionSym :: forall a (f :: * -> *) (g :: * -> *) r.
a -> f (g r) -> Expression a g f r
expressionSym a
a f (g r)
fbr = a -> Expression a g f (g r) -> Expression a g f r
forall a (g :: * -> *) (f :: * -> *) r.
a -> Expression a g f (g r) -> Expression a g f r
OpenExpression a
a (f (g r) -> Expression a g f (g r)
forall a (g :: * -> *) (f :: * -> *) r. f r -> Expression a g f r
ClosedExpression f (g r)
fbr)

runValueExpression :: (Functor f) => Expression a ((->) b) f r -> f ((a -> b) -> r)
runValueExpression :: forall (f :: * -> *) a b r.
Functor f =>
Expression a ((->) b) f r -> f ((a -> b) -> r)
runValueExpression (ClosedExpression f r
fr) = (r -> (a -> b) -> r) -> f r -> f ((a -> b) -> r)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\r
r a -> b
_ab -> r
r) f r
fr
runValueExpression (OpenExpression a
a0 Expression a ((->) b) f (b -> r)
ebr) = (((a -> b) -> b -> r) -> (a -> b) -> r)
-> f ((a -> b) -> b -> r) -> f ((a -> b) -> r)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(a -> b) -> b -> r
abbr a -> b
ab -> (a -> b) -> b -> r
abbr a -> b
ab (a -> b
ab a
a0)) (Expression a ((->) b) f (b -> r) -> f ((a -> b) -> b -> r)
forall (f :: * -> *) a b r.
Functor f =>
Expression a ((->) b) f r -> f ((a -> b) -> r)
runValueExpression Expression a ((->) b) f (b -> r)
ebr)

runMatchExpression :: (Functor f) => Expression a ((,) b) f r -> f ([(a, b)], r)
runMatchExpression :: forall (f :: * -> *) a b r.
Functor f =>
Expression a ((,) b) f r -> f ([(a, b)], r)
runMatchExpression (ClosedExpression f r
fr) = (r -> ([(a, b)], r)) -> f r -> f ([(a, b)], r)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\r
r -> ([], r
r)) f r
fr
runMatchExpression (OpenExpression a
a Expression a ((,) b) f (b, r)
ebr) = (([(a, b)], (b, r)) -> ([(a, b)], r))
-> f ([(a, b)], (b, r)) -> f ([(a, b)], r)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\([(a, b)]
ab, (b
b, r
r)) -> ((a
a, b
b) (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
: [(a, b)]
ab, r
r)) (Expression a ((,) b) f (b, r) -> f ([(a, b)], (b, r))
forall (f :: * -> *) a b r.
Functor f =>
Expression a ((,) b) f r -> f ([(a, b)], r)
runMatchExpression Expression a ((,) b) f (b, r)
ebr)