James/tricu
1
1
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Strings for IO driver errors

Browse Source
This commit is contained in:
James Eversole
2026-05-18 18:28:24 -05:00
parent 593aa96193
commit 2e13583de3
6 changed files with 69 additions and 102 deletions
Download Patch File Download Diff File Expand all files Collapse all files

86
src/IODriver.hs
View File

@@ -95,67 +95,33 @@ data Machine = Machine
--
-- Runtime protocol errors are returned as direct values via errResult.
-- Error code ranges:
-- 1-19 host IO / filesystem errors
-- 20-39 policy / permission errors
-- 40-59 protocol / decode / type errors
-- 60-79 async errors
-- 80-99 scheduler / runtime errors
-- Host IO / filesystem errors (1-19)
errDoesNotExist, errPermission, errAlreadyExists, errIOOther :: Integer
errDoesNotExist = 1
errPermission = 2
errAlreadyExists = 3
errIOOther = 4
-- Policy / permission errors (20-39)
errPolicyDeny :: Integer
errPolicyDeny = 20
-- Protocol / decode / type errors (40-59)
errInvalidAction, errInvalidString :: Integer
errInvalidAction = 40
errInvalidString = 41
-- Async errors (60-79)
errInvalidHandle, errSelfAwait, errInvalidSleep, errCyclicAwait :: Integer
errInvalidHandle = 60
errSelfAwait = 61
errInvalidSleep = 62
errCyclicAwait = 63
-- Scheduler / runtime errors (80-99)
errDeadlock :: Integer
errDeadlock = 80
ioErrorCode :: IOException -> Integer
ioErrorCode e
| isDoesNotExistError e = errDoesNotExist
| isPermissionError e = errPermission
| isAlreadyExistsError e = errAlreadyExists
| otherwise = errIOOther
okResult :: T -> T
okResult val = Fork (Stem Leaf) (Fork val Leaf)
errResult :: Integer -> T
errResult code = Fork Leaf (Fork (ofNumber code) Leaf)
errResult :: String -> T
errResult msg = Fork Leaf (Fork (ofString msg) Leaf)
pureAction :: T -> T
pureAction x = Fork (ofNumber 0) x
invalidAsyncHandleResult :: T
invalidAsyncHandleResult = errResult errInvalidHandle
invalidAsyncHandleResult = errResult "invalid task handle"
selfAwaitResult :: T
selfAwaitResult = errResult errSelfAwait
selfAwaitResult = errResult "self await"
deadlockResult :: T
deadlockResult = errResult errDeadlock
deadlockResult = errResult "deadlock"
invalidSleepResult :: T
invalidSleepResult = errResult errInvalidSleep
invalidSleepResult = errResult "invalid sleep"
ioErrorString :: IOException -> String
ioErrorString e
| isDoesNotExistError e = "does not exist"
| isPermissionError e = "permission denied"
| isAlreadyExistsError e = "already exists"
| otherwise = "io error"
-- ---------------------------------------------------------------------------
-- Task identity and handles
@@ -350,7 +316,7 @@ stepMachine :: Machine -> IO Step
stepMachine machine =
case decodeAction (machineCurrent machine) of
Right action -> dispatch action
Left _ -> finishValue machine (errResult errInvalidAction)
Left _ -> finishValue machine (errResult "invalid action")
where
dispatch action = case action of
APure val ->
@@ -367,14 +333,14 @@ stepMachine machine =
Right s ->
pure (AsyncAction (putStr s >> pure Leaf) machine)
Left _ ->
finishValue machine (errResult errInvalidString)
finishValue machine (errResult "invalid string")
APutBytes bs ->
case decodeBytes bs "PutBytes" of
Right b ->
pure (AsyncAction (BS.putStr b >> pure Leaf) machine)
Left _ ->
finishValue machine (errResult errInvalidString)
finishValue machine (errResult "invalid bytes")
AGetLine ->
pure (AsyncAction (ofString <$> getLine) machine)
@@ -386,7 +352,7 @@ stepMachine machine =
case mDeny of
Just denied -> finishValue machine denied
Nothing -> pure (AsyncAction (tryReadFile p) machine)
Left _ -> finishValue machine (errResult errInvalidString)
Left _ -> finishValue machine (errResult "invalid string")
AWriteFile path contents ->
case decodeString path "WriteFile" of
@@ -397,8 +363,8 @@ stepMachine machine =
case mDeny of
Just denied -> finishValue machine denied
Nothing -> pure (AsyncAction (tryWriteFile p c) machine)
Left _ -> finishValue machine (errResult errInvalidString)
Left _ -> finishValue machine (errResult errInvalidString)
Left _ -> finishValue machine (errResult "invalid string")
Left _ -> finishValue machine (errResult "invalid string")
AWriteBytes path contents ->
case decodeString path "WriteBytes" of
@@ -409,8 +375,8 @@ stepMachine machine =
case mDeny of
Just denied -> finishValue machine denied
Nothing -> pure (AsyncAction (tryWriteFileBytes p c) machine)
Left _ -> finishValue machine (errResult errInvalidString)
Left _ -> finishValue machine (errResult errInvalidString)
Left _ -> finishValue machine (errResult "invalid bytes")
Left _ -> finishValue machine (errResult "invalid string")
AAsk ->
finishValue machine (rtEnv (machineRuntime machine))
@@ -480,7 +446,7 @@ stepMachine machine =
then return Nothing
else return $ Just policyErrResult
policyErrResult = errResult errPolicyDeny
policyErrResult = errResult "permission denied"
canonicalizeSafe :: FilePath -> IO (Either String FilePath)
canonicalizeSafe p = do
@@ -534,19 +500,19 @@ stepMachine machine =
result <- try (BS.readFile path) :: IO (Either IOException BS.ByteString)
case result of
Right content -> return $ okResult (ofBytes content)
Left e -> return $ errResult (ioErrorCode e)
Left e -> return $ errResult (ioErrorString e)
tryWriteFile path contents = do
result <- try (IO.writeFile path contents) :: IO (Either IOException ())
case result of
Right () -> return $ okResult Leaf
Left e -> return $ errResult (ioErrorCode e)
Left e -> return $ errResult (ioErrorString e)
tryWriteFileBytes path contents = do
result <- try (BS.writeFile path contents) :: IO (Either IOException ())
case result of
Right () -> return $ okResult Leaf
Left e -> return $ errResult (ioErrorCode e)
Left e -> return $ errResult (ioErrorString e)
decodeString t ctx =
case toString t of
@@ -732,7 +698,7 @@ handleStep currentId (AwaitRequested targetId machine) scheduler
Just (BlockedOn nextId _) ->
if wouldCycle targetId currentId (schedulerTasks scheduler)
then resumeCurrentWith currentId (errResult errCyclicAwait) machine scheduler
then resumeCurrentWith currentId (errResult "cyclic await") machine scheduler
else block
Just _ -> block