diff options
Diffstat (limited to 'src/compiler/GF/Grammar')
| -rw-r--r-- | src/compiler/GF/Grammar/Canonical.hs | 1 | ||||
| -rw-r--r-- | src/compiler/GF/Grammar/CanonicalJSON.hs | 16 | ||||
| -rw-r--r-- | src/compiler/GF/Grammar/Lexer.x | 14 | ||||
| -rw-r--r-- | src/compiler/GF/Grammar/Macros.hs | 3 |
4 files changed, 24 insertions, 10 deletions
diff --git a/src/compiler/GF/Grammar/Canonical.hs b/src/compiler/GF/Grammar/Canonical.hs index 4adff02f2..0df3236ff 100644 --- a/src/compiler/GF/Grammar/Canonical.hs +++ b/src/compiler/GF/Grammar/Canonical.hs @@ -265,7 +265,6 @@ instance PPA LinPattern where RecordPattern r -> block r TuplePattern ps -> "<"<>punctuate "," ps<>">" WildPattern -> pp "_" - _ -> parens p instance RhsSeparator LinPattern where rhsSep _ = pp "=" diff --git a/src/compiler/GF/Grammar/CanonicalJSON.hs b/src/compiler/GF/Grammar/CanonicalJSON.hs index 8b3464674..0ec7f43e6 100644 --- a/src/compiler/GF/Grammar/CanonicalJSON.hs +++ b/src/compiler/GF/Grammar/CanonicalJSON.hs @@ -6,6 +6,7 @@ import Text.JSON import Control.Applicative ((<|>)) import Data.Ratio (denominator, numerator) import GF.Grammar.Canonical +import Control.Monad (guard) encodeJSON :: FilePath -> Grammar -> IO () @@ -126,10 +127,10 @@ instance JSON LinType where -- records are encoded as records: showJSON (RecordType rows) = showJSON rows - readJSON o = do "Str" <- readJSON o; return StrType - <|> do "Float" <- readJSON o; return FloatType - <|> do "Int" <- readJSON o; return IntType - <|> do ptype <- readJSON o; return (ParamType ptype) + readJSON o = StrType <$ parseString "Str" o + <|> FloatType <$ parseString "Float" o + <|> IntType <$ parseString "Int" o + <|> ParamType <$> readJSON o <|> TableType <$> o!".tblarg" <*> o!".tblval" <|> TupleType <$> o!".tuple" <|> RecordType <$> readJSON o @@ -186,7 +187,7 @@ instance JSON LinPattern where -- and records as records: showJSON (RecordPattern r) = showJSON r - readJSON o = do "_" <- readJSON o; return WildPattern + readJSON o = do p <- parseString "_" o; return WildPattern <|> do p <- readJSON o; return (ParamPattern (Param p [])) <|> ParamPattern <$> readJSON o <|> RecordPattern <$> readJSON o @@ -237,7 +238,7 @@ instance JSON VarId where showJSON Anonymous = showJSON "_" showJSON (VarId x) = showJSON x - readJSON o = do "_" <- readJSON o; return Anonymous + readJSON o = do parseString "_" o; return Anonymous <|> VarId <$> readJSON o instance JSON QualId where @@ -268,6 +269,9 @@ instance JSON FlagValue where -------------------------------------------------------------------------------- -- ** Convenience functions +parseString :: String -> JSValue -> Result () +parseString s o = guard . (== s) =<< readJSON o + (!) :: JSON a => JSValue -> String -> Result a obj ! key = maybe (fail $ "CanonicalJSON.(!): Could not find key: " ++ show key) readJSON diff --git a/src/compiler/GF/Grammar/Lexer.x b/src/compiler/GF/Grammar/Lexer.x index d1550dd09..bde0aa064 100644 --- a/src/compiler/GF/Grammar/Lexer.x +++ b/src/compiler/GF/Grammar/Lexer.x @@ -1,5 +1,6 @@ -- -*- haskell -*- { +{-# LANGUAGE CPP #-} module GF.Grammar.Lexer ( Token(..), Posn(..) , P, runP, runPartial, token, lexer, getPosn, failLoc @@ -18,6 +19,7 @@ import qualified Data.Map as Map import Data.Word(Word8) import Data.Char(readLitChar) --import Debug.Trace(trace) +import qualified Control.Monad.Fail as Fail } @@ -33,7 +35,7 @@ $u = [.\n] -- universal: any character :- "--" [.]* ; -- Toss single line comments -"{-" ([$u # \-] | \- [$u # \}])* ("-")+ "}" ; +"{-" ([$u # \-] | \- [$u # \}])* ("-")+ "}" ; $white+ ; @rsyms { tok ident } @@ -136,7 +138,7 @@ data Token res = eitherResIdent eitherResIdent :: (Ident -> Token) -> Ident -> Token -eitherResIdent tv s = +eitherResIdent tv s = case Map.lookup s resWords of Just t -> t Nothing -> tv s @@ -282,8 +284,16 @@ instance Monad P where (P m) >>= k = P $ \ s -> case m s of POk s a -> unP (k a) s PFailed posn err -> PFailed posn err + +#if !(MIN_VERSION_base(4,13,0)) + -- Monad(fail) will be removed in GHC 8.8+ + fail = Fail.fail +#endif + +instance Fail.MonadFail P where fail msg = P $ \(_,AI posn _ _) -> PFailed posn msg + runP :: P a -> BS.ByteString -> Either (Posn,String) a runP p bs = snd <$> runP' p (Pn 1 0,bs) diff --git a/src/compiler/GF/Grammar/Macros.hs b/src/compiler/GF/Grammar/Macros.hs index 4c92fae8c..b088fe49c 100644 --- a/src/compiler/GF/Grammar/Macros.hs +++ b/src/compiler/GF/Grammar/Macros.hs @@ -32,6 +32,7 @@ import Control.Monad (liftM, liftM2, liftM3) import Data.List (sortBy,nub) import Data.Monoid import GF.Text.Pretty(render,(<+>),hsep,fsep) +import qualified Control.Monad.Fail as Fail -- ** Functions for constructing and analysing source code terms. @@ -237,7 +238,7 @@ isPredefConstant t = case t of Q (mod,_) | mod == cPredef || mod == cPredefAbs -> True _ -> False -checkPredefError :: Monad m => Term -> m Term +checkPredefError :: Fail.MonadFail m => Term -> m Term checkPredefError t = case t of Error s -> fail ("Error: "++s) |