{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

#if __GLASGOW_HASKELL__ >= 705
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PolyKinds #-}
#endif

{-# OPTIONS_GHC -fno-warn-orphans #-}

module ExampleSpec (main, spec) where

import           Generics.Deriving
import           Generics.Deriving.TH

import           GHC.Exts (Addr#, Char#, Double#, Float#, Int#, Word#)

import           Prelude hiding (Either(..))

import           Test.Hspec (Spec, describe, hspec, it, parallel, shouldBe)

import qualified Text.Read.Lex (Lexeme)

-------------------------------------------------------------------------------
-- Example: Haskell's lists and Maybe
-------------------------------------------------------------------------------

hList:: [Int]
hList = [1..10]

maybe1, maybe2 :: Maybe (Maybe Char)
maybe1 = Nothing
maybe2 = Just (Just 'p')

double :: [Int] -> [Int]
double []     = []
double (x:xs) = x:x:xs

-------------------------------------------------------------------------------
-- Example: trees of integers (kind *)
-------------------------------------------------------------------------------

data Tree = Empty | Branch Int Tree Tree

$(deriveAll0 ''Tree)

instance GShow Tree where
    gshowsPrec = gshowsPrecdefault

instance Uniplate Tree where
  children   = childrendefault
  context    = contextdefault
  descend    = descenddefault
  descendM   = descendMdefault
  transform  = transformdefault
  transformM = transformMdefault

instance GEnum Tree where
    genum = genumDefault

upgradeTree :: Tree -> Tree
upgradeTree Empty          = Branch 0 Empty Empty
upgradeTree (Branch n l r) = Branch (succ n) l r

tree :: Tree
tree = Branch 2 Empty (Branch 1 Empty Empty)

-------------------------------------------------------------------------------
-- Example: lists (kind * -> *)
-------------------------------------------------------------------------------

data List a = Nil | Cons a (List a)

$(deriveAll0And1 ''List)

instance GFunctor List where
  gmap = gmapdefault

instance (GShow a) => GShow (List a) where
  gshowsPrec = gshowsPrecdefault

instance (Uniplate a) => Uniplate (List a) where
  children   = childrendefault
  context    = contextdefault
  descend    = descenddefault
  descendM   = descendMdefault
  transform  = transformdefault
  transformM = transformMdefault

list :: List Char
list = Cons 'p' (Cons 'q' Nil)

listlist :: List (List Char)
listlist = Cons list (Cons Nil Nil) -- ["pq",""]

-------------------------------------------------------------------------------
-- Example: Type composition
-------------------------------------------------------------------------------

data Rose a = Rose [a] [Rose a]

$(deriveAll0And1 ''Rose)

instance (GShow a) => GShow (Rose a) where
  gshowsPrec = gshowsPrecdefault

instance GFunctor Rose where
  gmap = gmapdefault

-- Example usage
rose1 :: Rose Int
rose1 = Rose [1,2] [Rose [3,4] [], Rose [5] []]

-------------------------------------------------------------------------------
-- Example: Higher-order kinded datatype, type composition
-------------------------------------------------------------------------------

data GRose f a = GRose (f a) (f (GRose f a))
deriving instance Functor f => Functor (GRose f)

$(deriveMeta           ''GRose)
$(deriveRepresentable0 ''GRose)
$(deriveRep1           ''GRose)
instance Functor f => Generic1 (GRose f) where
  type Rep1 (GRose f) = $(makeRep1 ''GRose) f
  from1 = $(makeFrom1 ''GRose)
  to1   = $(makeTo1 ''GRose)

instance (GShow (f a), GShow (f (GRose f a))) => GShow (GRose f a) where
  gshowsPrec = gshowsPrecdefault

instance (Functor f, GFunctor f) => GFunctor (GRose f) where
  gmap = gmapdefault

grose1 :: GRose [] Int
grose1 = GRose [1,2] [GRose [3] [], GRose [] []]

-------------------------------------------------------------------------------
-- Example: Two parameters, nested on other parameter
-------------------------------------------------------------------------------

data Either a b = Left (Either [a] b) | Right b

$(deriveAll0And1 ''Either)

instance (GShow a, GShow b) => GShow (Either a b) where
  gshowsPrec = gshowsPrecdefault

instance GFunctor (Either a) where
  gmap = gmapdefault

either1 :: Either Int Char
either1 = Left either2

either2 :: Either [Int] Char
either2 = Right 'p'

-------------------------------------------------------------------------------
-- Example: Nested datatype, record selectors
-------------------------------------------------------------------------------

data Nested a = Leaf | Nested { value :: a, rec :: Nested [a] }
  deriving Functor

$(deriveAll0And1 ''Nested)

instance (GShow a) => GShow (Nested a) where
  gshowsPrec = gshowsPrecdefault

instance GFunctor Nested where
  gmap = gmapdefault

nested :: Nested Int
nested = Nested { value = 1, rec = Nested [2] (Nested [[3],[4,5],[]] Leaf) }

-------------------------------------------------------------------------------
-- Example: Nested datatype Bush (minimal)
-------------------------------------------------------------------------------

data Bush a = BushNil | BushCons a (Bush (Bush a)) deriving Functor

$(deriveAll0And1 ''Bush)

instance GFunctor Bush where
  gmap = gmapdefault

instance (GShow a) => GShow (Bush a) where
  gshowsPrec = gshowsPrecdefault

bush1 :: Bush Int
bush1 = BushCons 0 (BushCons (BushCons 1 BushNil) BushNil)

-------------------------------------------------------------------------------
-- Example: Double type composition (minimal)
-------------------------------------------------------------------------------

data Weird a = Weird [[[a]]] deriving Show

$(deriveAll0And1 ''Weird)

instance GFunctor Weird where
  gmap = gmapdefault

--------------------------------------------------------------------------------
-- Temporary tests for TH generation
--------------------------------------------------------------------------------

data Empty a

data (:/:) f a = MyType1Nil
               | MyType1Cons { _myType1Rec :: (f :/: a), _myType2Rec :: MyType2 }
               | MyType1Cons2 (f :/: a) Int a (f a)
               | (f :/: a) :/: MyType2

infixr 5 :!@!:
data GADTSyntax a b where
  GADTPrefix :: d -> c -> GADTSyntax c d
  (:!@!:)    :: e -> f -> GADTSyntax e f

data MyType2 = MyType2 Float ([] :/: Int)
data PlainHash a = Hash a Addr# Char# Double# Float# Int# Word#

-- Test to see if generated names are unique
data Lexeme = Lexeme

#if MIN_VERSION_template_haskell(2,7,0)
data family MyType3
# if __GLASGOW_HASKELL__ >= 705
  (a :: v) (b :: w) (c :: x)      (d :: y) (e :: z)
# else
  (a :: *) (b :: *) (c :: * -> *) (d :: *) (e :: *)
# endif
newtype instance MyType3 (f p) (f p) f p (q :: *) = MyType3Newtype q
data    instance MyType3 Bool  ()    f p q        = MyType3True | MyType3False
data    instance MyType3 Int   ()    f p (q :: *) = MyType3Hash q Addr# Char# Double# Float# Int# Word#
#endif

$(deriveAll0And1 ''Empty)
$(deriveAll0And1 ''(:/:))
$(deriveAll0And1 ''GADTSyntax)
$(deriveAll0     ''MyType2)
$(deriveAll0And1 ''PlainHash)
$(deriveAll0     ''ExampleSpec.Lexeme)
$(deriveAll0     ''Text.Read.Lex.Lexeme)

#if MIN_VERSION_template_haskell(2,7,0)
# if __GLASGOW_HASKELL__ < 705
-- We can't use deriveAll0And1 on GHC 7.4 due to an old bug :(
$(deriveMeta 'MyType3Newtype)
$(deriveRep0 'MyType3Newtype)
$(deriveRep1 'MyType3Newtype)
instance Generic (MyType3 (f p) (f p) f p q) where
    type Rep (MyType3 (f p) (f p) f p q) = $(makeRep0 'MyType3Newtype) f p q
    from = $(makeFrom0 'MyType3Newtype)
    to   = $(makeTo0 'MyType3Newtype)
instance Generic1 (MyType3 (f p) (f p) f p) where
    type Rep1 (MyType3 (f p) (f p) f p) = $(makeRep1 'MyType3Newtype) f p
    from1 = $(makeFrom1 'MyType3Newtype)
    to1   = $(makeTo1 'MyType3Newtype)
# else
$(deriveAll0And1 'MyType3Newtype)
# endif
$(deriveAll0And1 'MyType3False)
$(deriveAll0And1 'MyType3Hash)
#endif

-------------------------------------------------------------------------------
-- Unit tests
-------------------------------------------------------------------------------

main :: IO ()
main = hspec spec

spec :: Spec
spec = parallel $ do
    describe "[] and Maybe tests" $ do
        it "gshow hList" $
            gshow hList `shouldBe`
                "[1,2,3,4,5,6,7,8,9,10]"

        it "gshow (children maybe2)" $
            gshow (children maybe2) `shouldBe`
                "[]"

        it "gshow (transform (const \"abc\") [])" $
            gshow (transform (const "abc") []) `shouldBe`
                "\"abc\""

        it "gshow (transform double hList)" $
            gshow (transform double hList) `shouldBe`
                "[1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8,9,9,10,10]"

        it "gshow (geq hList hList)" $
            gshow (geq hList hList) `shouldBe`
                "True"

        it "gshow (geq maybe1 maybe2)" $
            gshow (geq maybe1 maybe2) `shouldBe`
                "False"

        it "gshow (take 5 genum)" $
            gshow (take 5 (genum :: [Maybe Int])) `shouldBe`
                "[Nothing,Just 0,Just -1,Just 1,Just -2]"

        it "gshow (take 15 genum)" $
            gshow (take 15 (genum :: [[Int]])) `shouldBe`
                "[[],[0],[0,0],[-1],[0,0,0],[-1,0],[1],[0,-1],[-1,0,0],[1,0],[-2],[0,0,0,0],[-1,-1],[1,0,0],[-2,0]]"

        it "gshow (range ([0], [1]))" $
            gshow (range ([0], [1::Int])) `shouldBe`
                "[[0],[0,0],[-1],[0,0,0],[-1,0]]"

        it "gshow (inRange ([0], [3,5]) hList)" $
            gshow (inRange ([0], [3,5::Int]) hList) `shouldBe`
                "False"

    describe "Tests for Tree" $ do
        it "gshow tree" $
            gshow tree `shouldBe`
                "Branch 2 Empty (Branch 1 Empty Empty)"

        it "gshow (children tree)" $
            gshow (children tree) `shouldBe`
                "[Empty,Branch 1 Empty Empty]"

        it "gshow (descend (descend (\\_ -> Branch 0 Empty Empty)) tree)" $
            gshow (descend (descend (\_ -> Branch 0 Empty Empty)) tree) `shouldBe`
                "Branch 2 Empty (Branch 1 (Branch 0 Empty Empty) (Branch 0 Empty Empty))"

        it "gshow (context tree [Branch 1 Empty Empty,Empty])" $
            gshow (context tree [Branch 1 Empty Empty,Empty]) `shouldBe`
                "Branch 2 (Branch 1 Empty Empty) Empty"

        it "gshow (transform upgradeTree tree)" $
            gshow (transform upgradeTree tree) `shouldBe`
                "Branch 3 (Branch 0 Empty Empty) (Branch 2 (Branch 0 Empty Empty) (Branch 0 Empty Empty))"

        it "gshow (take 10 genum)" $ do
            gshow (take 10 (genum :: [Tree])) `shouldBe`
                "[Empty,Branch 0 Empty Empty,Branch 0 Empty (Branch 0 Empty Empty),Branch -1 Empty Empty,Branch 0 (Branch 0 Empty Empty) Empty,Branch -1 Empty (Branch 0 Empty Empty),Branch 1 Empty Empty,Branch 0 Empty (Branch 0 Empty (Branch 0 Empty Empty)),Branch -1 (Branch 0 Empty Empty) Empty,Branch 1 Empty (Branch 0 Empty Empty)]"

    describe "Tests for List" $ do
        it "gshow (gmap fromEnum list)" $
            gshow (gmap fromEnum list) `shouldBe`
                "Cons 112 (Cons 113 Nil)"

        it "gshow (gmap gshow listlist)" $
            gshow (gmap gshow listlist) `shouldBe`
                "Cons \"Cons 'p' (Cons 'q' Nil)\" (Cons \"Nil\" Nil)"

        it "gshow list" $
            gshow list `shouldBe`
                "Cons 'p' (Cons 'q' Nil)"

        it "gshow listlist" $
            gshow listlist `shouldBe`
                "Cons (Cons 'p' (Cons 'q' Nil)) (Cons Nil Nil)"

        it "gshow (children list)" $
            gshow (children list) `shouldBe`
                "[Cons 'q' Nil]"

        it "gshow (children listlist)" $
            gshow (children listlist) `shouldBe`
                "[Cons Nil Nil]"

    describe "Tests for Rose" $ do
        it "gshow rose1" $
            gshow rose1 `shouldBe`
                "Rose [1,2] [Rose [3,4] [],Rose [5] []]"

        it "gshow (gmap gshow rose1)" $
            gshow (gmap gshow rose1) `shouldBe`
                "Rose [\"1\",\"2\"] [Rose [\"3\",\"4\"] [],Rose [\"5\"] []]"

    describe "Tests for GRose" $ do
        it "gshow grose1" $
            gshow grose1 `shouldBe`
                "GRose [1,2] [GRose [3] [],GRose [] []]"

        it "gshow (gmap gshow grose1)" $
            gshow (gmap gshow grose1) `shouldBe`
                "GRose [\"1\",\"2\"] [GRose [\"3\"] [],GRose [] []]"

    describe "Tests for Either" $ do
        it "gshow either1" $
            gshow either1 `shouldBe`
                "Left Right 'p'"

        it "gshow (gmap gshow either1)" $
            gshow (gmap gshow either1) `shouldBe`
                "Left Right \"'p'\""

    describe "Tests for Nested" $ do
        it "gshow nested" $
            gshow nested `shouldBe`
                "Nested {value = 1, rec = Nested {value = [2], rec = Nested {value = [[3],[4,5],[]], rec = Leaf}}}"

        it "gshow (gmap gshow nested)" $
            gshow (gmap gshow nested) `shouldBe`
                "Nested {value = \"1\", rec = Nested {value = [\"2\"], rec = Nested {value = [[\"3\"],[\"4\",\"5\"],[]], rec = Leaf}}}"

    describe "Tests for Bush" $ do
        it "gshow bush1" $
            gshow bush1 `shouldBe`
                "BushCons 0 (BushCons (BushCons 1 BushNil) BushNil)"

        it "gshow (gmap gshow bush1)" $
            gshow (gmap gshow bush1) `shouldBe`
                "BushCons \"0\" (BushCons (BushCons \"1\" BushNil) BushNil)"