mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-29 06:22:51 -06:00
Reduced clutter in monadic code
+ Eliminated vairous ad-hoc coersion functions between specific monads (IO, Err, IOE, Check) in favor of more general lifting functions (liftIO, liftErr). + Generalized many basic monadic operations from specific monads to arbitrary monads in the appropriate class (MonadIO and/or ErrorMonad), thereby completely eliminating the need for lifting functions in lots of places. This can be considered a small step forward towards a cleaner compiler API and more malleable compiler code in general.
This commit is contained in:
@@ -15,7 +15,7 @@
|
||||
module GF.Infra.CheckM
|
||||
(Check, CheckResult, Message, runCheck,
|
||||
checkError, checkCond, checkWarn, checkWarnings, checkAccumError,
|
||||
checkErr, checkIn, checkMap, checkMapRecover,
|
||||
{-checkErr,-} checkIn, checkMap, checkMapRecover,
|
||||
parallelCheck, accumulateError, commitCheck,
|
||||
) where
|
||||
|
||||
@@ -92,14 +92,14 @@ commitCheck c =
|
||||
list = vcat . reverse
|
||||
|
||||
-- | Run an error check, report errors and warnings
|
||||
runCheck :: Check a -> Err (a,String)
|
||||
runCheck :: ErrorMonad m => Check a -> m (a,String)
|
||||
runCheck c =
|
||||
case unCheck c {-[]-} ([],[]) of
|
||||
(([],ws),Success v) -> Ok (v,render (list ws))
|
||||
(([],ws),Success v) -> return (v,render (list ws))
|
||||
(msgs ,Success v) -> bad msgs
|
||||
((es,ws),Fail e) -> bad ((e:es),ws)
|
||||
where
|
||||
bad (es,ws) = Bad (render $ list ws $$ list es)
|
||||
bad (es,ws) = raise (render $ list ws $$ list es)
|
||||
list = vcat . reverse
|
||||
|
||||
parallelCheck :: [Check a] -> Check [a]
|
||||
@@ -135,10 +135,6 @@ checkMapRecover f mp = do
|
||||
return (Map.fromAscList kx)
|
||||
-}
|
||||
|
||||
checkErr :: Err a -> Check a
|
||||
checkErr (Ok x) = return x
|
||||
checkErr (Bad err) = checkError (text err)
|
||||
|
||||
checkIn :: Doc -> Check a -> Check a
|
||||
checkIn msg c = Check $ \{-ctxt-} msgs0 ->
|
||||
case unCheck c {-ctxt-} ([],[]) of
|
||||
|
||||
Reference in New Issue
Block a user