diff options
| author | krasimir <krasimir@chalmers.se> | 2009-12-13 18:50:29 +0000 |
|---|---|---|
| committer | krasimir <krasimir@chalmers.se> | 2009-12-13 18:50:29 +0000 |
| commit | f85232947e74ee7ef8c7b0ad2338212e7e68f1be (patch) | |
| tree | 667b886a5e3a4b026a63d4e3597f32497d824761 /src/GF/Infra/CheckM.hs | |
| parent | d88a865faff59c98fc91556ff8700b10ee5f2df8 (diff) | |
reorganize the directories under src, and rescue the JavaScript interpreter from deprecated
Diffstat (limited to 'src/GF/Infra/CheckM.hs')
| -rw-r--r-- | src/GF/Infra/CheckM.hs | 77 |
1 files changed, 0 insertions, 77 deletions
diff --git a/src/GF/Infra/CheckM.hs b/src/GF/Infra/CheckM.hs deleted file mode 100644 index 8a1b42cdf..000000000 --- a/src/GF/Infra/CheckM.hs +++ /dev/null @@ -1,77 +0,0 @@ ----------------------------------------------------------------------- --- | --- Module : CheckM --- Maintainer : (Maintainer) --- Stability : (stable) --- Portability : (portable) --- --- > CVS $Date: 2005/04/21 16:22:33 $ --- > CVS $Author: bringert $ --- > CVS $Revision: 1.5 $ --- --- (Description of the module) ------------------------------------------------------------------------------ - -module GF.Infra.CheckM - (Check, Message, runCheck, - checkError, checkCond, checkWarn, - checkErr, checkIn, checkMap - ) where - -import GF.Data.Operations -import GF.Infra.Ident -import GF.Grammar.Grammar -import GF.Grammar.Printer - -import qualified Data.Map as Map -import Text.PrettyPrint - -type Message = Doc -data CheckResult a - = Fail [Message] - | Success a [Message] -newtype Check a = Check {unCheck :: Context -> [Message] -> CheckResult a} - -instance Monad Check where - return x = Check (\ctxt msgs -> Success x msgs) - f >>= g = Check (\ctxt msgs -> case unCheck f ctxt msgs of - Success x msgs -> unCheck (g x) ctxt msgs - Fail msgs -> Fail msgs) - -instance ErrorMonad Check where - raise s = checkError (text s) - handle f h = Check (\ctxt msgs -> case unCheck f ctxt msgs of - Success x msgs -> Success x msgs - Fail (msg:msgs) -> unCheck (h (render msg)) ctxt msgs) - -checkError :: Message -> Check a -checkError msg = Check (\ctxt msgs -> Fail (msg : msgs)) - -checkCond :: Message -> Bool -> Check () -checkCond s b = if b then return () else checkError s - --- | warnings should be reversed in the end -checkWarn :: Message -> Check () -checkWarn msg = Check (\ctxt msgs -> Success () ((text "Warning:" <+> msg) : msgs)) - -runCheck :: Check a -> Err (a,String) -runCheck c = - case unCheck c [] [] of - Fail msgs -> Bad ( render (vcat (reverse msgs))) - Success v msgs -> Ok (v, render (vcat (reverse msgs))) - -checkMap :: (Ord a) => (a -> b -> Check b) -> Map.Map a b -> Check (Map.Map a b) -checkMap f map = do xs <- mapM (\(k,v) -> do v <- f k v - return (k,v)) (Map.toList map) - return (Map.fromAscList xs) - -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 msgs -> - case unCheck c ctxt [] of - Fail msgs' -> Fail ((msg $$ nest 3 (vcat (reverse msgs'))) : msgs) - Success v msgs' | null msgs' -> Success v msgs - | otherwise -> Success v ((msg $$ nest 3 (vcat (reverse msgs'))) : msgs) |
