module Data.Semiring.Free
( Free(..)
, liftFree
, unFree
) where
import Control.Applicative (liftA2)
import Data.Coerce
import Data.Semiring
newtype Free a = Free
{ getFree :: [[a]]
} deriving (Show, Read, Functor, Foldable, Traversable, Monoid)
instance Semiring (Free a) where
Free xs <+> Free ys = Free (xs ++ ys)
Free xs <.> Free ys = Free (liftA2 (++) xs ys)
one = Free [[]]
zero = Free []
instance Applicative Free where
pure = Free . pure . pure
Free fs <*> Free xs = Free (liftA2 (<*>) fs xs)
liftFree :: Semiring s => (a -> s) -> Free a -> s
liftFree f = unFree . fmap f
unFree :: Semiring s => Free s -> s
unFree = getAdd .# foldMap (Add .# getMul .# foldMap Mul) . getFree
infixr 9 .#
(.#) :: Coercible b c => (b -> c) -> (a -> b) -> a -> c
(.#) _ = coerce