module Language.PureScript.CoreFn.FromJSON
( moduleFromJSON
, parseVersion'
) where
import Prelude
import Control.Applicative ((<|>))
import Data.Aeson
import Data.Aeson.Types (Parser, listParser)
import qualified Data.Map.Strict as M
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Vector as V
import Data.Version (Version, parseVersion)
import Language.PureScript.AST.SourcePos (SourceSpan(..))
import Language.PureScript.AST.Literals
import Language.PureScript.CoreFn.Ann
import Language.PureScript.CoreFn
import Language.PureScript.Names
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