GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-05-21 09:02:50 -06:00
Code Issues Packages Projects Releases Wiki Activity

Remove MonadFail requirements for aeson code

Browse Source
This commit is contained in:
Andreas Källberg
2020-09-11 10:58:54 +02:00
parent 2fd1040724
commit 127a1b2842
1 changed files with 10 additions and 6 deletions
Download Patch File Download Diff File Expand all files Collapse all files

16
src/compiler/GF/Grammar/CanonicalJSON.hs
View File

@@ -6,6 +6,7 @@ import Text.JSON
import Control.Applicative ((<|>)) import Control.Applicative ((<|>))
import Data.Ratio (denominator, numerator) import Data.Ratio (denominator, numerator)
import GF.Grammar.Canonical import GF.Grammar.Canonical
import Control.Monad (guard)
encodeJSON :: FilePath -> Grammar -> IO () encodeJSON :: FilePath -> Grammar -> IO ()
@@ -126,10 +127,10 @@ instance JSON LinType where
-- records are encoded as records: -- records are encoded as records:
showJSON (RecordType rows) = showJSON rows showJSON (RecordType rows) = showJSON rows
readJSON o = do "Str" <- readJSON o; return StrType readJSON o = StrType <$ parseString "Str" o
<|> do "Float" <- readJSON o; return FloatType <|> FloatType <$ parseString "Float" o
<|> do "Int" <- readJSON o; return IntType <|> IntType <$ parseString "Int" o
<|> do ptype <- readJSON o; return (ParamType ptype) <|> ParamType <$> readJSON o
<|> TableType <$> o!".tblarg" <*> o!".tblval" <|> TableType <$> o!".tblarg" <*> o!".tblval"
<|> TupleType <$> o!".tuple" <|> TupleType <$> o!".tuple"
<|> RecordType <$> readJSON o <|> RecordType <$> readJSON o
@@ -186,7 +187,7 @@ instance JSON LinPattern where
-- and records as records: -- and records as records:
showJSON (RecordPattern r) = showJSON r 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 [])) <|> do p <- readJSON o; return (ParamPattern (Param p []))
<|> ParamPattern <$> readJSON o <|> ParamPattern <$> readJSON o
<|> RecordPattern <$> readJSON o <|> RecordPattern <$> readJSON o
@@ -237,7 +238,7 @@ instance JSON VarId where
showJSON Anonymous = showJSON "_" showJSON Anonymous = showJSON "_"
showJSON (VarId x) = showJSON x showJSON (VarId x) = showJSON x
readJSON o = do "_" <- readJSON o; return Anonymous readJSON o = do parseString "_" o; return Anonymous
<|> VarId <$> readJSON o <|> VarId <$> readJSON o
instance JSON QualId where instance JSON QualId where
@@ -268,6 +269,9 @@ instance JSON FlagValue where
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- ** Convenience functions -- ** Convenience functions
parseString :: String -> JSValue -> Result ()
parseString s o = guard . (== s) =<< readJSON o
(!) :: JSON a => JSValue -> String -> Result a (!) :: JSON a => JSValue -> String -> Result a
obj ! key = maybe (fail $ "CanonicalJSON.(!): Could not find key: " ++ show key) obj ! key = maybe (fail $ "CanonicalJSON.(!): Could not find key: " ++ show key)
readJSON readJSON