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

View File

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