countable-1.0: src/Data/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);
}