module Hydra.Langs.Graphql.Coder (moduleToGraphql) where

import Hydra.Kernel
import Hydra.Langs.Graphql.Language
import Hydra.Langs.Graphql.Serde
import qualified Hydra.Langs.Graphql.Syntax as G
import Hydra.Tools.Serialization
import Hydra.Tools.Formatting

import qualified Control.Monad as CM
import qualified Data.List as L
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.Maybe as Y


type Prefixes = M.Map Namespace String

moduleToGraphql :: Module -> Flow (Graph) (M.Map FilePath String)
moduleToGraphql :: Module -> Flow Graph (Map FilePath FilePath)
moduleToGraphql Module
mod = do
    Map FilePath Document
files <- Module -> Flow Graph (Map FilePath Document)
moduleToGraphqlSchemas Module
mod
    Map FilePath FilePath -> Flow Graph (Map FilePath FilePath)
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map FilePath FilePath -> Flow Graph (Map FilePath FilePath))
-> Map FilePath FilePath -> Flow Graph (Map FilePath FilePath)
forall a b. (a -> b) -> a -> b
$ [(FilePath, FilePath)] -> Map FilePath FilePath
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ((FilePath, Document) -> (FilePath, FilePath)
forall {a}. (a, Document) -> (a, FilePath)
mapPair ((FilePath, Document) -> (FilePath, FilePath))
-> [(FilePath, Document)] -> [(FilePath, FilePath)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map FilePath Document -> [(FilePath, Document)]
forall k a. Map k a -> [(k, a)]
M.toList Map FilePath Document
files)
  where
    mapPair :: (a, Document) -> (a, FilePath)
mapPair (a
path, Document
sf) = (a
path, Expr -> FilePath
printExpr (Expr -> FilePath) -> Expr -> FilePath
forall a b. (a -> b) -> a -> b
$ Expr -> Expr
parenthesize (Expr -> Expr) -> Expr -> Expr
forall a b. (a -> b) -> a -> b
$ Document -> Expr
exprDocument Document
sf)

moduleToGraphqlSchemas :: Module -> Flow (Graph) (M.Map FilePath G.Document)
moduleToGraphqlSchemas :: Module -> Flow Graph (Map FilePath Document)
moduleToGraphqlSchemas Module
mod = Language
-> (Term -> Flow Graph ())
-> (Module
    -> Map Type (Coder Graph Graph Term ())
    -> [(Element, TypedTerm)]
    -> Flow Graph (Map FilePath Document))
-> Module
-> Flow Graph (Map FilePath Document)
forall e d.
Language
-> (Term -> Flow Graph e)
-> (Module
    -> Map Type (Coder Graph Graph Term e)
    -> [(Element, TypedTerm)]
    -> Flow Graph d)
-> Module
-> Flow Graph d
transformModule Language
graphqlLanguage Term -> Flow Graph ()
encodeTerm Module
-> Map Type (Coder Graph Graph Term ())
-> [(Element, TypedTerm)]
-> Flow Graph (Map FilePath Document)
constructModule Module
mod

constructModule :: Module
  -> M.Map (Type) (Coder (Graph) (Graph) (Term) ())
  -> [(Element, TypedTerm)]
  -> Flow (Graph) (M.Map FilePath G.Document)
constructModule :: Module
-> Map Type (Coder Graph Graph Term ())
-> [(Element, TypedTerm)]
-> Flow Graph (Map FilePath Document)
constructModule Module
mod Map Type (Coder Graph Graph Term ())
coders [(Element, TypedTerm)]
pairs = do
    -- Gather all dependencies because GraphQL does not support imports (in a standard way)
    [Element]
withDeps <- [Element] -> Flow Graph [Element]
elementsWithDependencies ([Element] -> Flow Graph [Element])
-> [Element] -> Flow Graph [Element]
forall a b. (a -> b) -> a -> b
$ (Element, TypedTerm) -> Element
forall a b. (a, b) -> a
fst ((Element, TypedTerm) -> Element)
-> [(Element, TypedTerm)] -> [Element]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Element, TypedTerm)]
pairs
    -- Qualify the names of dependencies with prefixes, so as to avoid name collisions
    let prefixes :: Map Namespace FilePath
prefixes = [Element] -> Map Namespace FilePath
findPrefixes [Element]
withDeps
    -- Elements to GraphQL type definitions
    [TypeDefinition]
tdefs <- (Element -> Flow Graph TypeDefinition)
-> [Element] -> Flow Graph [TypeDefinition]
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 (Map Namespace FilePath -> Element -> Flow Graph TypeDefinition
toTypeDef Map Namespace FilePath
prefixes) [Element]
withDeps
    let doc :: Document
doc = [Definition] -> Document
G.Document ([Definition] -> Document) -> [Definition] -> Document
forall a b. (a -> b) -> a -> b
$ (TypeSystemDefinitionOrExtension -> Definition
G.DefinitionTypeSystem (TypeSystemDefinitionOrExtension -> Definition)
-> (TypeDefinition -> TypeSystemDefinitionOrExtension)
-> TypeDefinition
-> Definition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeSystemDefinition -> TypeSystemDefinitionOrExtension
G.TypeSystemDefinitionOrExtensionDefinition (TypeSystemDefinition -> TypeSystemDefinitionOrExtension)
-> (TypeDefinition -> TypeSystemDefinition)
-> TypeDefinition
-> TypeSystemDefinitionOrExtension
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeDefinition -> TypeSystemDefinition
G.TypeSystemDefinitionType) (TypeDefinition -> Definition) -> [TypeDefinition] -> [Definition]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypeDefinition]
tdefs
    Map FilePath Document -> Flow Graph (Map FilePath Document)
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map FilePath Document -> Flow Graph (Map FilePath Document))
-> Map FilePath Document -> Flow Graph (Map FilePath Document)
forall a b. (a -> b) -> a -> b
$ [(FilePath, Document)] -> Map FilePath Document
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(FilePath
filePath, Document
doc)]
  where
    filePath :: FilePath
filePath = Bool -> FileExtension -> Namespace -> FilePath
namespaceToFilePath Bool
False (FilePath -> FileExtension
FileExtension FilePath
"graphql") (Module -> Namespace
moduleNamespace Module
mod)
    findPrefixes :: [Element] -> Map Namespace FilePath
findPrefixes [Element]
els = [(Namespace, FilePath)] -> Map Namespace FilePath
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Namespace, FilePath)] -> Map Namespace FilePath)
-> [(Namespace, FilePath)] -> Map Namespace FilePath
forall a b. (a -> b) -> a -> b
$ Namespace -> (Namespace, FilePath)
toPair (Namespace -> (Namespace, FilePath))
-> [Namespace] -> [(Namespace, FilePath)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Namespace]
namespaces
      where
        namespaces :: [Namespace]
namespaces = [Namespace] -> [Namespace]
forall a. Eq a => [a] -> [a]
L.nub ([Namespace] -> [Namespace]) -> [Namespace] -> [Namespace]
forall a b. (a -> b) -> a -> b
$ (Maybe Namespace -> Namespace
forall a. HasCallStack => Maybe a -> a
Y.fromJust (Maybe Namespace -> Namespace)
-> (Element -> Maybe Namespace) -> Element -> Namespace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Maybe Namespace
namespaceOfEager (Name -> Maybe Namespace)
-> (Element -> Name) -> Element -> Maybe Namespace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Name
elementName) (Element -> Namespace) -> [Element] -> [Namespace]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Element]
els
        toPair :: Namespace -> (Namespace, FilePath)
toPair Namespace
ns = (Namespace
ns, if Namespace
ns Namespace -> Namespace -> Bool
forall a. Eq a => a -> a -> Bool
== Module -> Namespace
moduleNamespace Module
mod then FilePath
"" else (Set FilePath -> FilePath -> FilePath
sanitizeWithUnderscores Set FilePath
forall a. Set a
S.empty (Namespace -> FilePath
unNamespace Namespace
ns)) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"_")
    toTypeDef :: Map Namespace FilePath -> Element -> Flow Graph TypeDefinition
toTypeDef Map Namespace FilePath
prefixes Element
el = do
      Type
typ <- Term -> Flow Graph Type
requireTermType (Element -> Term
elementData Element
el)
      if Type -> Bool
isType Type
typ
        then Term -> Flow Graph Type
coreDecodeType (Element -> Term
elementData Element
el) Flow Graph Type
-> (Type -> Flow Graph TypeDefinition) -> Flow Graph TypeDefinition
forall a b. Flow Graph a -> (a -> Flow Graph b) -> Flow Graph b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Map Namespace FilePath
-> Element -> Type -> Flow Graph TypeDefinition
encodeNamedType Map Namespace FilePath
prefixes Element
el
        else FilePath -> Flow Graph TypeDefinition
forall a. FilePath -> Flow Graph a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> Flow Graph TypeDefinition)
-> FilePath -> Flow Graph TypeDefinition
forall a b. (a -> b) -> a -> b
$ FilePath
"mapping of non-type elements to GraphQL is not yet supported: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Name -> FilePath
unName (Element -> Name
elementName Element
el)

descriptionFromType :: Type -> Flow (Graph) (Maybe G.Description)
descriptionFromType :: Type -> Flow Graph (Maybe Description)
descriptionFromType Type
typ = do
  Maybe FilePath
mval <- Type -> Flow Graph (Maybe FilePath)
getTypeDescription Type
typ
  Maybe Description -> Flow Graph (Maybe Description)
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Description -> Flow Graph (Maybe Description))
-> Maybe Description -> Flow Graph (Maybe Description)
forall a b. (a -> b) -> a -> b
$ StringValue -> Description
G.Description (StringValue -> Description)
-> (FilePath -> StringValue) -> FilePath -> Description
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> StringValue
G.StringValue (FilePath -> Description) -> Maybe FilePath -> Maybe Description
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FilePath
mval

encodeEnumFieldType :: FieldType -> Flow (Graph) G.EnumValueDefinition
encodeEnumFieldType :: FieldType -> Flow Graph EnumValueDefinition
encodeEnumFieldType FieldType
ft = do
  Maybe Description
desc <- Type -> Flow Graph (Maybe Description)
descriptionFromType (Type -> Flow Graph (Maybe Description))
-> Type -> Flow Graph (Maybe Description)
forall a b. (a -> b) -> a -> b
$ FieldType -> Type
fieldTypeType FieldType
ft
  EnumValueDefinition -> Flow Graph EnumValueDefinition
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return G.EnumValueDefinition {
    enumValueDefinitionDescription :: Maybe Description
G.enumValueDefinitionDescription = Maybe Description
desc,
    enumValueDefinitionEnumValue :: EnumValue
G.enumValueDefinitionEnumValue = Name -> EnumValue
encodeEnumFieldName (Name -> EnumValue) -> Name -> EnumValue
forall a b. (a -> b) -> a -> b
$ FieldType -> Name
fieldTypeName FieldType
ft,
    enumValueDefinitionDirectives :: Maybe Directives
G.enumValueDefinitionDirectives = Maybe Directives
forall a. Maybe a
Nothing}

encodeEnumFieldName :: Name -> G.EnumValue
encodeEnumFieldName :: Name -> EnumValue
encodeEnumFieldName = Name -> EnumValue
G.EnumValue (Name -> EnumValue) -> (Name -> Name) -> Name -> EnumValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Name
G.Name (FilePath -> Name) -> (Name -> FilePath) -> Name -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
sanitize (FilePath -> FilePath) -> (Name -> FilePath) -> Name -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> FilePath
unName

encodeFieldName :: Name -> G.Name
encodeFieldName :: Name -> Name
encodeFieldName = FilePath -> Name
G.Name (FilePath -> Name) -> (Name -> FilePath) -> Name -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
sanitize (FilePath -> FilePath) -> (Name -> FilePath) -> Name -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> FilePath
unName

encodeFieldType :: Prefixes -> FieldType -> Flow (Graph) G.FieldDefinition
encodeFieldType :: Map Namespace FilePath -> FieldType -> Flow Graph FieldDefinition
encodeFieldType Map Namespace FilePath
prefixes FieldType
ft = do
  Type
gtype <- Map Namespace FilePath -> Type -> Flow Graph Type
encodeType Map Namespace FilePath
prefixes (Type -> Flow Graph Type) -> Type -> Flow Graph Type
forall a b. (a -> b) -> a -> b
$ FieldType -> Type
fieldTypeType FieldType
ft
  Maybe Description
desc <- Type -> Flow Graph (Maybe Description)
descriptionFromType (Type -> Flow Graph (Maybe Description))
-> Type -> Flow Graph (Maybe Description)
forall a b. (a -> b) -> a -> b
$ FieldType -> Type
fieldTypeType FieldType
ft
  FieldDefinition -> Flow Graph FieldDefinition
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return G.FieldDefinition {
    fieldDefinitionDescription :: Maybe Description
G.fieldDefinitionDescription = Maybe Description
desc,
    fieldDefinitionName :: Name
G.fieldDefinitionName = Name -> Name
encodeFieldName (Name -> Name) -> Name -> Name
forall a b. (a -> b) -> a -> b
$ FieldType -> Name
fieldTypeName FieldType
ft,
    fieldDefinitionArgumentsDefinition :: Maybe ArgumentsDefinition
G.fieldDefinitionArgumentsDefinition = Maybe ArgumentsDefinition
forall a. Maybe a
Nothing,
    fieldDefinitionType :: Type
G.fieldDefinitionType = Type
gtype,
    fieldDefinitionDirectives :: Maybe Directives
G.fieldDefinitionDirectives = Maybe Directives
forall a. Maybe a
Nothing}

encodeLiteralType :: LiteralType -> Flow (Graph) G.NamedType
encodeLiteralType :: LiteralType -> Flow Graph NamedType
encodeLiteralType LiteralType
lt = Name -> NamedType
G.NamedType (Name -> NamedType) -> (FilePath -> Name) -> FilePath -> NamedType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Name
G.Name (FilePath -> NamedType)
-> Flow Graph FilePath -> Flow Graph NamedType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case LiteralType
lt of
  LiteralType
LiteralTypeBoolean -> FilePath -> Flow Graph FilePath
forall a. a -> Flow Graph a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
"Boolean"
  LiteralTypeFloat FloatType
ft -> case FloatType
ft of
    FloatType
FloatTypeFloat64 -> FilePath -> Flow Graph FilePath
forall a. a -> Flow Graph a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
"Float"
    FloatType
_ -> FilePath -> FilePath -> Flow Graph FilePath
forall s x. FilePath -> FilePath -> Flow s x
unexpected FilePath
"64-bit float type" (FilePath -> Flow Graph FilePath)
-> FilePath -> Flow Graph FilePath
forall a b. (a -> b) -> a -> b
$ FloatType -> FilePath
forall a. Show a => a -> FilePath
show FloatType
ft
  LiteralTypeInteger IntegerType
it -> case IntegerType
it of
    IntegerType
IntegerTypeInt32 -> FilePath -> Flow Graph FilePath
forall a. a -> Flow Graph a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
"Int"
    IntegerType
_ -> FilePath -> FilePath -> Flow Graph FilePath
forall s x. FilePath -> FilePath -> Flow s x
unexpected FilePath
"32-bit signed integer type" (FilePath -> Flow Graph FilePath)
-> FilePath -> Flow Graph FilePath
forall a b. (a -> b) -> a -> b
$ IntegerType -> FilePath
forall a. Show a => a -> FilePath
show IntegerType
it
  LiteralType
LiteralTypeString -> FilePath -> Flow Graph FilePath
forall a. a -> Flow Graph a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
"String"
  LiteralType
_ -> FilePath -> FilePath -> Flow Graph FilePath
forall s x. FilePath -> FilePath -> Flow s x
unexpected FilePath
"GraphQL-compatible literal type" (FilePath -> Flow Graph FilePath)
-> FilePath -> Flow Graph FilePath
forall a b. (a -> b) -> a -> b
$ LiteralType -> FilePath
forall a. Show a => a -> FilePath
show LiteralType
lt

encodeNamedType :: Prefixes -> Element -> Type -> Flow (Graph) G.TypeDefinition
encodeNamedType :: Map Namespace FilePath
-> Element -> Type -> Flow Graph TypeDefinition
encodeNamedType Map Namespace FilePath
prefixes Element
el Type
typ = do
    Graph
g <- Flow Graph Graph
forall s. Flow s s
getState
    let cx :: AdapterContext
cx = Graph
-> Language
-> Map
     Name (Adapter AdapterContext AdapterContext Type Type Term Term)
-> AdapterContext
AdapterContext Graph
g Language
graphqlLanguage Map
  Name (Adapter AdapterContext AdapterContext Type Type Term Term)
forall k a. Map k a
M.empty
    Adapter AdapterContext AdapterContext Type Type Term Term
ad <- AdapterContext
-> Flow
     AdapterContext
     (Adapter AdapterContext AdapterContext Type Type Term Term)
-> Flow
     Graph (Adapter AdapterContext AdapterContext Type Type Term Term)
forall s1 a s2. s1 -> Flow s1 a -> Flow s2 a
withState AdapterContext
cx (Flow
   AdapterContext
   (Adapter AdapterContext AdapterContext Type Type Term Term)
 -> Flow
      Graph (Adapter AdapterContext AdapterContext Type Type Term Term))
-> Flow
     AdapterContext
     (Adapter AdapterContext AdapterContext Type Type Term Term)
-> Flow
     Graph (Adapter AdapterContext AdapterContext Type Type Term Term)
forall a b. (a -> b) -> a -> b
$ TypeAdapter
termAdapter Type
typ
    case Type -> Type
stripType (Adapter AdapterContext AdapterContext Type Type Term Term -> Type
forall s1 s2 t1 t2 v1 v2. Adapter s1 s2 t1 t2 v1 v2 -> t2
adapterTarget Adapter AdapterContext AdapterContext Type Type Term Term
ad) of
      TypeRecord RowType
rt -> do
        [FieldDefinition]
gfields <- (FieldType -> Flow Graph FieldDefinition)
-> [FieldType] -> Flow Graph [FieldDefinition]
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 (Map Namespace FilePath -> FieldType -> Flow Graph FieldDefinition
encodeFieldType Map Namespace FilePath
prefixes) ([FieldType] -> Flow Graph [FieldDefinition])
-> [FieldType] -> Flow Graph [FieldDefinition]
forall a b. (a -> b) -> a -> b
$ RowType -> [FieldType]
rowTypeFields RowType
rt
        Maybe Description
desc <- Type -> Flow Graph (Maybe Description)
descriptionFromType Type
typ
        TypeDefinition -> Flow Graph TypeDefinition
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeDefinition -> Flow Graph TypeDefinition)
-> TypeDefinition -> Flow Graph TypeDefinition
forall a b. (a -> b) -> a -> b
$ ObjectTypeDefinition -> TypeDefinition
G.TypeDefinitionObject (ObjectTypeDefinition -> TypeDefinition)
-> ObjectTypeDefinition -> TypeDefinition
forall a b. (a -> b) -> a -> b
$ G.ObjectTypeDefinition {
          objectTypeDefinitionDescription :: Maybe Description
G.objectTypeDefinitionDescription = Maybe Description
desc,
          objectTypeDefinitionName :: Name
G.objectTypeDefinitionName = Map Namespace FilePath -> Name -> Name
encodeTypeName Map Namespace FilePath
prefixes (Name -> Name) -> Name -> Name
forall a b. (a -> b) -> a -> b
$ Element -> Name
elementName Element
el,
          objectTypeDefinitionImplementsInterfaces :: Maybe ImplementsInterfaces
G.objectTypeDefinitionImplementsInterfaces = Maybe ImplementsInterfaces
forall a. Maybe a
Nothing,
          objectTypeDefinitionDirectives :: Maybe Directives
G.objectTypeDefinitionDirectives = Maybe Directives
forall a. Maybe a
Nothing,
          objectTypeDefinitionFieldsDefinition :: Maybe FieldsDefinition
G.objectTypeDefinitionFieldsDefinition = FieldsDefinition -> Maybe FieldsDefinition
forall a. a -> Maybe a
Just (FieldsDefinition -> Maybe FieldsDefinition)
-> FieldsDefinition -> Maybe FieldsDefinition
forall a b. (a -> b) -> a -> b
$ [FieldDefinition] -> FieldsDefinition
G.FieldsDefinition [FieldDefinition]
gfields}
      TypeUnion RowType
rt -> do
        [EnumValueDefinition]
values <- (FieldType -> Flow Graph EnumValueDefinition)
-> [FieldType] -> Flow Graph [EnumValueDefinition]
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 FieldType -> Flow Graph EnumValueDefinition
encodeEnumFieldType ([FieldType] -> Flow Graph [EnumValueDefinition])
-> [FieldType] -> Flow Graph [EnumValueDefinition]
forall a b. (a -> b) -> a -> b
$ RowType -> [FieldType]
rowTypeFields RowType
rt
        Maybe Description
desc <- Type -> Flow Graph (Maybe Description)
descriptionFromType Type
typ
        TypeDefinition -> Flow Graph TypeDefinition
forall a. a -> Flow Graph a
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeDefinition -> Flow Graph TypeDefinition)
-> TypeDefinition -> Flow Graph TypeDefinition
forall a b. (a -> b) -> a -> b
$ EnumTypeDefinition -> TypeDefinition
G.TypeDefinitionEnum (EnumTypeDefinition -> TypeDefinition)
-> EnumTypeDefinition -> TypeDefinition
forall a b. (a -> b) -> a -> b
$ G.EnumTypeDefinition {
          enumTypeDefinitionDescription :: Maybe Description
G.enumTypeDefinitionDescription = Maybe Description
desc,
          enumTypeDefinitionName :: Name
G.enumTypeDefinitionName = Map Namespace FilePath -> Name -> Name
encodeTypeName Map Namespace FilePath
prefixes (Name -> Name) -> Name -> Name
forall a b. (a -> b) -> a -> b
$ Element -> Name
elementName Element
el,
          enumTypeDefinitionDirectives :: Maybe Directives
G.enumTypeDefinitionDirectives = Maybe Directives
forall a. Maybe a
Nothing,
          enumTypeDefinitionEnumValuesDefinition :: Maybe EnumValuesDefinition
G.enumTypeDefinitionEnumValuesDefinition = EnumValuesDefinition -> Maybe EnumValuesDefinition
forall a. a -> Maybe a
Just (EnumValuesDefinition -> Maybe EnumValuesDefinition)
-> EnumValuesDefinition -> Maybe EnumValuesDefinition
forall a b. (a -> b) -> a -> b
$ [EnumValueDefinition] -> EnumValuesDefinition
G.EnumValuesDefinition [EnumValueDefinition]
values}
      TypeList Type
_ -> Flow Graph TypeDefinition
wrapAsRecord
      TypeLiteral LiteralType
_ -> Flow Graph TypeDefinition
wrapAsRecord
      TypeVariable Name
_ -> Flow Graph TypeDefinition
wrapAsRecord
      Type
t -> FilePath -> FilePath -> Flow Graph TypeDefinition
forall s x. FilePath -> FilePath -> Flow s x
unexpected FilePath
"record or union type" (FilePath -> Flow Graph TypeDefinition)
-> FilePath -> Flow Graph TypeDefinition
forall a b. (a -> b) -> a -> b
$ Type -> FilePath
forall a. Show a => a -> FilePath
show Type
t
  where
    wrapAsRecord :: Flow Graph TypeDefinition
wrapAsRecord = Map Namespace FilePath
-> Element -> Type -> Flow Graph TypeDefinition
encodeNamedType Map Namespace FilePath
prefixes Element
el (Type -> Flow Graph TypeDefinition)
-> Type -> Flow Graph TypeDefinition
forall a b. (a -> b) -> a -> b
$ RowType -> Type
TypeRecord (RowType -> Type) -> RowType -> Type
forall a b. (a -> b) -> a -> b
$ Name -> Maybe Name -> [FieldType] -> RowType
RowType (Element -> Name
elementName Element
el) Maybe Name
forall a. Maybe a
Nothing [
      Name -> Type -> FieldType
FieldType (FilePath -> Name
Name FilePath
"value") Type
typ]

encodeTerm :: Term -> Flow (Graph) ()
encodeTerm :: Term -> Flow Graph ()
encodeTerm Term
term = FilePath -> Flow Graph ()
forall a. FilePath -> Flow Graph a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"not yet implemented"

encodeType :: Prefixes -> Type -> Flow (Graph) G.Type
encodeType :: Map Namespace FilePath -> Type -> Flow Graph Type
encodeType Map Namespace FilePath
prefixes Type
typ = case Type -> Type
stripType Type
typ of
    TypeOptional Type
et -> case Type -> Type
stripType Type
et of
        TypeList Type
et -> ListType -> Type
G.TypeList (ListType -> Type) -> (Type -> ListType) -> Type -> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> ListType
G.ListType (Type -> Type) -> Flow Graph Type -> Flow Graph Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Namespace FilePath -> Type -> Flow Graph Type
encodeType Map Namespace FilePath
prefixes Type
et
        TypeLiteral LiteralType
lt -> NamedType -> Type
G.TypeNamed (NamedType -> Type) -> Flow Graph NamedType -> Flow Graph Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LiteralType -> Flow Graph NamedType
encodeLiteralType LiteralType
lt
        TypeRecord RowType
rt -> RowType -> Flow Graph Type
forRowType RowType
rt
        TypeUnion RowType
rt -> RowType -> Flow Graph Type
forRowType RowType
rt
--         TypeWrap name -> forName name
        TypeVariable Name
name -> Name -> Flow Graph Type
forName Name
name
        Type
t -> FilePath -> FilePath -> Flow Graph Type
forall s x. FilePath -> FilePath -> Flow s x
unexpected FilePath
"GraphQL-compatible type" (FilePath -> Flow Graph Type) -> FilePath -> Flow Graph Type
forall a b. (a -> b) -> a -> b
$ Type -> FilePath
forall a. Show a => a -> FilePath
show Type
t
      where
        forName :: Name -> Flow Graph Type
forName = Type -> Flow Graph Type
forall a. a -> Flow Graph a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type -> Flow Graph Type)
-> (Name -> Type) -> Name -> Flow Graph Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NamedType -> Type
G.TypeNamed (NamedType -> Type) -> (Name -> NamedType) -> Name -> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> NamedType
G.NamedType (Name -> NamedType) -> (Name -> Name) -> Name -> NamedType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Namespace FilePath -> Name -> Name
encodeTypeName Map Namespace FilePath
prefixes
        forRowType :: RowType -> Flow Graph Type
forRowType = Name -> Flow Graph Type
forName (Name -> Flow Graph Type)
-> (RowType -> Name) -> RowType -> Flow Graph Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RowType -> Name
rowTypeTypeName
    Type
t -> NonNullType -> Type
G.TypeNonNull (NonNullType -> Type) -> Flow Graph NonNullType -> Flow Graph Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> Flow Graph NonNullType
nonnull Type
t
  where
    nonnull :: Type -> Flow Graph NonNullType
nonnull Type
t = case Type -> Type
stripType Type
t of
        TypeList Type
et -> ListType -> NonNullType
G.NonNullTypeList (ListType -> NonNullType)
-> (Type -> ListType) -> Type -> NonNullType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> ListType
G.ListType (Type -> NonNullType) -> Flow Graph Type -> Flow Graph NonNullType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Namespace FilePath -> Type -> Flow Graph Type
encodeType Map Namespace FilePath
prefixes Type
et
        TypeLiteral LiteralType
lt -> NamedType -> NonNullType
G.NonNullTypeNamed (NamedType -> NonNullType)
-> Flow Graph NamedType -> Flow Graph NonNullType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LiteralType -> Flow Graph NamedType
encodeLiteralType LiteralType
lt
        TypeRecord RowType
rt -> RowType -> Flow Graph NonNullType
forRowType RowType
rt
        TypeUnion RowType
rt -> RowType -> Flow Graph NonNullType
forRowType RowType
rt
        TypeVariable Name
name -> Name -> Flow Graph NonNullType
forName Name
name
--         TypeWrap name -> forName name
        Type
_ -> FilePath -> FilePath -> Flow Graph NonNullType
forall s x. FilePath -> FilePath -> Flow s x
unexpected FilePath
"GraphQL-compatible non-null type" (FilePath -> Flow Graph NonNullType)
-> FilePath -> Flow Graph NonNullType
forall a b. (a -> b) -> a -> b
$ Type -> FilePath
forall a. Show a => a -> FilePath
show Type
t
      where
        forName :: Name -> Flow Graph NonNullType
forName = NonNullType -> Flow Graph NonNullType
forall a. a -> Flow Graph a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NonNullType -> Flow Graph NonNullType)
-> (Name -> NonNullType) -> Name -> Flow Graph NonNullType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NamedType -> NonNullType
G.NonNullTypeNamed (NamedType -> NonNullType)
-> (Name -> NamedType) -> Name -> NonNullType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> NamedType
G.NamedType (Name -> NamedType) -> (Name -> Name) -> Name -> NamedType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Namespace FilePath -> Name -> Name
encodeTypeName Map Namespace FilePath
prefixes
        forRowType :: RowType -> Flow Graph NonNullType
forRowType = Name -> Flow Graph NonNullType
forName (Name -> Flow Graph NonNullType)
-> (RowType -> Name) -> RowType -> Flow Graph NonNullType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RowType -> Name
rowTypeTypeName

encodeTypeName :: Prefixes -> Name -> G.Name
encodeTypeName :: Map Namespace FilePath -> Name -> Name
encodeTypeName Map Namespace FilePath
prefixes Name
name = FilePath -> Name
G.Name (FilePath -> Name) -> FilePath -> Name
forall a b. (a -> b) -> a -> b
$ (FilePath
prefix FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
sanitize FilePath
local)
  where
    prefix :: FilePath
prefix = FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
Y.fromMaybe FilePath
"UNKNOWN" (Maybe FilePath -> FilePath) -> Maybe FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ Namespace -> Map Namespace FilePath -> Maybe FilePath
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Namespace
ns Map Namespace FilePath
prefixes
    QualifiedName (Just Namespace
ns) FilePath
local = Name -> QualifiedName
qualifyNameEager Name
name

sanitize :: String -> String
sanitize :: FilePath -> FilePath
sanitize = Set FilePath -> FilePath -> FilePath
sanitizeWithUnderscores Set FilePath
graphqlReservedWords