-- Copyright (c) 2019-2025 Rudy Matela.
-- Distributed under the 3-Clause BSD licence (see the file LICENSE).
{-# LANGUAGE TemplateHaskell #-}

-- uncomment to debug derivation:
-- {-# OPTIONS_GHC -ddump-splices #-}

import Test hiding ((-:), (->:))
-- -: and ->: should be generated by deriveConjurable

-- replication of Haskell's built-in data types
-- in the order of the Haskell98 standard
-- https://www.haskell.org/onlinereport/basic.html
data  Choice  =  Yes | No  deriving (Show, Eq)
data  Peano  =  Zero | Succ Peano  deriving (Show, Eq)
data  Lst a  =  Nil | a :- Lst a  deriving (Show, Eq)
data  Unit  =  Unit  deriving (Show, Eq)
data  Perhaps a  =  Naught | Precisely a  deriving (Show, Eq)
data  Alternatively a b  =  Sinister a | Dexter b  deriving (Show, Eq)
data  Relation  =  Smaller | Same | Bigger  deriving (Show, Eq)

deriveConjurable ''Choice
deriveConjurable ''Peano
deriveConjurable ''Lst
deriveConjurable ''Unit
deriveConjurable ''Perhaps
deriveConjurable ''Alternatively
deriveConjurable ''Relation

-- tree types
data  Bush a  =  Bush a :-: Bush a | Leaf a  deriving (Show, Eq)
data  Tree a  =  Node (Tree a) a (Tree a) | Null  deriving (Show, Eq)

deriveConjurable ''Bush
deriveConjurable ''Tree

-- inner/outer
data  Inner  =  I  deriving (Eq, Ord, Show)
data  Outer  =  O Inner  deriving (Eq, Ord, Show)

deriveConjurableCascading ''Outer

-- Nested datatype cascade
data  Nested  =  Nested N0 (N1 Int) (N2 Int Int)  deriving (Eq, Show)
data  N0      =  R0 Int  deriving (Eq, Show)
data  N1 a    =  R1 a    deriving (Eq, Show)
data  N2 a b  =  R2 a b  deriving (Eq, Show)

deriveConjurableCascading ''Nested

-- Recursive nested datatype cascade
data  RN       =  RN RN0 (RN1 Int) (RN2 Int RN0)  deriving (Eq, Show)
data  RN0      =  Nest0 Int | Recurse0 RN  deriving (Eq, Show)
data  RN1 a    =  Nest1 a   | Recurse1 RN  deriving (Eq, Show)
data  RN2 a b  =  Nest2 a b | Recurse2 RN  deriving (Eq, Show)

deriveConjurableCascading ''RN

-- Those should have no effect (instance already exists):
{- uncommenting those should generate warnings
deriveConjurable ''Bool
deriveConjurable ''Maybe
deriveConjurable ''Either
-}

-- Those should not generate warnings
deriveConjurableIfNeeded ''Bool
deriveConjurableIfNeeded ''Maybe
deriveConjurableIfNeeded ''Either

data Mutual    =  Mutual0   | Mutual CoMutual deriving (Eq, Show)
data CoMutual  =  CoMutual0 | CoMutual Mutual deriving (Eq, Show)

deriveConjurableCascading ''Mutual


main :: IO ()
main  =  mainTest tests 5040

tests :: Int -> [Bool]
tests n  =
  [ True

  -- re-test standard types
  , conjurableOK (undefined :: Bool)
  , conjurableOK (undefined :: Int)
  , conjurableOK (undefined :: [A])
  , conjurableOK (undefined :: [Int])
  , conjurableOK (undefined :: [Bool])
  , conjurableOK (undefined :: ())
  , conjurableOK (undefined :: Maybe A)
  , conjurableOK (undefined :: Either A B)
  , conjurableOK (undefined :: Ordering)

  -- replication of Haskell's built-in types
  , conjurableOK (undefined :: Choice)
  , conjurableOK (undefined :: Peano)
  , conjurableOK (undefined :: Lst A)
  , conjurableOK (undefined :: Lst Peano)
  , conjurableOK (undefined :: Lst Choice)
  , conjurableOK (undefined :: Unit)
  , conjurableOK (undefined :: Perhaps A)
  , conjurableOK (undefined :: Alternatively A B)
  , conjurableOK (undefined :: Relation)

  -- tree types
  , conjurableOK (undefined :: Bush Int)
  , conjurableOK (undefined :: Tree Int)

  , conjurableOK (undefined :: Inner)
  , conjurableOK (undefined :: Outer)

  , conjurableOK (undefined :: RN)
  , conjurableOK (undefined :: Mutual)
  , conjurableOK (undefined :: CoMutual)

  , conjureSize Yes == 1
  , conjureSize No == 1

  , conjureSize Zero == 1
  , conjureSize (Succ Zero) == 2
  , conjureSize (Succ (Succ Zero)) == 3
  , conjureSize (Succ (Succ (Succ Zero))) == 4

  , conjureSize (Nil :: Lst Int) == 1
  , conjureSize (10 :- (20 :- Nil) :: Lst Int) == 33

  , conjureSize Unit == 1

  , conjureCases choice
    == [ val Yes
       , val No
       ]

  , conjureCases peano
    == [ val Zero
       , value "Succ" Succ :$ hole (undefined :: Peano)
       ]

  , conjureCases (lst int)
    == [ val (Nil :: Lst Int)
       , value ":-" ((:-) ->>: lst int) :$ hole int :$ hole (lst int)
       ]

  , conjureCases relation
    == [ val Smaller
       , val Same
       , val Bigger
       ]

  , conjureCases (bush int)
    == [ value ":-:" ((:-:) ->>: bush int) :$ hole (bush int) :$ hole (bush int)
       , value "Leaf" (Leaf ->: bush int) :$ hole int
       ]

  , conjureCases (tree int)
    == [ value "Node" (Node ->>>: tree int) :$ hole (tree int) :$ hole int :$ hole (tree int)
       , val (Null :: Tree Int)
       ]

  , conjureCases nested
    == [ value "Nested" Nested :$ hole n0 :$ hole (n1 int) :$ hole (n2 int int)
       ]

  , conjureHoles (undefined :: Choice) == [ hole (undefined :: Choice)
                                          , hole (undefined :: Bool)
                                          ]
  , conjureHoles (undefined :: Peano) == [ hole (undefined :: Peano)
                                         , hole (undefined :: Bool)
                                         ]
  , conjureHoles (undefined :: Lst Int) == [ hole (undefined :: Int)
                                           , hole (undefined :: Lst Int)
                                           , hole (undefined :: Bool)
                                           ]
  , conjureHoles (undefined :: Lst Peano) == [ hole (undefined :: Peano)
                                             , hole (undefined :: Lst Peano)
                                             , hole (undefined :: Bool)
                                             ]
  , conjureHoles (undefined :: Nested) == [ hole (undefined :: N0)
                                          , hole (undefined :: N1 Int)
                                          , hole (undefined :: Int)
                                          , hole (undefined :: N2 Int Int)
                                          , hole (undefined :: Nested)
                                          , hole (undefined :: Bool)
                                          ]
  , conjureHoles (undefined :: RN) == [ hole (undefined :: RN1 Int)
                                      , hole (undefined :: Int)
                                      , hole (undefined :: RN0)
                                      , hole (undefined :: RN2 Int RN0)
                                      , hole (undefined :: RN)
                                      , hole (undefined :: Bool)
                                      ]
  , conjureHoles (undefined :: Mutual) == [ hole (undefined :: CoMutual)
                                          , hole (undefined :: Mutual)
                                          , hole (undefined :: Bool)
                                          ]
  , conjureHoles (undefined :: CoMutual) == [ hole (undefined :: Mutual)
                                            , hole (undefined :: CoMutual)
                                            , hole (undefined :: Bool)
                                            ]
  ]


-- proxies --
choice :: Choice
choice  =  undefined

peano :: Peano
peano  =  undefined

lst :: a -> Lst a
lst _  =  undefined

relation :: Relation
relation  =  undefined

bush :: a -> Bush a
bush _  =  undefined

tree :: a -> Tree a
tree _  =  undefined

nested :: Nested
nested  =  undefined

n0 :: N0
n0  =  undefined

n1 :: a -> N1 a
n1 _  =  undefined

n2 :: a -> b -> N2 a b
n2 _ _  =  undefined