-- | See the package [README](https://github.com/GaloisInc/oughta/blob/main/README.md) for a high-level description.
module Oughta
  ( -- * Running checks
    Output(..)
  , check
  , check'
    -- * Loading Lua programs
  , OE.LuaProgram
  , OE.addPrefix
  , OE.plainLuaProgram
  , OE.fromLines
  , OE.fromLineComments
    -- * Interpreting results
  , OR.Failure(..)
  , OR.Progress(..)
  , OR.Success(..)
  , OR.Result(..)
  , OR.resultNull
  , OR.printResult
    -- ** Source locations
  , Loc(..)
  , Pos(..)
  , OP.Span(..)
  ) where

import Control.Exception qualified as X
import Data.ByteString (ByteString)
import Oughta.Extract (LuaProgram)
import Oughta.Extract qualified as OE
import Oughta.LuaApi qualified as FCLA
import Oughta.Pos (Loc(..), Pos(..))
import Oughta.Pos qualified as OP
import Oughta.Result qualified as OR
import GHC.Stack (HasCallStack)
import Prelude hiding (lines, span)

-- | Output of the program under test
newtype Output = Output ByteString

-- | Check some program output against a Oughta Lua program.
check ::
  LuaProgram ->
  Output ->
  IO OR.Result
check :: LuaProgram -> Output -> IO Result
check LuaProgram
prog (Output ByteString
out) = LuaProgram -> ByteString -> IO Result
FCLA.check LuaProgram
prog ByteString
out

-- | Like 'check', but throws an exception on failure.
check' ::
  HasCallStack =>
  LuaProgram ->
  Output ->
  IO ()
check' :: HasCallStack => LuaProgram -> Output -> IO ()
check' LuaProgram
prog Output
out = do
  OR.Result Either Failure Success
r <- LuaProgram -> Output -> IO Result
check LuaProgram
prog Output
out
  case Either Failure Success
r of
    Left Failure
f -> Failure -> IO ()
forall e a. Exception e => e -> IO a
X.throwIO Failure
f
    Right {} -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()