feat(haskell): Interaction Tree IO
oops, now we have purely modelled IO 🤷
This commit is contained in:
58
test/Spec.hs
58
test/Spec.hs
@@ -8,10 +8,12 @@ import REPL
|
||||
import Research
|
||||
import Wire
|
||||
import ContentStore
|
||||
import IODriver
|
||||
|
||||
import Control.Exception (evaluate, try, SomeException)
|
||||
import Control.Monad (forM_)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import System.IO.Temp (withSystemTempDirectory)
|
||||
import Data.Bits (xor)
|
||||
import Data.Char (digitToInt)
|
||||
import Data.List (isInfixOf)
|
||||
@@ -51,6 +53,7 @@ tests = testGroup "Tricu Tests"
|
||||
, wireTests
|
||||
, tricuReaderTests
|
||||
, byteListUtilities
|
||||
, ioDriverTests
|
||||
]
|
||||
|
||||
lexer :: TestTree
|
||||
@@ -1252,3 +1255,58 @@ byteListUtilities = testGroup "Byte List Utility Tests"
|
||||
let env = evalTricu library (parseTricu input)
|
||||
result env @?= falseT
|
||||
]
|
||||
|
||||
-- --------------------------------------------------------------------------
|
||||
-- IO driver tests
|
||||
-- --------------------------------------------------------------------------
|
||||
|
||||
ioDriverTests :: TestTree
|
||||
ioDriverTests = testGroup "IO driver tests"
|
||||
[ testCase "readFile through onReadFile returns file contents" $
|
||||
withSystemTempDirectory "tricu-io-read" $ \dir -> do
|
||||
let sourcePath = dir ++ "/input.txt"
|
||||
writeFile sourcePath "abc123"
|
||||
final <- runIOSource $
|
||||
unlines
|
||||
[ "main = io (onReadFile \"" ++ sourcePath ++ "\""
|
||||
, " (err rest : pure \"read failed\")"
|
||||
, " (contents rest : pure contents))"
|
||||
]
|
||||
final @?= ofString "abc123"
|
||||
|
||||
, testCase "readFile error path returns explicit error branch" $
|
||||
withSystemTempDirectory "tricu-io-read-missing" $ \dir -> do
|
||||
let sourcePath = dir ++ "/missing.txt"
|
||||
final <- runIOSource $
|
||||
unlines
|
||||
[ "main = io (onReadFile \"" ++ sourcePath ++ "\""
|
||||
, " (err rest : pure \"read failed\")"
|
||||
, " (contents rest : pure contents))"
|
||||
]
|
||||
final @?= ofString "read failed"
|
||||
|
||||
, testCase "chains multiple readFile actions through Result-aware helper" $
|
||||
withSystemTempDirectory "tricu-io-chain" $ \dir -> do
|
||||
let firstPath = dir ++ "/first.txt"
|
||||
secondPath = dir ++ "/second.txt"
|
||||
writeFile firstPath "abc"
|
||||
writeFile secondPath "def"
|
||||
final <- runIOSource $
|
||||
unlines
|
||||
[ "main = io (onReadFile \"" ++ firstPath ++ "\""
|
||||
, " (err rest : pure \"first read failed\")"
|
||||
, " (first rest : onReadFile \"" ++ secondPath ++ "\""
|
||||
, " (err rest : pure \"second read failed\")"
|
||||
, " (second rest : pure (append first second))))"
|
||||
]
|
||||
final @?= ofString "abcdef"
|
||||
]
|
||||
|
||||
runIOSource :: String -> IO T
|
||||
runIOSource source = do
|
||||
ioEnv <- evaluateFile "./lib/io.tri"
|
||||
env <- evalTricuWithStore Nothing ioEnv (parseTricu source)
|
||||
case checkIOSentinel (mainResult env) of
|
||||
Right (1, action) -> runIO defaultPerms action
|
||||
Right (v, _) -> assertFailure ("Unsupported IO ABI version: " ++ show v)
|
||||
Left err -> assertFailure ("Expected IO sentinel: " ++ err)
|
||||
|
||||
Reference in New Issue
Block a user