multirec-alt-deriver-0.1.1: examples/Tree.hs

{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
module Tree where

import Generics.MultiRec
import Generics.MultiRec.TH.Alt
import Data.Tree
    
-- data HRPF r ix where
--     CaseTree :: CaseTree r -> HRPF r (Tree Int)
--     CaseForest :: CaseForest r -> HRPF r (Forest Int)

data family HRPF (phi :: (* -> *)) (r :: (* -> *)) ix :: *

class HasHRPF (phi :: * -> *) where
    to :: phi ix -> HRPF phi I0 ix -> ix
    from :: phi ix -> ix -> HRPF phi I0 ix

data instance HRPF TheFam r (Tree Int) =
    CaseNode Int (r (Forest Int))

data instance HRPF TheFam r (Forest Int) = 
      CaseNil
    | CaseCons (r (Tree Int)) (r (Forest Int))

instance HasHRPF TheFam where
    to Tree_Int (CaseNode i (I0 f)) = Node i f
    to Forest_Int CaseNil = []
    to Forest_Int (CaseCons (I0 u) (I0 v)) = u:v

    from Tree_Int (Node i f) = CaseNode i (I0 f)
    from Forest_Int [] = CaseNil
    from Forest_Int (u:v) = CaseCons (I0 u) (I0 v)
                                               

-- from :: TheFam ix -> ix -> HRPF I0 ix
-- from (Node i f) = CaseTree (CaseNode 

data TheFam :: (* -> *) where
              Tree_Int   :: TheFam   (Tree Int)
              Forest_Int :: TheFam (Forest Int)
              Pair       :: TheFam (Tree Int, Tree Int)
                           
-- $(deriveEverything
--   (DerivOptions
--    [ ( [t| Tree   Int |]          , "Tree_Int" )
--    , ( [t| Forest Int |]          , "Forest_Int" )
--    , ( [t| (Tree Int, Tree Int) |], "Pair" )
--    ]
--    "TheFam"
--    (\t c -> "CONSTRUCTOR_" ++ t ++ "_" ++ c)
--    "ThePF"
--    True
--   )
--  )

-- type instance PF TheFam = ThePF