{-# LANGUAGE AllowAmbiguousTypes   #-}
{-# LANGUAGE DeriveAnyClass        #-}
{-# LANGUAGE DeriveFoldable        #-}
{-# LANGUAGE DeriveFunctor         #-}
{-# LANGUAGE DeriveGeneric         #-}
{-# LANGUAGE DeriveTraversable     #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TemplateHaskell       #-}
{-# LANGUAGE TypeFamilies          #-}

module Data.Functor.Foldable.Examples ( Bert (..)
                                      , Ernie (..)
                                      , BertF (..)
                                      , ErnieF (..)
                                      , collapseErnieSyntaxTree
                                      , collapseErnieSyntaxTree'
                                      , collapseBertSyntaxTree
                                      , collapseBertSyntaxTree'
                                      ) where

import           Control.DeepSeq                     (NFData)
import           Data.Functor.Foldable
import           Data.Functor.Foldable.Extensions
import           Data.Functor.Foldable.Extensions.TH
import           Data.Functor.Foldable.TH
import           GHC.Generics                        (Generic)

-- | We call our co-dependent data types 'Ernie' and 'Bert'. They represent mutually recursive
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)

-- want: entangleBaseFunctors function to do this automatically!

makeBaseFunctor ''Ernie
makeBaseFunctor ''Bert

-- TODO default/dummy? Also infer dummy from applicative + dummy underlying type

instance Dummy Bert where
    dummy = Num 3

instance Dummy Ernie where
    dummy = Ernie dummy

entanglePair ''Ernie ''Bert
entanglePair ''Bert ''Ernie

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

-- | Dendromorphism collapsing the tree.
collapseErnieSyntaxTree :: (Recursive Ernie) => Ernie -> Ernie
collapseErnieSyntaxTree = dendro (dummy :: Bert) bertAlgebra ernieAlgebra

-- | We get two dendromorphisms for the price of one!
collapseBertSyntaxTree :: (Recursive Bert) => Bert -> Bert
collapseBertSyntaxTree = dendro (dummy :: Ernie) ernieAlgebra bertAlgebra

-- | Catamorphism, which collapses the tree, but not very well.
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

-- | Another catamorphism that is stupid and lame.
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