{-# 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            (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)

-- | 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

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

-- | 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