{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

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

module ExampleSpec (main, spec, Op (..), Plain (..)) where

import           Examples
import           Generics.Linear.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)
import           Data.Kind (Type)
import           Generics.Linear.Unsafe.ViaGHCGenerics
import qualified GHC.Generics as GHCG
import qualified Prelude as Prelude

-------------------------------------------------------------------------------
-- 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

$(deriveGeneric ''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)

$(deriveGenericAnd1 ''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]

$(deriveGenericAnd1 ''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)

$(deriveGenericAnd1 ''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

$(deriveGenericAnd1 ''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

$(deriveGenericAnd1 ''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

$(deriveGenericAnd1 ''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

$(deriveGenericAnd1 ''Weird)

instance GFunctor Weird where
  gmap = gmapdefault

data Bloom a = Bloom (Maybe (Bloom a)) | Bling a
$(deriveGenericAnd1 ''Bloom)

data Fix f a = Fix (f (Fix f a))
$(deriveGenericAnd1 ''Fix)

-------------------------------------------------------------------------------
-- Example: GHCGenerically1 compilation
-------------------------------------------------------------------------------

-- A contravariant functor
newtype Op a b = Op (b -> a)
data Plain a b c
  = Plain [a] (Either Int (Op b c))
  | Unplain (Either a (Op b (Maybe c)))
  deriving stock GHCG.Generic
  deriving Generic1 via GHCGenerically1 (Plain a b)

-------------------------------------------------------------------------------
-- Example: GHCGenerically1 running
-------------------------------------------------------------------------------

data GG a b c
  = GG1 [a] (Prelude.Either Int (Maybe (b, c)))
  | GG2 c
  | GG3 (Maybe c)
  | GG4 (Prelude.Either a b)
  deriving stock (GHCG.Generic, Show, Eq)
  deriving Generic1 via GHCGenerically1 (GG a b)

instance GFunctor (GG a b) 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

data family MyType3
  (a :: v) (b :: w) (c :: x)      (d :: y) (e :: z)
newtype instance MyType3 (f p) (f p) f p (q :: Type) = MyType3Newtype q
data    instance MyType3 Bool  ()    f p q        = MyType3True | MyType3False
data    instance MyType3 Int   ()    f p (q :: Type) = MyType3Hash q Addr# Char# Double# Float# Int# Word#

$(deriveGenericAnd1 ''Empty)
$(deriveGenericAnd1 ''(:/:))
$(deriveGenericAnd1 ''GADTSyntax)
$(deriveGeneric     ''MyType2)
$(deriveGenericAnd1 ''PlainHash)
$(deriveGeneric     ''ExampleSpec.Lexeme)
$(deriveGeneric     ''Text.Read.Lex.Lexeme)
$(deriveGenericAnd1 'MyType3Newtype)
$(deriveGenericAnd1 'MyType3False)
$(deriveGenericAnd1 'MyType3Hash)

-------------------------------------------------------------------------------
-- 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)"

    describe "Tests or GG" $ do
      it "gmap GG1" $
        gmap show (GG1 [12 :: Integer] (Prelude.Right (Just (7 :: Integer, 13 :: Integer)))) `shouldBe`
                   GG1 [12] (Prelude.Right (Just (7, "13")))
      it "gmap GG2" $
        gmap show (GG2 'a' :: GG Int Bool Char) `shouldBe` GG2 "'a'"
      it "gmap GG3" $
        gmap show (GG3 (Just 'a') :: GG Int Bool Char) `shouldBe` GG3 (Just "'a'")
      it "gmap GG4" $
        gmap show (GG4 (Prelude.Left 'a') :: GG Char Bool ()) `shouldBe` GG4 (Prelude.Left 'a')