{-# LANGUAGE NegativeLiterals #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}

module TOML.DecodeTest (test) where

import Data.Int (Int8)
import qualified Data.Text as Text
import qualified Data.Time as Time
import Numeric.Natural (Natural)
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit

import TOML.Decode (
  DecodeTOML,
  Decoder,
  decodeWith,
  getArrayOf,
  getField,
  getFieldOpt,
  getFieldOptWith,
  getFieldOr,
  getFieldWith,
  getFields,
  getFieldsOpt,
  getFieldsOptWith,
  getFieldsWith,
  tomlDecoder,
 )
import TOML.Error (
  ContextItem (..),
  DecodeError (..),
  TOMLError (..),
 )
import TOML.Value (Value (..))

test :: TestTree
test =
  testGroup "TOML.Decode" . concat $
    [ getFieldTests
    , [decoderInstanceTests]
    ]

getFieldTests :: [TestTree]
getFieldTests =
  [ testGroup
      "getField"
      [ testCase "decodes field" $
          decodeWith (getField @Int "a") "a = 1" @?= Right 1
      , testCase "errors if field does not exist" $
          decodeWith (getField @Int "a") "" @?= Left (DecodeError [Key "a"] MissingField)
      , testCase "errors if field is the wrong type" $
          decodeWith (getField @Int "a") "a = true" @?= Left (DecodeError [Key "a"] (TypeMismatch (Boolean True)))
      ]
  , testGroup
      "getFieldOr"
      [ testCase "decodes field" $
          decodeWith (getFieldOr @Int 42 "a") "a = 1" @?= Right 1
      , testCase "returns default if field does not exist" $
          decodeWith (getFieldOr @Int 42 "a") "" @?= Right 42
      , testCase "errors if field is the wrong type" $
          decodeWith (getFieldOr @Int 42 "a") "a = true" @?= Left (DecodeError [Key "a"] (TypeMismatch (Boolean True)))
      ]
  , testGroup
      "getFieldOpt"
      [ testCase "decodes field" $
          decodeWith (getFieldOpt @Int "a") "a = 1" @?= Right (Just 1)
      , testCase "returns Nothing if field does not exist" $
          decodeWith (getFieldOpt @Int "a") "" @?= Right Nothing
      , testCase "errors if field is the wrong type" $
          decodeWith (getFieldOpt @Int "a") "a = true" @?= Left (DecodeError [Key "a"] (TypeMismatch (Boolean True)))
      ]
  , testGroup
      "getFieldWith"
      [ testCase "decodes field" $
          decodeWith (getFieldWith @Int succDecoder "a") "a = 1" @?= Right 2
      , testCase "errors if field does not exist" $
          decodeWith (getFieldWith @Int succDecoder "a") "" @?= Left (DecodeError [Key "a"] MissingField)
      , testCase "errors if field is the wrong type" $
          decodeWith (getFieldWith @Int succDecoder "a") "a = true" @?= Left (DecodeError [Key "a"] (TypeMismatch (Boolean True)))
      ]
  , testGroup
      "getFieldOptWith"
      [ testCase "decodes field" $
          decodeWith (getFieldOptWith @Int succDecoder "a") "a = 1" @?= Right (Just 2)
      , testCase "returns Nothing if field does not exist" $
          decodeWith (getFieldOptWith @Int succDecoder "a") "" @?= Right Nothing
      , testCase "errors if field is the wrong type" $
          decodeWith (getFieldOptWith @Int succDecoder "a") "a = true" @?= Left (DecodeError [Key "a"] (TypeMismatch (Boolean True)))
      ]
  , testGroup
      "getFields"
      [ testCase "decodes field" $
          decodeWith (getFields @Int ["a", "b"]) "a = { b = 1 }" @?= Right 1
      , testCase "errors if field does not exist" $
          decodeWith (getFields @Int ["a", "b"]) "a = {}" @?= Left (DecodeError [Key "a", Key "b"] MissingField)
      , testCase "errors if intermediate field does not exist" $
          decodeWith (getFields @Int ["a", "b", "c"]) "a = {}" @?= Left (DecodeError [Key "a", Key "b"] MissingField)
      , testCase "errors if field is the wrong type" $
          decodeWith (getFields @Int ["a", "b"]) "a = { b = true }" @?= Left (DecodeError [Key "a", Key "b"] (TypeMismatch (Boolean True)))
      , testCase "errors if intermediate field is the wrong type" $
          decodeWith (getFields @Int ["a", "b", "c"]) "a = { b = true }" @?= Left (DecodeError [Key "a", Key "b"] (TypeMismatch (Boolean True)))
      ]
  , testGroup
      "getFieldsOpt"
      [ testCase "decodes field" $
          decodeWith (getFieldsOpt @Int ["a", "b"]) "a = { b = 1 }" @?= Right (Just 1)
      , testCase "returns Nothing if field does not exist" $
          decodeWith (getFieldsOpt @Int ["a", "b"]) "a = {}" @?= Right Nothing
      , testCase "returns Nothing if intermediate field does not exist" $
          decodeWith (getFieldsOpt @Int ["a", "b", "c"]) "a = {}" @?= Right Nothing
      , testCase "errors if field is the wrong type" $
          decodeWith (getFieldsOpt @Int ["a", "b"]) "a = { b = true }" @?= Left (DecodeError [Key "a", Key "b"] (TypeMismatch (Boolean True)))
      , testCase "errors if intermediate field is the wrong type" $
          decodeWith (getFieldsOpt @Int ["a", "b", "c"]) "a = { b = true }" @?= Left (DecodeError [Key "a", Key "b"] (TypeMismatch (Boolean True)))
      ]
  , testGroup
      "getFieldsWith"
      [ testCase "decodes field" $
          decodeWith (getFieldsWith @Int succDecoder ["a", "b"]) "a = { b = 1 }" @?= Right 2
      , testCase "errors if field does not exist" $
          decodeWith (getFieldsWith @Int succDecoder ["a", "b"]) "a = {}" @?= Left (DecodeError [Key "a", Key "b"] MissingField)
      , testCase "errors if intermediate field does not exist" $
          decodeWith (getFieldsWith @Int succDecoder ["a", "b", "c"]) "a = {}" @?= Left (DecodeError [Key "a", Key "b"] MissingField)
      , testCase "errors if field is the wrong type" $
          decodeWith (getFieldsWith @Int succDecoder ["a", "b"]) "a = { b = true }" @?= Left (DecodeError [Key "a", Key "b"] (TypeMismatch (Boolean True)))
      , testCase "errors if intermediate field is the wrong type" $
          decodeWith (getFieldsWith @Int succDecoder ["a", "b", "c"]) "a = { b = true }" @?= Left (DecodeError [Key "a", Key "b"] (TypeMismatch (Boolean True)))
      ]
  , testGroup
      "getFieldsOptWith"
      [ testCase "decodes field" $
          decodeWith (getFieldsOptWith @Int succDecoder ["a", "b"]) "a = { b = 1 }" @?= Right (Just 2)
      , testCase "returns Nothing if field does not exist" $
          decodeWith (getFieldsOptWith @Int succDecoder ["a", "b"]) "a = {}" @?= Right Nothing
      , testCase "returns Nothing if intermediate field does not exist" $
          decodeWith (getFieldsOptWith @Int succDecoder ["a", "b", "c"]) "a = {}" @?= Right Nothing
      , testCase "errors if field is the wrong type" $
          decodeWith (getFieldsOptWith @Int succDecoder ["a", "b"]) "a = { b = true }" @?= Left (DecodeError [Key "a", Key "b"] (TypeMismatch (Boolean True)))
      , testCase "errors if intermediate field is the wrong type" $
          decodeWith (getFieldsOptWith @Int succDecoder ["a", "b", "c"]) "a = { b = true }" @?= Left (DecodeError [Key "a", Key "b"] (TypeMismatch (Boolean True)))
      ]
  , testGroup
      "getArrayOf"
      [ testCase "decodes field" $
          decodeWith (getFieldWith (getArrayOf @Int succDecoder) "a") "a = [1, 2]" @?= Right [2, 3]
      , testCase "errors if value is the wrong type" $
          decodeWith (getFieldWith (getArrayOf @Int succDecoder) "a") "a = true" @?= Left (DecodeError [Key "a"] (TypeMismatch (Boolean True)))
      , testCase "errors if value in array is the wrong type" $
          decodeWith (getFieldWith (getArrayOf @Int succDecoder) "a") "a = [1, 2, true]" @?= Left (DecodeError [Key "a", Index 2] (TypeMismatch (Boolean True)))
      ]
  , testCase "Decoding multiple fields at once" $ do
      let decoder :: Decoder (Int, Maybe String, Maybe Int, Bool)
          decoder =
            (,,,)
              <$> getField "a"
              <*> getFieldOpt "b"
              <*> getFieldOpt "missing"
              <*> getFields ["c", "d"]
          doc =
            Text.unlines
              [ "a = 1"
              , "b = \"hello\""
              , "[c]"
              , "d = true"
              ]
      decodeWith decoder doc @?= Right (1, Just "hello", Nothing, True)
  ]
  where
    succDecoder :: (Enum a, DecodeTOML a) => Decoder a
    succDecoder = succ <$> tomlDecoder

decoderInstanceTests :: TestTree
decoderInstanceTests =
  testGroup
    "DecodeTOML instances"
    [ testCase "Bool" $ do
        decodeWith (getField @Bool "a") "a = true" @?= Right True
        decodeWith (getField @Bool "a") "a = false" @?= Right False
    , testCase "String" $ do
        decodeWith (getField @String "a") "a = 'z'" @?= Right "z"
        decodeWith (getField @String "a") "a = 'asdf'" @?= Right "asdf"
    , testCase "Char" $
        decodeWith (getField @Char "a") "a = 'z'" @?= Right 'z'
    , testCase "Char errors with multi-character string" $
        assertInvalidValue "Expected single character string" $
          decodeWith (getField @Char "a") "a = 'asdf'"
    , testCase "Int" $ do
        decodeWith (getField @Int "a") "a = 42" @?= Right 42
        decodeWith (getField @Int "a") "a = -13" @?= Right (-13)
    , testCase "Natural" $
        decodeWith (getField @Natural "a") "a = 42" @?= Right 42
    , testCase "Natural errors with negative numbers" $
        assertInvalidValue "Got negative number" $
          decodeWith (getField @Natural "a") "a = -13"
    , testCase "Int8" $ do
        decodeWith (getField @Int8 "a") "a = 127" @?= Right 127
        decodeWith (getField @Int8 "a") "a = 42" @?= Right 42
        decodeWith (getField @Int8 "a") "a = -13" @?= Right (-13)
        decodeWith (getField @Int8 "a") "a = -128" @?= Right (-128)
    , testCase "Int8 errors with underflow/overflow" $ do
        assertInvalidValue "Overflow" $
          decodeWith (getField @Int8 "a") "a = 128"
        assertInvalidValue "Underflow" $
          decodeWith (getField @Int8 "a") "a = -129"
    , testCase "Double" $ do
        decodeWith (getField @Double "a") "a = 42.0" @?= Right 42.0
        decodeWith (getField @Double "a") "a = -13.2" @?= Right (-13.2)
    , testCase "Array" $
        decodeWith (getField @[Int] "a") "a = [1, 2]" @?= Right [1, 2]
    , testCase "UTCTime" $
        decodeWith (getField @Time.UTCTime "a") "a = 2020-01-31T00:00:01-01:00"
          @?= Right (Time.UTCTime (Time.fromGregorian 2020 1 31) 3601)
    , testCase "ZonedTime" $
        -- ZonedTime does not have an Eq instance
        case decodeWith (getField @Time.ZonedTime "a") "a = 2020-01-31T00:00:01-01:00" of
          Right (Time.ZonedTime (Time.LocalTime day time) (Time.TimeZone (-60) _ _))
            | day == Time.fromGregorian 2020 1 31
            , time == Time.TimeOfDay 0 0 1 ->
                return ()
          result -> unexpectedResult result
    , testCase "LocalTime" $
        decodeWith (getField @Time.LocalTime "a") "a = 2020-01-31T00:00:01"
          @?= Right (Time.LocalTime (Time.fromGregorian 2020 1 31) (Time.TimeOfDay 0 0 1))
    , testCase "Day" $
        decodeWith (getField @Time.Day "a") "a = 2020-01-31"
          @?= Right (Time.fromGregorian 2020 1 31)
    , testCase "TimeOfDay" $
        decodeWith (getField @Time.TimeOfDay "a") "a = 07:32:59.1"
          @?= Right (Time.TimeOfDay 7 32 59.1)
    , testCase "Maybe" $
        decodeWith (getField @(Maybe Int) "a") "a = 1" @?= Right (Just 1)
    , testCase "Either" $ do
        decodeWith (getField @(Either Int Double) "a") "a = 1" @?= Right (Left 1)
        decodeWith (getField @(Either Int Double) "a") "a = 1.0" @?= Right (Right 1)
    , testCase "()" $
        decodeWith (getField @() "a") "a = []" @?= Right ()
    , testCase "(a, b)" $
        decodeWith (getField @(Int, Double) "a") "a = [1, 2.5]" @?= Right (1, 2.5)
    , testCase "Tuples show errors with index" $
        case decodeWith (getField @(Int, Double) "a") "a = [1, true]" of
          Left (DecodeError [Key "a", Index 1] _) -> return ()
          result -> unexpectedResult result
    ]
  where
    assertInvalidValue expected result =
      case result of
        Left (DecodeError _ (InvalidValue actual _)) -> actual @?= expected
        _ -> unexpectedResult result

    unexpectedResult result = assertFailure $ "Got unexpected result: " <> show result