{-# LANGUAGE TypeOperators        #-}
{-# LANGUAGE TypeFamilies         #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE OverlappingInstances #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE StandaloneDeriving   #-}
{-# LANGUAGE TemplateHaskell      #-}
{-# LANGUAGE EmptyDataDecls       #-}

module Test where

import Control.Monad (liftM)

import Generics.Regular
import Generics.Regular.TH

data GRoseInt f = Leaf Int | Node (f (GRoseInt f))

deriving instance Show (GRoseInt [])

$(deriveConstructors ''GRoseInt)

gRoseInt1 = Leaf 3
gRoseInt2 = Node [Leaf 2, gRoseInt1]
gRoseInt3 = Node [Leaf 1, gRoseInt2]

type instance PF (GRoseInt f) = C Leaf (K Int) :+: C Node (f :.: I)

instance (Functor f, Regular1 f) => Regular (GRoseInt f) where
  from (Leaf i) = L (C (K i))
  from (Node l) = R . C . Comp . fmap I $ l
  to (L (C (K i)))    = Leaf i
  to (R (C (Comp l))) = Node . fmap unI $ l


data Matrix = M [[Int]] deriving Show

matrix1 = M [[1,2,3],[4,5,6],[7,8,9]]

$(deriveConstructors ''Matrix)

type instance PF Matrix = C M (([] :.: []) :.: (K Int))

instance Regular Matrix where
  from (M l) = C (Comp (Comp (map (map K) l)))
  to (C (Comp (Comp x))) = M (map (map unK) x)
  
data Nil
instance Constructor Nil where conName _ = "[]"
data Cons
instance Constructor Cons where conName _ = "(:)"

type instance PF1 [] = C Nil U :+: C Cons (I :*: [])  
instance Regular1 [] where
  from1 []    = L (C U)
  from1 (h:t) = R (C (I h :*: t))
  to1 (L (C U))           = []
  to1 (R (C (I h :*: t))) = h : t

{-------------------------------------------------------------------------------
-- Parametrized GRose
data GRose f a = Tip a | GRose (f (GRose a)) deriving Show

instance Regular (GRose f a) where
  type PF (GRose f a) = C (K a) :+: C ((PF1 f) :.: I)
  from (Tip x) = L (C "Tip" (K x))
  from (GRose l) = R (C "GRose" (Comp [I x | x <- l]))
  to (L (C _ (K x))) = Tip x
  to (R (C _ (Comp l))) = GRose [ x | (I x) <- l]
-------------------------------------------------------------------------------}

{-
-- Duplicate instance
instance Functor [] where
  fmap h = dft_map
-}

instance GMap [] where
  fmapM = dft_fmapM

instance GShow [] where
  gshowf = dft_gshowf

instance Zip [] where
  fzipM = dft_fzipM

instance Crush [] where
  crush = dft_crush

instance LR [] where
  leftf = dft_leftf
  rightf = dft_rightf


-- Examples
ex1 = gshow gRoseInt3 ""
ex2 = dft_fmapM Just [1..3]
ex3 = dft_crush (+) 0 [1..3]
ex4 = dft_leftf 1 :: [Int]
ex5 = dft_rightf 1 :: [Int]
ex6 = left :: GRoseInt []
ex7 = right :: GRoseInt []
ex8 = fold alg gRoseInt3 where
  --alg :: (Int -> Int, [Int] -> Int)
  alg = (const 1 & sum)