    {-# LANGUAGE LambdaCase #-}
    {-|
    Module      : Test.Tasty.Lua.Core
    Copyright   : © 2019–2020 Albert Krewinkel
    License     : MIT
    Maintainer  : Albert Krewinkel <albert+hslua@zeitkraut.de>
    Stability   : alpha
    Portability : not portable, requires GHC or later

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

    import Control.Monad (void)
    import Data.ByteString (ByteString)
    import Foreign.Lua (Lua, Peekable, StackIndex)
    import Test.Tasty.Lua.Module (pushModule)
    import qualified Data.Text as Text
    import qualified Data.Text.Encoding as Text.Encoding
    import qualified Foreign.Lua as Lua
    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 :: FilePath -> Lua (Either String [ResultTree])
    runTastyFile :: FilePath -> Lua (Either FilePath [ResultTree])
    runTastyFile fp :: FilePath
    fp = do
      Lua ()
    Lua.openlibs
      FilePath -> Lua () -> Lua ()
    Lua.requirehs "tasty" (Lua NumResults -> Lua ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void Lua NumResults
    pushModule)
      Status
    res <- FilePath -> Lua Status
    Lua.dofile 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
    toString (ByteString -> Either FilePath [ResultTree])
    -> Lua ByteString -> Lua (Either FilePath [ResultTree])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> StackIndex -> Lua ByteString
    Lua.tostring' StackIndex
    Lua.stackTop
        else Lua [ResultTree] -> Lua (Either Exception [ResultTree])
    forall a. Lua a -> Lua (Either Exception a)
    Lua.try (StackIndex -> Lua [ResultTree]
    forall a. Peekable a => StackIndex -> Lua [a]
    Lua.peekList StackIndex
    Lua.stackTop) Lua (Either Exception [ResultTree])
    -> (Either Exception [ResultTree]
        -> Lua (Either FilePath [ResultTree]))
    -> Lua (Either FilePath [ResultTree])
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
               Left (Lua.Exception e :: FilePath
    e) -> Either FilePath [ResultTree] -> Lua (Either FilePath [ResultTree])
    forall (m :: * -> *) a. Monad m => a -> m a
    return (FilePath -> Either FilePath [ResultTree]
    forall a b. a -> Either a b
    Left FilePath
    e)
               Right trees :: [ResultTree]
    trees            -> Either FilePath [ResultTree] -> Lua (Either FilePath [ResultTree])
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([ResultTree] -> Either FilePath [ResultTree]
    forall a b. b -> Either a b
    Right [ResultTree]
    trees)

    -- | Convert UTF8-encoded @'ByteString'@ to a @'String'@.
    toString :: ByteString -> String
    toString :: ByteString -> FilePath
    toString = Text -> FilePath
    Text.unpack (Text -> FilePath)
    -> (ByteString -> Text) -> ByteString -> FilePath
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> Text
    Text.Encoding.decodeUtf8

    -- | 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

    instance Peekable ResultTree where
      peek :: StackIndex -> Lua ResultTree
    peek = StackIndex -> Lua ResultTree
    peekResultTree

    peekResultTree :: StackIndex -> Lua ResultTree
    peekResultTree :: StackIndex -> Lua ResultTree
    peekResultTree idx :: StackIndex
    idx = do
      FilePath
    name   <- StackIndex -> FilePath -> Lua ()
    Lua.getfield StackIndex
    idx "name"   Lua () -> Lua FilePath -> Lua FilePath
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> Lua FilePath
    forall a. Peekable a => Lua a
    Lua.popValue
      UnnamedTree
    result <- StackIndex -> FilePath -> Lua ()
    Lua.getfield StackIndex
    idx "result" Lua () -> Lua UnnamedTree -> Lua UnnamedTree
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> Lua UnnamedTree
    forall a. Peekable a => Lua a
    Lua.popValue
      ResultTree -> Lua ResultTree
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ResultTree -> Lua ResultTree) -> ResultTree -> Lua 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]

    instance Peekable UnnamedTree where
      peek :: StackIndex -> Lua UnnamedTree
    peek = StackIndex -> Lua UnnamedTree
    peekUnnamedTree

    -- | Unmarshal an @'UnnamedTree'@.
    peekUnnamedTree :: StackIndex -> Lua UnnamedTree
    peekUnnamedTree :: StackIndex -> Lua UnnamedTree
    peekUnnamedTree idx :: StackIndex
    idx = do
      Type
    ty <- StackIndex -> Lua Type
    Lua.ltype StackIndex
    idx
      case Type
    ty of
        Lua.TypeTable   -> [ResultTree] -> UnnamedTree
    TestGroup   ([ResultTree] -> UnnamedTree)
    -> Lua [ResultTree] -> Lua UnnamedTree
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> StackIndex -> Lua [ResultTree]
    forall a. Peekable a => StackIndex -> Lua [a]
    Lua.peekList StackIndex
    idx
        _               -> Outcome -> UnnamedTree
    SingleTest  (Outcome -> UnnamedTree) -> Lua Outcome -> Lua UnnamedTree
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> StackIndex -> Lua Outcome
    forall a. Peekable a => StackIndex -> Lua a
    Lua.peek StackIndex
    idx

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

    instance Peekable Outcome where
      peek :: StackIndex -> Lua Outcome
    peek = StackIndex -> Lua Outcome
    peekOutcome

    -- | Unmarshal a test outcome
    peekOutcome :: StackIndex -> Lua Outcome
    peekOutcome :: StackIndex -> Lua Outcome
    peekOutcome idx :: StackIndex
    idx = do
      Type
    ty <- StackIndex -> Lua Type
    Lua.ltype StackIndex
    idx
      case Type
    ty of
        Lua.TypeString  -> FilePath -> Outcome
    Failure (FilePath -> Outcome) -> Lua FilePath -> Lua Outcome
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> StackIndex -> Lua FilePath
    forall a. Peekable a => StackIndex -> Lua a
    Lua.peek StackIndex
    idx
        Lua.TypeBoolean -> do
          Bool
    b <- StackIndex -> Lua Bool
    forall a. Peekable a => StackIndex -> Lua a
    Lua.peek StackIndex
    idx
          Outcome -> Lua Outcome
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Outcome -> Lua Outcome) -> Outcome -> Lua Outcome
    forall a b. (a -> b) -> a -> b
    $ if Bool
    b then Outcome
    Success else FilePath -> Outcome
    Failure "???"
        _ -> do
          FilePath
    s <- ByteString -> FilePath
    toString (ByteString -> FilePath) -> Lua ByteString -> Lua FilePath
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> StackIndex -> Lua ByteString
    Lua.tostring' StackIndex
    idx
          FilePath -> Lua Outcome
    forall a. FilePath -> Lua a
    Lua.throwException ("not a test result: " FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    s)