    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-|
    Module      : Test.Tasty.Lua.Core
    Copyright   : © 2019-2023 Albert Krewinkel
    License     : MIT
    Maintainer  : Albert Krewinkel <tarleb@hslua.org>

    Core types and functions for tasty Lua tests.
    -}
    module Test.Tasty.Lua.Core
      ( runTastyFile
      , ResultTree (..)
      , Outcome (..)
      , UnnamedTree (..)
      )
    where

    import Control.Monad ((<$!>), void)
    import HsLua.Core (LuaE, LuaError, pop, toboolean, top)
    import HsLua.Marshalling
      ( Peeker, lastly, liftLua, resultToEither, retrieving
      , peekFieldRaw, peekList, peekString, runPeek)
    import Test.Tasty.Lua.Module (pushModule)
    import qualified HsLua.Core as Lua
    import qualified HsLua.Core.Utf8 as Utf8
    import qualified Test.Tasty as Tasty

    -- | Run a tasty Lua script from a file and return either the resulting
    -- test tree or the error message.
    runTastyFile :: LuaError e => FilePath -> LuaE e (Either String [ResultTree])
    runTastyFile :: forall e.
    LuaError e =>
    FilePath -> LuaE e (Either FilePath [ResultTree])
    runTastyFile FilePath
    fp = do
      LuaE e ()
    forall e. LuaE e ()
    Lua.openlibs
      Name -> (Name -> LuaE e ()) -> LuaE e ()
    forall e. LuaError e => Name -> (Name -> LuaE e ()) -> LuaE e ()
    Lua.requirehs Name
    "tasty" (LuaE e () -> Name -> LuaE e ()
    forall a b. a -> b -> a
    const (LuaE e () -> Name -> LuaE e ())
    -> (LuaE e NumResults -> LuaE e ())
    -> LuaE e NumResults
    -> Name
    -> LuaE e ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LuaE e NumResults -> LuaE e ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (LuaE e NumResults -> Name -> LuaE e ())
    -> LuaE e NumResults -> Name -> LuaE e ()
    forall a b. (a -> b) -> a -> b
    $ LuaE e NumResults
    forall e. LuaError e => HaskellFunction e
    pushModule)
      Status
    res <- Maybe FilePath -> LuaE e Status
    forall e. Maybe FilePath -> LuaE e Status
    Lua.dofileTrace (FilePath -> Maybe FilePath
    forall a. a -> Maybe a
    Just FilePath
    fp)
      if Status
    res Status -> Status -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Status
    Lua.OK
        then FilePath -> Either FilePath [ResultTree]
    forall a b. a -> Either a b
    Left (FilePath -> Either FilePath [ResultTree])
    -> (ByteString -> FilePath)
    -> ByteString
    -> Either FilePath [ResultTree]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> FilePath
    Utf8.toString (ByteString -> Either FilePath [ResultTree])
    -> LuaE e ByteString -> LuaE e (Either FilePath [ResultTree])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> StackIndex -> LuaE e ByteString
    forall e. LuaError e => StackIndex -> LuaE e ByteString
    Lua.tostring' StackIndex
    top
        else Result [ResultTree] -> Either FilePath [ResultTree]
    forall a. Result a -> Either FilePath a
    resultToEither (Result [ResultTree] -> Either FilePath [ResultTree])
    -> LuaE e (Result [ResultTree])
    -> LuaE e (Either FilePath [ResultTree])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Peek e [ResultTree] -> LuaE e (Result [ResultTree])
    forall e a. Peek e a -> LuaE e (Result a)
    runPeek (Peeker e ResultTree -> Peeker e [ResultTree]
    forall a e. LuaError e => Peeker e a -> Peeker e [a]
    peekList Peeker e ResultTree
    forall e. LuaError e => Peeker e ResultTree
    peekResultTree StackIndex
    top)

    -- | Tree of test results returned by tasty Lua scripts. This is
    -- similar to tasty's @'TestTree'@, with the important difference that
    -- all tests have already been run, and all test results are known.
    data ResultTree = ResultTree Tasty.TestName UnnamedTree

    peekResultTree :: LuaError e => Peeker e ResultTree
    peekResultTree :: forall e. LuaError e => Peeker e ResultTree
    peekResultTree StackIndex
    idx = do
      FilePath
    name   <- Peeker e FilePath -> Name -> Peeker e FilePath
    forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
    peekFieldRaw Peeker e FilePath
    forall e. Peeker e FilePath
    peekString Name
    "name" StackIndex
    idx
      UnnamedTree
    result <- Peeker e UnnamedTree -> Name -> Peeker e UnnamedTree
    forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
    peekFieldRaw Peeker e UnnamedTree
    forall e. LuaError e => Peeker e UnnamedTree
    peekUnnamedTree Name
    "result" StackIndex
    idx
      ResultTree -> Peek e ResultTree
    forall a. a -> Peek e a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ResultTree -> Peek e ResultTree)
    -> ResultTree -> Peek e ResultTree
    forall a b. (a -> b) -> a -> b
    $! FilePath -> UnnamedTree -> ResultTree
    ResultTree FilePath
    name UnnamedTree
    result

    -- | Either a raw test outcome, or a nested @'Tree'@.
    data UnnamedTree
      = SingleTest Outcome
      | TestGroup [ResultTree]

    -- | Unmarshal an @'UnnamedTree'@.
    peekUnnamedTree :: LuaError e => Peeker e UnnamedTree
    peekUnnamedTree :: forall e. LuaError e => Peeker e UnnamedTree
    peekUnnamedTree StackIndex
    idx = LuaE e Type -> Peek e Type
    forall e a. LuaE e a -> Peek e a
    liftLua (StackIndex -> LuaE e Type
    forall e. StackIndex -> LuaE e Type
    Lua.ltype StackIndex
    idx) Peek e Type -> (Type -> Peek e UnnamedTree) -> Peek e UnnamedTree
    forall a b. Peek e a -> (a -> Peek e b) -> Peek e b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
      Type
    Lua.TypeTable -> [ResultTree] -> UnnamedTree
    TestGroup   ([ResultTree] -> UnnamedTree)
    -> Peek e [ResultTree] -> Peek e UnnamedTree
    forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
    <$!> Peeker e ResultTree -> Peeker e [ResultTree]
    forall a e. LuaError e => Peeker e a -> Peeker e [a]
    peekList Peeker e ResultTree
    forall e. LuaError e => Peeker e ResultTree
    peekResultTree StackIndex
    idx
      Type
    _             -> Outcome -> UnnamedTree
    SingleTest  (Outcome -> UnnamedTree) -> Peek e Outcome -> Peek e UnnamedTree
    forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
    <$!> Peeker e Outcome
    forall e. LuaError e => Peeker e Outcome
    peekOutcome StackIndex
    idx

    -- | Test outcome
    data Outcome = Success | Failure String

    -- | Unmarshal a test outcome
    peekOutcome :: LuaError e => Peeker e Outcome
    peekOutcome :: forall e. LuaError e => Peeker e Outcome
    peekOutcome StackIndex
    idx = Name -> Peek e Outcome -> Peek e Outcome
    forall e a. Name -> Peek e a -> Peek e a
    retrieving Name
    "test result" (Peek e Outcome -> Peek e Outcome)
    -> Peek e Outcome -> Peek e Outcome
    forall a b. (a -> b) -> a -> b
    $ do
      LuaE e Type -> Peek e Type
    forall e a. LuaE e a -> Peek e a
    liftLua (StackIndex -> LuaE e Type
    forall e. StackIndex -> LuaE e Type
    Lua.ltype StackIndex
    idx) Peek e Type -> (Type -> Peek e Outcome) -> Peek e Outcome
    forall a b. Peek e a -> (a -> Peek e b) -> Peek e b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
        Type
    Lua.TypeString  -> FilePath -> Outcome
    Failure (FilePath -> Outcome) -> Peek e FilePath -> Peek e Outcome
    forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
    <$!> Peeker e FilePath
    forall e. Peeker e FilePath
    peekString StackIndex
    idx
        Type
    Lua.TypeBoolean -> do
          Bool
    b <- LuaE e Bool -> Peek e Bool
    forall e a. LuaE e a -> Peek e a
    liftLua (LuaE e Bool -> Peek e Bool) -> LuaE e Bool -> Peek e Bool
    forall a b. (a -> b) -> a -> b
    $ StackIndex -> LuaE e Bool
    forall e. StackIndex -> LuaE e Bool
    toboolean StackIndex
    idx
          Outcome -> Peek e Outcome
    forall a. a -> Peek e a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Outcome -> Peek e Outcome) -> Outcome -> Peek e Outcome
    forall a b. (a -> b) -> a -> b
    $ if Bool
    b then Outcome
    Success else FilePath -> Outcome
    Failure FilePath
    "???"
        Type
    _ -> FilePath -> Outcome
    Failure (FilePath -> Outcome) -> Peek e FilePath -> Peek e Outcome
    forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
    <$!>
             (LuaE e ByteString -> Peek e ByteString
    forall e a. LuaE e a -> Peek e a
    liftLua (StackIndex -> LuaE e ByteString
    forall e. LuaError e => StackIndex -> LuaE e ByteString
    Lua.tostring' StackIndex
    idx) Peek e ByteString -> Peek e FilePath -> Peek e FilePath
    forall a b. Peek e a -> Peek e b -> Peek e b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> Peeker e FilePath
    forall e. Peeker e FilePath
    peekString StackIndex
    top) Peek e FilePath -> LuaE e () -> Peek e FilePath
    forall e a b. Peek e a -> LuaE e b -> Peek e a
    `lastly` Int -> LuaE e ()
    forall e. Int -> LuaE e ()
    pop Int
    1