small steps towards actual error handling

This commit is contained in:
crumbtoo
2023-11-27 17:38:46 -07:00
parent 6fffb1345b
commit 77f0e7521e
2 changed files with 17 additions and 11 deletions

View File

@@ -50,33 +50,37 @@ debugFlagReader = maybeReader $ Just . \case
----------------------------------------------------------------------------------
-- temp
data CompilerError = CompilerError String
main :: IO ()
main = do
opts <- execParser optParser
evalRLPCIO opts driver
(_, es) <- evalRLPCIO opts driver
forM_ es $ \ (CompilerError e) -> print $ "warning: " <> e
pure ()
driver :: RLPCIO () ()
driver :: RLPCIO CompilerError ()
driver = sequence_
[ dshowFlags
, ddumpEval
]
dshowFlags :: RLPCIO () ()
dshowFlags :: RLPCIO CompilerError ()
dshowFlags = whenFlag flagDDumpOpts do
ask >>= liftIO . print
liftIO $ exitSuccess
ddumpEval :: RLPCIO () ()
ddumpEval :: RLPCIO CompilerError ()
ddumpEval = whenFlag flagDDumpEval do
fs <- view rlpcInputFiles
forM_ fs $ \f -> liftIO (readFile f) >>= doProg
where
doProg :: String -> RLPCIO () ()
doProg :: String -> RLPCIO CompilerError ()
doProg s = ask >>= \o -> case parseProg o s of
-- TODO: error handling
Left e -> error $ show e
Left e -> addFatal . CompilerError $ show e
Right (a,_) -> do
log <- view rlpcLogFile
case log of

View File

@@ -2,11 +2,13 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveGeneric, DerivingStrategies, DerivingVia #-}
module Compiler.RLPC
( RLPC(..)
( RLPC
, RLPCT
, RLPCIO
, RLPCOptions(RLPCOptions)
, addFatal
, addWound
, MonadErrorful
, Severity(..)
, evalRLPCT
, evalRLPCIO
@@ -37,7 +39,7 @@ import Lens.Micro.TH
----------------------------------------------------------------------------------
-- TODO: fancy errors
newtype RLPCT e m a = RLPC {
newtype RLPCT e m a = RLPCT {
runRLPCT :: ReaderT RLPCOptions (ErrorfulT e m) a
}
deriving (Functor, Applicative, Monad, MonadReader RLPCOptions)
@@ -86,9 +88,9 @@ type ErrorDoc = String
class Diagnostic e where
errorDoc :: e -> ErrorDoc
instance MonadErrorful e (RLPC e) where
addWound = RLPC . lift . addWound
addFatal = RLPC . lift . addFatal
instance (Monad m) => MonadErrorful e (RLPCT e m) where
addWound = RLPCT . lift . addWound
addFatal = RLPCT . lift . addFatal
----------------------------------------------------------------------------------