{-# LANGUAGE OverloadedStrings #-}
module Hydra.Sources.Tier4.Langs.Cypher.Features where
import Hydra.Sources.Tier3.All
import Hydra.Dsl.Annotations
import Hydra.Dsl.Bootstrap
import Hydra.Dsl.Types as Types
import qualified Control.Monad as CM
import qualified Data.List as L
import qualified Data.Map as M
import qualified Data.Maybe as Y
openCypherFeaturesModule :: Module
openCypherFeaturesModule :: Module
openCypherFeaturesModule = Namespace
-> [Element] -> [Module] -> [Module] -> Maybe String -> Module
Module Namespace
ns [Element]
elements [Module
hydraCoreModule] [Module]
tier0Modules (Maybe String -> Module) -> Maybe String -> Module
forall a b. (a -> b) -> a -> b
$
String -> Maybe String
forall a. a -> Maybe a
Just (String
"A model for characterizing OpenCypher queries and implementations in terms of included features.")
where
ns :: Namespace
ns = String -> Namespace
Namespace String
"hydra/langs/cypher/features"
cypherFeatures :: String -> Type
cypherFeatures = Namespace -> String -> Type
typeref Namespace
ns
def :: String -> Type -> Element
def = Namespace -> String -> Type -> Element
datatype Namespace
ns
defFeatureSet :: String -> String -> [FieldType] -> Element
defFeatureSet String
name String
desc [FieldType]
fields = String -> Type -> Element
def (String -> String
capitalize String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Features") (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
String -> Type -> Type
doc (String
"A set of features for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
desc String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".") (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
record [FieldType]
fields
feature :: String -> String -> FieldType
feature String
n String
s = String -> String -> FieldType
featureField String
n (String -> FieldType) -> String -> FieldType
forall a b. (a -> b) -> a -> b
$ String
"Whether to expect " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."
featureField :: String -> String -> FieldType
featureField String
name String
comment = String
nameString -> Type -> FieldType
>: String -> Type -> Type
doc String
comment Type
boolean
featureSet :: String -> String -> FieldType
featureSet String
name String
desc = String
nameString -> Type -> FieldType
>:
String -> Type -> Type
doc (String
"Whether to expect " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
desc String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", and if so, which specific features") (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
Type -> Type
optional (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ String -> Type
cypherFeatures (String -> Type) -> String -> Type
forall a b. (a -> b) -> a -> b
$ String -> String
capitalize String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Features"
fixedFeature :: String -> String -> FieldType
fixedFeature String
n String
s = String -> String -> FieldType
featureField String
n (String -> FieldType) -> String -> FieldType
forall a b. (a -> b) -> a -> b
$ String
"Whether to expect " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" (note: included by most if not all implementations)."
function :: String -> FieldType
function String
name = String -> String -> FieldType
feature String
name (String -> FieldType) -> String -> FieldType
forall a b. (a -> b) -> a -> b
$ String
"the " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"() function"
functionWithKeyword :: String -> String -> FieldType
functionWithKeyword String
name String
keyword = String -> String -> FieldType
feature String
name (String -> FieldType) -> String -> FieldType
forall a b. (a -> b) -> a -> b
$ String
"the " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"() / " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
keyword String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" aggregate function"
elements :: [Element]
elements = [
String -> String -> [FieldType] -> Element
defFeatureSet String
"Aggregate" String
"aggregation functions" [
String -> String -> FieldType
functionWithKeyword String
"avg" String
"AVG",
String -> String -> FieldType
functionWithKeyword String
"collect" String
"COLLECT",
String -> String -> FieldType
functionWithKeyword String
"count" String
"COUNT",
String -> String -> FieldType
functionWithKeyword String
"max" String
"MAX",
String -> String -> FieldType
functionWithKeyword String
"min" String
"MIN",
String -> FieldType
function String
"percentileCont",
String -> FieldType
function String
"percentileDisc",
String -> FieldType
function String
"stdev",
String -> String -> FieldType
functionWithKeyword String
"sum" String
"SUM"],
String -> String -> [FieldType] -> Element
defFeatureSet String
"Arithmetic" String
"arithmetic operations" [
String -> String -> FieldType
feature String
"plus" String
"the + operator",
String -> String -> FieldType
feature String
"minus" String
"the - operator",
String -> String -> FieldType
feature String
"multiply" String
"the * operator",
String -> String -> FieldType
feature String
"divide" String
"the / operator",
String -> String -> FieldType
feature String
"modulus" String
"the % operator",
String -> String -> FieldType
feature String
"powerOf" String
"the ^ operator"],
String -> String -> [FieldType] -> Element
defFeatureSet String
"Atom" String
"various kinds of atomic expressions" [
String -> String -> FieldType
feature String
"caseExpression" String
"CASE expressions",
String -> String -> FieldType
feature String
"count" String
"the COUNT (*) expression",
String -> String -> FieldType
feature String
"existentialSubquery" String
"existential subqueries",
String -> String -> FieldType
feature String
"functionInvocation" String
"function invocation",
String -> String -> FieldType
featureSet String
"list" String
"lists",
String -> String -> FieldType
featureSet String
"literal" String
"literal values",
String -> String -> FieldType
feature String
"parameter" String
"parameter expressions",
String -> String -> FieldType
feature String
"patternComprehension" String
"pattern comprehensions",
String -> String -> FieldType
feature String
"patternPredicate" String
"relationship patterns as subexpressions",
String -> String -> FieldType
featureSet String
"quantifier" String
"quantifier expressions",
String -> String -> FieldType
fixedFeature String
"variable" String
"variable expressions"],
String -> String -> [FieldType] -> Element
defFeatureSet String
"Comparison" String
"comparison operators and functions" [
String -> String -> FieldType
feature String
"equal" String
"the = comparison operator",
String -> String -> FieldType
feature String
"greaterThan" String
"the > comparison operator",
String -> String -> FieldType
feature String
"greaterThanOrEqual" String
"the >= comparison operator",
String -> String -> FieldType
feature String
"lessThan" String
"the < comparison operator",
String -> String -> FieldType
feature String
"lessThanOrEqual" String
"the <= comparison operator",
String -> String -> FieldType
feature String
"notEqual" String
"the <> comparison operator",
String -> FieldType
function String
"nullIf"],
String -> Type -> Element
def String
"CypherFeatures" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
String -> Type -> Type
doc (String
"A set of features which characterize an OpenCypher query or implementation. "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Any features which are omitted from the set are assumed to be unsupported or nonrequired.") (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
[FieldType] -> Type
record [
String -> String -> FieldType
featureSet String
"aggregate" String
"aggregate functions",
String -> String -> FieldType
featureSet String
"arithmetic" String
"arithmetic operations",
String -> String -> FieldType
featureSet String
"atom" String
"atomic expressions",
String -> String -> FieldType
featureSet String
"comparison" String
"comparison operations",
String -> String -> FieldType
featureSet String
"delete" String
"delete operations",
String -> String -> FieldType
featureSet String
"element" String
"element functions",
String -> String -> FieldType
featureSet String
"logical" String
"logical operations",
String -> String -> FieldType
featureSet String
"map" String
"property map functions",
String -> String -> FieldType
featureSet String
"match" String
"match queries",
String -> String -> FieldType
featureSet String
"merge" String
"merge operations",
String -> String -> FieldType
featureSet String
"nodePattern" String
"node patterns",
String -> String -> FieldType
featureSet String
"null" String
"IS NULL / IS NOT NULL checks",
String -> String -> FieldType
featureSet String
"numeric" String
"numeric functions",
String -> String -> FieldType
featureSet String
"path" String
"path functions",
String -> String -> FieldType
featureSet String
"procedureCall" String
"procedure calls",
String -> String -> FieldType
featureSet String
"projection" String
"projection operations",
String -> String -> FieldType
featureSet String
"randomness" String
"random value generation",
String -> String -> FieldType
featureSet String
"rangeLiteral" String
"range literals",
String -> String -> FieldType
featureSet String
"reading" String
"reading operations",
String -> String -> FieldType
featureSet String
"relationshipDirection" String
"relationship directions",
String -> String -> FieldType
featureSet String
"relationshipPattern" String
"relationship patterns",
String -> String -> FieldType
featureSet String
"remove" String
"remove operations",
String -> String -> FieldType
featureSet String
"schema" String
"schema functions",
String -> String -> FieldType
featureSet String
"set" String
"set operations",
String -> String -> FieldType
featureSet String
"string" String
"string operations",
String -> String -> FieldType
featureSet String
"updating" String
"updating operations"],
String -> String -> [FieldType] -> Element
defFeatureSet String
"Delete" String
"delete operations" [
String -> String -> FieldType
feature String
"delete" String
"the basic DELETE clause",
String -> String -> FieldType
feature String
"detachDelete" String
"the DETACH DELETE clause"],
String -> String -> [FieldType] -> Element
defFeatureSet String
"Element" String
"element functions" [
String -> FieldType
function String
"elementId",
String -> FieldType
function String
"endNode",
String -> FieldType
function String
"labels",
String -> FieldType
function String
"properties",
String -> FieldType
function String
"startNode"],
String -> String -> [FieldType] -> Element
defFeatureSet String
"List" String
"list functionality" [
String -> FieldType
function String
"all",
String -> FieldType
function String
"any",
String -> FieldType
function String
"coalesce",
String -> FieldType
function String
"isEmpty",
String -> FieldType
function String
"head",
String -> FieldType
function String
"last",
String -> String -> FieldType
feature String
"listComprehension" String
"basic list comprehensions",
String -> String -> FieldType
feature String
"listRange" String
"list range comprehensions (e.g. [1..10])",
String -> FieldType
function String
"none",
String -> FieldType
function String
"reduce",
String -> FieldType
function String
"reverse",
String -> FieldType
function String
"single",
String -> FieldType
function String
"size",
String -> FieldType
function String
"tail",
String -> FieldType
function String
"toBooleanList",
String -> FieldType
function String
"toFloatList",
String -> FieldType
function String
"toIntegerList",
String -> FieldType
function String
"toStringList"],
String -> String -> [FieldType] -> Element
defFeatureSet String
"Literal" String
"various types of literal values" [
String -> String -> FieldType
fixedFeature String
"boolean" String
"boolean literals",
String -> String -> FieldType
feature String
"double" String
"double-precision floating-point literals",
String -> String -> FieldType
feature String
"integer" String
"integer literals",
String -> String -> FieldType
feature String
"list" String
"list literals",
String -> String -> FieldType
feature String
"map" String
"map literals",
String -> String -> FieldType
feature String
"null" String
"the NULL literal",
String -> String -> FieldType
fixedFeature String
"string" String
"string literals"],
String -> String -> [FieldType] -> Element
defFeatureSet String
"Logical" String
"logical operations" [
String -> String -> FieldType
feature String
"and" String
"the AND operator",
String -> String -> FieldType
feature String
"not" String
"the NOT operator",
String -> String -> FieldType
feature String
"or" String
"the OR operator",
String -> String -> FieldType
feature String
"xor" String
"the XOR operator"],
String -> String -> [FieldType] -> Element
defFeatureSet String
"Map" String
"property map functions" [
String -> FieldType
function String
"keys"],
String -> String -> [FieldType] -> Element
defFeatureSet String
"Match" String
"match queries" [
String -> String -> FieldType
feature String
"match" String
"the basic (non-optional) MATCH clause",
String -> String -> FieldType
feature String
"optionalMatch" String
"OPTIONAL MATCH"],
String -> String -> [FieldType] -> Element
defFeatureSet String
"Merge" String
"merge operations" [
String -> String -> FieldType
feature String
"merge" String
"the basic MERGE clause",
String -> String -> FieldType
feature String
"mergeOnCreate" String
"MERGE with the ON CREATE action",
String -> String -> FieldType
feature String
"mergeOnMatch" String
"MERGE with the ON MATCH action"],
String -> String -> [FieldType] -> Element
defFeatureSet String
"NodePattern" String
"node patterns" [
String -> String -> FieldType
feature String
"multipleLabels" String
"specifying multiple labels in a node pattern",
String -> String -> FieldType
feature String
"parameter" String
"specifying a parameter as part of a node pattern",
String -> String -> FieldType
feature String
"propertyMap" String
"specifying a key/value map of properties in a node pattern",
String -> String -> FieldType
fixedFeature String
"variableNode" String
"binding a variable to a node in a node pattern",
String -> String -> FieldType
feature String
"wildcardLabel" String
"omitting labels from a node pattern"],
String -> String -> [FieldType] -> Element
defFeatureSet String
"Null" String
"IS NULL / IS NOT NULL checks" [
String -> String -> FieldType
feature String
"isNull" String
"the IS NULL operator",
String -> String -> FieldType
feature String
"isNotNull" String
"the IS NOT NULL operator"],
String -> String -> [FieldType] -> Element
defFeatureSet String
"Numeric" String
"numeric functions" [
String -> FieldType
function String
"abs",
String -> FieldType
function String
"ceil",
String -> FieldType
function String
"e",
String -> FieldType
function String
"exp",
String -> FieldType
function String
"floor",
String -> FieldType
function String
"isNaN",
String -> FieldType
function String
"log",
String -> FieldType
function String
"log10",
String -> FieldType
function String
"range",
String -> FieldType
function String
"round",
String -> FieldType
function String
"sign",
String -> FieldType
function String
"sqrt"],
String -> String -> [FieldType] -> Element
defFeatureSet String
"Path" String
"path functions" [
String -> FieldType
function String
"length",
String -> FieldType
function String
"nodes",
String -> FieldType
function String
"relationships",
String -> FieldType
function String
"shortestPath"],
String -> String -> [FieldType] -> Element
defFeatureSet String
"ProcedureCall" String
"procedure calls" [
String -> String -> FieldType
feature String
"inQueryCall" String
"CALL within a query",
String -> String -> FieldType
feature String
"standaloneCall" String
"standalone / top-level CALL",
String -> String -> FieldType
feature String
"yield" String
"the YIELD clause in CALL"],
String -> String -> [FieldType] -> Element
defFeatureSet String
"Projection" String
"projections" [
String -> String -> FieldType
feature String
"limit" String
"the LIMIT clause",
String -> String -> FieldType
feature String
"orderBy" String
"the ORDER BY clause",
String -> String -> FieldType
feature String
"projectDistinct" String
"the DISTINCT keyword",
String -> String -> FieldType
feature String
"projectAll" String
"the * projection",
String -> String -> FieldType
feature String
"projectAs" String
"the AS keyword",
String -> String -> FieldType
feature String
"skip" String
"the SKIP clause",
String -> String -> FieldType
feature String
"sortOrder" String
"the ASC/ASCENDING and DESC/DESCENDING keywords"],
String -> String -> [FieldType] -> Element
defFeatureSet String
"Quantifier" String
"quantifier expressions" [
String -> String -> FieldType
feature String
"all" String
"the ALL quantifier",
String -> String -> FieldType
feature String
"any" String
"the ANY quantifier",
String -> FieldType
function String
"exists",
String -> String -> FieldType
feature String
"none" String
"the NONE quantifier",
String -> String -> FieldType
feature String
"single" String
"the SINGLE quantifier"],
String -> String -> [FieldType] -> Element
defFeatureSet String
"Randomness" String
"random value generation" [
String -> FieldType
function String
"rand",
String -> FieldType
function String
"randomUUID"],
String -> String -> [FieldType] -> Element
defFeatureSet String
"RangeLiteral" String
"range literals within relationship patterns" [
String -> String -> FieldType
feature String
"bounds" String
"range literals with both lower and upper bounds",
String -> String -> FieldType
feature String
"exactRange" String
"range literals providing an exact number of repetitions",
String -> String -> FieldType
feature String
"lowerBound" String
"range literals with a lower bound (only)",
String -> String -> FieldType
feature String
"starRange" String
"the * range literal",
String -> String -> FieldType
feature String
"upperBound" String
"range literals with an upper bound (only)"],
String -> String -> [FieldType] -> Element
defFeatureSet String
"Reading" String
"specific syntax related to reading data from the graph." [
String -> String -> FieldType
feature String
"union" String
"the UNION operator",
String -> String -> FieldType
feature String
"unionAll" String
"the UNION ALL operator",
String -> String -> FieldType
feature String
"unwind" String
"the UNWIND clause"],
String -> String -> [FieldType] -> Element
defFeatureSet String
"RelationshipDirection" String
"relationship directions / arrow patterns" [
String -> String -> FieldType
feature String
"both" String
"the two-headed arrow (<-[]->) relationship direction",
String -> String -> FieldType
feature String
"left" String
"the left arrow (<-[]-) relationship direction",
String -> String -> FieldType
feature String
"neither" String
"the headless arrow (-[]-) relationship direction",
String -> String -> FieldType
feature String
"right" String
"the right arrow (-[]->) relationship direction"],
String -> String -> [FieldType] -> Element
defFeatureSet String
"RelationshipPattern" String
"relationship patterns" [
String -> String -> FieldType
feature String
"multipleTypes" String
"specifying a disjunction of multiple types in a relationship pattern",
String -> String -> FieldType
fixedFeature String
"variableRelationship" String
"binding a variable to a relationship in a relationship pattern",
String -> String -> FieldType
feature String
"wildcardType" String
"omitting types from a relationship pattern"],
String -> String -> [FieldType] -> Element
defFeatureSet String
"Remove" String
"REMOVE operations" [
String -> String -> FieldType
feature String
"byLabel" String
"REMOVE Variable:NodeLabels",
String -> String -> FieldType
feature String
"byProperty" String
"REMOVE PropertyExpression"],
String -> String -> [FieldType] -> Element
defFeatureSet String
"Schema" String
"schema functions" [
String -> FieldType
function String
"type",
String -> FieldType
function String
"valueType"],
String -> String -> [FieldType] -> Element
defFeatureSet String
"Set" String
"set definitions" [
String -> String -> FieldType
feature String
"propertyEquals" String
"defining a set using PropertyExpression = Expression",
String -> String -> FieldType
feature String
"variableEquals" String
"defining a set using Variable = Expression",
String -> String -> FieldType
feature String
"variablePlusEquals" String
"defining a set using Variable += Expression",
String -> String -> FieldType
feature String
"variableWithNodeLabels" String
"defining a set using Variable:NodeLabels"],
String -> String -> [FieldType] -> Element
defFeatureSet String
"String" String
"string functions" [
String -> FieldType
function String
"char_length",
String -> FieldType
function String
"character_length",
String -> String -> FieldType
functionWithKeyword String
"contains" String
"CONTAINS",
String -> String -> FieldType
functionWithKeyword String
"endsWith" String
"ENDS WITH",
String -> String -> FieldType
functionWithKeyword String
"in" String
"IN",
String -> String -> FieldType
functionWithKeyword String
"startsWith" String
"STARTS WITH",
String -> FieldType
function String
"toBoolean",
String -> FieldType
function String
"toBooleanOrNull",
String -> FieldType
function String
"toFloat",
String -> FieldType
function String
"toFloatOrNull",
String -> FieldType
function String
"toInteger",
String -> FieldType
function String
"toIntegerOrNull"],
String -> String -> [FieldType] -> Element
defFeatureSet String
"Updating" String
"specific syntax related to updating data in the graph" [
String -> String -> FieldType
feature String
"create" String
"the CREATE clause",
String -> String -> FieldType
feature String
"set" String
"the SET clause",
String -> String -> FieldType
feature String
"with" String
"multi-part queries using WITH"]]
openCypherFeaturesEnumModule :: Flow Graph Module
openCypherFeaturesEnumModule = do
Type
enum <- Flow Graph Type
openCypherFeaturesEnum
Module -> Flow Graph Module
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (Module -> Flow Graph Module) -> Module -> Flow Graph Module
forall a b. (a -> b) -> a -> b
$ Namespace
-> [Element] -> [Module] -> [Module] -> Maybe String -> Module
Module Namespace
ns (Type -> [Element]
elements Type
enum) [Module
hydraCoreModule] [Module]
tier0Modules (Maybe String -> Module) -> Maybe String -> Module
forall a b. (a -> b) -> a -> b
$
String -> Maybe String
forall a. a -> Maybe a
Just (String
"A model with an enumeration of (Open)Cypher features.")
where
ns :: Namespace
ns = String -> Namespace
Namespace String
"hydra/org/opencypher/features"
def :: String -> Type -> Element
def = Namespace -> String -> Type -> Element
datatype Namespace
ns
elements :: Type -> [Element]
elements Type
enum = [
String -> Type -> Element
def String
"CypherFeature" (Type -> Element) -> Type -> Element
forall a b. (a -> b) -> a -> b
$
String -> Type -> Type
doc String
"An enumeration of (Open)Cypher features."
Type
enum]
openCypherFeaturesEnum :: Flow Graph Type
openCypherFeaturesEnum = do
let els :: [Element]
els = Module -> [Element]
moduleElements Module
openCypherFeaturesModule
Map Name Type
types <- [(Name, Type)] -> Map Name Type
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Name, Type)] -> Map Name Type)
-> Flow Graph [(Name, Type)] -> Flow Graph (Map Name Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Element -> Flow Graph (Name, Type))
-> [Element] -> Flow Graph [(Name, Type)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
CM.mapM Element -> Flow Graph (Name, Type)
toPair [Element]
els)
[(String, Maybe String)]
pairs <- Map Name Type -> Flow Graph [(String, Maybe String)]
findPairs Map Name Type
types
Type -> Flow Graph Type
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (Type -> Flow Graph Type) -> Type -> Flow Graph Type
forall a b. (a -> b) -> a -> b
$ [FieldType] -> Type
union ((String, Maybe String) -> FieldType
toField ((String, Maybe String) -> FieldType)
-> [(String, Maybe String)] -> [FieldType]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(String, Maybe String)]
pairs)
where
toPair :: Element -> Flow Graph (Name, Type)
toPair Element
el = do
Type
typ <- Term -> Flow Graph Type
coreDecodeType (Term -> Flow Graph Type) -> Term -> Flow Graph Type
forall a b. (a -> b) -> a -> b
$ Element -> Term
elementData Element
el
(Name, Type) -> Flow Graph (Name, Type)
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (Element -> Name
elementName Element
el, Type
typ)
findPairs :: Map Name Type -> Flow Graph [(String, Maybe String)]
findPairs Map Name Type
types = String -> Name -> Flow Graph [(String, Maybe String)]
forVar String
"" (String -> Name
Name String
"hydra/langs/cypher/features.CypherFeatures")
where
forVar :: String -> Name -> Flow Graph [(String, Maybe String)]
forVar String
prefix Name
ref = case Name -> Map Name Type -> Maybe Type
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
ref Map Name Type
types of
Just Type
typ -> String -> Type -> Flow Graph [(String, Maybe String)]
forType String
prefix Type
typ
Maybe Type
Nothing -> String -> Flow Graph [(String, Maybe String)]
forall a. String -> Flow Graph a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unknown type reference"
forType :: String -> Type -> Flow Graph [(String, Maybe String)]
forType String
prefix Type
features = case Type -> Type
stripType Type
features of
TypeRecord (RowType Name
_ Maybe Name
_ [FieldType]
fields) -> do
[[(String, Maybe String)]]
pairs <- (FieldType -> Flow Graph [(String, Maybe String)])
-> [FieldType] -> Flow Graph [[(String, Maybe String)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
CM.mapM (String -> FieldType -> Flow Graph [(String, Maybe String)]
forField String
prefix) [FieldType]
fields
[(String, Maybe String)] -> Flow Graph [(String, Maybe String)]
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(String, Maybe String)] -> Flow Graph [(String, Maybe String)])
-> [(String, Maybe String)] -> Flow Graph [(String, Maybe String)]
forall a b. (a -> b) -> a -> b
$ [[(String, Maybe String)]] -> [(String, Maybe String)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
L.concat [[(String, Maybe String)]]
pairs
forField :: String -> FieldType -> Flow Graph [(String, Maybe String)]
forField String
prefix FieldType
ft = do
Maybe String
mdesc <- Type -> Flow Graph (Maybe String)
getTypeDescription (Type -> Flow Graph (Maybe String))
-> Type -> Flow Graph (Maybe String)
forall a b. (a -> b) -> a -> b
$ FieldType -> Type
fieldTypeType FieldType
ft
case Type -> Type
stripType (FieldType -> Type
fieldTypeType FieldType
ft) of
TypeLiteral LiteralType
LiteralTypeBoolean -> [(String, Maybe String)] -> Flow Graph [(String, Maybe String)]
forall a. a -> Flow Graph a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(String
fname, Maybe String
mdesc)]
TypeOptional (TypeVariable Name
ref) -> String -> Name -> Flow Graph [(String, Maybe String)]
forVar String
newPrefix Name
ref
Type
_ -> String -> Flow Graph [(String, Maybe String)]
forall a. String -> Flow Graph a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Flow Graph [(String, Maybe String)])
-> String -> Flow Graph [(String, Maybe String)]
forall a b. (a -> b) -> a -> b
$ String
"unexpected field type: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ FieldType -> String
forall a. Show a => a -> String
show FieldType
ft
where
fname :: String
fname = String
prefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Name -> String
unName (Name -> String) -> Name -> String
forall a b. (a -> b) -> a -> b
$ FieldType -> Name
fieldTypeName FieldType
ft)
newPrefix :: String
newPrefix = String
fname String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_"
toField :: (String, Maybe String) -> FieldType
toField (String
name, Maybe String
mdesc) = Name -> Type -> FieldType
FieldType (String -> Name
Name String
name) (Type -> FieldType) -> Type -> FieldType
forall a b. (a -> b) -> a -> b
$ case Maybe String
mdesc of
Maybe String
Nothing -> Type
unit
Just String
desc -> String -> Type -> Type
doc String
desc Type
unit