PeekTests.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-|
Module      : Foreign.Lua.PeekTests
Copyright   : © 2020 Albert Krewinkel
License     : MIT
Maintainer  : Albert Krewinkel <tarleb+hslua@zeitkraut.de>
Stability   : alpha
Portability : OverloadedStrings, TypeApplications

Tests for Haskell-value retriever functions.
-}
module Foreign.Lua.PeekTests (tests) where

import Control.Monad (forM_, zipWithM_)
import Data.Either (isLeft)
import Foreign.Lua.Peek

import Test.HsLua.Arbitrary ()
import Test.HsLua.Util ( (=:), pushLuaExpr, shouldBeResultOf
                       , shouldHoldForResultOf)
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.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 Foreign.Lua as Lua
import qualified Foreign.Lua.Utf8 as Utf8

-- | Calling Haskell functions from Lua.
tests :: TestTree
tests = testGroup "Peek"
  [ testGroup "peekBool"
    [ "True" =:
      Right True `shouldBeResultOf` do
        Lua.pushboolean True
        peekBool Lua.stackTop

    , "False" =:
      Right False `shouldBeResultOf` do
        Lua.pushboolean False
        peekBool Lua.stackTop

    , "Numbers are truthy" =:
      Right True `shouldBeResultOf` do
        Lua.pushnumber 0
        peekBool Lua.stackTop

    , "Nil is falsy" =:
      Right False `shouldBeResultOf` do
        Lua.pushnil
        peekBool Lua.stackTop

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

  , testGroup "peekIntegral"
    [ "negative Int" =:
      Right (-5) `shouldBeResultOf` do
        Lua.pushinteger (-5)
        peekIntegral @Int Lua.stackTop

    , "Int as string" =:
      Right 720 `shouldBeResultOf` do
        Lua.pushstring "720"
        peekIntegral @Int Lua.stackTop

    , "fail on boolean" =:
      let msg = "expected Integral, got 'true' (boolean)"
      in Left (errorMsg msg) `shouldBeResultOf` do
        Lua.pushboolean True
        peekIntegral @Int Lua.stackTop

    , "fail on non-numeric string" =:
      let msg = "expected Integral, got 'not a number' (string)"
      in Left (errorMsg msg) `shouldBeResultOf` do
        Lua.pushstring "not a number"
        peekIntegral @Integer Lua.stackTop
    ]

  , testGroup "peekRealFloat"
    [ "negative Float" =:
      Right (-13.37) `shouldBeResultOf` do
        Lua.pushnumber (-13.37)
        peekRealFloat @Float Lua.stackTop

    , "number as string" =:
      Right (-720.0) `shouldBeResultOf` do
        Lua.pushstring "-720"
        peekRealFloat @Float Lua.stackTop

    , "scientific notation string" =:
      Right 0.00071 `shouldBeResultOf` do
        Lua.pushstring "7.1e-4"
        peekRealFloat @Float Lua.stackTop

    , "fail on boolean" =:
      let msg = "expected RealFloat, got 'true' (boolean)"
      in Left (errorMsg msg) `shouldBeResultOf` do
        Lua.pushboolean True
        peekRealFloat @Float Lua.stackTop

    , "fail on non-numeric string" =:
      let msg = "expected RealFloat, got 'not a number' (string)"
      in Left (errorMsg msg) `shouldBeResultOf` do
        Lua.pushstring "not a number"
        peekRealFloat @Double Lua.stackTop
    ]

  , testGroup "Strings"
    [ testGroup "peekByteString"
      [ testProperty "retrieve any string" $ \bs -> monadicIO $ do
          retrieved <- run $ Lua.run $ do
            Lua.pushstring bs
            peekByteString Lua.stackTop
          assert (retrieved == Right bs)

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

      , "fails on boolean" =:
      let msg = "expected string, got 'true' (boolean)"
      in Left (errorMsg msg) `shouldBeResultOf` do
        Lua.pushboolean True
        peekByteString Lua.stackTop
      ]

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

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

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

      , "fails on nil" =:
        let msg = "expected string, got 'nil' (nil)"
        in Left (errorMsg msg) `shouldBeResultOf` do
          Lua.pushnil
          peekByteString Lua.stackTop
      ]

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

      , "fails on table" =:
        isLeft `shouldHoldForResultOf` do
          _ <- Lua.pushglobaltable
          peekString Lua.stackTop

      , "fails on thread" =:
        isLeft `shouldHoldForResultOf` do
          _ <- Lua.pushthread
          peekString Lua.stackTop
      ]
    ]

  , testGroup "Containers"
    [ testGroup "peekList"
      [ "empty list" =:
        Right [] `shouldBeResultOf` do
          Lua.newtable
          peekList peekBool Lua.stackTop

      , testProperty "list of strings" $ \lst -> monadicIO $ do
          retrieved <- run $ Lua.run $ do
            Lua.newtable
            zipWithM_
              (\i s -> Lua.pushstring s *>
                       Lua.rawseti (Lua.nthFromTop 2) i)
              [1..]
              lst
            peekList peekByteString Lua.stackTop
          assert (retrieved == Right lst)

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

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

    , testGroup "peekSet"
      [ "empty set" =:
        Right Set.empty `shouldBeResultOf` do
          Lua.newtable
          peekSet peekBool Lua.stackTop

      , testProperty "set of strings" $ \set -> monadicIO $ do
          retrieved <- run $ Lua.run $ do
            Lua.newtable
            forM_ (Set.toList set) $ \x -> do
              Lua.pushstring x
              Lua.pushboolean True
              Lua.rawset (Lua.nthFromTop 3)
            peekSet peekByteString Lua.stackTop
          assert (retrieved == Right set)

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

      , "fails if element peeker fails" =:
        let errorStack = [ "retrieving Set"
                         , "retrieving key-value pair"
                         , "retrieving key"
                         , "expected string, got 'true' (boolean)"]
        in Left (PeekError $ NonEmpty.fromList errorStack) `shouldBeResultOf` do
          pushLuaExpr "{ NaN = true, [true] = false }"
          peekSet peekText Lua.stackTop
      ]

    , testGroup "peekMap"
      [ "empty map" =:
        Right Map.empty `shouldBeResultOf` do
          Lua.newtable
          peekMap peekText peekText Lua.stackTop

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

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

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