module Data.Functor.Foldable.Examples ( Bert (..)
, Ernie (..)
, BertF (..)
, ErnieF (..)
, collapseErnieSyntaxTree
, collapseErnieSyntaxTree'
, collapseBertSyntaxTree
, collapseBertSyntaxTree'
) where
import Control.DeepSeq (NFData)
import Data.Functor.Foldable (Recursive, cata, embed)
import Data.Functor.Foldable.Extensions (Dummy (dummy), SubHom (homo),
SubType (switch), dendro)
import Data.Functor.Foldable.TH (makeBaseFunctor)
import GHC.Generics (Generic)
data Bert = Bert Ernie
| Num Integer
| String String
| Add Bert Bert
deriving (Show, Eq, Generic, NFData)
data Ernie = Ernie Bert
| Multiply Ernie Ernie
| List [Ernie]
deriving (Show, Eq, Generic, NFData)
makeBaseFunctor ''Ernie
makeBaseFunctor ''Bert
instance Dummy Bert where
dummy = Num 3
instance Dummy Ernie where
dummy = Ernie dummy
instance SubHom ErnieF BertF Ernie Bert where
homo ea alberta (BertF e) = Bert $ dendro (dummy :: Bert) alberta ea e
homo _ f b = f b
instance SubType Bert where
switch (Bert (Ernie b)) = b
switch x = x
instance SubHom BertF ErnieF Bert Ernie where
homo alberta ea (ErnieF b) = Ernie $ dendro (dummy :: Ernie) ea alberta b
homo _ f e = f e
instance SubType Ernie where
switch (Ernie (Bert e)) = e
switch x = x
bertAlgebra :: BertF Bert -> Bert
bertAlgebra (AddF (Num i) (Num j)) = Num $ i + j
bertAlgebra x = embed x
ernieAlgebra :: ErnieF Ernie -> Ernie
ernieAlgebra (ErnieF (Bert e)) = e
ernieAlgebra (MultiplyF (Ernie (Num i)) (Ernie (Num j))) = Ernie . Num $ i * j
ernieAlgebra x = embed x
collapseErnieSyntaxTree :: (Recursive Ernie) => Ernie -> Ernie
collapseErnieSyntaxTree = dendro (dummy :: Bert) bertAlgebra ernieAlgebra
collapseBertSyntaxTree :: (Recursive Bert) => Bert -> Bert
collapseBertSyntaxTree = dendro (dummy :: Ernie) ernieAlgebra bertAlgebra
collapseErnieSyntaxTree' :: (Recursive Ernie) => Ernie -> Ernie
collapseErnieSyntaxTree' = cata algebra
where algebra (ErnieF e) = Ernie $ collapseBertSyntaxTree' e
algebra (MultiplyF (Ernie (Num i)) (Ernie (Num j))) = Ernie . Num $ i * j
algebra x = embed x
collapseBertSyntaxTree' :: (Recursive Bert) => Bert -> Bert
collapseBertSyntaxTree' = cata algebra
where algebra (BertF e) = Bert $ collapseErnieSyntaxTree' e
algebra (AddF (Num i) (Num j)) = Num $ i + j
algebra x = embed x