module Language.PureScript.CoreFn.FromJSON
( moduleFromJSON
, parseVersion'
) where
import Prelude
import Control.Applicative ((<|>))
import Data.Aeson (FromJSON(..), Object, Value(..), withObject, withText, (.:))
import Data.Aeson.Types (Parser, listParser)
import Data.Map.Strict qualified as M
import Data.Text (Text)
import Data.Text qualified as T
import Data.Vector qualified as V
import Data.Version (Version, parseVersion)
import Language.PureScript.AST.SourcePos (SourceSpan(..))
import Language.PureScript.AST.Literals (Literal(..))
import Language.PureScript.CoreFn.Ann (Ann)
import Language.PureScript.CoreFn (Bind(..), Binder(..), CaseAlternative(..), ConstructorType(..), Expr(..), Guard, Meta(..), Module(..))
import Language.PureScript.Names (Ident(..), ModuleName(..), ProperName(..), Qualified(..), QualifiedBy(..), unusedIdent)
import Language.PureScript.PSString (PSString)
import Text.ParserCombinators.ReadP (readP_to_S)
parseVersion' :: String -> Maybe Version
parseVersion' :: [Char] -> Maybe Version
parseVersion' [Char]
str =
case forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$ forall a. ReadP a -> ReadS a
readP_to_S ReadP Version
parseVersion [Char]
str of
[(Version
vers, [Char]
"")] -> forall a. a -> Maybe a
Just Version
vers
[(Version, [Char])]
_ -> forall a. Maybe a
Nothing
constructorTypeFromJSON :: Value -> Parser ConstructorType
constructorTypeFromJSON :: Value -> Parser ConstructorType
constructorTypeFromJSON Value
v = do
Text
t <- forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
case Text
t of
Text
"ProductType" -> forall (m :: * -> *) a. Monad m => a -> m a
return ConstructorType
ProductType
Text
"SumType" -> forall (m :: * -> *) a. Monad m => a -> m a
return ConstructorType
SumType
Text
_ -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"not recognized ConstructorType: " forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
t)
metaFromJSON :: Value -> Parser (Maybe Meta)
metaFromJSON :: Value -> Parser (Maybe Meta)
metaFromJSON Value
Null = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
metaFromJSON Value
v = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"Meta" Object -> Parser (Maybe Meta)
metaFromObj Value
v
where
metaFromObj :: Object -> Parser (Maybe Meta)
metaFromObj Object
o = do
Text
type_ <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"metaType"
case Text
type_ of
Text
"IsConstructor" -> Object -> Parser (Maybe Meta)
isConstructorFromJSON Object
o
Text
"IsNewtype" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Meta
IsNewtype
Text
"IsTypeClassConstructor"
-> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Meta
IsTypeClassConstructor
Text
"IsForeign" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Meta
IsForeign
Text
"IsWhere" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Meta
IsWhere
Text
"IsSyntheticApp"
-> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Meta
IsSyntheticApp
Text
_ -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"not recognized Meta: " forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
type_)
isConstructorFromJSON :: Object -> Parser (Maybe Meta)
isConstructorFromJSON Object
o = do
ConstructorType
ct <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"constructorType" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Parser ConstructorType
constructorTypeFromJSON
[Ident]
is <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"identifiers" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Value -> Parser a) -> Value -> Parser [a]
listParser Value -> Parser Ident
identFromJSON
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (ConstructorType -> [Ident] -> Meta
IsConstructor ConstructorType
ct [Ident]
is)
annFromJSON :: FilePath -> Value -> Parser Ann
annFromJSON :: [Char] -> Value -> Parser Ann
annFromJSON [Char]
modulePath = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"Ann" Object -> Parser Ann
annFromObj
where
annFromObj :: Object -> Parser Ann
annFromObj Object
o = do
SourceSpan
ss <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"sourceSpan" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> Value -> Parser SourceSpan
sourceSpanFromJSON [Char]
modulePath
Maybe Meta
mm <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"meta" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Parser (Maybe Meta)
metaFromJSON
forall (m :: * -> *) a. Monad m => a -> m a
return (SourceSpan
ss, [], forall a. Maybe a
Nothing, Maybe Meta
mm)
sourceSpanFromJSON :: FilePath -> Value -> Parser SourceSpan
sourceSpanFromJSON :: [Char] -> Value -> Parser SourceSpan
sourceSpanFromJSON [Char]
modulePath = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"SourceSpan" forall a b. (a -> b) -> a -> b
$ \Object
o ->
[Char] -> SourcePos -> SourcePos -> SourceSpan
SourceSpan [Char]
modulePath forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"start" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"end"
literalFromJSON :: (Value -> Parser a) -> Value -> Parser (Literal a)
literalFromJSON :: forall a. (Value -> Parser a) -> Value -> Parser (Literal a)
literalFromJSON Value -> Parser a
t = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"Literal" Object -> Parser (Literal a)
literalFromObj
where
literalFromObj :: Object -> Parser (Literal a)
literalFromObj Object
o = do
Text
type_ <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"literalType" :: Parser Text
case Text
type_ of
Text
"IntLiteral" -> forall a. Either Integer Double -> Literal a
NumericLiteral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"value"
Text
"NumberLiteral" -> forall a. Either Integer Double -> Literal a
NumericLiteral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"value"
Text
"StringLiteral" -> forall a. PSString -> Literal a
StringLiteral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"value"
Text
"CharLiteral" -> forall a. Char -> Literal a
CharLiteral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"value"
Text
"BooleanLiteral" -> forall a. Bool -> Literal a
BooleanLiteral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"value"
Text
"ArrayLiteral" -> Object -> Parser (Literal a)
parseArrayLiteral Object
o
Text
"ObjectLiteral" -> Object -> Parser (Literal a)
parseObjectLiteral Object
o
Text
_ -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"error parsing Literal: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Object
o)
parseArrayLiteral :: Object -> Parser (Literal a)
parseArrayLiteral Object
o = do
Vector Value
val <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"value"
[a]
as <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Value -> Parser a
t (forall a. Vector a -> [a]
V.toList Vector Value
val)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Literal a
ArrayLiteral [a]
as
parseObjectLiteral :: Object -> Parser (Literal a)
parseObjectLiteral Object
o = do
Value
val <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"value"
forall a. [(PSString, a)] -> Literal a
ObjectLiteral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (Value -> Parser a) -> Value -> Parser [(PSString, a)]
recordFromJSON Value -> Parser a
t Value
val
identFromJSON :: Value -> Parser Ident
identFromJSON :: Value -> Parser Ident
identFromJSON = forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
withText [Char]
"Ident" forall a b. (a -> b) -> a -> b
$ \case
Text
ident | Text
ident forall a. Eq a => a -> a -> Bool
== Text
unusedIdent -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Ident
UnusedIdent
| Bool
otherwise -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> Ident
Ident Text
ident
properNameFromJSON :: Value -> Parser (ProperName a)
properNameFromJSON :: forall (a :: ProperNameType). Value -> Parser (ProperName a)
properNameFromJSON = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (a :: ProperNameType). Text -> ProperName a
ProperName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => Value -> Parser a
parseJSON
qualifiedFromJSON :: (Text -> a) -> Value -> Parser (Qualified a)
qualifiedFromJSON :: forall a. (Text -> a) -> Value -> Parser (Qualified a)
qualifiedFromJSON Text -> a
f = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"Qualified" Object -> Parser (Qualified a)
qualifiedFromObj
where
qualifiedFromObj :: Object -> Parser (Qualified a)
qualifiedFromObj Object
o =
Object -> Parser (Qualified a)
qualifiedByModuleFromObj Object
o forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Object -> Parser (Qualified a)
qualifiedBySourcePosFromObj Object
o
qualifiedByModuleFromObj :: Object -> Parser (Qualified a)
qualifiedByModuleFromObj Object
o = do
ModuleName
mn <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"moduleName" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Parser ModuleName
moduleNameFromJSON
a
i <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"identifier" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
withText [Char]
"Ident" (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> a
f)
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
mn) a
i
qualifiedBySourcePosFromObj :: Object -> Parser (Qualified a)
qualifiedBySourcePosFromObj Object
o = do
SourcePos
ss <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"sourcePos"
a
i <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"identifier" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
withText [Char]
"Ident" (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> a
f)
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. QualifiedBy -> a -> Qualified a
Qualified (SourcePos -> QualifiedBy
BySourcePos SourcePos
ss) a
i
moduleNameFromJSON :: Value -> Parser ModuleName
moduleNameFromJSON :: Value -> Parser ModuleName
moduleNameFromJSON Value
v = Text -> ModuleName
ModuleName forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
T.intercalate Text
"." forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (Value -> Parser a) -> Value -> Parser [a]
listParser forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
moduleFromJSON :: Value -> Parser (Version, Module Ann)
moduleFromJSON :: Value -> Parser (Version, Module Ann)
moduleFromJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"Module" Object -> Parser (Version, Module Ann)
moduleFromObj
where
moduleFromObj :: Object -> Parser (Version, Module Ann)
moduleFromObj Object
o = do
Version
version <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"builtWith" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> Parser Version
versionFromJSON
ModuleName
moduleName <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"moduleName" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Parser ModuleName
moduleNameFromJSON
[Char]
modulePath <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"modulePath"
SourceSpan
moduleSourceSpan <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"sourceSpan" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> Value -> Parser SourceSpan
sourceSpanFromJSON [Char]
modulePath
[(Ann, ModuleName)]
moduleImports <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"imports" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Value -> Parser a) -> Value -> Parser [a]
listParser ([Char] -> Value -> Parser (Ann, ModuleName)
importFromJSON [Char]
modulePath)
[Ident]
moduleExports <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"exports" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Value -> Parser a) -> Value -> Parser [a]
listParser Value -> Parser Ident
identFromJSON
Map ModuleName [Ident]
moduleReExports <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"reExports" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Parser (Map ModuleName [Ident])
reExportsFromJSON
[Bind Ann]
moduleDecls <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"decls" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Value -> Parser a) -> Value -> Parser [a]
listParser ([Char] -> Value -> Parser (Bind Ann)
bindFromJSON [Char]
modulePath)
[Ident]
moduleForeign <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"foreign" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Value -> Parser a) -> Value -> Parser [a]
listParser Value -> Parser Ident
identFromJSON
[Comment]
moduleComments <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"comments" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Value -> Parser a) -> Value -> Parser [a]
listParser forall a. FromJSON a => Value -> Parser a
parseJSON
forall (m :: * -> *) a. Monad m => a -> m a
return (Version
version, Module {[Char]
[(Ann, ModuleName)]
[Comment]
[Ident]
[Bind Ann]
Map ModuleName [Ident]
SourceSpan
ModuleName
moduleDecls :: [Bind Ann]
moduleForeign :: [Ident]
moduleReExports :: Map ModuleName [Ident]
moduleExports :: [Ident]
moduleImports :: [(Ann, ModuleName)]
modulePath :: [Char]
moduleName :: ModuleName
moduleComments :: [Comment]
moduleSourceSpan :: SourceSpan
moduleComments :: [Comment]
moduleForeign :: [Ident]
moduleDecls :: [Bind Ann]
moduleReExports :: Map ModuleName [Ident]
moduleExports :: [Ident]
moduleImports :: [(Ann, ModuleName)]
moduleSourceSpan :: SourceSpan
modulePath :: [Char]
moduleName :: ModuleName
..})
versionFromJSON :: String -> Parser Version
versionFromJSON :: [Char] -> Parser Version
versionFromJSON [Char]
v =
case [Char] -> Maybe Version
parseVersion' [Char]
v of
Just Version
r -> forall (m :: * -> *) a. Monad m => a -> m a
return Version
r
Maybe Version
Nothing -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"failed parsing purs version"
importFromJSON :: FilePath -> Value -> Parser (Ann, ModuleName)
importFromJSON :: [Char] -> Value -> Parser (Ann, ModuleName)
importFromJSON [Char]
modulePath = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"Import"
(\Object
o -> do
Ann
ann <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"annotation" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> Value -> Parser Ann
annFromJSON [Char]
modulePath
ModuleName
mn <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"moduleName" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Parser ModuleName
moduleNameFromJSON
forall (m :: * -> *) a. Monad m => a -> m a
return (Ann
ann, ModuleName
mn))
reExportsFromJSON :: Value -> Parser (M.Map ModuleName [Ident])
reExportsFromJSON :: Value -> Parser (Map ModuleName [Ident])
reExportsFromJSON = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b k. (a -> b) -> Map k a -> Map k b
M.map (forall a b. (a -> b) -> [a] -> [b]
map Text -> Ident
Ident)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => Value -> Parser a
parseJSON
bindFromJSON :: FilePath -> Value -> Parser (Bind Ann)
bindFromJSON :: [Char] -> Value -> Parser (Bind Ann)
bindFromJSON [Char]
modulePath = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"Bind" Object -> Parser (Bind Ann)
bindFromObj
where
bindFromObj :: Object -> Parser (Bind Ann)
bindFromObj :: Object -> Parser (Bind Ann)
bindFromObj Object
o = do
Text
type_ <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"bindType" :: Parser Text
case Text
type_ of
Text
"NonRec" -> (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry) forall a. a -> Ident -> Expr a -> Bind a
NonRec forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Parser ((Ann, Ident), Expr Ann)
bindFromObj' Object
o
Text
"Rec" -> forall a. [((a, Ident), Expr a)] -> Bind a
Rec forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"binds" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Value -> Parser a) -> Value -> Parser [a]
listParser (forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"Bind" Object -> Parser ((Ann, Ident), Expr Ann)
bindFromObj'))
Text
_ -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"not recognized bind type \"" forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
type_ forall a. [a] -> [a] -> [a]
++ [Char]
"\"")
bindFromObj' :: Object -> Parser ((Ann, Ident), Expr Ann)
bindFromObj' :: Object -> Parser ((Ann, Ident), Expr Ann)
bindFromObj' Object
o = do
Ann
a <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"annotation" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> Value -> Parser Ann
annFromJSON [Char]
modulePath
Ident
i <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"identifier" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Parser Ident
identFromJSON
Expr Ann
e <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"expression" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> Value -> Parser (Expr Ann)
exprFromJSON [Char]
modulePath
forall (m :: * -> *) a. Monad m => a -> m a
return ((Ann
a, Ident
i), Expr Ann
e)
recordFromJSON :: (Value -> Parser a) -> Value -> Parser [(PSString, a)]
recordFromJSON :: forall a. (Value -> Parser a) -> Value -> Parser [(PSString, a)]
recordFromJSON Value -> Parser a
p = forall a. (Value -> Parser a) -> Value -> Parser [a]
listParser Value -> Parser (PSString, a)
parsePair
where
parsePair :: Value -> Parser (PSString, a)
parsePair Value
v = do
(PSString
l, Value
v') <- forall a. FromJSON a => Value -> Parser a
parseJSON Value
v :: Parser (PSString, Value)
a
a <- Value -> Parser a
p Value
v'
forall (m :: * -> *) a. Monad m => a -> m a
return (PSString
l, a
a)
exprFromJSON :: FilePath -> Value -> Parser (Expr Ann)
exprFromJSON :: [Char] -> Value -> Parser (Expr Ann)
exprFromJSON [Char]
modulePath = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"Expr" Object -> Parser (Expr Ann)
exprFromObj
where
exprFromObj :: Object -> Parser (Expr Ann)
exprFromObj Object
o = do
Text
type_ <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
case Text
type_ of
Text
"Var" -> Object -> Parser (Expr Ann)
varFromObj Object
o
Text
"Literal" -> Object -> Parser (Expr Ann)
literalExprFromObj Object
o
Text
"Constructor" -> Object -> Parser (Expr Ann)
constructorFromObj Object
o
Text
"Accessor" -> Object -> Parser (Expr Ann)
accessorFromObj Object
o
Text
"ObjectUpdate" -> Object -> Parser (Expr Ann)
objectUpdateFromObj Object
o
Text
"Abs" -> Object -> Parser (Expr Ann)
absFromObj Object
o
Text
"App" -> Object -> Parser (Expr Ann)
appFromObj Object
o
Text
"Case" -> Object -> Parser (Expr Ann)
caseFromObj Object
o
Text
"Let" -> Object -> Parser (Expr Ann)
letFromObj Object
o
Text
_ -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"not recognized expression type: \"" forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
type_ forall a. [a] -> [a] -> [a]
++ [Char]
"\"")
varFromObj :: Object -> Parser (Expr Ann)
varFromObj Object
o = do
Ann
ann <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"annotation" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> Value -> Parser Ann
annFromJSON [Char]
modulePath
Qualified Ident
qi <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"value" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Text -> a) -> Value -> Parser (Qualified a)
qualifiedFromJSON Text -> Ident
Ident
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Qualified Ident -> Expr a
Var Ann
ann Qualified Ident
qi
literalExprFromObj :: Object -> Parser (Expr Ann)
literalExprFromObj Object
o = do
Ann
ann <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"annotation" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> Value -> Parser Ann
annFromJSON [Char]
modulePath
Literal (Expr Ann)
lit <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"value" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Value -> Parser a) -> Value -> Parser (Literal a)
literalFromJSON ([Char] -> Value -> Parser (Expr Ann)
exprFromJSON [Char]
modulePath)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Literal (Expr a) -> Expr a
Literal Ann
ann Literal (Expr Ann)
lit
constructorFromObj :: Object -> Parser (Expr Ann)
constructorFromObj Object
o = do
Ann
ann <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"annotation" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> Value -> Parser Ann
annFromJSON [Char]
modulePath
ProperName 'TypeName
tyn <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"typeName" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (a :: ProperNameType). Value -> Parser (ProperName a)
properNameFromJSON
ProperName 'ConstructorName
con <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"constructorName" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (a :: ProperNameType). Value -> Parser (ProperName a)
properNameFromJSON
[Ident]
is <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"fieldNames" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Value -> Parser a) -> Value -> Parser [a]
listParser Value -> Parser Ident
identFromJSON
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a.
a
-> ProperName 'TypeName
-> ProperName 'ConstructorName
-> [Ident]
-> Expr a
Constructor Ann
ann ProperName 'TypeName
tyn ProperName 'ConstructorName
con [Ident]
is
accessorFromObj :: Object -> Parser (Expr Ann)
accessorFromObj Object
o = do
Ann
ann <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"annotation" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> Value -> Parser Ann
annFromJSON [Char]
modulePath
PSString
f <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"fieldName"
Expr Ann
e <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"expression" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> Value -> Parser (Expr Ann)
exprFromJSON [Char]
modulePath
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> PSString -> Expr a -> Expr a
Accessor Ann
ann PSString
f Expr Ann
e
objectUpdateFromObj :: Object -> Parser (Expr Ann)
objectUpdateFromObj Object
o = do
Ann
ann <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"annotation" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> Value -> Parser Ann
annFromJSON [Char]
modulePath
Expr Ann
e <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"expression" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> Value -> Parser (Expr Ann)
exprFromJSON [Char]
modulePath
[(PSString, Expr Ann)]
us <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"updates" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Value -> Parser a) -> Value -> Parser [(PSString, a)]
recordFromJSON ([Char] -> Value -> Parser (Expr Ann)
exprFromJSON [Char]
modulePath)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Expr a -> [(PSString, Expr a)] -> Expr a
ObjectUpdate Ann
ann Expr Ann
e [(PSString, Expr Ann)]
us
absFromObj :: Object -> Parser (Expr Ann)
absFromObj Object
o = do
Ann
ann <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"annotation" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> Value -> Parser Ann
annFromJSON [Char]
modulePath
Ident
idn <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"argument" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Parser Ident
identFromJSON
Expr Ann
e <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"body" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> Value -> Parser (Expr Ann)
exprFromJSON [Char]
modulePath
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Ident -> Expr a -> Expr a
Abs Ann
ann Ident
idn Expr Ann
e
appFromObj :: Object -> Parser (Expr Ann)
appFromObj Object
o = do
Ann
ann <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"annotation" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> Value -> Parser Ann
annFromJSON [Char]
modulePath
Expr Ann
e <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"abstraction" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> Value -> Parser (Expr Ann)
exprFromJSON [Char]
modulePath
Expr Ann
e' <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"argument" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> Value -> Parser (Expr Ann)
exprFromJSON [Char]
modulePath
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Expr a -> Expr a -> Expr a
App Ann
ann Expr Ann
e Expr Ann
e'
caseFromObj :: Object -> Parser (Expr Ann)
caseFromObj Object
o = do
Ann
ann <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"annotation" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> Value -> Parser Ann
annFromJSON [Char]
modulePath
[Expr Ann]
cs <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"caseExpressions" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Value -> Parser a) -> Value -> Parser [a]
listParser ([Char] -> Value -> Parser (Expr Ann)
exprFromJSON [Char]
modulePath)
[CaseAlternative Ann]
cas <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"caseAlternatives" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Value -> Parser a) -> Value -> Parser [a]
listParser ([Char] -> Value -> Parser (CaseAlternative Ann)
caseAlternativeFromJSON [Char]
modulePath)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> [Expr a] -> [CaseAlternative a] -> Expr a
Case Ann
ann [Expr Ann]
cs [CaseAlternative Ann]
cas
letFromObj :: Object -> Parser (Expr Ann)
letFromObj Object
o = do
Ann
ann <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"annotation" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> Value -> Parser Ann
annFromJSON [Char]
modulePath
[Bind Ann]
bs <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"binds" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Value -> Parser a) -> Value -> Parser [a]
listParser ([Char] -> Value -> Parser (Bind Ann)
bindFromJSON [Char]
modulePath)
Expr Ann
e <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"expression" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> Value -> Parser (Expr Ann)
exprFromJSON [Char]
modulePath
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> [Bind a] -> Expr a -> Expr a
Let Ann
ann [Bind Ann]
bs Expr Ann
e
caseAlternativeFromJSON :: FilePath -> Value -> Parser (CaseAlternative Ann)
caseAlternativeFromJSON :: [Char] -> Value -> Parser (CaseAlternative Ann)
caseAlternativeFromJSON [Char]
modulePath = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"CaseAlternative" Object -> Parser (CaseAlternative Ann)
caseAlternativeFromObj
where
caseAlternativeFromObj :: Object -> Parser (CaseAlternative Ann)
caseAlternativeFromObj Object
o = do
[Binder Ann]
bs <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"binders" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Value -> Parser a) -> Value -> Parser [a]
listParser ([Char] -> Value -> Parser (Binder Ann)
binderFromJSON [Char]
modulePath)
Bool
isGuarded <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"isGuarded"
if Bool
isGuarded
then do
[(Expr Ann, Expr Ann)]
es <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"expressions" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Value -> Parser a) -> Value -> Parser [a]
listParser Value -> Parser (Expr Ann, Expr Ann)
parseResultWithGuard
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a.
[Binder a]
-> Either [(Guard a, Guard a)] (Guard a) -> CaseAlternative a
CaseAlternative [Binder Ann]
bs (forall a b. a -> Either a b
Left [(Expr Ann, Expr Ann)]
es)
else do
Expr Ann
e <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"expression" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> Value -> Parser (Expr Ann)
exprFromJSON [Char]
modulePath
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a.
[Binder a]
-> Either [(Guard a, Guard a)] (Guard a) -> CaseAlternative a
CaseAlternative [Binder Ann]
bs (forall a b. b -> Either a b
Right Expr Ann
e)
parseResultWithGuard :: Value -> Parser (Guard Ann, Expr Ann)
parseResultWithGuard :: Value -> Parser (Expr Ann, Expr Ann)
parseResultWithGuard = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"parseCaseWithGuards" forall a b. (a -> b) -> a -> b
$
\Object
o -> do
Expr Ann
g <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"guard" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> Value -> Parser (Expr Ann)
exprFromJSON [Char]
modulePath
Expr Ann
e <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"expression" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> Value -> Parser (Expr Ann)
exprFromJSON [Char]
modulePath
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr Ann
g, Expr Ann
e)
binderFromJSON :: FilePath -> Value -> Parser (Binder Ann)
binderFromJSON :: [Char] -> Value -> Parser (Binder Ann)
binderFromJSON [Char]
modulePath = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"Binder" Object -> Parser (Binder Ann)
binderFromObj
where
binderFromObj :: Object -> Parser (Binder Ann)
binderFromObj Object
o = do
Text
type_ <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"binderType"
case Text
type_ of
Text
"NullBinder" -> Object -> Parser (Binder Ann)
nullBinderFromObj Object
o
Text
"VarBinder" -> Object -> Parser (Binder Ann)
varBinderFromObj Object
o
Text
"LiteralBinder" -> Object -> Parser (Binder Ann)
literalBinderFromObj Object
o
Text
"ConstructorBinder" -> Object -> Parser (Binder Ann)
constructorBinderFromObj Object
o
Text
"NamedBinder" -> Object -> Parser (Binder Ann)
namedBinderFromObj Object
o
Text
_ -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"not recognized binder: \"" forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
type_ forall a. [a] -> [a] -> [a]
++ [Char]
"\"")
nullBinderFromObj :: Object -> Parser (Binder Ann)
nullBinderFromObj Object
o = do
Ann
ann <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"annotation" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> Value -> Parser Ann
annFromJSON [Char]
modulePath
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Binder a
NullBinder Ann
ann
varBinderFromObj :: Object -> Parser (Binder Ann)
varBinderFromObj Object
o = do
Ann
ann <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"annotation" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> Value -> Parser Ann
annFromJSON [Char]
modulePath
Ident
idn <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"identifier" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Parser Ident
identFromJSON
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Ident -> Binder a
VarBinder Ann
ann Ident
idn
literalBinderFromObj :: Object -> Parser (Binder Ann)
literalBinderFromObj Object
o = do
Ann
ann <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"annotation" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> Value -> Parser Ann
annFromJSON [Char]
modulePath
Literal (Binder Ann)
lit <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"literal" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Value -> Parser a) -> Value -> Parser (Literal a)
literalFromJSON ([Char] -> Value -> Parser (Binder Ann)
binderFromJSON [Char]
modulePath)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Literal (Binder a) -> Binder a
LiteralBinder Ann
ann Literal (Binder Ann)
lit
constructorBinderFromObj :: Object -> Parser (Binder Ann)
constructorBinderFromObj Object
o = do
Ann
ann <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"annotation" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> Value -> Parser Ann
annFromJSON [Char]
modulePath
Qualified (ProperName 'TypeName)
tyn <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"typeName" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Text -> a) -> Value -> Parser (Qualified a)
qualifiedFromJSON forall (a :: ProperNameType). Text -> ProperName a
ProperName
Qualified (ProperName 'ConstructorName)
con <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"constructorName" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Text -> a) -> Value -> Parser (Qualified a)
qualifiedFromJSON forall (a :: ProperNameType). Text -> ProperName a
ProperName
[Binder Ann]
bs <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"binders" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Value -> Parser a) -> Value -> Parser [a]
listParser ([Char] -> Value -> Parser (Binder Ann)
binderFromJSON [Char]
modulePath)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a.
a
-> Qualified (ProperName 'TypeName)
-> Qualified (ProperName 'ConstructorName)
-> [Binder a]
-> Binder a
ConstructorBinder Ann
ann Qualified (ProperName 'TypeName)
tyn Qualified (ProperName 'ConstructorName)
con [Binder Ann]
bs
namedBinderFromObj :: Object -> Parser (Binder Ann)
namedBinderFromObj Object
o = do
Ann
ann <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"annotation" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> Value -> Parser Ann
annFromJSON [Char]
modulePath
Ident
n <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"identifier" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Parser Ident
identFromJSON
Binder Ann
b <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"binder" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> Value -> Parser (Binder Ann)
binderFromJSON [Char]
modulePath
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Ident -> Binder a -> Binder a
NamedBinder Ann
ann Ident
n Binder Ann
b