{-# 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 GRose f a b = Leaf b | Node a (f (GRose f a b))

deriving instance (Show a, Show b) => Show (GRose [] a b)

gRose1, gRose2, gRose3 :: GRose [] Char Int
gRose1 = Leaf 'p'
gRose2 = Node 1 [Leaf 'q', gRose1]
gRose3 = Node 2 [Leaf 'r', gRose2]

type instance PF (GRose f a b) = E (Succ Zero) :+: E Zero :*: (PF1 f :.: I)
{-
instance (Functor f, Regular1 f) => Regular (GRose f a b) where
  from (Leaf x)   = L (E (S (Z x)))
  from (Node x l) = R (E (Z x) :*: (Comp (fmap I l)))
  to (L (E (S (Z x))))          = Leaf x
  to (R (E (Z x) :*: (Comp l))) = Node x (fmap unI l)


data Matrix = M [[Int]] deriving Show

matrix1 = [[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 :: GRose []
ex7 = right :: GRose []
ex8 = fold alg gRoseInt3 where
  --alg :: (Int -> Int, [Int] -> Int)
  alg = (const 1 & sum)
-}