mirror of
https://github.com/anoma/juvix.git
synced 2024-12-14 08:27:03 +03:00
48 lines
1.4 KiB
Haskell
48 lines
1.4 KiB
Haskell
module Base (
|
|
module Test.Tasty,
|
|
module Test.Tasty.HUnit,
|
|
module MiniJuvix.Prelude,
|
|
module Base
|
|
) where
|
|
|
|
import Test.Tasty
|
|
import Test.Tasty.HUnit
|
|
import MiniJuvix.Prelude
|
|
import qualified MiniJuvix.Syntax.Concrete.Language as M
|
|
import qualified MiniJuvix.Syntax.Concrete.Parser as M
|
|
import qualified MiniJuvix.Syntax.Concrete.Scoped.Scoper as M
|
|
|
|
parseModuleIO :: FilePath -> IO (M.Module 'M.Parsed 'M.ModuleTop)
|
|
parseModuleIO = fromRightIO id . M.runModuleParserIO
|
|
|
|
parseTextModuleIO :: Text -> IO (M.Module 'M.Parsed 'M.ModuleTop)
|
|
parseTextModuleIO = fromRightIO id . return . M.runModuleParser "literal string"
|
|
|
|
fromRightIO' :: (e -> IO ()) -> IO (Either e r) -> IO r
|
|
fromRightIO' pp = do
|
|
eitherM ifLeft return
|
|
where
|
|
ifLeft e = pp e >> exitFailure
|
|
|
|
fromRightIO :: (e -> Text) -> IO (Either e r) -> IO r
|
|
fromRightIO pp = fromRightIO' (putStrLn . pp)
|
|
|
|
scopeModuleIO :: M.Module 'M.Parsed 'M.ModuleTop -> IO (M.Module 'M.Scoped 'M.ModuleTop)
|
|
scopeModuleIO = fromRightIO' printErrorAnsi . M.scopeCheck1IO "."
|
|
|
|
data AssertionDescr =
|
|
Single Assertion
|
|
| Steps ((String -> IO ()) -> Assertion)
|
|
|
|
data TestDescr = TestDescr {
|
|
testName :: String,
|
|
testRoot :: FilePath,
|
|
-- | relative to root
|
|
testAssertion :: AssertionDescr
|
|
}
|
|
|
|
mkTest :: TestDescr -> TestTree
|
|
mkTest TestDescr {..} = case testAssertion of
|
|
Single assertion -> testCase testName $ withCurrentDirectory testRoot assertion
|
|
Steps steps -> testCaseSteps testName (withCurrentDirectory testRoot . steps)
|