{-# LANGUAGE TypeFamilies             #-}
{-# LANGUAGE TypeOperators            #-}
{-# LANGUAGE FlexibleInstances        #-}
{-# LANGUAGE MultiParamTypeClasses    #-}
{-# LANGUAGE EmptyDataDecls           #-}
{-# LANGUAGE TemplateHaskell          #-}
{-# LANGUAGE OverlappingInstances     #-}

import Generics.Instant
import Generics.Instant.TH
import Generics.Instant.Functions
import Prelude hiding (Eq, Show(..))
import qualified Prelude as P (Show(..))

-------------------------------------------------------------------------------
-- Simple Datatype
-------------------------------------------------------------------------------

-- Example datatype
data Exp = Const Int | Plus Exp Exp

data Const
data Plus

instance Constructor Const where conName _ = "Const"
instance Constructor Plus  where conName _ = "Plus"

-- Representable instance
instance Representable Exp where
  type Rep Exp = C Const (Var Int) :+: C Plus (Rec Exp :*: Rec Exp)

  from (Const n)   = L (C (Var n))
  from (Plus e e') = R (C (Rec e :*: Rec e'))

  to (L (C (Var n)))            = Const n
  to (R (C (Rec e :*: Rec e'))) = Plus e e'

exp1 = Plus (Const 1) (Const 2)
exp2 = Plus exp1 (Const 3)

instance Eq Exp where eq' = eq

testExp1 :: (Bool, Bool)
testExp1 = (eq exp2 exp2, eq exp1 exp2)

instance Empty Exp where empty' = empty

testExp2 :: Exp
testExp2 = empty

instance Show Exp where show' = show
instance P.Show Exp where show = show -- convenience

testExp3 :: String
testExp3 = show exp2
{-
instance Update Exp where update' = update
instance MapOn Int where mapOn = (+1)

testExp4 :: Exp
testExp4 = update exp2
-}
-------------------------------------------------------------------------------
-- Mutually recursive datatypes
-------------------------------------------------------------------------------

data Decl = None | Seq Decl Decl | Assign String Expr

data Expr = V String | Lam String Expr | App Expr Expr | Let Decl Expr
{-
data None
data Seq
data Assign
data V
data Lam
data App
data Let

instance Constructor None   where conName _ = "None"
instance Constructor Seq    where conName _ = "Seq"
instance Constructor Assign where conName _ = "Assign"
instance Constructor V      where conName _ = "V"
instance Constructor Lam    where conName _ = "Lam"
instance Constructor App    where conName _ = "App"
instance Constructor Let    where conName _ = "Let"

instance Representable Decl where
  type Rep Decl =    C None U 
                 :+: C Seq (Rec Decl :*: Rec Decl)
                 :+: C Assign (Var String :*: Rec Expr)

  from None         = L (C U)
  from (Seq d1 d2)  = R (L (C (Rec d1 :*: Rec d2)))
  from (Assign v e) = R (R (C (Var v :*: Rec e)))

  to (L (C U))                       = None
  to (R (L (C (Rec d1 :*: Rec d2)))) = Seq d1 d2
  to (R (R (C (Var v :*: Rec e))))   = Assign v e

instance Representable Expr where
  type Rep Expr =    C V (Var String)
                 :+: C Lam (Var String :*: Rec Expr)
                 :+: C App (Rec Expr :*: Rec Expr)
                 :+: C Let (Rec Decl :*: Rec Expr)

  from (V x)     = L (C (Var x))
  from (Lam v e) = R (L (C (Var v :*: Rec e)))
  from (App f e) = R (R (L (C (Rec f :*: Rec e))))
  from (Let d e) = R (R (R (C (Rec d :*: Rec e))))

  to (L (C (Var x)))                   = V x
  to (R (L (C (Var v :*: Rec e))))     = Lam v e
  to (R (R (L (C (Rec f :*: Rec e))))) = App f e
  to (R (R (R (C (Rec d :*: Rec e))))) = Let d e
-}

-- Using TH instead
$(deriveAll ''Decl)
$(deriveAll ''Expr)


decls = Seq (Assign "x" (Lam "z" (V "z"))) (Assign "y" (V "x"))
expr  = Let decls (App (V "x") (V "y"))

instance Show Expr where show' = show
instance Show Decl where show' = show
instance P.Show Expr where show = show -- convenience
instance P.Show Decl where show = show -- convenience

testAST1 :: String
testAST1 = show expr

instance Empty Expr where empty' = empty
instance Empty Decl where empty' = empty

testAST2 :: Expr
testAST2 = empty

testAST3 :: Decl
testAST3 = empty

instance Eq Expr where eq' = eq
instance Eq Decl where eq' = eq

testAST4 :: Bool
testAST4 = eq expr expr
{-
instance Update Decl where update' = update
instance Update Expr where update' = update
instance MapOn [Char] where mapOn _ = "a"

testAST5 :: Decl
testAST5 = update decls

testAST6 :: Expr
testAST6 = update expr
-}