{-# OPTIONS_GHC -Wall #-}
{-# Language DeriveGeneric #-}

module Main where

import GHC.Generics ( Generic )

import Data.Int ( Int8, Int16 )
import Data.Word ( Word64 )
import Data.Monoid ( mempty )
import Text.Printf ( printf )
import Test.Framework ( ColorMode(..), RunnerOptions'(..), TestOptions'(..), defaultMainWithOpts )
import qualified Test.HUnit.Base as HUnit
import Test.Framework ( Test, testGroup )
import Test.Framework.Providers.HUnit ( testCase )

import Accessors
import Accessors.Dynamic

main :: IO ()
main = do
  defaultMainWithOpts
    [ accessorTests
    , dynamicTests
    ]
    opts

opts :: RunnerOptions' Maybe
opts = mempty { ropt_color_mode = Just ColorAlways
              , ropt_threads = Just 1
              , ropt_test_options = Just my_test_opts
              }

my_test_opts :: TestOptions' Maybe
my_test_opts = mempty { topt_timeout = Just (Just 2000000) }


data Xyz a = Xyz { xx :: Int8
                 , yy :: Double
                 , zz :: Float
                 , bb :: (Bool, Bool, Bool)
                 , ww :: a
                 } deriving (Generic, Show)
data One = MkOne { one :: Double
                 } deriving (Generic, Show)
data Foo = MkFoo { aaa :: Int16
                 , bbb :: Xyz Word64
                 , lol :: Bool
                 , notlol :: Bool
                 , yoyo :: Xyz (Xyz Double)
                 , ccc :: One
                 } deriving (Generic, Show)
instance Lookup One
instance Lookup a => Lookup (Xyz a)
instance Lookup Foo

yo :: Xyz (Xyz Double)
yo = Xyz 42 45 2000 (True, True, False) (Xyz 2 3 4 (False, True, False) 5)

foo :: Foo
foo = MkFoo 2 (Xyz 6 7 8 (True, False, False) 9) True False yo (MkOne 17)

yup :: Either (GAField Foo) (GAData Foo)
yup = accessors


accessorTests :: Test
accessorTests =
  testGroup "accessors"
  [ testCase "showTree" treeTest
  , testCase "showFlat" flatTest
  , testCase "showFlat (aligned)" flatTestAligned
  ]

dynamicTests :: Test
dynamicTests =
  testGroup "dynamic"
  [ testCase "toDValue" toDValueTest
  , testCase "updateDValueTest" updateDValueTest
  , testCase "badupdateDValueTest" badUpdateDValueTest
  ]

assertEqualString :: String -> String -> HUnit.Assertion
assertEqualString x y = HUnit.assertBool msg (x == y)
  where
    msg = "------------------ expected: ------------------\n" ++
          x ++
          "\n------------------ but got: -------------------\n" ++
          y ++
          "\n-----------------------------------------------"

assertEqualString' :: Either String String -> Either String String -> HUnit.Assertion
assertEqualString' ex ey = HUnit.assertBool msg (ex == ey)
  where
    x = case ex of
      Left r -> r
      Right r -> r
    y = case ey of
      Left r -> r
      Right r -> r
    msg = "------------------ expected: ------------------\n" ++
          x ++
          "\n------------------ but got: -------------------\n" ++
          y ++
          "\n-----------------------------------------------"

toDValueTest :: HUnit.Assertion
toDValueTest = assertEqualString x y
  where
    x = "Right (DData \"Xyz\" (DConstructor \"Xyz\" [(Just \"xx\",Left (DInt8 1)),(Just \"yy\",Left (DDouble 2.0)),(Just \"zz\",Left (DFloat 3.0)),(Just \"bb\",Right (DData \"(,,)\" (DConstructor \"(,,)\" [(Just \"(x,_,_)\",Left (DBool True)),(Just \"(_,x,_)\",Left (DBool False)),(Just \"(_,_,x)\",Left (DBool True))]))),(Just \"ww\",Right (DData \"One\" (DConstructor \"MkOne\" [(Just \"one\",Left (DDouble 4.0))])))]))"

    y = show (toDData (Xyz 1 2 3 (True, False, True) (MkOne 4)))

updateDValueTest :: HUnit.Assertion
updateDValueTest = assertEqualString' (fmap show x) (fmap show y)
  where
    x0 :: Xyz One
    x0 = Xyz 1 2 3 (True, False, True) (MkOne 4)

    dvalue =
      DData "Xyz" $
      DConstructor "Xyz" $
      [ (Just "xx", Left (DInt8 10))
      , (Just "yy", Left (DDouble 20.0))
      , (Just "zz", Left (DFloat 30.0))
      , ( Just "bb"
        , Right (DData "(,,)"
                 (DConstructor "(,,)"
                  [ (Just "(x,_,_)", Left (DBool False))
                  , (Just "(_,x,_)", Left (DBool True))
                  , (Just "(_,_,x)", Left (DBool True))
                  ]))
        )
      , (Just "ww", Right (DData "One"
                           (DConstructor "MkOne"
                            [ (Just "one", Left (DDouble 40.0))
                            ])))
      ]

    x :: Either String (Xyz One)
    x = Right $ Xyz 10 20 30 (False, True, True) (MkOne 40)

    y :: Either String (Xyz One)
    y = updateLookupable x0 (Right dvalue)

badUpdateDValueTest :: HUnit.Assertion
badUpdateDValueTest = assertEqualString' (fmap show x) (fmap show y)
  where
    x0 :: Xyz One
    x0 = Xyz 1 2 3 (True, False, True) (MkOne 4)

    dvalue =
      DData "Xyz" $
      DConstructor "Xyz" $
      [ (Just "xx", Left (DInt8 10))
      , (Just "yy", Left (DDouble 20.0))
      , (Just "zz", Left (DFloat 30.0))
      , ( Just "b"
        , Right (DData "(,,)"
                 (DConstructor "(,,)"
                  [ (Just "(x,_,_)", Left (DBool False))
                  , (Just "(_,x,_)", Left (DBool True))
                  , (Just "(_,_,x)", Left (DBool True))
                  ]))
        )
      , (Just "ww", Right (DData "One"
                           (DConstructor "MkOne"
                            [ (Just "one", Left (DDouble 40.0))
                            ])))
      ]

    x :: Either String (Xyz One)
    x = Left "accessor selector name Just \"bb\" doesn't match dynamic selector name Just \"b\""

    y :: Either String (Xyz One)
    y = updateLookupable x0 (Right dvalue)

treeTest :: HUnit.Assertion
treeTest = assertEqualString x y
  where
    x = init $ unlines
        [ "MkFoo"
        , "{ aaa = 2"
        , ", bbb = Xyz"
        , "        { xx = 6"
        , "        , yy = 7.00e0"
        , "        , zz = 8.00e0"
        , "        , bb = (,,)"
        , "               { (x,_,_) = True"
        , "               , (_,x,_) = False"
        , "               , (_,_,x) = False"
        , "               }"
        , "        , ww = 9"
        , "        }"
        , ", lol = True"
        , ", notlol = False"
        , ", yoyo = Xyz"
        , "         { xx = 42"
        , "         , yy = 4.50e1"
        , "         , zz = 2.00e3"
        , "         , bb = (,,)"
        , "                { (x,_,_) = True"
        , "                , (_,x,_) = True"
        , "                , (_,_,x) = False"
        , "                }"
        , "         , ww = Xyz"
        , "                { xx = 2"
        , "                , yy = 3.00e0"
        , "                , zz = 4.00e0"
        , "                , bb = (,,)"
        , "                       { (x,_,_) = False"
        , "                       , (_,x,_) = True"
        , "                       , (_,_,x) = False"
        , "                       }"
        , "                , ww = 5.00e0"
        , "                }"
        , "         }"
        , ", ccc = MkOne"
        , "        { one = 1.70e1"
        , "        }"
        , "}"
        ]
    y = showTree yup (printf "%.2e") foo

flatTest :: HUnit.Assertion
flatTest = assertEqualString x y
  where
    x = init $ unlines
        [ "aaa = 2"
        , "bbb.xx = 6"
        , "bbb.yy = 7.00e0"
        , "bbb.zz = 8.00e0"
        , "bbb.bb.(x,_,_) = True"
        , "bbb.bb.(_,x,_) = False"
        , "bbb.bb.(_,_,x) = False"
        , "bbb.ww = 9"
        , "lol = True"
        , "notlol = False"
        , "yoyo.xx = 42"
        , "yoyo.yy = 4.50e1"
        , "yoyo.zz = 2.00e3"
        , "yoyo.bb.(x,_,_) = True"
        , "yoyo.bb.(_,x,_) = True"
        , "yoyo.bb.(_,_,x) = False"
        , "yoyo.ww.xx = 2"
        , "yoyo.ww.yy = 3.00e0"
        , "yoyo.ww.zz = 4.00e0"
        , "yoyo.ww.bb.(x,_,_) = False"
        , "yoyo.ww.bb.(_,x,_) = True"
        , "yoyo.ww.bb.(_,_,x) = False"
        , "yoyo.ww.ww = 5.00e0"
        , "ccc.one = 1.70e1"
        ]
    y = showFlat yup False (printf "%.2e") foo

flatTestAligned :: HUnit.Assertion
flatTestAligned = assertEqualString x y
  where
    x = init $ unlines
        [ "aaa                = 2"
        , "bbb.xx             = 6"
        , "bbb.yy             = 7.00e0"
        , "bbb.zz             = 8.00e0"
        , "bbb.bb.(x,_,_)     = True"
        , "bbb.bb.(_,x,_)     = False"
        , "bbb.bb.(_,_,x)     = False"
        , "bbb.ww             = 9"
        , "lol                = True"
        , "notlol             = False"
        , "yoyo.xx            = 42"
        , "yoyo.yy            = 4.50e1"
        , "yoyo.zz            = 2.00e3"
        , "yoyo.bb.(x,_,_)    = True"
        , "yoyo.bb.(_,x,_)    = True"
        , "yoyo.bb.(_,_,x)    = False"
        , "yoyo.ww.xx         = 2"
        , "yoyo.ww.yy         = 3.00e0"
        , "yoyo.ww.zz         = 4.00e0"
        , "yoyo.ww.bb.(x,_,_) = False"
        , "yoyo.ww.bb.(_,x,_) = True"
        , "yoyo.ww.bb.(_,_,x) = False"
        , "yoyo.ww.ww         = 5.00e0"
        , "ccc.one            = 1.70e1"
        ]
    y = showFlat yup True (printf "%.2e") foo