{- | Aeson instances for the Fortran AST defined in fortran-src.

As of fortran-src v0.10.0, most node types store an annotation and a 'SrcSpan'.
The general approach to instance design is as follows:

  * Annotations are placed in @anno@ fields.
  * Spans are placed in @span@ fields.
  * Where possible, we use a generic derivation that takes field names from the
    data type. (This works for most single-constructor product types.)
  * For sum types, an object is created storing an annotation, span and tag. The
    tag indicates the constructor being used. The other fields are then
    "flattened" into the tag object. (This isn't what Aeson's generic derivation
    does by default due to safety concerns, but it can be nicer for JSON.)

-}

{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE OverloadedStrings #-}

module Language.Fortran.Extras.JSON() where

import Language.Fortran.Extras.JSON.Helpers
import Language.Fortran.Extras.JSON.Supporting()
import Language.Fortran.Extras.JSON.Literals()
import Data.Aeson hiding ( Value )
import Language.Fortran.AST
import qualified Data.Text as Text
import Data.Text ( Text )

-- Assorted
-- DerivingVia needs GHC 8.6
--deriving via String instance ToJSON (Comment a)
instance ToJSON (Comment a) where
    toJSON :: Comment a -> Value
toJSON     (Comment String
str) = String -> Value
forall a. ToJSON a => a -> Value
toJSON     String
str
    toEncoding :: Comment a -> Encoding
toEncoding (Comment String
str) = String -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding String
str

instance ToJSON BaseType where
    toJSON :: BaseType -> Value
toJSON     = Text -> Value
forall a. ToJSON a => a -> Value
toJSON     (Text -> Value) -> (BaseType -> Text) -> BaseType -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BaseType -> Text
aesonBaseTypeHelper
    toEncoding :: BaseType -> Encoding
toEncoding = Text -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding (Text -> Encoding) -> (BaseType -> Text) -> BaseType -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BaseType -> Text
aesonBaseTypeHelper

aesonBaseTypeHelper :: BaseType -> Text
aesonBaseTypeHelper :: BaseType -> Text
aesonBaseTypeHelper = \case
  BaseType
TypeInteger         -> Text
"integer"
  BaseType
TypeReal            -> Text
"real"
  BaseType
TypeDoublePrecision -> Text
"double_precision"
  BaseType
TypeComplex         -> Text
"complex"
  BaseType
TypeDoubleComplex   -> Text
"double_complex"
  BaseType
TypeLogical         -> Text
"logical"
  BaseType
TypeCharacter       -> Text
"character"
  TypeCustom String
a        -> Text
"custom:"Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>String -> Text
Text.pack String
a
  BaseType
TypeByte            -> Text
"byte"
  BaseType
ClassStar           -> Text
"star"
  ClassCustom String
a       -> Text
"custom:class:"Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>String -> Text
Text.pack String
a

instance ToJSON Intent where
    toJSON :: Intent -> Value
toJSON     = Options -> Intent -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
gtj (Options -> Intent -> Value) -> Options -> Intent -> Value
forall a b. (a -> b) -> a -> b
$ String -> Options
jcEnumDrop String
""
    toEncoding :: Intent -> Encoding
toEncoding = Options -> Intent -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
gte (Options -> Intent -> Encoding) -> Options -> Intent -> Encoding
forall a b. (a -> b) -> a -> b
$ String -> Options
jcEnumDrop String
""

-- USE statements
instance ToJSON ModuleNature where
    toJSON :: ModuleNature -> Value
toJSON     = Options -> ModuleNature -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
gtj (Options -> ModuleNature -> Value)
-> Options -> ModuleNature -> Value
forall a b. (a -> b) -> a -> b
$ String -> Options
jcEnumDrop String
"Mod"
    toEncoding :: ModuleNature -> Encoding
toEncoding = Options -> ModuleNature -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
gte (Options -> ModuleNature -> Encoding)
-> Options -> ModuleNature -> Encoding
forall a b. (a -> b) -> a -> b
$ String -> Options
jcEnumDrop String
"Mod"
instance ToJSON Only where
    toJSON :: Only -> Value
toJSON     = Options -> Only -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
gtj (Options -> Only -> Value) -> Options -> Only -> Value
forall a b. (a -> b) -> a -> b
$ String -> Options
jcEnumDrop String
""
    toEncoding :: Only -> Encoding
toEncoding = Options -> Only -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
gte (Options -> Only -> Encoding) -> Options -> Only -> Encoding
forall a b. (a -> b) -> a -> b
$ String -> Options
jcEnumDrop String
""

-- Expressions
instance ToJSON UnaryOp where
    toJSON :: UnaryOp -> Value
toJSON     = Options -> UnaryOp -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
gtj (Options -> UnaryOp -> Value) -> Options -> UnaryOp -> Value
forall a b. (a -> b) -> a -> b
$ String -> Options
jcSumDrop String
""
    toEncoding :: UnaryOp -> Encoding
toEncoding = Options -> UnaryOp -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
gte (Options -> UnaryOp -> Encoding) -> Options -> UnaryOp -> Encoding
forall a b. (a -> b) -> a -> b
$ String -> Options
jcSumDrop String
""
instance ToJSON BinaryOp where
    toJSON :: BinaryOp -> Value
toJSON     = Options -> BinaryOp -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
gtj (Options -> BinaryOp -> Value) -> Options -> BinaryOp -> Value
forall a b. (a -> b) -> a -> b
$ String -> Options
jcSumDrop String
""
    toEncoding :: BinaryOp -> Encoding
toEncoding = Options -> BinaryOp -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
gte (Options -> BinaryOp -> Encoding)
-> Options -> BinaryOp -> Encoding
forall a b. (a -> b) -> a -> b
$ String -> Options
jcSumDrop String
""

--------------------------------------------------------------------------------

-- standalone apart from a, SrcSpan
instance ToJSON a => ToJSON (Prefix a) where toJSON :: Prefix a -> Value
toJSON = Options -> Prefix a -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
gtj (Options -> Prefix a -> Value) -> Options -> Prefix a -> Value
forall a b. (a -> b) -> a -> b
$ String -> Options
jcSumDrop String
"Pfx"

instance ToJSON a => ToJSON (Value a) where
    toJSON :: Value a -> Value
toJSON     = Options -> Value a -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
gtj (Options -> Value a -> Value) -> Options -> Value a -> Value
forall a b. (a -> b) -> a -> b
$ String -> Options
jcSumDrop String
"Val"
    toEncoding :: Value a -> Encoding
toEncoding = Options -> Value a -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
gte (Options -> Value a -> Encoding) -> Options -> Value a -> Encoding
forall a b. (a -> b) -> a -> b
$ String -> Options
jcSumDrop String
"Val"

instance ToJSON a => ToJSON (Selector a) where
    toJSON :: Selector a -> Value
toJSON     = Options -> Selector a -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
gtj (Options -> Selector a -> Value) -> Options -> Selector a -> Value
forall a b. (a -> b) -> a -> b
$ String -> Options
jcProdDrop String
"selector"
    toEncoding :: Selector a -> Encoding
toEncoding = Options -> Selector a -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
gte (Options -> Selector a -> Encoding)
-> Options -> Selector a -> Encoding
forall a b. (a -> b) -> a -> b
$ String -> Options
jcProdDrop String
"selector"

instance ToJSON a => ToJSON (TypeSpec a) where
    toJSON :: TypeSpec a -> Value
toJSON     = Options -> TypeSpec a -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
gtj (Options -> TypeSpec a -> Value) -> Options -> TypeSpec a -> Value
forall a b. (a -> b) -> a -> b
$ String -> Options
jcProdDrop String
"typeSpec"
    toEncoding :: TypeSpec a -> Encoding
toEncoding = Options -> TypeSpec a -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
gte (Options -> TypeSpec a -> Encoding)
-> Options -> TypeSpec a -> Encoding
forall a b. (a -> b) -> a -> b
$ String -> Options
jcProdDrop String
"typeSpec"

instance ToJSON a => ToJSON (DimensionDeclarator a) where
    toJSON :: DimensionDeclarator a -> Value
toJSON     = Options -> DimensionDeclarator a -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
gtj (Options -> DimensionDeclarator a -> Value)
-> Options -> DimensionDeclarator a -> Value
forall a b. (a -> b) -> a -> b
$ String -> Options
jcProdDrop String
"dimDecl"
    toEncoding :: DimensionDeclarator a -> Encoding
toEncoding = Options -> DimensionDeclarator a -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
gte (Options -> DimensionDeclarator a -> Encoding)
-> Options -> DimensionDeclarator a -> Encoding
forall a b. (a -> b) -> a -> b
$ String -> Options
jcProdDrop String
"dimDecl"

instance ToJSON a => ToJSON (Declarator a) where
    toJSON :: Declarator a -> Value
toJSON     Declarator a
d = [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [Pair]
fieldsMain [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [Pair]
fieldsType
      where
        fieldsMain :: [Pair]
fieldsMain =
          [ Key
"anno"     Key -> a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Declarator a -> a
forall a. Declarator a -> a
declaratorAnno     Declarator a
d
          , Key
"span"     Key -> SrcSpan -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Declarator a -> SrcSpan
forall a. Declarator a -> SrcSpan
declaratorSpan     Declarator a
d
          , Key
"variable" Key -> Expression a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Declarator a -> Expression a
forall a. Declarator a -> Expression a
declaratorVariable Declarator a
d
          , Key
"length"   Key -> Maybe (Expression a) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Declarator a -> Maybe (Expression a)
forall a. Declarator a -> Maybe (Expression a)
declaratorLength   Declarator a
d
          , Key
"initial"  Key -> Maybe (Expression a) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Declarator a -> Maybe (Expression a)
forall a. Declarator a -> Maybe (Expression a)
declaratorInitial  Declarator a
d
          ]
        fieldsType :: [Pair]
fieldsType = case Declarator a -> DeclaratorType a
forall a. Declarator a -> DeclaratorType a
declaratorType Declarator a
d of
                       DeclaratorType a
ScalarDecl      -> [ Key
"type" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"scalar" ]
                       ArrayDecl  AList DimensionDeclarator a
dims -> [ Key
"type" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"array"
                                          , Key
"dims" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AList DimensionDeclarator a -> Value
forall a. ToJSON a => a -> Value
toJSON AList DimensionDeclarator a
dims ]
    -- TODO toEncoding

instance ToJSON a => ToJSON (Suffix a) where
    toJSON :: Suffix a -> Value
toJSON (SfxBind a
a SrcSpan
s Maybe (Expression a)
e) = Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"bind" a
a SrcSpan
s [Key
"expression" Key -> Maybe (Expression a) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (Expression a)
e]
    -- TODO toEncoding

instance ToJSON a => ToJSON (Attribute a) where
    toJSON :: Attribute a -> Value
toJSON = \case
      AttrParameter    a
a SrcSpan
s      -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"parameter" a
a SrcSpan
s []
      AttrPublic       a
a SrcSpan
s      -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"public" a
a SrcSpan
s []
      AttrProtected    a
a SrcSpan
s      -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"protected" a
a SrcSpan
s []
      AttrPrivate      a
a SrcSpan
s      -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"private" a
a SrcSpan
s []
      AttrAllocatable  a
a SrcSpan
s      -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"allocatable" a
a SrcSpan
s []
      AttrDimension    a
a SrcSpan
s AList DimensionDeclarator a
dims -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"dimension" a
a SrcSpan
s [Key
"dimensions" Key -> AList DimensionDeclarator a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AList DimensionDeclarator a
dims]
      AttrExternal     a
a SrcSpan
s      -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"external" a
a SrcSpan
s []
      AttrIntent       a
a SrcSpan
s Intent
int  -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"intent" a
a SrcSpan
s [Key
"intent" Key -> Intent -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Intent
int]
      AttrOptional     a
a SrcSpan
s      -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"optional" a
a SrcSpan
s []
      AttrPointer      a
a SrcSpan
s      -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"pointer" a
a SrcSpan
s []
      AttrSave         a
a SrcSpan
s      -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"save" a
a SrcSpan
s []
      AttrTarget       a
a SrcSpan
s      -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"target" a
a SrcSpan
s []
      AttrIntrinsic    a
a SrcSpan
s      -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"intrinsic" a
a SrcSpan
s []
      AttrAsynchronous a
a SrcSpan
s      -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"asynchronous" a
a SrcSpan
s []
      AttrSuffix       a
a SrcSpan
s Suffix a
sfx  -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"suffix" a
a SrcSpan
s [Key
"suffix" Key -> Suffix a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Suffix a
sfx]
      AttrValue        a
a SrcSpan
s      -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"value" a
a SrcSpan
s []
      AttrVolatile     a
a SrcSpan
s      -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"volatile" a
a SrcSpan
s []
    -- TODO toEncoding

--------------------------------------------------------------------------------

instance ToJSON a => ToJSON (StructureItem a) where
    toJSON :: StructureItem a -> Value
toJSON = \case
      StructFields a
a SrcSpan
s TypeSpec a
t Maybe (AList Attribute a)
attrs AList Declarator a
decls -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"fields" a
a SrcSpan
s
        [Key
"type" Key -> TypeSpec a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TypeSpec a
t, Key
"attributes" Key -> Maybe (AList Attribute a) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (AList Attribute a)
attrs, Key
"declarators" Key -> AList Declarator a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AList Declarator a
decls]
      StructUnion a
a SrcSpan
s AList UnionMap a
maps -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"union" a
a SrcSpan
s [Key
"maps" Key -> AList UnionMap a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AList UnionMap a
maps]
      StructStructure a
a SrcSpan
s Maybe String
name String
fname AList StructureItem a
decls -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"structure" a
a SrcSpan
s
        [Key
"name" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
fname, Key
"substructure_name" Key -> Maybe String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe String
name, Key
"fields" Key -> AList StructureItem a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AList StructureItem a
decls]
    -- TODO toEncoding
instance ToJSON a => ToJSON (UnionMap a) where
    toJSON :: UnionMap a -> Value
toJSON     = Options -> UnionMap a -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
gtj (Options -> UnionMap a -> Value) -> Options -> UnionMap a -> Value
forall a b. (a -> b) -> a -> b
$ String -> Options
jcProdDrop String
"unionMap"
    toEncoding :: UnionMap a -> Encoding
toEncoding = Options -> UnionMap a -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
gte (Options -> UnionMap a -> Encoding)
-> Options -> UnionMap a -> Encoding
forall a b. (a -> b) -> a -> b
$ String -> Options
jcProdDrop String
"unionMap"

-- TODO rec: Expression
instance ToJSON a => ToJSON (DataGroup a) where
    toJSON :: DataGroup a -> Value
toJSON     = Options -> DataGroup a -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
gtj (Options -> DataGroup a -> Value)
-> Options -> DataGroup a -> Value
forall a b. (a -> b) -> a -> b
$ String -> Options
jcProdDrop String
"dataGroup"
    toEncoding :: DataGroup a -> Encoding
toEncoding = Options -> DataGroup a -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
gte (Options -> DataGroup a -> Encoding)
-> Options -> DataGroup a -> Encoding
forall a b. (a -> b) -> a -> b
$ String -> Options
jcProdDrop String
"dataGroup"

-- TODO rec: Expression (only ExpValue (ValVariable))
instance ToJSON a => ToJSON (Namelist a) where
    toJSON :: Namelist a -> Value
toJSON     = Options -> Namelist a -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
gtj (Options -> Namelist a -> Value) -> Options -> Namelist a -> Value
forall a b. (a -> b) -> a -> b
$ String -> Options
jcProdDrop String
"namelist"
    toEncoding :: Namelist a -> Encoding
toEncoding = Options -> Namelist a -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
gte (Options -> Namelist a -> Encoding)
-> Options -> Namelist a -> Encoding
forall a b. (a -> b) -> a -> b
$ String -> Options
jcProdDrop String
"namelist"

instance ToJSON a => ToJSON (CommonGroup a) where
    toJSON :: CommonGroup a -> Value
toJSON     = Options -> CommonGroup a -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
gtj (Options -> CommonGroup a -> Value)
-> Options -> CommonGroup a -> Value
forall a b. (a -> b) -> a -> b
$ String -> Options
jcProdDrop String
"commonGroup"
    toEncoding :: CommonGroup a -> Encoding
toEncoding = Options -> CommonGroup a -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
gte (Options -> CommonGroup a -> Encoding)
-> Options -> CommonGroup a -> Encoding
forall a b. (a -> b) -> a -> b
$ String -> Options
jcProdDrop String
"commonGroup"

-- TODO not in original package, no field names
instance ToJSON a => ToJSON (FormatItem a) where
    toJSON :: FormatItem a -> Value
toJSON     = Options -> FormatItem a -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
gtj (Options -> FormatItem a -> Value)
-> Options -> FormatItem a -> Value
forall a b. (a -> b) -> a -> b
$ String -> Options
jcSumDrop String
"FI"
    toEncoding :: FormatItem a -> Encoding
toEncoding = Options -> FormatItem a -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
gte (Options -> FormatItem a -> Encoding)
-> Options -> FormatItem a -> Encoding
forall a b. (a -> b) -> a -> b
$ String -> Options
jcSumDrop String
"FI"

instance ToJSON a => ToJSON (ImpList a) where
    toJSON :: ImpList a -> Value
toJSON     = Options -> ImpList a -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
gtj (Options -> ImpList a -> Value) -> Options -> ImpList a -> Value
forall a b. (a -> b) -> a -> b
$ String -> Options
jcProdDrop String
"impList"
    toEncoding :: ImpList a -> Encoding
toEncoding = Options -> ImpList a -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
gte (Options -> ImpList a -> Encoding)
-> Options -> ImpList a -> Encoding
forall a b. (a -> b) -> a -> b
$ String -> Options
jcProdDrop String
"impList"

instance ToJSON a => ToJSON (ImpElement a) where
    toJSON :: ImpElement a -> Value
toJSON     = Options -> ImpElement a -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
gtj (Options -> ImpElement a -> Value)
-> Options -> ImpElement a -> Value
forall a b. (a -> b) -> a -> b
$ String -> Options
jcProdDrop String
"impElement"
    toEncoding :: ImpElement a -> Encoding
toEncoding = Options -> ImpElement a -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
gte (Options -> ImpElement a -> Encoding)
-> Options -> ImpElement a -> Encoding
forall a b. (a -> b) -> a -> b
$ String -> Options
jcProdDrop String
"impElement"

-- random
instance ToJSON a => ToJSON (ControlPair a) where
    toJSON :: ControlPair a -> Value
toJSON     = Options -> ControlPair a -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
gtj (Options -> ControlPair a -> Value)
-> Options -> ControlPair a -> Value
forall a b. (a -> b) -> a -> b
$ String -> Options
jcProdDrop String
"controlPair"
    toEncoding :: ControlPair a -> Encoding
toEncoding = Options -> ControlPair a -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
gte (Options -> ControlPair a -> Encoding)
-> Options -> ControlPair a -> Encoding
forall a b. (a -> b) -> a -> b
$ String -> Options
jcProdDrop String
"controlPair"

instance ToJSON a => ToJSON (FlushSpec a) where
    toJSON :: FlushSpec a -> Value
toJSON     = \case
      FSUnit   a
a SrcSpan
s Expression a
e -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"unit" a
a SrcSpan
s [Key
"expression" Key -> Expression a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Expression a
e]
      FSIOStat a
a SrcSpan
s Expression a
e -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"unit" a
a SrcSpan
s [Key
"expression" Key -> Expression a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Expression a
e]
      FSIOMsg  a
a SrcSpan
s Expression a
e -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"unit" a
a SrcSpan
s [Key
"expression" Key -> Expression a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Expression a
e]
      FSErr    a
a SrcSpan
s Expression a
e -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"unit" a
a SrcSpan
s [Key
"expression" Key -> Expression a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Expression a
e]
    -- TODO toEncoding

instance ToJSON a => ToJSON (AllocOpt a) where
    toJSON :: AllocOpt a -> Value
toJSON     = \case
      AOStat   a
a SrcSpan
s Expression a
e -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"stat" a
a SrcSpan
s [Key
"expression" Key -> Expression a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Expression a
e]
      AOErrMsg a
a SrcSpan
s Expression a
e -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"stat" a
a SrcSpan
s [Key
"expression" Key -> Expression a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Expression a
e]
      AOSource a
a SrcSpan
s Expression a
e -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"stat" a
a SrcSpan
s [Key
"expression" Key -> Expression a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Expression a
e]
    -- TODO toEncoding

instance ToJSON a => ToJSON (Use a) where
    toJSON :: Use a -> Value
toJSON     = \case
      UseRename a
a SrcSpan
s Expression a
eLocal Expression a
eUse -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"rename" a
a SrcSpan
s
        [ Key
"local" Key -> Expression a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Expression a
eLocal, Key
"use" Key -> Expression a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Expression a
eUse ]
      UseID     a
a SrcSpan
s Expression a
e           -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"id"     a
a SrcSpan
s [Key
"name" Key -> Expression a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Expression a
e]
    -- TODO toEncoding

instance ToJSON a => ToJSON (ProcInterface a) where
    toJSON :: ProcInterface a -> Value
toJSON     = \case
      ProcInterfaceName a
a SrcSpan
s Expression a
e -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"name" a
a SrcSpan
s [Key
"name" Key -> Expression a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Expression a
e]
      ProcInterfaceType a
a SrcSpan
s TypeSpec a
t -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"type" a
a SrcSpan
s [Key
"type" Key -> TypeSpec a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TypeSpec a
t]
    -- TODO toEncoding

instance ToJSON a => ToJSON (ProcDecl a) where
    toJSON :: ProcDecl a -> Value
toJSON     = Options -> ProcDecl a -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
gtj (Options -> ProcDecl a -> Value) -> Options -> ProcDecl a -> Value
forall a b. (a -> b) -> a -> b
$ String -> Options
jcProdDrop String
"procDecl"
    toEncoding :: ProcDecl a -> Encoding
toEncoding = Options -> ProcDecl a -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
gte (Options -> ProcDecl a -> Encoding)
-> Options -> ProcDecl a -> Encoding
forall a b. (a -> b) -> a -> b
$ String -> Options
jcProdDrop String
"procDecl"

-- depends on statement, expression
instance ToJSON a => ToJSON (DoSpecification a) where
    toJSON :: DoSpecification a -> Value
toJSON     = Options -> DoSpecification a -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
gtj (Options -> DoSpecification a -> Value)
-> Options -> DoSpecification a -> Value
forall a b. (a -> b) -> a -> b
$ String -> Options
jcProdDrop String
"doSpec"
    toEncoding :: DoSpecification a -> Encoding
toEncoding = Options -> DoSpecification a -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
gte (Options -> DoSpecification a -> Encoding)
-> Options -> DoSpecification a -> Encoding
forall a b. (a -> b) -> a -> b
$ String -> Options
jcProdDrop String
"doSpec"

instance ToJSON a => ToJSON (Index a) where
  toJSON :: Index a -> Value
toJSON Index a
idx = case Index a
idx of
    IxSingle a
a SrcSpan
s Maybe String
nm Expression a
e    -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"single" a
a SrcSpan
s [Key
"name" Key -> Maybe String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe String
nm, Key
"index" Key -> Expression a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Expression a
e]
    IxRange  a
a SrcSpan
s Maybe (Expression a)
l  Maybe (Expression a)
u Maybe (Expression a)
st -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"range"  a
a SrcSpan
s
        [Key
"lower" Key -> Maybe (Expression a) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (Expression a)
l, Key
"upper" Key -> Maybe (Expression a) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (Expression a)
u, Key
"stride" Key -> Maybe (Expression a) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (Expression a)
st]
    -- TODO toEncoding

instance ToJSON a => ToJSON (Argument a) where
    toJSON :: Argument a -> Value
toJSON     = Options -> Argument a -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
gtj (Options -> Argument a -> Value) -> Options -> Argument a -> Value
forall a b. (a -> b) -> a -> b
$ String -> Options
jcProdDrop String
"argument"
    toEncoding :: Argument a -> Encoding
toEncoding = Options -> Argument a -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
gte (Options -> Argument a -> Encoding)
-> Options -> Argument a -> Encoding
forall a b. (a -> b) -> a -> b
$ String -> Options
jcProdDrop String
"argument"

-- weird part of the AST due to annotations and naming
instance ToJSON a => ToJSON (ArgumentExpression a) where
    toJSON :: ArgumentExpression a -> Value
toJSON     = Options -> ArgumentExpression a -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
gtj (Options -> ArgumentExpression a -> Value)
-> Options -> ArgumentExpression a -> Value
forall a b. (a -> b) -> a -> b
$ String -> Options
jcSumDrop String
"Arg"
    toEncoding :: ArgumentExpression a -> Encoding
toEncoding = Options -> ArgumentExpression a -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
gte (Options -> ArgumentExpression a -> Encoding)
-> Options -> ArgumentExpression a -> Encoding
forall a b. (a -> b) -> a -> b
$ String -> Options
jcSumDrop String
"Arg"

instance ToJSON a => ToJSON (ForallHeader a) where
    toJSON :: ForallHeader a -> Value
toJSON     = Options -> ForallHeader a -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
gtj (Options -> ForallHeader a -> Value)
-> Options -> ForallHeader a -> Value
forall a b. (a -> b) -> a -> b
$ String -> Options
jcProdDrop String
"forallHeader"
    toEncoding :: ForallHeader a -> Encoding
toEncoding = Options -> ForallHeader a -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
gte (Options -> ForallHeader a -> Encoding)
-> Options -> ForallHeader a -> Encoding
forall a b. (a -> b) -> a -> b
$ String -> Options
jcProdDrop String
"forallHeader"

instance ToJSON a => ToJSON (ForallHeaderPart a) where
    toJSON :: ForallHeaderPart a -> Value
toJSON     = Options -> ForallHeaderPart a -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
gtj (Options -> ForallHeaderPart a -> Value)
-> Options -> ForallHeaderPart a -> Value
forall a b. (a -> b) -> a -> b
$ String -> Options
jcProdDrop String
"forallHeaderPart"
    toEncoding :: ForallHeaderPart a -> Encoding
toEncoding = Options -> ForallHeaderPart a -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
gte (Options -> ForallHeaderPart a -> Encoding)
-> Options -> ForallHeaderPart a -> Encoding
forall a b. (a -> b) -> a -> b
$ String -> Options
jcProdDrop String
"forallHeaderPart"

instance ToJSON MetaInfo where
    toJSON :: MetaInfo -> Value
toJSON     = Options -> MetaInfo -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
gtj (Options -> MetaInfo -> Value) -> Options -> MetaInfo -> Value
forall a b. (a -> b) -> a -> b
$ String -> Options
jcSumDrop String
"mi"
    toEncoding :: MetaInfo -> Encoding
toEncoding = Options -> MetaInfo -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
gte (Options -> MetaInfo -> Encoding)
-> Options -> MetaInfo -> Encoding
forall a b. (a -> b) -> a -> b
$ String -> Options
jcSumDrop String
"mi"

instance ToJSON a => ToJSON (ProgramFile a) where
    toJSON :: ProgramFile a -> Value
toJSON     = Options -> ProgramFile a -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
gtj (Options -> ProgramFile a -> Value)
-> Options -> ProgramFile a -> Value
forall a b. (a -> b) -> a -> b
$ String -> Options
jcProdDrop String
"programFile"
    toEncoding :: ProgramFile a -> Encoding
toEncoding = Options -> ProgramFile a -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
gte (Options -> ProgramFile a -> Encoding)
-> Options -> ProgramFile a -> Encoding
forall a b. (a -> b) -> a -> b
$ String -> Options
jcProdDrop String
"programFile"

instance ToJSON a => ToJSON (Expression a) where
    toJSON :: Expression a -> Value
toJSON = \case
      ExpValue          a
a SrcSpan
s Value a
val      ->
        Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"value"          a
a SrcSpan
s [Key
"value" Key -> Value a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value a
val]
      ExpBinary         a
a SrcSpan
s BinaryOp
op Expression a
el Expression a
er ->
        Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"binary"         a
a SrcSpan
s [Key
"op" Key -> BinaryOp -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= BinaryOp
op, Key
"left" Key -> Expression a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Expression a
el, Key
"right" Key -> Expression a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Expression a
er]
      ExpUnary          a
a SrcSpan
s UnaryOp
op Expression a
e ->
        Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"unary"          a
a SrcSpan
s [Key
"op" Key -> UnaryOp -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= UnaryOp
op, Key
"expression" Key -> Expression a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Expression a
e]
      ExpSubscript      a
a SrcSpan
s Expression a
e AList Index a
idxs ->
        Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"subscript"      a
a SrcSpan
s [Key
"expression" Key -> Expression a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Expression a
e, Key
"indices" Key -> AList Index a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AList Index a
idxs]
      ExpDataRef        a
a SrcSpan
s Expression a
e1 Expression a
e2 ->
        Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"deref"          a
a SrcSpan
s [Key
"expression" Key -> Expression a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Expression a
e1, Key
"field" Key -> Expression a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Expression a
e2]
      ExpFunctionCall   a
a SrcSpan
s Expression a
fn AList Argument a
args ->
        Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"function_call"  a
a SrcSpan
s [Key
"function" Key -> Expression a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Expression a
fn, Key
"arguments" Key -> AList Argument a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AList Argument a
args]
      ExpImpliedDo      a
a SrcSpan
s AList Expression a
exps DoSpecification a
spec ->
        Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"implied_do"     a
a SrcSpan
s [Key
"expressions" Key -> AList Expression a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AList Expression a
exps, Key
"do_spec" Key -> DoSpecification a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DoSpecification a
spec]
      ExpInitialisation a
a SrcSpan
s AList Expression a
exps ->
        Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"initialisation" a
a SrcSpan
s [Key
"expressions" Key -> AList Expression a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AList Expression a
exps]
      ExpReturnSpec     a
a SrcSpan
s Expression a
tgt  ->
        Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"return_spec"    a
a SrcSpan
s [Key
"target" Key -> Expression a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Expression a
tgt]
    -- TODO toEncoding

instance ToJSON a => ToJSON (Block a) where
    toJSON :: Block a -> Value
toJSON = \case
      BlStatement a
a SrcSpan
s Maybe (Expression a)
l Statement a
st -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"statement" a
a SrcSpan
s
        [Key
"label" Key -> Maybe (Expression a) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (Expression a)
l, Key
"statement" Key -> Statement a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Statement a
st]
      BlIf a
a SrcSpan
s Maybe (Expression a)
l Maybe String
nm NonEmpty (Expression a, [Block a])
conds Maybe [Block a]
blocks Maybe (Expression a)
endlabel -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"if" a
a SrcSpan
s
        [ Key
"label"      Key -> Maybe (Expression a) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (Expression a)
l
        , Key
"name"       Key -> Maybe String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe String
nm
        , Key
"conditions" Key -> NonEmpty (Expression a, [Block a]) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= NonEmpty (Expression a, [Block a])
conds
        , Key
"blocks"     Key -> Maybe [Block a] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Block a]
blocks
        , Key
"end_label"  Key -> Maybe (Expression a) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (Expression a)
endlabel
        ]
      BlCase a
a SrcSpan
s Maybe (Expression a)
l Maybe String
nm Expression a
scrut [(AList Index a, [Block a])]
ranges Maybe [Block a]
blocks Maybe (Expression a)
endlabel -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"case" a
a SrcSpan
s
        [ Key
"label"     Key -> Maybe (Expression a) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (Expression a)
l
        , Key
"name"      Key -> Maybe String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe String
nm
        , Key
"scrutinee" Key -> Expression a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Expression a
scrut
        , Key
"ranges"    Key -> [(AList Index a, [Block a])] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [(AList Index a, [Block a])]
ranges
        , Key
"blocks"    Key -> Maybe [Block a] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Block a]
blocks
        , Key
"end_label" Key -> Maybe (Expression a) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (Expression a)
endlabel
        ]
      BlDo a
a SrcSpan
s Maybe (Expression a)
l Maybe String
nm Maybe (Expression a)
target Maybe (DoSpecification a)
dospec [Block a]
body Maybe (Expression a)
endlabel -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"do" a
a SrcSpan
s
        [ Key
"label"     Key -> Maybe (Expression a) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (Expression a)
l
        , Key
"name"      Key -> Maybe String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe String
nm
        , Key
"target"    Key -> Maybe (Expression a) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (Expression a)
target
        , Key
"do_spec"   Key -> Maybe (DoSpecification a) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (DoSpecification a)
dospec
        , Key
"body"      Key -> [Block a] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Block a]
body
        , Key
"end_label" Key -> Maybe (Expression a) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (Expression a)
endlabel
        ]
      BlDoWhile a
a SrcSpan
s Maybe (Expression a)
l Maybe String
nm Maybe (Expression a)
target Expression a
cond [Block a]
body Maybe (Expression a)
endlabel -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"do_while" a
a SrcSpan
s
        [ Key
"label"     Key -> Maybe (Expression a) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (Expression a)
l
        , Key
"name"      Key -> Maybe String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe String
nm
        , Key
"target"    Key -> Maybe (Expression a) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (Expression a)
target
        , Key
"condition" Key -> Expression a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Expression a
cond
        , Key
"body"      Key -> [Block a] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Block a]
body
        , Key
"end_label" Key -> Maybe (Expression a) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (Expression a)
endlabel
        ]
      BlInterface a
a SrcSpan
s Maybe (Expression a)
l Bool
decls [ProgramUnit a]
blocks [Block a]
_ -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"interface" a
a SrcSpan
s
        [Key
"label" Key -> Maybe (Expression a) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (Expression a)
l, Key
"declarations" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
decls, Key
"blocks" Key -> [ProgramUnit a] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [ProgramUnit a]
blocks]
      BlForall a
a SrcSpan
s Maybe (Expression a)
ml Maybe String
mn ForallHeader a
h [Block a]
bs Maybe (Expression a)
mel -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"forall" a
a SrcSpan
s
        [ Key
"label"     Key -> Maybe (Expression a) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (Expression a)
ml
        , Key
"name"      Key -> Maybe String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe String
mn
        , Key
"header"    Key -> ForallHeader a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ForallHeader a
h
        , Key
"blocks"    Key -> [Block a] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Block a]
bs
        , Key
"end_label" Key -> Maybe (Expression a) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (Expression a)
mel
        ]
      BlAssociate a
a SrcSpan
s Maybe (Expression a)
ml Maybe String
mn AList (ATuple Expression Expression) a
abbrevs [Block a]
bs Maybe (Expression a)
mel -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"associate" a
a SrcSpan
s
        [ Key
"label"     Key -> Maybe (Expression a) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (Expression a)
ml
        , Key
"name"      Key -> Maybe String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe String
mn
        , Key
"abbrevs"   Key -> AList (ATuple Expression Expression) a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AList (ATuple Expression Expression) a
abbrevs
        , Key
"blocks"    Key -> [Block a] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Block a]
bs
        , Key
"end_label" Key -> Maybe (Expression a) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (Expression a)
mel
        ]
      BlComment a
a SrcSpan
s Comment a
c -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"comment" a
a SrcSpan
s [Key
"comment" Key -> Comment a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Comment a
c]
    -- TODO toEncoding

instance ToJSON a => ToJSON (ProgramUnit a) where
    toJSON :: ProgramUnit a -> Value
toJSON = \case
      PUMain a
a SrcSpan
s Maybe String
name [Block a]
blocks Maybe [ProgramUnit a]
pus -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"main" a
a SrcSpan
s
        [Key
"name" Key -> Maybe String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe String
name, Key
"blocks" Key -> [Block a] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Block a]
blocks, Key
"subprograms" Key -> Maybe [ProgramUnit a] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [ProgramUnit a]
pus]
      PUModule a
a SrcSpan
s String
name [Block a]
blocks Maybe [ProgramUnit a]
pus -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"module" a
a SrcSpan
s
        [Key
"name" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
name, Key
"blocks" Key -> [Block a] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Block a]
blocks, Key
"subprograms" Key -> Maybe [ProgramUnit a] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [ProgramUnit a]
pus]
      PUSubroutine a
a SrcSpan
s PrefixSuffix a
pfxsfx String
name Maybe (AList Expression a)
args [Block a]
blocks Maybe [ProgramUnit a]
pus -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"subroutine" a
a SrcSpan
s
        [ Key
"name"        Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
name
        , Key
"arguments"   Key -> Maybe (AList Expression a) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (AList Expression a)
args
        , Key
"blocks"      Key -> [Block a] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Block a]
blocks
        , Key
"subprograms" Key -> Maybe [ProgramUnit a] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [ProgramUnit a]
pus
        , Key
"options"     Key -> PrefixSuffix a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PrefixSuffix a
pfxsfx
        ]
      PUFunction a
a SrcSpan
s Maybe (TypeSpec a)
t PrefixSuffix a
_ String
name Maybe (AList Expression a)
args Maybe (Expression a)
res [Block a]
blocks Maybe [ProgramUnit a]
pus -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"function" a
a SrcSpan
s
        [ Key
"name" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
name
        , Key
"type" Key -> Maybe (TypeSpec a) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (TypeSpec a)
t
        , Key
"arguments" Key -> Maybe (AList Expression a) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (AList Expression a)
args
        , Key
"blocks" Key -> [Block a] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Block a]
blocks
        , Key
"result" Key -> Maybe (Expression a) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (Expression a)
res
        , Key
"subprograms" Key -> Maybe [ProgramUnit a] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [ProgramUnit a]
pus
        ]
      PUBlockData a
a SrcSpan
s Maybe String
name [Block a]
blocks -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"block_data" a
a SrcSpan
s
        [Key
"name" Key -> Maybe String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe String
name, Key
"blocks" Key -> [Block a] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Block a]
blocks]
      PUComment a
a SrcSpan
s Comment a
c -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"comment" a
a SrcSpan
s [Key
"comment" Key -> Comment a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Comment a
c]
    -- TODO toEncoding

instance ToJSON a => ToJSON (Statement a) where
    toJSON :: Statement a -> Value
toJSON Statement a
st = case Statement a
st of
      StOptional    a
a SrcSpan
s AList Expression a
es -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"optional"  a
a SrcSpan
s [Key
"vars" Key -> AList Expression a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AList Expression a
es]
      StPublic      a
a SrcSpan
s Maybe (AList Expression a)
es -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"public"    a
a SrcSpan
s [Key
"vars" Key -> Maybe (AList Expression a) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (AList Expression a)
es]
      StPrivate     a
a SrcSpan
s Maybe (AList Expression a)
es -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"private"   a
a SrcSpan
s [Key
"vars" Key -> Maybe (AList Expression a) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (AList Expression a)
es]
      StProtected   a
a SrcSpan
s Maybe (AList Expression a)
es -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"protected" a
a SrcSpan
s [Key
"vars" Key -> Maybe (AList Expression a) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (AList Expression a)
es]
      StExternal    a
a SrcSpan
s AList Expression a
es -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"external"  a
a SrcSpan
s [Key
"vars" Key -> AList Expression a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AList Expression a
es]
      StIntrinsic   a
a SrcSpan
s AList Expression a
es -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"intrinsic" a
a SrcSpan
s [Key
"vars" Key -> AList Expression a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AList Expression a
es]

      StDimension    a
a SrcSpan
s AList Declarator a
ds -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"dimension"    a
a SrcSpan
s [Key
"declarators" Key -> AList Declarator a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AList Declarator a
ds]
      StAllocatable  a
a SrcSpan
s AList Declarator a
ds -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"allocatable"  a
a SrcSpan
s [Key
"declarators" Key -> AList Declarator a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AList Declarator a
ds]
      StAsynchronous a
a SrcSpan
s AList Declarator a
ds -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"asynchronous" a
a SrcSpan
s [Key
"declarators" Key -> AList Declarator a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AList Declarator a
ds]
      StPointer      a
a SrcSpan
s AList Declarator a
ds -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"pointer"      a
a SrcSpan
s [Key
"declarators" Key -> AList Declarator a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AList Declarator a
ds]
      StTarget       a
a SrcSpan
s AList Declarator a
ds -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"target"       a
a SrcSpan
s [Key
"declarators" Key -> AList Declarator a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AList Declarator a
ds]
      StValue        a
a SrcSpan
s AList Declarator a
ds -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"value"        a
a SrcSpan
s [Key
"declarators" Key -> AList Declarator a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AList Declarator a
ds]
      StVolatile     a
a SrcSpan
s AList Declarator a
ds -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"volatile"     a
a SrcSpan
s [Key
"declarators" Key -> AList Declarator a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AList Declarator a
ds]
      StParameter    a
a SrcSpan
s AList Declarator a
ds -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"parameter"    a
a SrcSpan
s [Key
"declarators" Key -> AList Declarator a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AList Declarator a
ds]
      StAutomatic    a
a SrcSpan
s AList Declarator a
ds -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"automatic"    a
a SrcSpan
s [Key
"declarators" Key -> AList Declarator a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AList Declarator a
ds]
      StStatic       a
a SrcSpan
s AList Declarator a
ds -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"static"       a
a SrcSpan
s [Key
"declarators" Key -> AList Declarator a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AList Declarator a
ds]

      StDeclaration a
a SrcSpan
s TypeSpec a
t Maybe (AList Attribute a)
attrs AList Declarator a
ds -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"declaration" a
a SrcSpan
s
        [Key
"type" Key -> TypeSpec a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= TypeSpec a
t, Key
"attributes" Key -> Maybe (AList Attribute a) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (AList Attribute a)
attrs, Key
"declarators" Key -> AList Declarator a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AList Declarator a
ds]
      StStructure a
a SrcSpan
s Maybe String
name AList StructureItem a
ds -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"structure" a
a SrcSpan
s
        [Key
"name" Key -> Maybe String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe String
name, Key
"fields" Key -> AList StructureItem a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AList StructureItem a
ds]
      StIntent a
a SrcSpan
s Intent
intent AList Expression a
es      -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"intent" a
a SrcSpan
s
        [Key
"intent" Key -> Intent -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Intent
intent, Key
"vars" Key -> AList Expression a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AList Expression a
es]

      StSave a
a SrcSpan
s Maybe (AList Expression a)
args -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"save" a
a SrcSpan
s [Key
"vars" Key -> Maybe (AList Expression a) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (AList Expression a)
args]

      StData a
a SrcSpan
s AList DataGroup a
args     -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"data" a
a SrcSpan
s [Key
"data_groups" Key -> AList DataGroup a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AList DataGroup a
args]
      StNamelist a
a SrcSpan
s AList Namelist a
nls -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"namelist" a
a SrcSpan
s [Key
"namelists" Key -> AList Namelist a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AList Namelist a
nls]
      StCommon a
a SrcSpan
s AList CommonGroup a
args -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"common" a
a SrcSpan
s [Key
"common_groups" Key -> AList CommonGroup a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AList CommonGroup a
args]
      StEquivalence a
a SrcSpan
s AList (AList Expression) a
args -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"equivalence" a
a SrcSpan
s [Key
"groups" Key -> AList (AList Expression) a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AList (AList Expression) a
args]
      StFormat a
a SrcSpan
s AList FormatItem a
fis -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"format" a
a SrcSpan
s [Key
"parts" Key -> AList FormatItem a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AList FormatItem a
fis]
      StImplicit a
a SrcSpan
s Maybe (AList ImpList a)
itms    -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"implicit" a
a SrcSpan
s [Key
"items" Key -> Maybe (AList ImpList a) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (AList ImpList a)
itms]
      StEntry a
a SrcSpan
s Expression a
v Maybe (AList Expression a)
args Maybe (Expression a)
r -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"entry" a
a SrcSpan
s
        [Key
"name" Key -> Expression a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Expression a
v, Key
"args" Key -> Maybe (AList Expression a) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (AList Expression a)
args, Key
"return" Key -> Maybe (Expression a) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (Expression a)
r]
      StInclude a
a SrcSpan
s Expression a
path Maybe [Block a]
blocks -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"include" a
a SrcSpan
s
        [Key
"path" Key -> Expression a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Expression a
path, Key
"blocks" Key -> Maybe [Block a] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Block a]
blocks]

      StDo      a
a SrcSpan
s Maybe String
nm Maybe (Expression a)
lbl Maybe (DoSpecification a)
spec -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"do"       a
a SrcSpan
s
        [Key
"name" Key -> Maybe String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe String
nm, Key
"label" Key -> Maybe (Expression a) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (Expression a)
lbl, Key
"do_spec" Key -> Maybe (DoSpecification a) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (DoSpecification a)
spec]
      StDoWhile a
a SrcSpan
s Maybe String
nm Maybe (Expression a)
lbl Expression a
cond -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"do_while" a
a SrcSpan
s
        [Key
"name" Key -> Maybe String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe String
nm, Key
"label" Key -> Maybe (Expression a) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (Expression a)
lbl, Key
"condition" Key -> Expression a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Expression a
cond]
      StEnddo   a
a SrcSpan
s Maybe String
nm          -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"end_do"   a
a SrcSpan
s [Key
"name" Key -> Maybe String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe String
nm]

      StCycle a
a SrcSpan
s Maybe (Expression a)
v -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"cycle" a
a SrcSpan
s [Key
"var" Key -> Maybe (Expression a) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (Expression a)
v]
      StExit  a
a SrcSpan
s Maybe (Expression a)
v -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"exit"  a
a SrcSpan
s [Key
"var" Key -> Maybe (Expression a) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (Expression a)
v]

      StFormatBogus a
a SrcSpan
s String
fmt -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"format" a
a SrcSpan
s [Key
"format" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
fmt]

      StForallStatement a
a SrcSpan
s ForallHeader a
h Statement a
stmt -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"forall_statement" a
a SrcSpan
s
        [Key
"header" Key -> ForallHeader a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ForallHeader a
h, Key
"statement" Key -> Statement a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Statement a
stmt]

      StIfLogical a
a SrcSpan
s Expression a
cond Statement a
stmt -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"if_logical" a
a SrcSpan
s
        [Key
"condition" Key -> Expression a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Expression a
cond, Key
"statement" Key -> Statement a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Statement a
stmt]
      StIfArithmetic a
a SrcSpan
s Expression a
e Expression a
lt Expression a
eq Expression a
gt -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"if_arithmetic" a
a SrcSpan
s
        [ Key
"expression"    Key -> Expression a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Expression a
e
        , Key
"less"    Key -> Expression a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Expression a
lt
        , Key
"equal"   Key -> Expression a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Expression a
eq
        , Key
"greater" Key -> Expression a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Expression a
gt ]

      StSelectCase a
a SrcSpan
s Maybe String
nm Expression a
e    -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"select_case" a
a SrcSpan
s
        [Key
"name" Key -> Maybe String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe String
nm, Key
"expression" Key -> Expression a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Expression a
e]
      StCase       a
a SrcSpan
s Maybe String
nm Maybe (AList Index a)
idxs -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"case"        a
a SrcSpan
s
        [Key
"name" Key -> Maybe String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe String
nm, Key
"indices" Key -> Maybe (AList Index a) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (AList Index a)
idxs]
      StEndcase    a
a SrcSpan
s Maybe String
nm      -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"end_select"  a
a SrcSpan
s
        [Key
"name" Key -> Maybe String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe String
nm]

      StFunction a
a SrcSpan
s Expression a
fn AList Expression a
args Expression a
body -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"function" a
a SrcSpan
s
        [Key
"name" Key -> Expression a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Expression a
fn, Key
"arguments" Key -> AList Expression a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AList Expression a
args, Key
"body" Key -> Expression a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Expression a
body]

      StExpressionAssign a
a SrcSpan
s Expression a
tgt Expression a
e     -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"assign_expression" a
a SrcSpan
s
        [Key
"target" Key -> Expression a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Expression a
tgt, Key
"expression" Key -> Expression a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Expression a
e]
      StPointerAssign    a
a SrcSpan
s Expression a
eFrom Expression a
eTo -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"assign_pointer"    a
a SrcSpan
s
        [Key
"target" Key -> Expression a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Expression a
eFrom, Key
"expression" Key -> Expression a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Expression a
eTo]
      StLabelAssign      a
a SrcSpan
s Expression a
lbl Expression a
tgt   -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"assign_label"      a
a SrcSpan
s
        [Key
"target" Key -> Expression a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Expression a
tgt, Key
"label" Key -> Expression a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Expression a
lbl]

      StGotoUnconditional a
a SrcSpan
s Expression a
tgt      -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"goto"          a
a SrcSpan
s
        [Key
"target" Key -> Expression a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Expression a
tgt]
      StGotoAssigned      a
a SrcSpan
s Expression a
tgt Maybe (AList Expression a)
lbls -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"goto_assigned" a
a SrcSpan
s
        [Key
"target" Key -> Expression a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Expression a
tgt, Key
"labels" Key -> Maybe (AList Expression a) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (AList Expression a)
lbls]
      StGotoComputed      a
a SrcSpan
s AList Expression a
lbls Expression a
tgt -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"goto_computed" a
a SrcSpan
s
        [Key
"target" Key -> Expression a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Expression a
tgt, Key
"labels" Key -> AList Expression a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AList Expression a
lbls]

      StCall   a
a SrcSpan
s Expression a
fn AList Argument a
args -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"call"   a
a SrcSpan
s
        [Key
"function" Key -> Expression a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Expression a
fn, Key
"arguments" Key -> AList Argument a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AList Argument a
args]
      StReturn a
a SrcSpan
s Maybe (Expression a)
tgt     -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"return" a
a SrcSpan
s
        [Key
"span" Key -> SrcSpan -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= SrcSpan
s, Key
"target" Key -> Maybe (Expression a) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (Expression a)
tgt]

      StContinue a
a SrcSpan
s     -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"continue" a
a SrcSpan
s []
      StStop     a
a SrcSpan
s Maybe (Expression a)
msg -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"stop"     a
a SrcSpan
s [Key
"message" Key -> Maybe (Expression a) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (Expression a)
msg]
      StPause    a
a SrcSpan
s Maybe (Expression a)
msg -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"pause"    a
a SrcSpan
s [Key
"message" Key -> Maybe (Expression a) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (Expression a)
msg]

      StRead      a
a SrcSpan
s AList ControlPair a
fmt Maybe (AList Expression a)
args -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"read"  a
a SrcSpan
s
        [Key
"format" Key -> AList ControlPair a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AList ControlPair a
fmt, Key
"arguments" Key -> Maybe (AList Expression a) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (AList Expression a)
args]
      StRead2     a
a SrcSpan
s Expression a
fmt Maybe (AList Expression a)
args -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"read2" a
a SrcSpan
s
        [Key
"format" Key -> Expression a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Expression a
fmt, Key
"arguments" Key -> Maybe (AList Expression a) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (AList Expression a)
args]
      StWrite     a
a SrcSpan
s AList ControlPair a
fmt Maybe (AList Expression a)
args -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"write" a
a SrcSpan
s
        [Key
"format" Key -> AList ControlPair a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AList ControlPair a
fmt, Key
"arguments" Key -> Maybe (AList Expression a) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (AList Expression a)
args]
      StPrint     a
a SrcSpan
s Expression a
fmt Maybe (AList Expression a)
args -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"print" a
a SrcSpan
s
        [Key
"format" Key -> Expression a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Expression a
fmt, Key
"arguments" Key -> Maybe (AList Expression a) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (AList Expression a)
args]
      StTypePrint a
a SrcSpan
s Expression a
fmt Maybe (AList Expression a)
args -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"type_print"  a
a SrcSpan
s
        [Key
"format" Key -> Expression a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Expression a
fmt, Key
"arguments" Key -> Maybe (AList Expression a) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (AList Expression a)
args]

      StOpen       a
a SrcSpan
s AList ControlPair a
spec -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"open"       a
a SrcSpan
s [Key
"specification" Key -> AList ControlPair a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AList ControlPair a
spec]
      StClose      a
a SrcSpan
s AList ControlPair a
spec -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"close"      a
a SrcSpan
s [Key
"specification" Key -> AList ControlPair a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AList ControlPair a
spec]
      StFlush      a
a SrcSpan
s AList FlushSpec a
spec -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"flush"      a
a SrcSpan
s [Key
"specification" Key -> AList FlushSpec a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AList FlushSpec a
spec]
      StInquire    a
a SrcSpan
s AList ControlPair a
spec -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"inquire"    a
a SrcSpan
s [Key
"specification" Key -> AList ControlPair a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AList ControlPair a
spec]
      StRewind     a
a SrcSpan
s AList ControlPair a
spec -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"rewind"     a
a SrcSpan
s [Key
"specification" Key -> AList ControlPair a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AList ControlPair a
spec]
      StRewind2    a
a SrcSpan
s Expression a
spec -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"rewind2"    a
a SrcSpan
s [Key
"specification" Key -> Expression a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Expression a
spec]
      StBackspace  a
a SrcSpan
s AList ControlPair a
spec -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"backspace"  a
a SrcSpan
s [Key
"specification" Key -> AList ControlPair a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AList ControlPair a
spec]
      StBackspace2 a
a SrcSpan
s Expression a
spec -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"backspace2" a
a SrcSpan
s [Key
"specification" Key -> Expression a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Expression a
spec]
      StEndfile    a
a SrcSpan
s AList ControlPair a
spec -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"endfile"    a
a SrcSpan
s [Key
"specification" Key -> AList ControlPair a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AList ControlPair a
spec]
      StEndfile2   a
a SrcSpan
s Expression a
spec -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"endfile2"   a
a SrcSpan
s [Key
"specification" Key -> Expression a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Expression a
spec]

      StAllocate   a
a SrcSpan
s Maybe (TypeSpec a)
t AList Expression a
es Maybe (AList AllocOpt a)
os -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"allocate"   a
a SrcSpan
s
        [Key
"type" Key -> Maybe (TypeSpec a) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (TypeSpec a)
t, Key
"pointers" Key -> AList Expression a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AList Expression a
es, Key
"options" Key -> Maybe (AList AllocOpt a) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (AList AllocOpt a)
os]
      StNullify    a
a SrcSpan
s AList Expression a
es      -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"nullify"    a
a SrcSpan
s
        [Key
"pointers" Key -> AList Expression a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AList Expression a
es]
      StDeallocate a
a SrcSpan
s AList Expression a
es Maybe (AList AllocOpt a)
os   -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"deallocate" a
a SrcSpan
s
        [Key
"pointers" Key -> AList Expression a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AList Expression a
es, Key
"options" Key -> Maybe (AList AllocOpt a) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (AList AllocOpt a)
os]

      StWhere a
a SrcSpan
s Expression a
e Statement a
asn -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"where" a
a SrcSpan
s
        [Key
"expression" Key -> Expression a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Expression a
e, Key
"assignment" Key -> Statement a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Statement a
asn]

      StWhereConstruct a
a SrcSpan
s Maybe String
nm Expression a
e -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"where_start" a
a SrcSpan
s
        [Key
"name" Key -> Maybe String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe String
nm, Key
"expression" Key -> Expression a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Expression a
e]
      StElsewhere      a
a SrcSpan
s Maybe String
nm Maybe (Expression a)
e -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"elsewhere"   a
a SrcSpan
s
        [Key
"name" Key -> Maybe String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe String
nm, Key
"expression" Key -> Maybe (Expression a) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (Expression a)
e]
      StEndWhere       a
a SrcSpan
s Maybe String
nm   -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"end_where"   a
a SrcSpan
s
        [Key
"name" Key -> Maybe String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe String
nm]

      StUse a
a SrcSpan
s Expression a
nm Maybe ModuleNature
mn Only
only Maybe (AList Use a)
imports -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"use" a
a SrcSpan
s
        [Key
"module" Key -> Expression a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Expression a
nm, Key
"nature" Key -> Maybe ModuleNature -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe ModuleNature
mn, Key
"only" Key -> Only -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Only
only, Key
"import" Key -> Maybe (AList Use a) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (AList Use a)
imports]
      StModuleProcedure a
a SrcSpan
s AList Expression a
vs -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"module_procedure" a
a SrcSpan
s
        [Key
"procedures" Key -> AList Expression a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AList Expression a
vs]

      StType    a
a SrcSpan
s Maybe (AList Attribute a)
attrs String
nm -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"type"     a
a SrcSpan
s
        [Key
"attributes" Key -> Maybe (AList Attribute a) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (AList Attribute a)
attrs, Key
"name" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= String
nm]
      StEndType a
a SrcSpan
s       Maybe String
nm -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"end_type" a
a SrcSpan
s
        [Key
"name" Key -> Maybe String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe String
nm]

      StSequence a
a SrcSpan
s -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"sequence" a
a SrcSpan
s []

      StForall    a
a SrcSpan
s Maybe String
nm ForallHeader a
h -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"forall"     a
a SrcSpan
s [Key
"name" Key -> Maybe String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe String
nm, Key
"header" Key -> ForallHeader a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ForallHeader a
h]
      StEndForall a
a SrcSpan
s Maybe String
nm   -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"end_forall" a
a SrcSpan
s [Key
"name" Key -> Maybe String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe String
nm]

      StProcedure a
a SrcSpan
s Maybe (ProcInterface a)
iface Maybe (AList Attribute a)
attrs AList ProcDecl a
decls -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"procedure" a
a SrcSpan
s
        [Key
"interface" Key -> Maybe (ProcInterface a) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (ProcInterface a)
iface, Key
"attributes" Key -> Maybe (AList Attribute a) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (AList Attribute a)
attrs, Key
"declarations" Key -> AList ProcDecl a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AList ProcDecl a
decls]

      StImport a
a SrcSpan
s AList Expression a
nms -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"import" a
a SrcSpan
s [Key
"names" Key -> AList Expression a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AList Expression a
nms]

      StEnum       a
a SrcSpan
s ->       Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"enum"       a
a SrcSpan
s []
      StEnumerator a
a SrcSpan
s AList Declarator a
decls -> Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"enumerator" a
a SrcSpan
s [Key
"declarators" Key -> AList Declarator a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AList Declarator a
decls]
      StEndEnum    a
a SrcSpan
s ->       Text -> a -> SrcSpan -> [Pair] -> Value
forall a.
(ToJSON a, ToJSON SrcSpan) =>
Text -> a -> SrcSpan -> [Pair] -> Value
tja Text
"end_enum"   a
a SrcSpan
s []

    -- TODO toEncoding