module GF.Grammar.CanonicalJSON (
encodeJSON
) where
import Text.JSON
import Control.Applicative ((<|>))
import Data.Ratio (denominator, numerator)
import GF.Grammar.Canonical
import Control.Monad (guard)
import GF.Infra.Ident (RawIdent,showRawIdent,rawIdentS)
encodeJSON :: FilePath -> Grammar -> IO ()
encodeJSON :: FilePath -> Grammar -> IO ()
encodeJSON FilePath
fpath Grammar
g = FilePath -> FilePath -> IO ()
writeFile FilePath
fpath (Grammar -> FilePath
forall a. JSON a => a -> FilePath
encode Grammar
g)
instance JSON Grammar where
showJSON :: Grammar -> JSValue
showJSON (Grammar Abstract
abs [Concrete]
cncs) = [(FilePath, JSValue)] -> JSValue
makeObj [(FilePath
"abstract", Abstract -> JSValue
forall a. JSON a => a -> JSValue
showJSON Abstract
abs), (FilePath
"concretes", [Concrete] -> JSValue
forall a. JSON a => a -> JSValue
showJSON [Concrete]
cncs)]
readJSON :: JSValue -> Result Grammar
readJSON JSValue
o = Abstract -> [Concrete] -> Grammar
Grammar (Abstract -> [Concrete] -> Grammar)
-> Result Abstract -> Result ([Concrete] -> Grammar)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSValue
oJSValue -> FilePath -> Result Abstract
forall a. JSON a => JSValue -> FilePath -> Result a
!FilePath
"abstract" Result ([Concrete] -> Grammar)
-> Result [Concrete] -> Result Grammar
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> JSValue
oJSValue -> FilePath -> Result [Concrete]
forall a. JSON a => JSValue -> FilePath -> Result a
!FilePath
"concretes"
instance JSON Abstract where
showJSON :: Abstract -> JSValue
showJSON (Abstract ModId
absid Flags
flags [CatDef]
cats [FunDef]
funs)
= [(FilePath, JSValue)] -> JSValue
makeObj [(FilePath
"abs", ModId -> JSValue
forall a. JSON a => a -> JSValue
showJSON ModId
absid),
(FilePath
"flags", Flags -> JSValue
forall a. JSON a => a -> JSValue
showJSON Flags
flags),
(FilePath
"cats", [CatDef] -> JSValue
forall a. JSON a => a -> JSValue
showJSON [CatDef]
cats),
(FilePath
"funs", [FunDef] -> JSValue
forall a. JSON a => a -> JSValue
showJSON [FunDef]
funs)]
readJSON :: JSValue -> Result Abstract
readJSON JSValue
o = ModId -> Flags -> [CatDef] -> [FunDef] -> Abstract
Abstract
(ModId -> Flags -> [CatDef] -> [FunDef] -> Abstract)
-> Result ModId
-> Result (Flags -> [CatDef] -> [FunDef] -> Abstract)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSValue
oJSValue -> FilePath -> Result ModId
forall a. JSON a => JSValue -> FilePath -> Result a
!FilePath
"abs"
Result (Flags -> [CatDef] -> [FunDef] -> Abstract)
-> Result Flags -> Result ([CatDef] -> [FunDef] -> Abstract)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>(JSValue
oJSValue -> FilePath -> Result Flags
forall a. JSON a => JSValue -> FilePath -> Result a
!FilePath
"flags" Result Flags -> Result Flags -> Result Flags
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Flags -> Result Flags
forall (m :: * -> *) a. Monad m => a -> m a
return ([(FlagName, FlagValue)] -> Flags
Flags []))
Result ([CatDef] -> [FunDef] -> Abstract)
-> Result [CatDef] -> Result ([FunDef] -> Abstract)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> JSValue
oJSValue -> FilePath -> Result [CatDef]
forall a. JSON a => JSValue -> FilePath -> Result a
!FilePath
"cats"
Result ([FunDef] -> Abstract) -> Result [FunDef] -> Result Abstract
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> JSValue
oJSValue -> FilePath -> Result [FunDef]
forall a. JSON a => JSValue -> FilePath -> Result a
!FilePath
"funs"
instance JSON CatDef where
showJSON :: CatDef -> JSValue
showJSON (CatDef CatId
c []) = CatId -> JSValue
forall a. JSON a => a -> JSValue
showJSON CatId
c
showJSON (CatDef CatId
c [CatId]
cs) = [(FilePath, JSValue)] -> JSValue
makeObj [(FilePath
"cat", CatId -> JSValue
forall a. JSON a => a -> JSValue
showJSON CatId
c), (FilePath
"args", [CatId] -> JSValue
forall a. JSON a => a -> JSValue
showJSON [CatId]
cs)]
readJSON :: JSValue -> Result CatDef
readJSON JSValue
o = CatId -> [CatId] -> CatDef
CatDef (CatId -> [CatId] -> CatDef)
-> Result CatId -> Result ([CatId] -> CatDef)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSValue -> Result CatId
forall a. JSON a => JSValue -> Result a
readJSON JSValue
o Result ([CatId] -> CatDef) -> Result [CatId] -> Result CatDef
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [CatId] -> Result [CatId]
forall (m :: * -> *) a. Monad m => a -> m a
return []
Result CatDef -> Result CatDef -> Result CatDef
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> CatId -> [CatId] -> CatDef
CatDef (CatId -> [CatId] -> CatDef)
-> Result CatId -> Result ([CatId] -> CatDef)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSValue
oJSValue -> FilePath -> Result CatId
forall a. JSON a => JSValue -> FilePath -> Result a
!FilePath
"cat" Result ([CatId] -> CatDef) -> Result [CatId] -> Result CatDef
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> JSValue
oJSValue -> FilePath -> Result [CatId]
forall a. JSON a => JSValue -> FilePath -> Result a
!FilePath
"args"
instance JSON FunDef where
showJSON :: FunDef -> JSValue
showJSON (FunDef FunId
f Type
ty) = [(FilePath, JSValue)] -> JSValue
makeObj [(FilePath
"fun", FunId -> JSValue
forall a. JSON a => a -> JSValue
showJSON FunId
f), (FilePath
"type", Type -> JSValue
forall a. JSON a => a -> JSValue
showJSON Type
ty)]
readJSON :: JSValue -> Result FunDef
readJSON JSValue
o = FunId -> Type -> FunDef
FunDef (FunId -> Type -> FunDef)
-> Result FunId -> Result (Type -> FunDef)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSValue
oJSValue -> FilePath -> Result FunId
forall a. JSON a => JSValue -> FilePath -> Result a
!FilePath
"fun" Result (Type -> FunDef) -> Result Type -> Result FunDef
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> JSValue
oJSValue -> FilePath -> Result Type
forall a. JSON a => JSValue -> FilePath -> Result a
!FilePath
"type"
instance JSON Type where
showJSON :: Type -> JSValue
showJSON (Type [TypeBinding]
bs TypeApp
ty) = [(FilePath, JSValue)] -> JSValue
makeObj [(FilePath
".args", [TypeBinding] -> JSValue
forall a. JSON a => a -> JSValue
showJSON [TypeBinding]
bs), (FilePath
".result", TypeApp -> JSValue
forall a. JSON a => a -> JSValue
showJSON TypeApp
ty)]
readJSON :: JSValue -> Result Type
readJSON JSValue
o = [TypeBinding] -> TypeApp -> Type
Type ([TypeBinding] -> TypeApp -> Type)
-> Result [TypeBinding] -> Result (TypeApp -> Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSValue
oJSValue -> FilePath -> Result [TypeBinding]
forall a. JSON a => JSValue -> FilePath -> Result a
!FilePath
".args" Result (TypeApp -> Type) -> Result TypeApp -> Result Type
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> JSValue
oJSValue -> FilePath -> Result TypeApp
forall a. JSON a => JSValue -> FilePath -> Result a
!FilePath
".result"
instance JSON TypeApp where
showJSON :: TypeApp -> JSValue
showJSON (TypeApp CatId
c []) = CatId -> JSValue
forall a. JSON a => a -> JSValue
showJSON CatId
c
showJSON (TypeApp CatId
c [Type]
args) = [(FilePath, JSValue)] -> JSValue
makeObj [(FilePath
".cat", CatId -> JSValue
forall a. JSON a => a -> JSValue
showJSON CatId
c), (FilePath
".args", [Type] -> JSValue
forall a. JSON a => a -> JSValue
showJSON [Type]
args)]
readJSON :: JSValue -> Result TypeApp
readJSON JSValue
o = CatId -> [Type] -> TypeApp
TypeApp (CatId -> [Type] -> TypeApp)
-> Result CatId -> Result ([Type] -> TypeApp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSValue -> Result CatId
forall a. JSON a => JSValue -> Result a
readJSON JSValue
o Result ([Type] -> TypeApp) -> Result [Type] -> Result TypeApp
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Type] -> Result [Type]
forall (m :: * -> *) a. Monad m => a -> m a
return []
Result TypeApp -> Result TypeApp -> Result TypeApp
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> CatId -> [Type] -> TypeApp
TypeApp (CatId -> [Type] -> TypeApp)
-> Result CatId -> Result ([Type] -> TypeApp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSValue
oJSValue -> FilePath -> Result CatId
forall a. JSON a => JSValue -> FilePath -> Result a
!FilePath
".cat" Result ([Type] -> TypeApp) -> Result [Type] -> Result TypeApp
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> JSValue
oJSValue -> FilePath -> Result [Type]
forall a. JSON a => JSValue -> FilePath -> Result a
!FilePath
".args"
instance JSON TypeBinding where
showJSON :: TypeBinding -> JSValue
showJSON (TypeBinding VarId
Anonymous (Type [] (TypeApp CatId
c []))) = CatId -> JSValue
forall a. JSON a => a -> JSValue
showJSON CatId
c
showJSON (TypeBinding VarId
x Type
ty) = [(FilePath, JSValue)] -> JSValue
makeObj [(FilePath
".var", VarId -> JSValue
forall a. JSON a => a -> JSValue
showJSON VarId
x), (FilePath
".type", Type -> JSValue
forall a. JSON a => a -> JSValue
showJSON Type
ty)]
readJSON :: JSValue -> Result TypeBinding
readJSON JSValue
o = do CatId
c <- JSValue -> Result CatId
forall a. JSON a => JSValue -> Result a
readJSON JSValue
o
TypeBinding -> Result TypeBinding
forall (m :: * -> *) a. Monad m => a -> m a
return (VarId -> Type -> TypeBinding
TypeBinding VarId
Anonymous ([TypeBinding] -> TypeApp -> Type
Type [] (CatId -> [Type] -> TypeApp
TypeApp CatId
c [])))
Result TypeBinding -> Result TypeBinding -> Result TypeBinding
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> VarId -> Type -> TypeBinding
TypeBinding (VarId -> Type -> TypeBinding)
-> Result VarId -> Result (Type -> TypeBinding)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSValue
oJSValue -> FilePath -> Result VarId
forall a. JSON a => JSValue -> FilePath -> Result a
!FilePath
".var" Result (Type -> TypeBinding) -> Result Type -> Result TypeBinding
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> JSValue
oJSValue -> FilePath -> Result Type
forall a. JSON a => JSValue -> FilePath -> Result a
!FilePath
".type"
instance JSON Concrete where
showJSON :: Concrete -> JSValue
showJSON (Concrete ModId
cncid ModId
absid Flags
flags [ParamDef]
params [LincatDef]
lincats [LinDef]
lins)
= [(FilePath, JSValue)] -> JSValue
makeObj [(FilePath
"cnc", ModId -> JSValue
forall a. JSON a => a -> JSValue
showJSON ModId
cncid),
(FilePath
"abs", ModId -> JSValue
forall a. JSON a => a -> JSValue
showJSON ModId
absid),
(FilePath
"flags", Flags -> JSValue
forall a. JSON a => a -> JSValue
showJSON Flags
flags),
(FilePath
"params", [ParamDef] -> JSValue
forall a. JSON a => a -> JSValue
showJSON [ParamDef]
params),
(FilePath
"lincats", [LincatDef] -> JSValue
forall a. JSON a => a -> JSValue
showJSON [LincatDef]
lincats),
(FilePath
"lins", [LinDef] -> JSValue
forall a. JSON a => a -> JSValue
showJSON [LinDef]
lins)]
readJSON :: JSValue -> Result Concrete
readJSON JSValue
o = ModId
-> ModId
-> Flags
-> [ParamDef]
-> [LincatDef]
-> [LinDef]
-> Concrete
Concrete
(ModId
-> ModId
-> Flags
-> [ParamDef]
-> [LincatDef]
-> [LinDef]
-> Concrete)
-> Result ModId
-> Result
(ModId
-> Flags -> [ParamDef] -> [LincatDef] -> [LinDef] -> Concrete)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSValue
oJSValue -> FilePath -> Result ModId
forall a. JSON a => JSValue -> FilePath -> Result a
!FilePath
"cnc"
Result
(ModId
-> Flags -> [ParamDef] -> [LincatDef] -> [LinDef] -> Concrete)
-> Result ModId
-> Result
(Flags -> [ParamDef] -> [LincatDef] -> [LinDef] -> Concrete)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> JSValue
oJSValue -> FilePath -> Result ModId
forall a. JSON a => JSValue -> FilePath -> Result a
!FilePath
"abs"
Result (Flags -> [ParamDef] -> [LincatDef] -> [LinDef] -> Concrete)
-> Result Flags
-> Result ([ParamDef] -> [LincatDef] -> [LinDef] -> Concrete)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>(JSValue
oJSValue -> FilePath -> Result Flags
forall a. JSON a => JSValue -> FilePath -> Result a
!FilePath
"flags" Result Flags -> Result Flags -> Result Flags
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Flags -> Result Flags
forall (m :: * -> *) a. Monad m => a -> m a
return ([(FlagName, FlagValue)] -> Flags
Flags []))
Result ([ParamDef] -> [LincatDef] -> [LinDef] -> Concrete)
-> Result [ParamDef]
-> Result ([LincatDef] -> [LinDef] -> Concrete)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> JSValue
oJSValue -> FilePath -> Result [ParamDef]
forall a. JSON a => JSValue -> FilePath -> Result a
!FilePath
"params"
Result ([LincatDef] -> [LinDef] -> Concrete)
-> Result [LincatDef] -> Result ([LinDef] -> Concrete)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> JSValue
oJSValue -> FilePath -> Result [LincatDef]
forall a. JSON a => JSValue -> FilePath -> Result a
!FilePath
"lincats"
Result ([LinDef] -> Concrete) -> Result [LinDef] -> Result Concrete
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> JSValue
oJSValue -> FilePath -> Result [LinDef]
forall a. JSON a => JSValue -> FilePath -> Result a
!FilePath
"lins"
instance JSON ParamDef where
showJSON :: ParamDef -> JSValue
showJSON (ParamDef ParamId
p [ParamValueDef]
pvs) = [(FilePath, JSValue)] -> JSValue
makeObj [(FilePath
"param", ParamId -> JSValue
forall a. JSON a => a -> JSValue
showJSON ParamId
p), (FilePath
"values", [ParamValueDef] -> JSValue
forall a. JSON a => a -> JSValue
showJSON [ParamValueDef]
pvs)]
showJSON (ParamAliasDef ParamId
p LinType
t) = [(FilePath, JSValue)] -> JSValue
makeObj [(FilePath
"param", ParamId -> JSValue
forall a. JSON a => a -> JSValue
showJSON ParamId
p), (FilePath
"alias", LinType -> JSValue
forall a. JSON a => a -> JSValue
showJSON LinType
t)]
readJSON :: JSValue -> Result ParamDef
readJSON JSValue
o = ParamId -> [ParamValueDef] -> ParamDef
ParamDef (ParamId -> [ParamValueDef] -> ParamDef)
-> Result ParamId -> Result ([ParamValueDef] -> ParamDef)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSValue
oJSValue -> FilePath -> Result ParamId
forall a. JSON a => JSValue -> FilePath -> Result a
!FilePath
"param" Result ([ParamValueDef] -> ParamDef)
-> Result [ParamValueDef] -> Result ParamDef
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> JSValue
oJSValue -> FilePath -> Result [ParamValueDef]
forall a. JSON a => JSValue -> FilePath -> Result a
!FilePath
"values"
Result ParamDef -> Result ParamDef -> Result ParamDef
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParamId -> LinType -> ParamDef
ParamAliasDef (ParamId -> LinType -> ParamDef)
-> Result ParamId -> Result (LinType -> ParamDef)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSValue
oJSValue -> FilePath -> Result ParamId
forall a. JSON a => JSValue -> FilePath -> Result a
!FilePath
"param" Result (LinType -> ParamDef) -> Result LinType -> Result ParamDef
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> JSValue
oJSValue -> FilePath -> Result LinType
forall a. JSON a => JSValue -> FilePath -> Result a
!FilePath
"alias"
instance JSON LincatDef where
showJSON :: LincatDef -> JSValue
showJSON (LincatDef CatId
c LinType
lt) = [(FilePath, JSValue)] -> JSValue
makeObj [(FilePath
"cat", CatId -> JSValue
forall a. JSON a => a -> JSValue
showJSON CatId
c), (FilePath
"lintype", LinType -> JSValue
forall a. JSON a => a -> JSValue
showJSON LinType
lt)]
readJSON :: JSValue -> Result LincatDef
readJSON JSValue
o = CatId -> LinType -> LincatDef
LincatDef (CatId -> LinType -> LincatDef)
-> Result CatId -> Result (LinType -> LincatDef)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSValue
oJSValue -> FilePath -> Result CatId
forall a. JSON a => JSValue -> FilePath -> Result a
!FilePath
"cat" Result (LinType -> LincatDef) -> Result LinType -> Result LincatDef
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> JSValue
oJSValue -> FilePath -> Result LinType
forall a. JSON a => JSValue -> FilePath -> Result a
!FilePath
"lintype"
instance JSON LinDef where
showJSON :: LinDef -> JSValue
showJSON (LinDef FunId
f [VarId]
xs LinValue
lv) = [(FilePath, JSValue)] -> JSValue
makeObj [(FilePath
"fun", FunId -> JSValue
forall a. JSON a => a -> JSValue
showJSON FunId
f), (FilePath
"args", [VarId] -> JSValue
forall a. JSON a => a -> JSValue
showJSON [VarId]
xs), (FilePath
"lin", LinValue -> JSValue
forall a. JSON a => a -> JSValue
showJSON LinValue
lv)]
readJSON :: JSValue -> Result LinDef
readJSON JSValue
o = FunId -> [VarId] -> LinValue -> LinDef
LinDef (FunId -> [VarId] -> LinValue -> LinDef)
-> Result FunId -> Result ([VarId] -> LinValue -> LinDef)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSValue
oJSValue -> FilePath -> Result FunId
forall a. JSON a => JSValue -> FilePath -> Result a
!FilePath
"fun" Result ([VarId] -> LinValue -> LinDef)
-> Result [VarId] -> Result (LinValue -> LinDef)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> JSValue
oJSValue -> FilePath -> Result [VarId]
forall a. JSON a => JSValue -> FilePath -> Result a
!FilePath
"args" Result (LinValue -> LinDef) -> Result LinValue -> Result LinDef
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> JSValue
oJSValue -> FilePath -> Result LinValue
forall a. JSON a => JSValue -> FilePath -> Result a
!FilePath
"lin"
instance JSON LinType where
showJSON :: LinType -> JSValue
showJSON (LinType
StrType) = FilePath -> JSValue
forall a. JSON a => a -> JSValue
showJSON FilePath
"Str"
showJSON (LinType
FloatType) = FilePath -> JSValue
forall a. JSON a => a -> JSValue
showJSON FilePath
"Float"
showJSON (LinType
IntType) = FilePath -> JSValue
forall a. JSON a => a -> JSValue
showJSON FilePath
"Int"
showJSON (ParamType ParamType
pt) = ParamType -> JSValue
forall a. JSON a => a -> JSValue
showJSON ParamType
pt
showJSON (TableType LinType
pt LinType
lt) = [(FilePath, JSValue)] -> JSValue
makeObj [(FilePath
".tblarg", LinType -> JSValue
forall a. JSON a => a -> JSValue
showJSON LinType
pt), (FilePath
".tblval", LinType -> JSValue
forall a. JSON a => a -> JSValue
showJSON LinType
lt)]
showJSON (TupleType [LinType]
lts) = [(FilePath, JSValue)] -> JSValue
makeObj [(FilePath
".tuple", [LinType] -> JSValue
forall a. JSON a => a -> JSValue
showJSON [LinType]
lts)]
showJSON (RecordType [RecordRowType]
rows) = [RecordRowType] -> JSValue
forall a. JSON a => a -> JSValue
showJSON [RecordRowType]
rows
readJSON :: JSValue -> Result LinType
readJSON JSValue
o = LinType
StrType LinType -> Result () -> Result LinType
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ FilePath -> JSValue -> Result ()
parseString FilePath
"Str" JSValue
o
Result LinType -> Result LinType -> Result LinType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> LinType
FloatType LinType -> Result () -> Result LinType
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ FilePath -> JSValue -> Result ()
parseString FilePath
"Float" JSValue
o
Result LinType -> Result LinType -> Result LinType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> LinType
IntType LinType -> Result () -> Result LinType
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ FilePath -> JSValue -> Result ()
parseString FilePath
"Int" JSValue
o
Result LinType -> Result LinType -> Result LinType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParamType -> LinType
ParamType (ParamType -> LinType) -> Result ParamType -> Result LinType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSValue -> Result ParamType
forall a. JSON a => JSValue -> Result a
readJSON JSValue
o
Result LinType -> Result LinType -> Result LinType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> LinType -> LinType -> LinType
TableType (LinType -> LinType -> LinType)
-> Result LinType -> Result (LinType -> LinType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSValue
oJSValue -> FilePath -> Result LinType
forall a. JSON a => JSValue -> FilePath -> Result a
!FilePath
".tblarg" Result (LinType -> LinType) -> Result LinType -> Result LinType
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> JSValue
oJSValue -> FilePath -> Result LinType
forall a. JSON a => JSValue -> FilePath -> Result a
!FilePath
".tblval"
Result LinType -> Result LinType -> Result LinType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [LinType] -> LinType
TupleType ([LinType] -> LinType) -> Result [LinType] -> Result LinType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSValue
oJSValue -> FilePath -> Result [LinType]
forall a. JSON a => JSValue -> FilePath -> Result a
!FilePath
".tuple"
Result LinType -> Result LinType -> Result LinType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [RecordRowType] -> LinType
RecordType ([RecordRowType] -> LinType)
-> Result [RecordRowType] -> Result LinType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSValue -> Result [RecordRowType]
forall a. JSON a => JSValue -> Result a
readJSON JSValue
o
instance JSON LinValue where
showJSON :: LinValue -> JSValue
showJSON (LiteralValue LinLiteral
l ) = LinLiteral -> JSValue
forall a. JSON a => a -> JSValue
showJSON LinLiteral
l
showJSON (ParamConstant ParamValue
pv) = [(FilePath, JSValue)] -> JSValue
makeObj [(FilePath
".param", ParamValue -> JSValue
forall a. JSON a => a -> JSValue
showJSON ParamValue
pv)]
showJSON (PredefValue PredefId
p ) = [(FilePath, JSValue)] -> JSValue
makeObj [(FilePath
".predef", PredefId -> JSValue
forall a. JSON a => a -> JSValue
showJSON PredefId
p)]
showJSON (TableValue LinType
t [TableRowValue]
tvs) = [(FilePath, JSValue)] -> JSValue
makeObj [(FilePath
".tblarg", LinType -> JSValue
forall a. JSON a => a -> JSValue
showJSON LinType
t), (FilePath
".tblrows", [TableRowValue] -> JSValue
forall a. JSON a => a -> JSValue
showJSON [TableRowValue]
tvs)]
showJSON (TupleValue [LinValue]
lvs) = [(FilePath, JSValue)] -> JSValue
makeObj [(FilePath
".tuple", [LinValue] -> JSValue
forall a. JSON a => a -> JSValue
showJSON [LinValue]
lvs)]
showJSON (VarValue VarValueId
v ) = [(FilePath, JSValue)] -> JSValue
makeObj [(FilePath
".var", VarValueId -> JSValue
forall a. JSON a => a -> JSValue
showJSON VarValueId
v)]
showJSON (ErrorValue FilePath
s ) = [(FilePath, JSValue)] -> JSValue
makeObj [(FilePath
".error", FilePath -> JSValue
forall a. JSON a => a -> JSValue
showJSON FilePath
s)]
showJSON (Projection LinValue
lv LabelId
l ) = [(FilePath, JSValue)] -> JSValue
makeObj [(FilePath
".project", LinValue -> JSValue
forall a. JSON a => a -> JSValue
showJSON LinValue
lv), (FilePath
".label", LabelId -> JSValue
forall a. JSON a => a -> JSValue
showJSON LabelId
l)]
showJSON (Selection LinValue
tv LinValue
pv) = [(FilePath, JSValue)] -> JSValue
makeObj [(FilePath
".select", LinValue -> JSValue
forall a. JSON a => a -> JSValue
showJSON LinValue
tv), (FilePath
".key", LinValue -> JSValue
forall a. JSON a => a -> JSValue
showJSON LinValue
pv)]
showJSON (VariantValue [LinValue]
vs) = [(FilePath, JSValue)] -> JSValue
makeObj [(FilePath
".variants", [LinValue] -> JSValue
forall a. JSON a => a -> JSValue
showJSON [LinValue]
vs)]
showJSON (PreValue [([FilePath], LinValue)]
pre LinValue
def) = [(FilePath, JSValue)] -> JSValue
makeObj [(FilePath
".pre", [([FilePath], LinValue)] -> JSValue
forall a. JSON a => a -> JSValue
showJSON [([FilePath], LinValue)]
pre),(FilePath
".default", LinValue -> JSValue
forall a. JSON a => a -> JSValue
showJSON LinValue
def)]
showJSON (RecordValue [RecordRowValue]
rows) = [RecordRowValue] -> JSValue
forall a. JSON a => a -> JSValue
showJSON [RecordRowValue]
rows
showJSON v :: LinValue
v@(ConcatValue LinValue
_ LinValue
_) = [LinValue] -> JSValue
forall a. JSON a => a -> JSValue
showJSON (LinValue -> [LinValue] -> [LinValue]
flatten LinValue
v [])
where flatten :: LinValue -> [LinValue] -> [LinValue]
flatten (ConcatValue LinValue
v LinValue
v') = LinValue -> [LinValue] -> [LinValue]
flatten LinValue
v ([LinValue] -> [LinValue])
-> ([LinValue] -> [LinValue]) -> [LinValue] -> [LinValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LinValue -> [LinValue] -> [LinValue]
flatten LinValue
v'
flatten LinValue
v = (LinValue
v LinValue -> [LinValue] -> [LinValue]
forall a. a -> [a] -> [a]
:)
readJSON :: JSValue -> Result LinValue
readJSON JSValue
o = LinLiteral -> LinValue
LiteralValue (LinLiteral -> LinValue) -> Result LinLiteral -> Result LinValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSValue -> Result LinLiteral
forall a. JSON a => JSValue -> Result a
readJSON JSValue
o
Result LinValue -> Result LinValue -> Result LinValue
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParamValue -> LinValue
ParamConstant (ParamValue -> LinValue) -> Result ParamValue -> Result LinValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSValue
oJSValue -> FilePath -> Result ParamValue
forall a. JSON a => JSValue -> FilePath -> Result a
!FilePath
".param"
Result LinValue -> Result LinValue -> Result LinValue
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> PredefId -> LinValue
PredefValue (PredefId -> LinValue) -> Result PredefId -> Result LinValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSValue
oJSValue -> FilePath -> Result PredefId
forall a. JSON a => JSValue -> FilePath -> Result a
!FilePath
".predef"
Result LinValue -> Result LinValue -> Result LinValue
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> LinType -> [TableRowValue] -> LinValue
TableValue (LinType -> [TableRowValue] -> LinValue)
-> Result LinType -> Result ([TableRowValue] -> LinValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSValue
oJSValue -> FilePath -> Result LinType
forall a. JSON a => JSValue -> FilePath -> Result a
!FilePath
".tblarg" Result ([TableRowValue] -> LinValue)
-> Result [TableRowValue] -> Result LinValue
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> JSValue
oJSValue -> FilePath -> Result [TableRowValue]
forall a. JSON a => JSValue -> FilePath -> Result a
!FilePath
".tblrows"
Result LinValue -> Result LinValue -> Result LinValue
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [LinValue] -> LinValue
TupleValue ([LinValue] -> LinValue) -> Result [LinValue] -> Result LinValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSValue
oJSValue -> FilePath -> Result [LinValue]
forall a. JSON a => JSValue -> FilePath -> Result a
!FilePath
".tuple"
Result LinValue -> Result LinValue -> Result LinValue
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> VarValueId -> LinValue
VarValue (VarValueId -> LinValue) -> Result VarValueId -> Result LinValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSValue
oJSValue -> FilePath -> Result VarValueId
forall a. JSON a => JSValue -> FilePath -> Result a
!FilePath
".var"
Result LinValue -> Result LinValue -> Result LinValue
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FilePath -> LinValue
ErrorValue (FilePath -> LinValue) -> Result FilePath -> Result LinValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSValue
oJSValue -> FilePath -> Result FilePath
forall a. JSON a => JSValue -> FilePath -> Result a
!FilePath
".error"
Result LinValue -> Result LinValue -> Result LinValue
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> LinValue -> LabelId -> LinValue
Projection (LinValue -> LabelId -> LinValue)
-> Result LinValue -> Result (LabelId -> LinValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSValue
oJSValue -> FilePath -> Result LinValue
forall a. JSON a => JSValue -> FilePath -> Result a
!FilePath
".project" Result (LabelId -> LinValue) -> Result LabelId -> Result LinValue
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> JSValue
oJSValue -> FilePath -> Result LabelId
forall a. JSON a => JSValue -> FilePath -> Result a
!FilePath
".label"
Result LinValue -> Result LinValue -> Result LinValue
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> LinValue -> LinValue -> LinValue
Selection (LinValue -> LinValue -> LinValue)
-> Result LinValue -> Result (LinValue -> LinValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSValue
oJSValue -> FilePath -> Result LinValue
forall a. JSON a => JSValue -> FilePath -> Result a
!FilePath
".select" Result (LinValue -> LinValue) -> Result LinValue -> Result LinValue
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> JSValue
oJSValue -> FilePath -> Result LinValue
forall a. JSON a => JSValue -> FilePath -> Result a
!FilePath
".key"
Result LinValue -> Result LinValue -> Result LinValue
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [LinValue] -> LinValue
VariantValue ([LinValue] -> LinValue) -> Result [LinValue] -> Result LinValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSValue
oJSValue -> FilePath -> Result [LinValue]
forall a. JSON a => JSValue -> FilePath -> Result a
!FilePath
".variants"
Result LinValue -> Result LinValue -> Result LinValue
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [([FilePath], LinValue)] -> LinValue -> LinValue
PreValue ([([FilePath], LinValue)] -> LinValue -> LinValue)
-> Result [([FilePath], LinValue)] -> Result (LinValue -> LinValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSValue
oJSValue -> FilePath -> Result [([FilePath], LinValue)]
forall a. JSON a => JSValue -> FilePath -> Result a
!FilePath
".pre" Result (LinValue -> LinValue) -> Result LinValue -> Result LinValue
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> JSValue
oJSValue -> FilePath -> Result LinValue
forall a. JSON a => JSValue -> FilePath -> Result a
!FilePath
".default"
Result LinValue -> Result LinValue -> Result LinValue
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [RecordRowValue] -> LinValue
RecordValue ([RecordRowValue] -> LinValue)
-> Result [RecordRowValue] -> Result LinValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSValue -> Result [RecordRowValue]
forall a. JSON a => JSValue -> Result a
readJSON JSValue
o
Result LinValue -> Result LinValue -> Result LinValue
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do [LinValue]
vs <- JSValue -> Result [LinValue]
forall a. JSON a => JSValue -> Result a
readJSON JSValue
o :: Result [LinValue]
LinValue -> Result LinValue
forall (m :: * -> *) a. Monad m => a -> m a
return ((LinValue -> LinValue -> LinValue) -> [LinValue] -> LinValue
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 LinValue -> LinValue -> LinValue
ConcatValue [LinValue]
vs)
instance JSON LinLiteral where
showJSON :: LinLiteral -> JSValue
showJSON (StrConstant FilePath
s) = FilePath -> JSValue
forall a. JSON a => a -> JSValue
showJSON FilePath
s
showJSON (FloatConstant Float
f) = Float -> JSValue
forall a. JSON a => a -> JSValue
showJSON Float
f
showJSON (IntConstant Int
n) = Int -> JSValue
forall a. JSON a => a -> JSValue
showJSON Int
n
readJSON :: JSValue -> Result LinLiteral
readJSON = (FilePath -> LinLiteral)
-> (Int -> LinLiteral)
-> (Float -> LinLiteral)
-> JSValue
-> Result LinLiteral
forall int flt v.
(JSON int, Integral int, JSON flt, RealFloat flt) =>
(FilePath -> v) -> (int -> v) -> (flt -> v) -> JSValue -> Result v
readBasicJSON FilePath -> LinLiteral
StrConstant Int -> LinLiteral
IntConstant Float -> LinLiteral
FloatConstant
instance JSON LinPattern where
showJSON :: LinPattern -> JSValue
showJSON (LinPattern
WildPattern) = FilePath -> JSValue
forall a. JSON a => a -> JSValue
showJSON FilePath
"_"
showJSON (ParamPattern (Param ParamId
p [])) = ParamId -> JSValue
forall a. JSON a => a -> JSValue
showJSON ParamId
p
showJSON (ParamPattern Param LinPattern
pv) = Param LinPattern -> JSValue
forall a. JSON a => a -> JSValue
showJSON Param LinPattern
pv
showJSON (RecordPattern [RecordRow LinPattern]
r) = [RecordRow LinPattern] -> JSValue
forall a. JSON a => a -> JSValue
showJSON [RecordRow LinPattern]
r
readJSON :: JSValue -> Result LinPattern
readJSON JSValue
o = do ()
p <- FilePath -> JSValue -> Result ()
parseString FilePath
"_" JSValue
o; LinPattern -> Result LinPattern
forall (m :: * -> *) a. Monad m => a -> m a
return LinPattern
WildPattern
Result LinPattern -> Result LinPattern -> Result LinPattern
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do ParamId
p <- JSValue -> Result ParamId
forall a. JSON a => JSValue -> Result a
readJSON JSValue
o; LinPattern -> Result LinPattern
forall (m :: * -> *) a. Monad m => a -> m a
return (Param LinPattern -> LinPattern
ParamPattern (ParamId -> [LinPattern] -> Param LinPattern
forall arg. ParamId -> [arg] -> Param arg
Param ParamId
p []))
Result LinPattern -> Result LinPattern -> Result LinPattern
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Param LinPattern -> LinPattern
ParamPattern (Param LinPattern -> LinPattern)
-> Result (Param LinPattern) -> Result LinPattern
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSValue -> Result (Param LinPattern)
forall a. JSON a => JSValue -> Result a
readJSON JSValue
o
Result LinPattern -> Result LinPattern -> Result LinPattern
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [RecordRow LinPattern] -> LinPattern
RecordPattern ([RecordRow LinPattern] -> LinPattern)
-> Result [RecordRow LinPattern] -> Result LinPattern
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSValue -> Result [RecordRow LinPattern]
forall a. JSON a => JSValue -> Result a
readJSON JSValue
o
instance JSON arg => JSON (Param arg) where
showJSON :: Param arg -> JSValue
showJSON (Param ParamId
p []) = ParamId -> JSValue
forall a. JSON a => a -> JSValue
showJSON ParamId
p
showJSON (Param ParamId
p [arg]
args) = [(FilePath, JSValue)] -> JSValue
makeObj [(FilePath
".paramid", ParamId -> JSValue
forall a. JSON a => a -> JSValue
showJSON ParamId
p), (FilePath
".args", [arg] -> JSValue
forall a. JSON a => a -> JSValue
showJSON [arg]
args)]
readJSON :: JSValue -> Result (Param arg)
readJSON JSValue
o = ParamId -> [arg] -> Param arg
forall arg. ParamId -> [arg] -> Param arg
Param (ParamId -> [arg] -> Param arg)
-> Result ParamId -> Result ([arg] -> Param arg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSValue -> Result ParamId
forall a. JSON a => JSValue -> Result a
readJSON JSValue
o Result ([arg] -> Param arg) -> Result [arg] -> Result (Param arg)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [arg] -> Result [arg]
forall (m :: * -> *) a. Monad m => a -> m a
return []
Result (Param arg) -> Result (Param arg) -> Result (Param arg)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParamId -> [arg] -> Param arg
forall arg. ParamId -> [arg] -> Param arg
Param (ParamId -> [arg] -> Param arg)
-> Result ParamId -> Result ([arg] -> Param arg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSValue
oJSValue -> FilePath -> Result ParamId
forall a. JSON a => JSValue -> FilePath -> Result a
!FilePath
".paramid" Result ([arg] -> Param arg) -> Result [arg] -> Result (Param arg)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> JSValue
oJSValue -> FilePath -> Result [arg]
forall a. JSON a => JSValue -> FilePath -> Result a
!FilePath
".args"
instance JSON a => JSON (RecordRow a) where
showJSON :: RecordRow a -> JSValue
showJSON RecordRow a
row = [RecordRow a] -> JSValue
forall a. JSON a => [a] -> JSValue
showJSONs [RecordRow a
row]
showJSONs :: [RecordRow a] -> JSValue
showJSONs [RecordRow a]
rows = [(FilePath, JSValue)] -> JSValue
makeObj ((RecordRow a -> (FilePath, JSValue))
-> [RecordRow a] -> [(FilePath, JSValue)]
forall a b. (a -> b) -> [a] -> [b]
map RecordRow a -> (FilePath, JSValue)
forall a. JSON a => RecordRow a -> (FilePath, JSValue)
toRow [RecordRow a]
rows)
where toRow :: RecordRow a -> (FilePath, JSValue)
toRow (RecordRow (LabelId FlagName
lbl) a
val) = (FlagName -> FilePath
showRawIdent FlagName
lbl, a -> JSValue
forall a. JSON a => a -> JSValue
showJSON a
val)
readJSON :: JSValue -> Result (RecordRow a)
readJSON JSValue
obj = [RecordRow a] -> RecordRow a
forall a. [a] -> a
head ([RecordRow a] -> RecordRow a)
-> Result [RecordRow a] -> Result (RecordRow a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSValue -> Result [RecordRow a]
forall a. JSON a => JSValue -> Result [a]
readJSONs JSValue
obj
readJSONs :: JSValue -> Result [RecordRow a]
readJSONs JSValue
obj = ((FilePath, JSValue) -> Result (RecordRow a))
-> [(FilePath, JSValue)] -> Result [RecordRow a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (FilePath, JSValue) -> Result (RecordRow a)
forall rhs.
JSON rhs =>
(FilePath, JSValue) -> Result (RecordRow rhs)
fromRow (JSValue -> [(FilePath, JSValue)]
assocsJSObject JSValue
obj)
where fromRow :: (FilePath, JSValue) -> Result (RecordRow rhs)
fromRow (FilePath
lbl, JSValue
jsvalue) = do rhs
value <- JSValue -> Result rhs
forall a. JSON a => JSValue -> Result a
readJSON JSValue
jsvalue
RecordRow rhs -> Result (RecordRow rhs)
forall (m :: * -> *) a. Monad m => a -> m a
return (LabelId -> rhs -> RecordRow rhs
forall rhs. LabelId -> rhs -> RecordRow rhs
RecordRow (FlagName -> LabelId
LabelId (FilePath -> FlagName
rawIdentS FilePath
lbl)) rhs
value)
instance JSON rhs => JSON (TableRow rhs) where
showJSON :: TableRow rhs -> JSValue
showJSON (TableRow LinPattern
l rhs
v) = [(FilePath, JSValue)] -> JSValue
makeObj [(FilePath
".pattern", LinPattern -> JSValue
forall a. JSON a => a -> JSValue
showJSON LinPattern
l), (FilePath
".value", rhs -> JSValue
forall a. JSON a => a -> JSValue
showJSON rhs
v)]
readJSON :: JSValue -> Result (TableRow rhs)
readJSON JSValue
o = LinPattern -> rhs -> TableRow rhs
forall rhs. LinPattern -> rhs -> TableRow rhs
TableRow (LinPattern -> rhs -> TableRow rhs)
-> Result LinPattern -> Result (rhs -> TableRow rhs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSValue
oJSValue -> FilePath -> Result LinPattern
forall a. JSON a => JSValue -> FilePath -> Result a
!FilePath
".pattern" Result (rhs -> TableRow rhs) -> Result rhs -> Result (TableRow rhs)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> JSValue
oJSValue -> FilePath -> Result rhs
forall a. JSON a => JSValue -> FilePath -> Result a
!FilePath
".value"
instance JSON PredefId where showJSON :: PredefId -> JSValue
showJSON (PredefId FlagName
s) = FlagName -> JSValue
forall a. JSON a => a -> JSValue
showJSON FlagName
s ; readJSON :: JSValue -> Result PredefId
readJSON = (FlagName -> PredefId) -> Result FlagName -> Result PredefId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FlagName -> PredefId
PredefId (Result FlagName -> Result PredefId)
-> (JSValue -> Result FlagName) -> JSValue -> Result PredefId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSValue -> Result FlagName
forall a. JSON a => JSValue -> Result a
readJSON
instance JSON LabelId where showJSON :: LabelId -> JSValue
showJSON (LabelId FlagName
s) = FlagName -> JSValue
forall a. JSON a => a -> JSValue
showJSON FlagName
s ; readJSON :: JSValue -> Result LabelId
readJSON = (FlagName -> LabelId) -> Result FlagName -> Result LabelId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FlagName -> LabelId
LabelId (Result FlagName -> Result LabelId)
-> (JSValue -> Result FlagName) -> JSValue -> Result LabelId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSValue -> Result FlagName
forall a. JSON a => JSValue -> Result a
readJSON
instance JSON VarValueId where showJSON :: VarValueId -> JSValue
showJSON (VarValueId QualId
s) = QualId -> JSValue
forall a. JSON a => a -> JSValue
showJSON QualId
s ; readJSON :: JSValue -> Result VarValueId
readJSON = (QualId -> VarValueId) -> Result QualId -> Result VarValueId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap QualId -> VarValueId
VarValueId (Result QualId -> Result VarValueId)
-> (JSValue -> Result QualId) -> JSValue -> Result VarValueId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSValue -> Result QualId
forall a. JSON a => JSValue -> Result a
readJSON
instance JSON ParamId where showJSON :: ParamId -> JSValue
showJSON (ParamId QualId
s) = QualId -> JSValue
forall a. JSON a => a -> JSValue
showJSON QualId
s ; readJSON :: JSValue -> Result ParamId
readJSON = (QualId -> ParamId) -> Result QualId -> Result ParamId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap QualId -> ParamId
ParamId (Result QualId -> Result ParamId)
-> (JSValue -> Result QualId) -> JSValue -> Result ParamId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSValue -> Result QualId
forall a. JSON a => JSValue -> Result a
readJSON
instance JSON ParamType where showJSON :: ParamType -> JSValue
showJSON (ParamTypeId ParamId
s) = ParamId -> JSValue
forall a. JSON a => a -> JSValue
showJSON ParamId
s ; readJSON :: JSValue -> Result ParamType
readJSON = (ParamId -> ParamType) -> Result ParamId -> Result ParamType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ParamId -> ParamType
ParamTypeId (Result ParamId -> Result ParamType)
-> (JSValue -> Result ParamId) -> JSValue -> Result ParamType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSValue -> Result ParamId
forall a. JSON a => JSValue -> Result a
readJSON
instance JSON ModId where showJSON :: ModId -> JSValue
showJSON (ModId FlagName
s) = FlagName -> JSValue
forall a. JSON a => a -> JSValue
showJSON FlagName
s ; readJSON :: JSValue -> Result ModId
readJSON = (FlagName -> ModId) -> Result FlagName -> Result ModId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FlagName -> ModId
ModId (Result FlagName -> Result ModId)
-> (JSValue -> Result FlagName) -> JSValue -> Result ModId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSValue -> Result FlagName
forall a. JSON a => JSValue -> Result a
readJSON
instance JSON CatId where showJSON :: CatId -> JSValue
showJSON (CatId FlagName
s) = FlagName -> JSValue
forall a. JSON a => a -> JSValue
showJSON FlagName
s ; readJSON :: JSValue -> Result CatId
readJSON = (FlagName -> CatId) -> Result FlagName -> Result CatId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FlagName -> CatId
CatId (Result FlagName -> Result CatId)
-> (JSValue -> Result FlagName) -> JSValue -> Result CatId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSValue -> Result FlagName
forall a. JSON a => JSValue -> Result a
readJSON
instance JSON FunId where showJSON :: FunId -> JSValue
showJSON (FunId FlagName
s) = FlagName -> JSValue
forall a. JSON a => a -> JSValue
showJSON FlagName
s ; readJSON :: JSValue -> Result FunId
readJSON = (FlagName -> FunId) -> Result FlagName -> Result FunId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FlagName -> FunId
FunId (Result FlagName -> Result FunId)
-> (JSValue -> Result FlagName) -> JSValue -> Result FunId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSValue -> Result FlagName
forall a. JSON a => JSValue -> Result a
readJSON
instance JSON VarId where
showJSON :: VarId -> JSValue
showJSON VarId
Anonymous = FilePath -> JSValue
forall a. JSON a => a -> JSValue
showJSON FilePath
"_"
showJSON (VarId FlagName
x) = FlagName -> JSValue
forall a. JSON a => a -> JSValue
showJSON FlagName
x
readJSON :: JSValue -> Result VarId
readJSON JSValue
o = do FilePath -> JSValue -> Result ()
parseString FilePath
"_" JSValue
o; VarId -> Result VarId
forall (m :: * -> *) a. Monad m => a -> m a
return VarId
Anonymous
Result VarId -> Result VarId -> Result VarId
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FlagName -> VarId
VarId (FlagName -> VarId) -> Result FlagName -> Result VarId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSValue -> Result FlagName
forall a. JSON a => JSValue -> Result a
readJSON JSValue
o
instance JSON QualId where
showJSON :: QualId -> JSValue
showJSON (Qual (ModId FlagName
m) FlagName
n) = FilePath -> JSValue
forall a. JSON a => a -> JSValue
showJSON (FlagName -> FilePath
showRawIdent FlagName
mFilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
"."FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FlagName -> FilePath
showRawIdent FlagName
n)
showJSON (Unqual FlagName
n) = FlagName -> JSValue
forall a. JSON a => a -> JSValue
showJSON FlagName
n
readJSON :: JSValue -> Result QualId
readJSON JSValue
o = do FilePath
qualid <- JSValue -> Result FilePath
forall a. JSON a => JSValue -> Result a
readJSON JSValue
o
let (FilePath
mod, FilePath
id) = (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'.') FilePath
qualid
QualId -> Result QualId
forall (m :: * -> *) a. Monad m => a -> m a
return (QualId -> Result QualId) -> QualId -> Result QualId
forall a b. (a -> b) -> a -> b
$ if FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
mod then FlagName -> QualId
Unqual (FilePath -> FlagName
rawIdentS FilePath
id) else ModId -> FlagName -> QualId
Qual (FlagName -> ModId
ModId (FilePath -> FlagName
rawIdentS FilePath
mod)) (FilePath -> FlagName
rawIdentS FilePath
id)
instance JSON RawIdent where
showJSON :: FlagName -> JSValue
showJSON FlagName
i = FilePath -> JSValue
forall a. JSON a => a -> JSValue
showJSON (FilePath -> JSValue) -> FilePath -> JSValue
forall a b. (a -> b) -> a -> b
$ FlagName -> FilePath
showRawIdent FlagName
i
readJSON :: JSValue -> Result FlagName
readJSON JSValue
o = FilePath -> FlagName
rawIdentS (FilePath -> FlagName) -> Result FilePath -> Result FlagName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSValue -> Result FilePath
forall a. JSON a => JSValue -> Result a
readJSON JSValue
o
instance JSON Flags where
showJSON :: Flags -> JSValue
showJSON (Flags [(FlagName, FlagValue)]
fs) = [(FilePath, JSValue)] -> JSValue
makeObj [(FlagName -> FilePath
showRawIdent FlagName
f, FlagValue -> JSValue
forall a. JSON a => a -> JSValue
showJSON FlagValue
v) | (FlagName
f, FlagValue
v) <- [(FlagName, FlagValue)]
fs]
readJSON :: JSValue -> Result Flags
readJSON JSValue
obj = [(FlagName, FlagValue)] -> Flags
Flags ([(FlagName, FlagValue)] -> Flags)
-> Result [(FlagName, FlagValue)] -> Result Flags
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((FilePath, JSValue) -> Result (FlagName, FlagValue))
-> [(FilePath, JSValue)] -> Result [(FlagName, FlagValue)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (FilePath, JSValue) -> Result (FlagName, FlagValue)
forall b. JSON b => (FilePath, JSValue) -> Result (FlagName, b)
fromRow (JSValue -> [(FilePath, JSValue)]
assocsJSObject JSValue
obj)
where fromRow :: (FilePath, JSValue) -> Result (FlagName, b)
fromRow (FilePath
lbl, JSValue
jsvalue) = do b
value <- JSValue -> Result b
forall a. JSON a => JSValue -> Result a
readJSON JSValue
jsvalue
(FlagName, b) -> Result (FlagName, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> FlagName
rawIdentS FilePath
lbl, b
value)
instance JSON FlagValue where
showJSON :: FlagValue -> JSValue
showJSON (Str FilePath
s) = FilePath -> JSValue
forall a. JSON a => a -> JSValue
showJSON FilePath
s
showJSON (Int Int
i) = Int -> JSValue
forall a. JSON a => a -> JSValue
showJSON Int
i
showJSON (Flt Double
f) = Double -> JSValue
forall a. JSON a => a -> JSValue
showJSON Double
f
readJSON :: JSValue -> Result FlagValue
readJSON = (FilePath -> FlagValue)
-> (Int -> FlagValue)
-> (Double -> FlagValue)
-> JSValue
-> Result FlagValue
forall int flt v.
(JSON int, Integral int, JSON flt, RealFloat flt) =>
(FilePath -> v) -> (int -> v) -> (flt -> v) -> JSValue -> Result v
readBasicJSON FilePath -> FlagValue
Str Int -> FlagValue
Int Double -> FlagValue
Flt
parseString :: String -> JSValue -> Result ()
parseString :: FilePath -> JSValue -> Result ()
parseString FilePath
s JSValue
o = Bool -> Result ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Result ()) -> (FilePath -> Bool) -> FilePath -> Result ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
s) (FilePath -> Result ()) -> Result FilePath -> Result ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSValue -> Result FilePath
forall a. JSON a => JSValue -> Result a
readJSON JSValue
o
(!) :: JSON a => JSValue -> String -> Result a
JSValue
obj ! :: JSValue -> FilePath -> Result a
! FilePath
key = Result a -> (JSValue -> Result a) -> Maybe JSValue -> Result a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath -> Result a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> Result a) -> FilePath -> Result a
forall a b. (a -> b) -> a -> b
$ FilePath
"CanonicalJSON.(!): Could not find key: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
key)
JSValue -> Result a
forall a. JSON a => JSValue -> Result a
readJSON
(FilePath -> [(FilePath, JSValue)] -> Maybe JSValue
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup FilePath
key (JSValue -> [(FilePath, JSValue)]
assocsJSObject JSValue
obj))
assocsJSObject :: JSValue -> [(String, JSValue)]
assocsJSObject :: JSValue -> [(FilePath, JSValue)]
assocsJSObject (JSObject JSObject JSValue
o) = JSObject JSValue -> [(FilePath, JSValue)]
forall e. JSObject e -> [(FilePath, e)]
fromJSObject JSObject JSValue
o
assocsJSObject (JSArray [JSValue]
_) = FilePath -> [(FilePath, JSValue)]
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> [(FilePath, JSValue)])
-> FilePath -> [(FilePath, JSValue)]
forall a b. (a -> b) -> a -> b
$ FilePath
"CanonicalJSON.assocsJSObject: Expected a JSON object, found an Array"
assocsJSObject JSValue
jsvalue = FilePath -> [(FilePath, JSValue)]
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> [(FilePath, JSValue)])
-> FilePath -> [(FilePath, JSValue)]
forall a b. (a -> b) -> a -> b
$ FilePath
"CanonicalJSON.assocsJSObject: Expected a JSON object, found " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ JSValue -> FilePath
forall a. Show a => a -> FilePath
show JSValue
jsvalue
readBasicJSON :: (JSON int, Integral int, JSON flt, RealFloat flt) =>
(String -> v) -> (int -> v) -> (flt -> v) -> JSValue -> Result v
readBasicJSON :: (FilePath -> v) -> (int -> v) -> (flt -> v) -> JSValue -> Result v
readBasicJSON FilePath -> v
str int -> v
int flt -> v
flt JSValue
o
= FilePath -> v
str (FilePath -> v) -> Result FilePath -> Result v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSValue -> Result FilePath
forall a. JSON a => JSValue -> Result a
readJSON JSValue
o
Result v -> Result v -> Result v
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> flt -> v
int_or_flt (flt -> v) -> Result flt -> Result v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSValue -> Result flt
forall a. JSON a => JSValue -> Result a
readJSON JSValue
o
where int_or_flt :: flt -> v
int_or_flt flt
f | flt
f flt -> flt -> Bool
forall a. Eq a => a -> a -> Bool
== int -> flt
forall a b. (Integral a, Num b) => a -> b
fromIntegral int
n = int -> v
int int
n
| Bool
otherwise = flt -> v
flt flt
f
where n :: int
n = flt -> int
forall a b. (RealFrac a, Integral b) => a -> b
round flt
f