{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-|
Module      : HsLua.Marshalling.PeekersTests
Copyright   : © 2020-2024 Albert Krewinkel
License     : MIT
Maintainer  : Albert Krewinkel <tarleb@hslua.org>

Tests for Haskell-value retriever functions.
-}
module HsLua.Marshalling.PeekersTests (tests) where

import Control.Monad (forM_, zipWithM_)
import HsLua.Marshalling.Peek
import HsLua.Marshalling.Peekers

import Lua.Arbitrary ()
import Test.Tasty.HsLua
  ( (=:), pushLuaExpr, shouldBeResultOf, shouldHoldForResultOf
  , shouldBeErrorMessageOf)
import Test.QuickCheck.Instances ()
import Test.QuickCheck.Monadic (monadicIO, run, assert)
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.QuickCheck (testProperty)

import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as Char8
import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.Text as T
import qualified HsLua.Core as Lua
import qualified HsLua.Core.Utf8 as Utf8

-- | Calling Haskell functions from Lua.
tests :: TestTree
tests = testGroup "Peekers"
  [ testGroup "unit peekers"
    [ "peekNil succeeds on nil" =:
      Success () `shouldBeResultOf` do
        Lua.pushnil
        runPeek $ peekNil Lua.top
    , "peekNil fails on bool" =:
      isFailure `shouldHoldForResultOf` do
        Lua.pushboolean False
        runPeek $ peekNil Lua.top
    , "peekNoneOrNil succeeds on nil" =:
      Success () `shouldBeResultOf` do
        Lua.pushnil
        runPeek $ peekNoneOrNil Lua.top
    , "peekNoneOrNilfails on bool" =:
      isFailure `shouldHoldForResultOf` do
        Lua.pushboolean False
        runPeek $ peekNoneOrNil Lua.top
    ]
  , testGroup "peekBool"
    [ "True" =:
      Success True `shouldBeResultOf` do
        Lua.pushboolean True
        runPeeker peekBool Lua.top

    , "False" =:
      Success False `shouldBeResultOf` do
        Lua.pushboolean False
        runPeeker peekBool Lua.top

    , "Numbers are truthy" =:
      Success True `shouldBeResultOf` do
        Lua.pushnumber 0
        runPeeker peekBool Lua.top

    , "Nil is falsy" =:
      Success False `shouldBeResultOf` do
        Lua.pushnil
        runPeeker peekBool Lua.top

    -- no tests for failing cases, this function always succeeds.
    ]

  , testGroup "peekIntegral"
    [ "negative Int" =:
      Success (-5) `shouldBeResultOf` do
        Lua.pushinteger (-5)
        runPeek $ peekIntegral @Int Lua.top

    , "Int as string" =:
      Success 720 `shouldBeResultOf` do
        Lua.pushstring "720"
        runPeek $ peekIntegral @Int Lua.top

    , "fail on boolean" =:
      let msg = "Integral expected, got boolean"
      in failure msg `shouldBeResultOf` do
        Lua.pushboolean True
        runPeek $ peekIntegral @Int Lua.top

    , "fail on non-numeric string" =:
      let msg = "Integral expected, got string"
      in failure msg `shouldBeResultOf` do
        Lua.pushstring "not a number"
        runPeek $ peekIntegral @Integer Lua.top
    ]

  , testGroup "peekRealFloat"
    [ "negative Float" =:
      Success (-13.37) `shouldBeResultOf` do
        Lua.pushnumber (-13.37)
        runPeek $ peekRealFloat @Float Lua.top

    , "number as string" =:
      Success (-720.0) `shouldBeResultOf` do
        Lua.pushstring "-720"
        runPeek $ peekRealFloat @Float Lua.top

    , "scientific notation string" =:
      Success 0.00071 `shouldBeResultOf` do
        Lua.pushstring "7.1e-4"
        runPeek $ peekRealFloat @Float Lua.top

    , "fail on boolean" =:
      let msg = "RealFloat expected, got boolean"
      in failure msg `shouldBeResultOf` do
        Lua.pushboolean True
        runPeek $ peekRealFloat @Float Lua.top

    , "fail on non-numeric string" =:
      let msg = "RealFloat expected, got string"
      in failure msg `shouldBeResultOf` do
        Lua.pushstring "not a number"
        runPeek $ peekRealFloat @Double Lua.top
    ]

  , testGroup "Strings"
    [ testGroup "peekByteString"
      [ testProperty "retrieve any string" $ \bs -> monadicIO $ do
          retrieved <- run $ Lua.run @Lua.Exception $ do
            Lua.pushstring bs
            runPeeker peekByteString Lua.top
          assert (retrieved == Success bs)

      , testProperty "retrieve integer as string" $ \n -> monadicIO $ do
          retrieved <- run . Lua.run @Lua.Exception $ do
            Lua.pushinteger n
            runPeeker peekByteString Lua.top
          let numberAsByteString = Char8.pack . show @Integer . fromIntegral $ n
          assert (retrieved == Success numberAsByteString)

      , "fails on boolean" =:
      let msg = "string expected, got boolean"
      in failure msg `shouldBeResultOf` do
        Lua.pushboolean True
        runPeeker peekByteString Lua.top
      ]

    , testGroup "peekText"
      [ testProperty "retrieve any string" $ \bs -> monadicIO $ do
          retrieved <- run $ Lua.run @Lua.Exception $ do
            Lua.pushstring bs
            runPeeker peekText Lua.top
          assert (retrieved == Success (Utf8.toText bs))

      , testProperty "retrieve UTF-8 encoded Text" $ \txt -> monadicIO $ do
          retrieved <- run $ Lua.run @Lua.Exception $ do
            Lua.pushstring (Utf8.fromText txt)
            runPeeker peekText Lua.top
          assert (retrieved == Success txt)

      , testProperty "retrieve integer as Text" $ \n -> monadicIO $ do
          retrieved <- run . Lua.run @Lua.Exception $ do
            Lua.pushinteger n
            runPeeker peekText Lua.top
          let numberAsByteString = T.pack . show @Integer . fromIntegral $ n
          assert (retrieved == Success numberAsByteString)

      , "fails on nil" =:
        let msg = "string expected, got nil"
        in failure msg `shouldBeResultOf` do
          Lua.pushnil
          runPeeker peekByteString Lua.top
      ]

    , testGroup "peekString"
      [ testProperty "retrieve UTF-8 encoded string" $ \txt -> monadicIO $ do
          retrieved <- run $ Lua.run @Lua.Exception $ do
            Lua.pushstring (Utf8.fromString txt)
            runPeeker peekString Lua.top
          assert (retrieved == Success txt)

      , "fails on table" =:
        isFailure `shouldHoldForResultOf` do
          _ <- Lua.pushglobaltable
          runPeeker peekString Lua.top

      , "fails on thread" =:
        isFailure `shouldHoldForResultOf` do
          _ <- Lua.pushthread
          runPeeker peekString Lua.top
      ]

    , testGroup "peekStringy"
      [ testProperty "retrieve UTF-8 encoded string as Text" $ \txt ->
          monadicIO $ do
            retrieved <- run $ Lua.run @Lua.Exception $ do
              Lua.pushstring (Utf8.fromText txt)
              runPeeker (peekStringy @T.Text) Lua.top
            assert (retrieved == Success txt)

      , "retrieve ByteString" =:
        Success "This is an ASCII string" `shouldBeResultOf` do
          Lua.pushstring "This is an ASCII string"
          runPeeker (peekStringy @B.ByteString) Lua.top

      , "fails on table" =:
        isFailure `shouldHoldForResultOf` do
          _ <- Lua.pushglobaltable
          runPeeker (peekStringy @B.ByteString) Lua.top
      ]

    , testGroup "peekName"
      [ testProperty "retrieve string as Name" $ \txt ->
          monadicIO $ do
            retrieved <- run $ Lua.run @Lua.Exception $ do
              Lua.pushstring txt
              runPeeker peekName Lua.top
            assert (retrieved == Success (Lua.Name txt))

      , "fails on table" =:
        isFailure `shouldHoldForResultOf` do
          _ <- Lua.pushglobaltable
          runPeeker peekName Lua.top
      ]
    ]

  , testGroup "peekRead"
    [ testProperty "retrieve list of orderings" $ \xs ->
        monadicIO $ do
          retrieved <- run $ Lua.run @Lua.Exception $ do
            Lua.pushstring . Utf8.fromString $ show @[Ordering] xs
            runPeeker peekRead Lua.top
          assert (retrieved == Success xs)

    , "fails on unreadable input" =:
      isFailure `shouldHoldForResultOf` do
        Lua.pushstring "NaN"
        runPeek $ peekRead @Int Lua.top

    , "fails on non-string input" =:
      "string expected, got boolean" `shouldBeErrorMessageOf` do
        Lua.pushboolean True
        runPeeker (peekRead @Int) Lua.top >>= force
    ]

  , testGroup "Containers"
    [ testGroup "peekList"
      [ "empty list" =:
        Success [] `shouldBeResultOf` do
          Lua.newtable
          runPeek $ peekList peekBool Lua.top

      , testProperty "list of strings" $ \lst -> monadicIO $ do
          retrieved <- run $ Lua.run @Lua.Exception $ do
            Lua.newtable
            zipWithM_
              (\i s -> Lua.pushstring s *>
                       Lua.rawseti (Lua.nth 2) i)
              [1..]
              lst
            runPeek $ peekList peekByteString Lua.top
          assert (retrieved == Success lst)

      , "string keys are not in list" =:
        Success [] `shouldBeResultOf` do
          pushLuaExpr "{['1'] = 'hello', ['2'] = 'world'}"
          runPeek $ peekList peekByteString Lua.top

      , "missing pair causes an error" =:
        isFailure `shouldHoldForResultOf` do
          pushLuaExpr "{[1] = 'hello', [2] = 'world', [4] = 'nope'}"
          runPeek $ peekList peekByteString Lua.top
      ]

    , testGroup "peekNonEmpty"
      [ "empty list" =:
        Failure "empty list" ["retrieving NonEmpty"] `shouldBeResultOf` do
          Lua.newtable
          runPeek $ peekNonEmpty peekBool Lua.top

      , "non-empty list" =:
        Success (5 NonEmpty.:| [23]) `shouldBeResultOf` do
          pushLuaExpr "{ 5, 23 }"
          runPeek $ peekNonEmpty (peekIntegral @Int) Lua.top
      ]

    , testGroup "peekSet"
      [ "empty set" =:
        Success Set.empty `shouldBeResultOf` do
          Lua.newtable
          runPeek $ peekSet peekBool Lua.top

      , testProperty "set of strings" $ \set -> monadicIO $ do
          retrieved <- run $ Lua.run @Lua.Exception $ do
            Lua.newtable
            forM_ (Set.toList set) $ \x -> do
              Lua.pushstring x
              Lua.pushboolean True
              Lua.rawset (Lua.nth 3)
            runPeek $ peekSet peekByteString Lua.top
          assert (retrieved == Success set)

      , "keys with falsy values are not in set" =:
        Success (Set.fromList [1,3]) `shouldBeResultOf` do
          pushLuaExpr "{['1'] = 'hello', ['2'] = false, [3] = 5}"
          runPeek $ peekSet (peekIntegral @Int) Lua.top

      , "fails if element peeker fails" =:
        let errorStack = [ "retrieving Set"
                         , "retrieving key-value pair"
                         , "retrieving key"
                         ]
            errorMsg = "string expected, got boolean"
        in Failure errorMsg errorStack `shouldBeResultOf` do
          pushLuaExpr "{ NaN = true, [true] = false }"
          runPeek $ peekSet peekText Lua.top
      ]

    , testGroup "peekMap"
      [ "empty map" =:
        Success Map.empty `shouldBeResultOf` do
          Lua.newtable
          runPeek $ peekMap peekText peekText Lua.top

      , "tables become maps" =:
        Success (Map.fromList [("one", 1), ("two", 2)]) `shouldBeResultOf` do
          pushLuaExpr "{ one = 1, two = 2}"
          runPeek $ peekMap peekText (peekIntegral @Int) Lua.top

      , "fails if key peeker fails" =:
        let errorStack = [ "retrieving Map"
                         , "retrieving key-value pair"
                         , "retrieving key"
                         ]
            errorMsg = "Integral expected, got string"
        in Failure errorMsg errorStack `shouldBeResultOf` do
          pushLuaExpr "{ NaN = true }"
          runPeek $ peekMap (peekIntegral @Int) peekBool Lua.top

      , "fails if value peeker fails" =:
        let errorStack = [ "retrieving Map"
                         , "retrieving key-value pair"
                         , "retrieving value"
                         ]
            errorMsg = "string expected, got boolean"
        in Failure errorMsg errorStack `shouldBeResultOf` do
          pushLuaExpr "{ [42] = true }"
          runPeek $ peekMap (peekIntegral @Int) peekText Lua.top
      ]
    ]


  , testGroup "combinators"
    [ testGroup "peekFieldRaw"
      [ "access field" =:
        Success 8 `shouldBeResultOf` do
          pushLuaExpr "{ num = 8 }"
          runPeek $ peekFieldRaw (peekIntegral @Int) "num" Lua.top
      , "object not on top of stack" =:
        Success 9 `shouldBeResultOf` do
          pushLuaExpr "{ int = 9 }"
          Lua.pushnil
          runPeek $ peekFieldRaw (peekIntegral @Int) "int" (Lua.nth 2)
      ]

    , testGroup "peekPair"
      [ "pair from table" =:
        Success ("ninety", 90) `shouldBeResultOf` do
          pushLuaExpr "{'ninety', 90}"
          Lua.pushnil
          runPeek $
            peekPair peekString (peekIntegral @Int) (Lua.nth 2)

      , "fails if a component peeker fails" =:
        Failure "fail" [] `shouldBeResultOf` do
          pushLuaExpr "{ 'second', 2 }"
          runPeek $
            peekPair peekString (const $ failPeek @() "fail") Lua.top
      ]

    , testGroup "peekTriple"
      [ "pair from table" =:
        Success ("hundred", 100, True) `shouldBeResultOf` do
          pushLuaExpr "{'hundred', 100, 1}"
          Lua.pushnil
          runPeek $
            peekTriple peekString (peekIntegral @Int) peekBool (Lua.nth 2)

      , "fails if a component peeker fails" =:
        Failure "fail" [] `shouldBeResultOf` do
          pushLuaExpr "{ 'second', 2, true }"
          runPeek $
            peekTriple peekString
                       (const $ failPeek @() "fail")
                       peekBool
                       Lua.top
      ]
    , testGroup "peekChoice"
      [ "uses first result to succeed" =:
        Success 1337 `shouldBeResultOf` runPeek
          (choice [ const $ failPeek "nope"
                  , const $ failPeek "neither"
                  , const $ return (1337 :: Int)
                  ] Lua.top)

      , "uses peekers" =:
        Success "[]" `shouldBeResultOf` do
          Lua.newtable
          runPeeker
            (choice [ peekString
                    , fmap show . peekList peekBool
                    ])
            Lua.top

      , "fails if all peekers fail" =:
        Failure "all choices failed" [] `shouldBeResultOf` do
          runPeeker (choice [const $ failPeek @() "nope"]) Lua.top
      ]

    , testGroup "peekNilOr"
      [ "returns the parser result if the value is not nil" =:
        Success (Just "a") `shouldBeResultOf` runPeek
          (liftLua (Lua.pushstring "a") *> peekNilOr peekString Lua.top)
      , "returns nothing if the value is nil" =:
        Success Nothing `shouldBeResultOf` runPeek
          (liftLua Lua.pushnil *> peekNilOr peekString Lua.top)
      , "fails if the value is none" =:
        Failure "string expected, got no value" [] `shouldBeResultOf` runPeek
          (liftLua Lua.gettop >>= peekNilOr @Maybe peekString . (+1))
      ]

    , testGroup "peekNoneOr"
      [ "returns the parser result if a value is present" =:
        Success (Just "a") `shouldBeResultOf` runPeek
          (liftLua (Lua.pushstring "a") *> peekNoneOr peekString Lua.top)
      , "returns the parser result if the value is nil" =:
        Success (Just ()) `shouldBeResultOf` runPeek
          (liftLua Lua.pushnil *> peekNoneOr peekNil Lua.top)
      , "returns `empty` if the value is missing" =:
        Success Nothing `shouldBeResultOf` runPeek
          (liftLua Lua.gettop >>= peekNoneOr @Maybe peekString . (+1))
      , "fails if the parser cannot parse the value" =:
        Failure "string expected, got nil" [] `shouldBeResultOf` runPeek
          (liftLua Lua.pushnil *> peekNoneOr @Maybe peekString Lua.top)
      ]
    , testGroup "peekNoneOrNilOr"
      [ "returns the parser result if a value is present" =:
        Success (Just "a") `shouldBeResultOf` runPeek
          (liftLua (Lua.pushstring "a") *> peekNoneOrNilOr peekString Lua.top)
      , "returns `empty` if the value is nil" =:
        Success Nothing `shouldBeResultOf` runPeek
          (liftLua Lua.pushnil *> peekNoneOrNilOr @Maybe peekString Lua.top)
      , "returns `empty` if the value is missing" =:
        Success Nothing `shouldBeResultOf` runPeek
          (liftLua Lua.gettop >>= peekNoneOrNilOr @Maybe peekString . (+1))
      , "fails if the parser cannot parse the value" =:
        Failure "string expected, got boolean" [] `shouldBeResultOf` runPeek
          (liftLua (Lua.pushboolean True) *>
           peekNoneOrNilOr @Maybe peekString Lua.top)
      ]
    ]

  , testGroup "helper"
    [ testGroup "reportValueOnFailure"
      [ "success" =:
        Success 23 `shouldBeResultOf` do
          runPeeker
            (reportValueOnFailure "foo" (const . return $ Just (23 :: Int)))
            (Lua.nthBottom 1)

      , "failure" =:
        Failure "squirrel expected, got number" []
        `shouldBeResultOf` do
          Lua.pushinteger 23
          let peekSquirrel :: Peeker Lua.Exception ()
              peekSquirrel = reportValueOnFailure "squirrel"
                                                  (const $ return Nothing)
          runPeeker peekSquirrel Lua.top
      ]
    ]

  , testGroup "error messages"
    [ "value in list" =:
      mconcat ["Integral expected, got table\n"
              , "\twhile retrieving index 3\n"
              , "\twhile retrieving list"
              ] `shouldBeErrorMessageOf` do
        Lua.openlibs
        Lua.OK <- Lua.dostring $ Utf8.fromString
          "nope = {__tostring = function () return '⚘' end}"
        pushLuaExpr "{5, 8, setmetatable({}, nope), 21}"
        runPeeker (peekList (peekIntegral @Int)) Lua.top >>= force

    , "nil instead of list" =:
      mconcat ["table expected, got nil\n"
              , "\twhile retrieving list"
              ] `shouldBeErrorMessageOf` do
        Lua.pushnil
        runPeeker (peekList peekString) Lua.top >>= force

    , "value in key-value pairs" =:
      mconcat [ "string expected, got boolean\n"
              , "\twhile retrieving value\n"
              , "\twhile retrieving key-value pair"
              ] `shouldBeErrorMessageOf` do
        pushLuaExpr "{ a = true}"
        runPeeker (peekKeyValuePairs peekText peekText) Lua.top >>= force
    ]
  ]