Free Alternative

gistfile1.hs

{-# LANGUAGE DeriveFunctor, FlexibleInstances #-}
{-# OPTIONS -Wall #-}
import Control.Monad.Free
import Control.Applicative

data SomeF f a = Many [a] | One (f a) deriving Functor

instance Functor f => Alternative (Free (SomeF f)) where
    empty = Free (Many [])

    (Free (Many [])) <|> a = a
    a <|> (Free (Many [])) = a
    (Free (Many as)) <|> (Free (Many bs)) = Free $ Many $ as ++ bs
    a <|> (Free (Many bs)) = Free $ Many $ a : bs
    (Free (Many as)) <|> b = Free $ Many $ as ++ [b]
    a <|> b = Free $ Many [a, b]

liftFA :: Functor f => f a -> Free (SomeF f) a
liftFA = liftF . One