Expression.hs

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 pq (ClosedExpression fp) = ClosedExpression (fmap pq fp)
    fmap pq (OpenExpression a egp) = OpenExpression a (fmap (fmap pq) egp)

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

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

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

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

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