packages feed

morpheus-graphql (empty) → 0.0.1

raw patch · 71 files changed

+3106/−0 lines, 71 filesdep +aesondep +attoparsecdep +basesetup-changed

Dependencies added: aeson, attoparsec, base, bytestring, containers, mtl, scientific, text, transformers, unordered-containers, vector

Files

+ LICENSE view
@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2019 Daviti Nalchevanidze++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ morpheus-graphql.cabal view
@@ -0,0 +1,113 @@+-- This file has been generated from package.yaml by hpack version 0.28.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: d7cc2512dba12ffbd4ce4220a0c8dfc022a9ea87b81033770a75b7146ec2c5e1++name:           morpheus-graphql+version:        0.0.1+synopsis:       Morpheus GraphQL+description:    Build GraphQL APIs with your favourite functional language!+category:       web, graphql+homepage:       https://github.com/nalchevanidze/morpheus-graphql#readme+bug-reports:    https://github.com/nalchevanidze/morpheus-graphql/issues+author:         Daviti Nalchevanidze+maintainer:     d.nalchevanidze@gmail.com+copyright:      (c) 2019 Daviti Nalchevanidze+license:        BSD3+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.10++source-repository head+  type: git+  location: https://github.com/nalchevanidze/morpheus-graphql++library+  exposed-modules:+      Data.Morpheus+      Data.Morpheus.Error.Arguments+      Data.Morpheus.Error.Fragment+      Data.Morpheus.Error.Input+      Data.Morpheus.Error.Internal+      Data.Morpheus.Error.Mutation+      Data.Morpheus.Error.Selection+      Data.Morpheus.Error.Spread+      Data.Morpheus.Error.Syntax+      Data.Morpheus.Error.Utils+      Data.Morpheus.Error.Variable+      Data.Morpheus.Generics.DeriveResolvers+      Data.Morpheus.Generics.GDecode+      Data.Morpheus.Generics.GDecodeEnum+      Data.Morpheus.Generics.TypeRep+      Data.Morpheus.Generics.Utils+      Data.Morpheus.Kind+      Data.Morpheus.Kind.GQLArgs+      Data.Morpheus.Kind.GQLEnum+      Data.Morpheus.Kind.GQLInput+      Data.Morpheus.Kind.GQLKind+      Data.Morpheus.Kind.GQLMutation+      Data.Morpheus.Kind.GQLObject+      Data.Morpheus.Kind.GQLQuery+      Data.Morpheus.Kind.GQLScalar+      Data.Morpheus.Parser.Arguments+      Data.Morpheus.Parser.Body+      Data.Morpheus.Parser.Fragment+      Data.Morpheus.Parser.Mutation+      Data.Morpheus.Parser.Parser+      Data.Morpheus.Parser.Primitive+      Data.Morpheus.Parser.Query+      Data.Morpheus.Parser.RootHead+      Data.Morpheus.PreProcess.Fragment+      Data.Morpheus.PreProcess.Input.Enum+      Data.Morpheus.PreProcess.Input.Object+      Data.Morpheus.PreProcess.PreProcess+      Data.Morpheus.PreProcess.Resolve.Arguments+      Data.Morpheus.PreProcess.Resolve.ResolveRawQuery+      Data.Morpheus.PreProcess.Resolve.Spread+      Data.Morpheus.PreProcess.Selection+      Data.Morpheus.PreProcess.Utils+      Data.Morpheus.PreProcess.Validate.Arguments+      Data.Morpheus.PreProcess.Validate.Validate+      Data.Morpheus.PreProcess.Variable+      Data.Morpheus.Schema.Directive+      Data.Morpheus.Schema.DirectiveLocation+      Data.Morpheus.Schema.EnumValue+      Data.Morpheus.Schema.Field+      Data.Morpheus.Schema.InputValue+      Data.Morpheus.Schema.Internal.Types+      Data.Morpheus.Schema.Schema+      Data.Morpheus.Schema.Type+      Data.Morpheus.Schema.TypeKind+      Data.Morpheus.Schema.Utils.Utils+      Data.Morpheus.Types.Core+      Data.Morpheus.Types.Describer+      Data.Morpheus.Types.Error+      Data.Morpheus.Types.JSType+      Data.Morpheus.Types.MetaInfo+      Data.Morpheus.Types.Query.Fragment+      Data.Morpheus.Types.Query.Operator+      Data.Morpheus.Types.Query.RawSelection+      Data.Morpheus.Types.Query.Selection+      Data.Morpheus.Types.Request+      Data.Morpheus.Types.Response+      Data.Morpheus.Types.Types+      Data.Morpheus.Wrapper+  other-modules:+      Paths_morpheus_graphql+  hs-source-dirs:+      src+  ghc-options: -Wall+  build-depends:+      aeson >=1.0 && <=1.4.2.0+    , attoparsec >=0.13.2.2 && <0.14+    , base >=4.7 && <5+    , bytestring >=0.10.4 && <0.11+    , containers >=0.4.2.1 && <0.7+    , mtl >=2.0 && <=2.2.2+    , scientific >=0.3.6.2 && <0.4+    , text >=1.2.3.0 && <1.3+    , transformers >=0.3.0.0 && <0.6+    , unordered-containers >=0.2.8.0 && <0.3+    , vector >=0.12.0.1 && <0.13+  default-language: Haskell2010
+ src/Data/Morpheus.hs view
@@ -0,0 +1,59 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeOperators     #-}++module Data.Morpheus+  ( interpreter+  ) where++import           Control.Monad.Trans.Except          (ExceptT (..), runExceptT)+import           Data.Aeson                          (decode, encode)+import qualified Data.ByteString.Lazy.Char8          as B+import           Data.Morpheus.Error.Utils           (errorMessage, renderErrors)+import           Data.Morpheus.Kind.GQLMutation      (GQLMutation (..))+import           Data.Morpheus.Kind.GQLQuery         (GQLQuery (..))+import           Data.Morpheus.Parser.Parser         (parseGQL, parseLineBreaks)+import           Data.Morpheus.PreProcess.PreProcess (preProcessQuery)+import           Data.Morpheus.Schema.Internal.Types (TypeLib)+import           Data.Morpheus.Types.Error           (ResolveIO, failResolveIO)+import           Data.Morpheus.Types.JSType          (JSType)+import           Data.Morpheus.Types.Query.Operator  (Operator (..))+import           Data.Morpheus.Types.Request         (GQLRequest)+import           Data.Morpheus.Types.Response        (GQLResponse (..))+import           Data.Morpheus.Types.Types           (GQLRoot (..))+import           Data.Text                           (pack)++schema :: (GQLQuery a, GQLMutation b) => a -> b -> TypeLib+schema queryRes mutationRes = mutationSchema mutationRes $ querySchema queryRes++resolve :: (GQLQuery a, GQLMutation b) => GQLRoot a b -> GQLRequest -> ResolveIO JSType+resolve rootResolver body = do+  rootGQL <- ExceptT $ pure (parseGQL body >>= preProcessQuery gqlSchema)+  case rootGQL of+    Query _ _args selection _pos    -> encodeQuery queryRes gqlSchema selection+    Mutation _ _args selection _pos -> encodeMutation mutationRes selection+  where+    gqlSchema = schema queryRes mutationRes+    queryRes = query rootResolver+    mutationRes = mutation rootResolver++lineBreaks :: B.ByteString -> [Int]+lineBreaks req =+  case decode req of+    Just x  -> parseLineBreaks x+    Nothing -> []++interpreterRaw :: (GQLQuery a, GQLMutation b) => GQLRoot a b -> B.ByteString -> IO GQLResponse+interpreterRaw rootResolver request = do+  value <- runExceptT $ parseRequest request >>= resolve rootResolver+  case value of+    Left x  -> pure $ Errors $ renderErrors (lineBreaks request) x+    Right x -> pure $ Data x++interpreter :: (GQLQuery a, GQLMutation b) => GQLRoot a b -> B.ByteString -> IO B.ByteString+interpreter rootResolver request = encode <$> interpreterRaw rootResolver request++parseRequest :: B.ByteString -> ResolveIO GQLRequest+parseRequest text =+  case decode text of+    Just x  -> pure x+    Nothing -> failResolveIO $ errorMessage 0 (pack $ show text)
+ src/Data/Morpheus/Error/Arguments.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE OverloadedStrings #-}++module Data.Morpheus.Error.Arguments+  ( undefinedArgument+  , unknownArguments+  , argumentGotInvalidValue+  , argumentNameCollision+  ) where++import           Data.Morpheus.Error.Utils (errorMessage)+import           Data.Morpheus.Types.Core  (EnhancedKey (..))+import           Data.Morpheus.Types.Error (GQLError (..), GQLErrors)+import           Data.Text                 (Text)+import qualified Data.Text                 as T (concat)++{-+  ARGUMENTS:+    type Experience {+        experience ( lang: LANGUAGE ) : String ,+        date: String+    }++  - required field !?+  - experience( lang: "bal" ) -> "Expected type LANGUAGE, found \"a\"."+  - experience( lang: Bla ) -> "Expected type LANGUAGE, found Bla."+  - experience( lang: 1 ) -> "Expected type LANGUAGE, found 1."+  - experience( a1 : 1 ) -> "Unknown argument \"a1\" on field \"experience\" of type \"Experience\".",+  - date(name: "name") -> "Unknown argument \"name\" on field \"date\" of type \"Experience\"."+-}+argumentGotInvalidValue :: Text -> Text -> Int -> GQLErrors+argumentGotInvalidValue key' inputMessage' position' = errorMessage position' text+  where+    text = T.concat ["Argument ", key', " got invalid value ;", inputMessage']++unknownArguments :: Text -> [EnhancedKey] -> GQLErrors+unknownArguments fieldName = map keyToError+  where+    keyToError (EnhancedKey argName pos) = GQLError {desc = toMessage argName, posIndex = [pos]}+    toMessage argName = T.concat ["Unknown Argument \"", argName, "\" on Field \"", fieldName, "\"."]++argumentNameCollision :: [EnhancedKey] -> GQLErrors+argumentNameCollision = map keyToError+  where+    keyToError (EnhancedKey argName pos) = GQLError {desc = toMessage argName, posIndex = [pos]}+    toMessage argName = T.concat ["There can Be only One Argument Named \"", argName]++undefinedArgument :: EnhancedKey -> GQLErrors+undefinedArgument (EnhancedKey key' position') = errorMessage position' text+  where+    text = T.concat ["Required Argument: \"", key', "\" was not Defined"]
+ src/Data/Morpheus/Error/Fragment.hs view
@@ -0,0 +1,35 @@+{-# LANGUAGE OverloadedStrings #-}++module Data.Morpheus.Error.Fragment+  ( cannotSpreadWithinItself+  ) where++-- import Data.Morpheus.Error.Utils (errorMessage)+import           Data.Morpheus.Types.Core  (EnhancedKey (..))+import           Data.Morpheus.Types.Error (GQLError (..), GQLErrors)++-- import Data.Morpheus.Types.MetaInfo (MetaInfo(..))+import qualified Data.Text                 as T++{-+  FRAGMENT:+    type Experience {+        experience ( lang: LANGUAGE ) : String ,+        date: String+    }+    fragment type mismatch -> "Fragment \"H\" cannot be spread here as objects of type \"Hobby\" can never be of type \"Experience\"."+    fragment H on T1 { ...A} , fragment A on T { ...H } -> "Cannot spread fragment \"H\" within itself via A."+    fragment H on D {...}  ->  "Unknown type \"D\"."+    {...H} -> "Unknown fragment \"H\"."+-}+cannotSpreadWithinItself :: [EnhancedKey] -> GQLErrors+cannotSpreadWithinItself fragments = [GQLError {desc = text, posIndex = map location fragments}]+  where+    text =+      T.concat+        [ "Cannot spread fragment \""+        , uid $ head fragments+        , "\" within itself via "+        , T.intercalate "," (map uid fragments)+        , "."+        ]
+ src/Data/Morpheus/Error/Input.hs view
@@ -0,0 +1,49 @@+{-# LANGUAGE OverloadedStrings #-}++module Data.Morpheus.Error.Input+  ( inputErrorMessage+  , InputError(..)+  , Prop(..)+  , InputValidation+  ) where++import           Data.Aeson                 (encode)+import           Data.ByteString.Lazy.Char8 (unpack)+import           Data.Morpheus.Types.JSType (JSType)+import           Data.Text                  (Text)+import qualified Data.Text                  as T (concat, intercalate, pack)++type InputValidation a = Either InputError a++data InputError+  = UnexpectedType [Prop]+                   Text+                   JSType+  | UndefinedField [Prop]+                   Text+  | UnknownField [Prop]+                 Text++data Prop = Prop+  { propKey  :: Text+  , propType :: Text+  }++inputErrorMessage :: InputError -> Text+inputErrorMessage (UnexpectedType path type' jsType) = expectedTypeAFoundB path type' jsType+inputErrorMessage (UndefinedField path' field')      = undefinedField path' field'+inputErrorMessage (UnknownField path' field')        = unknownField path' field'++pathToText :: [Prop] -> Text+pathToText []    = ""+pathToText path' = T.concat ["on ", T.intercalate "." $ fmap propKey path']++expectedTypeAFoundB :: [Prop] -> Text -> JSType -> Text+expectedTypeAFoundB path' expected found =+  T.concat [pathToText path', " Expected type \"", expected, "\" found ", T.pack (unpack $ encode found), "."]++undefinedField :: [Prop] -> Text -> Text+undefinedField path' field' = T.concat [pathToText path', " Undefined Field \"", field', "\"."]++unknownField :: [Prop] -> Text -> Text+unknownField path' field' = T.concat [pathToText path', " Unknown Field \"", field', "\"."]
+ src/Data/Morpheus/Error/Internal.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE OverloadedStrings #-}++module Data.Morpheus.Error.Internal+  ( internalTypeMismatch+  , internalArgumentError+  , internalUnknownTypeMessage+  ) where++import           Data.Morpheus.Error.Utils  (errorMessage)+import           Data.Morpheus.Types.Error  (GQLErrors)+import           Data.Morpheus.Types.JSType (JSType (..))+import           Data.Text                  (Text)+import qualified Data.Text                  as T (concat, pack)++-- GQL:: if no mutation defined -> "Schema is not configured for mutations."+-- all kind internal error in development+internalError :: Text -> Either GQLErrors b+internalError x = Left $ errorMessage 0 $ T.concat ["INTERNAL ERROR: ", x]++-- if type did not not found, but was defined by Schema+internalUnknownTypeMessage :: Text -> GQLErrors+internalUnknownTypeMessage x = errorMessage 0 $ T.concat ["type did not not found, but was defined by Schema", x]++-- if arguments is already validated but has not found required argument+internalArgumentError :: Text -> Either GQLErrors b+internalArgumentError x = internalError $ T.concat ["Argument ", x]++-- if value is already validated but value has different type+internalTypeMismatch :: Text -> JSType -> Either GQLErrors b+internalTypeMismatch text jsType = internalError $ T.concat ["Type mismatch ", text, T.pack $ show jsType]
+ src/Data/Morpheus/Error/Mutation.hs view
@@ -0,0 +1,12 @@+{-# LANGUAGE OverloadedStrings #-}++module Data.Morpheus.Error.Mutation+  ( mutationIsNotDefined+  ) where++import           Data.Morpheus.Error.Utils    (errorMessage)+import           Data.Morpheus.Types.Error    (GQLErrors)+import           Data.Morpheus.Types.MetaInfo (Position)++mutationIsNotDefined :: Position -> GQLErrors+mutationIsNotDefined position' = errorMessage position' "Schema is not configured for mutations."
+ src/Data/Morpheus/Error/Selection.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE OverloadedStrings #-}++module Data.Morpheus.Error.Selection+  ( cannotQueryField+  , subfieldsNotSelected+  , duplicateQuerySelections+  , hasNoSubfields+  , fieldNotResolved+  ) where++import           Data.Morpheus.Error.Utils    (errorMessage)+import           Data.Morpheus.Types.Core     (EnhancedKey (..))+import           Data.Morpheus.Types.Error    (GQLError (..), GQLErrors)+import           Data.Morpheus.Types.MetaInfo (MetaInfo (..), Position)+import qualified Data.Text                    as T (Text, concat)++fieldNotResolved :: Position -> T.Text -> T.Text -> GQLErrors+fieldNotResolved position' key' message' = errorMessage position' text+  where+    text = T.concat ["Failure on Resolving Field \"", key', "\": ", message']++-- GQL: "Field \"default\" must not have a selection since type \"String!\" has no subfields."+hasNoSubfields :: MetaInfo -> GQLErrors+hasNoSubfields meta = errorMessage (position meta) text+  where+    text =+      T.concat+        ["Field \"", key meta, "\" must not have a selection since type \"", typeName meta, "\" has no subfields."]++cannotQueryField :: MetaInfo -> GQLErrors+cannotQueryField meta = errorMessage (position meta) text+  where+    text = T.concat ["Cannot query field \"", key meta, "\" on type \"", typeName meta, "\"."]++duplicateQuerySelections :: T.Text -> [EnhancedKey] -> GQLErrors+duplicateQuerySelections parentType = map keyToError+  where+    keyToError (EnhancedKey key' pos) = GQLError {desc = toMessage key', posIndex = [pos]}+    toMessage key' = T.concat ["duplicate selection of key \"", key', "\" on type \"", parentType, "\"."]++-- GQL:: Field \"hobby\" of type \"Hobby!\" must have a selection of subfields. Did you mean \"hobby { ... }\"?+subfieldsNotSelected :: MetaInfo -> GQLErrors+subfieldsNotSelected meta = errorMessage (position meta) text+  where+    text = T.concat ["Field \"", key meta, "\" of type \"", typeName meta, "\" must have a selection of subfields"]
+ src/Data/Morpheus/Error/Spread.hs view
@@ -0,0 +1,33 @@+{-# LANGUAGE OverloadedStrings #-}++module Data.Morpheus.Error.Spread+  ( unknownFragment+  , cannotBeSpreadOnType+  ) where++import           Data.Morpheus.Error.Utils    (errorMessage)+import           Data.Morpheus.Types.Error    (GQLErrors)+import           Data.Morpheus.Types.MetaInfo (MetaInfo (..), Position)+import           Data.Text                    (Text)+import qualified Data.Text                    as T++-- {...H} -> "Unknown fragment \"H\"."+unknownFragment :: Text -> Position -> GQLErrors+unknownFragment key' position' = errorMessage position' text+  where+    text = T.concat ["Unknown Fragment \"", key', "\"."]++-- Fragment type mismatch -> "Fragment \"H\" cannot be spread here as objects of type \"Hobby\" can never be of type \"Experience\"."+cannotBeSpreadOnType :: MetaInfo -> T.Text -> GQLErrors+cannotBeSpreadOnType spread selectionType = errorMessage (position spread) text+  where+    text =+      T.concat+        [ "Fragment \""+        , key spread+        , "\" cannot be spread here as objects of type \""+        , typeName spread+        , "\" can never be of type \""+        , selectionType+        , "\"."+        ]
+ src/Data/Morpheus/Error/Syntax.hs view
@@ -0,0 +1,15 @@+{-# LANGUAGE OverloadedStrings #-}++module Data.Morpheus.Error.Syntax+  ( syntaxError+  ) where++import           Data.Morpheus.Error.Utils    (errorMessage)+import           Data.Morpheus.Types.Error    (GQLErrors)+import           Data.Morpheus.Types.MetaInfo (Position)+import           Data.Text                    (Text)+import qualified Data.Text                    as T (concat)+++syntaxError :: Text -> Position -> GQLErrors+syntaxError e pos = errorMessage pos $ T.concat ["Syntax Error: ", e]
+ src/Data/Morpheus/Error/Utils.hs view
@@ -0,0 +1,30 @@+module Data.Morpheus.Error.Utils+  ( errorMessage+  , renderErrors+  ) where++import           Data.Morpheus.Types.Error    (ErrorLocation (..), GQLError (..), GQLErrors, JSONError (..))+import           Data.Morpheus.Types.MetaInfo (LineBreaks, Position)+import           Data.Text                    (Text)++errorMessage :: Position -> Text -> GQLErrors+errorMessage pos text = [GQLError {desc = text, posIndex = [pos]}]++renderErrors :: LineBreaks -> [GQLError] -> [JSONError]+renderErrors x = map (renderError x)++renderError :: LineBreaks -> GQLError -> JSONError+renderError lineBreaks internError =+  JSONError {message = desc internError, locations = map (errorLocation lineBreaks) $ posIndex internError}++lineIndexAndNumber :: Position -> LineBreaks -> (Int, Int)+lineIndexAndNumber position lineBreaks = (length linesBefore + 1, linePos linesBefore)+  where+    linesBefore = filter (position >=) lineBreaks+    linePos [] = 1+    linePos _  = maximum linesBefore + 1++errorLocation :: LineBreaks -> Position -> ErrorLocation+errorLocation lineBreaks pos = do+  let (lineBreaks', position) = lineIndexAndNumber pos lineBreaks+  ErrorLocation lineBreaks' (pos - position)
+ src/Data/Morpheus/Error/Variable.hs view
@@ -0,0 +1,64 @@+{-# LANGUAGE OverloadedStrings #-}++module Data.Morpheus.Error.Variable+  ( undefinedVariable+  , unknownType+  , variableGotInvalidValue+  , uninitializedVariable+  , unusedVariables+  ) where++import           Data.Morpheus.Error.Utils    (errorMessage)+import           Data.Morpheus.Types.Core     (EnhancedKey (..))+import           Data.Morpheus.Types.Error    (GQLError (..), GQLErrors)+import           Data.Morpheus.Types.MetaInfo (Position)+import           Data.Text                    (Text)+import qualified Data.Text                    as T (concat)+ -- query M ( $v : String ) { a } -> "Variable \"$bla\" is never used in operation \"MyMutation\".",++{-|+VARIABLES:++Variable -> Error (position Query Head)+  data E = EN | DE+  query M ( $v : E ){...}+++query Q ($a: D) ->  "Unknown type \"D\"."++case String+  - { "v" : "EN" }  ->  no error converts as enum++case type mismatch+  - { "v": { "a": "v1" ... } } -> "Variable \"$v\" got invalid value { "a": "v1" ... } ; Expected type LANGUAGE."+  - { "v" : "v1" }  -> "Variable \"$v\" got invalid value \"v1\"; Expected type LANGUAGE."+  - { "v": 1  }        "Variable \"$v\" got invalid value 1; Expected type LANGUAGE."++TODO: variable does not match to argument type+  - query M ( $v : String ) { a(p:$v) } -> "Variable \"$v\" of type \"String\" used in position expecting type \"LANGUAGE\"."+|-}+unusedVariables :: [EnhancedKey] -> GQLErrors+unusedVariables = map keyToError+  where+    keyToError (EnhancedKey key' position') = GQLError {desc = text key', posIndex = [position']}+    text key' = T.concat ["Variable \"$", key', "\" is never used in operation \"Query\"."]++variableGotInvalidValue :: Text -> Text -> Position -> GQLErrors+variableGotInvalidValue name' inputMessage' position' = errorMessage position' text+  where+    text = T.concat ["Variable \"$", name', "\" got invalid value; ", inputMessage']++unknownType :: Text -> Position -> GQLErrors+unknownType type' position' = errorMessage position' text+  where+    text = T.concat ["Unknown type \"", type', "\"."]++undefinedVariable :: Text -> Position -> Text -> GQLErrors+undefinedVariable operation' position' key' = errorMessage position' text+  where+    text = T.concat ["Variable \"", key', "\" is not defined by operation \"", operation', "\"."]++uninitializedVariable :: Position -> Text -> GQLErrors+uninitializedVariable position' key' = errorMessage position' text+  where+    text = T.concat ["Value for Variable \"$", key', "\" is not initialized in Query body."]
+ src/Data/Morpheus/Generics/DeriveResolvers.hs view
@@ -0,0 +1,51 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeOperators     #-}++module Data.Morpheus.Generics.DeriveResolvers+  ( DeriveResolvers(..)+  , resolveBySelection+  ) where++import           Data.Maybe                          (fromMaybe)+import           Data.Morpheus.Types.Error           (ResolveIO)+import           Data.Morpheus.Types.JSType          (JSType (..))+import qualified Data.Morpheus.Types.MetaInfo        as Meta (MetaInfo (..))+import           Data.Morpheus.Types.Query.Selection (Selection)+import qualified Data.Text                           as T+import           GHC.Generics++-- type D1 = M1 D+-- type C1 = M1 C+-- type S1 = M1 S+-- M1 : Meta-information (constructor names, etc.)+-- D  :Datatype : Class for dataTypes that represent dataTypes+-- C :Constructor :+-- S - Selector: Class for dataTypes that represent records+-- Rep = D1 (...)  (C1 ...) (S1 (...) :+: D1 (...)  (C1 ...) (S1 (...)+unwrapMonadTuple :: Monad m => (T.Text, m a) -> m (T.Text, a)+unwrapMonadTuple (text, ioa) = ioa >>= \x -> pure (text, x)++selectResolver ::+     [(T.Text, (T.Text, Selection) -> ResolveIO JSType)] -> (T.Text, Selection) -> ResolveIO (T.Text, JSType)+selectResolver x (key, gql) = unwrapMonadTuple (key, (fromMaybe (\_ -> pure JSNull) $ lookup key x) (key, gql))++resolveBySelection :: [(T.Text, Selection)] -> [(T.Text, (T.Text, Selection) -> ResolveIO JSType)] -> ResolveIO JSType+resolveBySelection selection resolvers = JSObject <$> mapM (selectResolver resolvers) selection++class DeriveResolvers f where+  deriveResolvers :: Meta.MetaInfo -> f a -> [(T.Text, (T.Text, Selection) -> ResolveIO JSType)]++instance DeriveResolvers U1 where+  deriveResolvers _ _ = []++instance (Selector s, DeriveResolvers f) => DeriveResolvers (M1 S s f) where+  deriveResolvers meta m@(M1 src) = deriveResolvers (meta {Meta.key = T.pack $ selName m}) src++instance (Datatype c, DeriveResolvers f) => DeriveResolvers (M1 D c f) where+  deriveResolvers meta m@(M1 src) = deriveResolvers (meta {Meta.typeName = T.pack $ datatypeName m}) src++instance (Constructor c, DeriveResolvers f) => DeriveResolvers (M1 C c f) where+  deriveResolvers meta (M1 src) = deriveResolvers meta src++instance (DeriveResolvers f, DeriveResolvers g) => DeriveResolvers (f :*: g) where+  deriveResolvers meta (a :*: b) = deriveResolvers meta a ++ deriveResolvers meta b
+ src/Data/Morpheus/Generics/GDecode.hs view
@@ -0,0 +1,33 @@+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeOperators         #-}++module Data.Morpheus.Generics.GDecode+  ( GDecode(..)+  ) where++import           Data.Morpheus.Types.Error    (Validation)+import           Data.Morpheus.Types.MetaInfo+import qualified Data.Text                    as T+import           GHC.Generics++fixProxy :: (a -> f a) -> f a+fixProxy f = f undefined++class GDecode i f where+  gDecode :: MetaInfo -> i -> Validation (f a)++instance GDecode i U1 where+  gDecode _ _ = pure U1++instance (Selector c, GDecode i f) => GDecode i (M1 S c f) where+  gDecode meta gql = fixProxy (\x -> M1 <$> gDecode (meta {key = T.pack $ selName x}) gql)++instance (Datatype c, GDecode i f) => GDecode i (M1 D c f) where+  gDecode meta gql = fixProxy (\x -> M1 <$> gDecode (meta {typeName = T.pack $ datatypeName x}) gql)++instance GDecode i f => GDecode i (M1 C c f) where+  gDecode meta gql = M1 <$> gDecode meta gql++instance (GDecode i f, GDecode i g) => GDecode i (f :*: g) where+  gDecode meta gql = (:*:) <$> gDecode meta gql <*> gDecode meta gql
+ src/Data/Morpheus/Generics/GDecodeEnum.hs view
@@ -0,0 +1,36 @@+{-# LANGUAGE FlexibleInstances   #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications    #-}+{-# LANGUAGE TypeOperators       #-}++module Data.Morpheus.Generics.GDecodeEnum+  ( GDecodeEnum(..)+  ) where++import           Data.Proxy   (Proxy (..))+import qualified Data.Text    as T+import           GHC.Generics++class GDecodeEnum f where+  gToEnum :: T.Text -> f a+  tagName :: Proxy f -> T.Text+  getTags :: Proxy f -> [T.Text]++instance (Datatype c, GDecodeEnum f) => GDecodeEnum (M1 D c f) where+  gToEnum = M1 . gToEnum+  tagName _ = ""+  getTags _ = getTags (Proxy :: Proxy f)++instance (Constructor c) => GDecodeEnum (M1 C c U1) where+  gToEnum _ = M1 U1+  tagName _ = T.pack $ conName (undefined :: (M1 C c U1 x))+  getTags proxy = [tagName proxy]++instance (GDecodeEnum a, GDecodeEnum b) => GDecodeEnum (a :+: b) where+  gToEnum name =+    if tagName (Proxy @a) == name+      then L1 $ gToEnum name+      else R1 $ gToEnum name+  tagName _ = ""+  getTags _ = getTags (Proxy @a) ++ getTags (Proxy @b)
+ src/Data/Morpheus/Generics/TypeRep.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE FlexibleContexts          #-}+{-# LANGUAGE FlexibleInstances         #-}+{-# LANGUAGE MultiParamTypeClasses     #-}+{-# LANGUAGE PolyKinds                 #-}+{-# LANGUAGE RankNTypes                #-}+{-# LANGUAGE ScopedTypeVariables       #-}+{-# LANGUAGE TypeApplications          #-}+{-# LANGUAGE TypeOperators             #-}++module Data.Morpheus.Generics.TypeRep+  ( Selectors(..)+  , resolveTypes+  ) where++import           Data.Morpheus.Schema.Internal.Types (TypeLib)+import           Data.Proxy                          (Proxy (..))+import           GHC.Generics++shift :: a -> (a -> b) -> b+shift x y = y x++resolveTypes :: TypeLib -> [TypeLib -> TypeLib] -> TypeLib+resolveTypes = foldl shift++class Selectors rep t where+  getFields :: Proxy rep -> [(t, TypeLib -> TypeLib)]++instance Selectors f t => Selectors (M1 D x f) t where+  getFields _ = getFields (Proxy @f)++instance Selectors f t => Selectors (M1 C x f) t where+  getFields _ = getFields (Proxy @f)++instance (Selectors a t, Selectors b t) => Selectors (a :*: b) t where+  getFields _ = getFields (Proxy @a) ++ getFields (Proxy @b)++instance Selectors U1 t where+  getFields _ = []
+ src/Data/Morpheus/Generics/Utils.hs view
@@ -0,0 +1,17 @@+module Data.Morpheus.Generics.Utils+  ( typeOf+  , SelOf+  , RecSel+  ) where++import           Data.Typeable    (Typeable, tyConName, typeRep, typeRepTyCon)+import           Data.Proxy   (Proxy)+import           Data.Text    (Text, pack)+import           GHC.Generics++typeOf :: Typeable a => Proxy a -> Text+typeOf = pack . tyConName . typeRepTyCon . typeRep++type SelOf s = M1 S s (Rec0 ()) ()++type RecSel s a = M1 S s (Rec0 a)
+ src/Data/Morpheus/Kind.hs view
@@ -0,0 +1,19 @@+module Data.Morpheus.Kind+  ( GQLObject+  , GQLKind(description)+  , GQLQuery+  , GQLArgs+  , GQLInput+  , GQLEnum+  , GQLMutation+  , GQLScalar(..)+  ) where++import           Data.Morpheus.Kind.GQLArgs     (GQLArgs)+import           Data.Morpheus.Kind.GQLEnum     (GQLEnum)+import           Data.Morpheus.Kind.GQLInput    (GQLInput)+import           Data.Morpheus.Kind.GQLKind     (GQLKind (description))+import           Data.Morpheus.Kind.GQLMutation (GQLMutation (..))+import           Data.Morpheus.Kind.GQLObject   (GQLObject)+import           Data.Morpheus.Kind.GQLQuery    (GQLQuery (..))+import           Data.Morpheus.Kind.GQLScalar   (GQLScalar (parseValue, serialize))
+ src/Data/Morpheus/Kind/GQLArgs.hs view
@@ -0,0 +1,52 @@+{-# LANGUAGE DefaultSignatures     #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE TypeApplications      #-}++module Data.Morpheus.Kind.GQLArgs+  ( GQLArgs(..)+  ) where++import           Data.Morpheus.Error.Internal        (internalArgumentError)+import           Data.Morpheus.Generics.GDecode      (GDecode (..))+import           Data.Morpheus.Generics.TypeRep      (Selectors (..))+import           Data.Morpheus.Generics.Utils        (RecSel, SelOf)+import qualified Data.Morpheus.Kind.GQLInput         as I (GQLInput (..))+import           Data.Morpheus.Schema.Internal.Types (InputField, TypeLib)+import           Data.Morpheus.Schema.Type           (DeprecationArgs)+import           Data.Morpheus.Types.Error           (Validation)+import           Data.Morpheus.Types.MetaInfo        (MetaInfo (..), initialMeta)+import           Data.Morpheus.Types.Query.Selection (Argument (..), Arguments)+import           Data.Proxy                          (Proxy (..))+import           Data.Text                           (Text, pack)+import           GHC.Generics++instance (Selector s, I.GQLInput a) => Selectors (RecSel s a) (Text, InputField) where+  getFields _ = [((name, I.asArgument (Proxy @a) name), I.introInput (Proxy @a))]+    where+      name = pack $ selName (undefined :: SelOf s)++instance I.GQLInput a => GDecode Arguments (K1 i a) where+  gDecode meta args =+    case lookup (key meta) args of+      Nothing                -> internalArgumentError "Required Argument Not Found"+      Just (Argument x _pos) -> K1 <$> I.decode x++class GQLArgs p where+  decode :: Arguments -> Validation p+  default decode :: (Generic p, GDecode Arguments (Rep p)) =>+    Arguments -> Validation p+  decode args = to <$> gDecode initialMeta args+  introspect :: Proxy p -> [((Text, InputField), TypeLib -> TypeLib)]+  default introspect :: Selectors (Rep p) (Text, InputField) =>+    Proxy p -> [((Text, InputField), TypeLib -> TypeLib)]+  introspect _ = getFields (Proxy @(Rep p))++instance GQLArgs () where+  decode _ = pure ()+  introspect _ = []++instance GQLArgs DeprecationArgs
+ src/Data/Morpheus/Kind/GQLEnum.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE AllowAmbiguousTypes     #-}+{-# LANGUAGE ConstrainedClassMethods #-}+{-# LANGUAGE DefaultSignatures       #-}+{-# LANGUAGE FlexibleContexts        #-}+{-# LANGUAGE ScopedTypeVariables     #-}+{-# LANGUAGE TypeApplications        #-}++module Data.Morpheus.Kind.GQLEnum+  ( GQLEnum(..)+  ) where++import           Data.Morpheus.Generics.GDecodeEnum     (GDecodeEnum (..))+import           Data.Morpheus.Kind.GQLKind             (GQLKind (..), enumTypeOf)+import           Data.Morpheus.Schema.DirectiveLocation (DirectiveLocation)+import           Data.Morpheus.Schema.Internal.Types    (Field (..), InputField (..), TypeLib)+import           Data.Morpheus.Schema.TypeKind          (TypeKind (..))+import           Data.Proxy                             (Proxy (..))+import           Data.Text                              (Text)+import           GHC.Generics++class GQLEnum a where+  decode :: Text -> a+  default decode :: (Generic a, GDecodeEnum (Rep a)) =>+    Text -> a+  decode text = to $ gToEnum text+  asInputField :: Proxy a -> Text -> InputField+  default asInputField :: GQLKind a =>+    Proxy a -> Text -> InputField+  asInputField proxy = InputField . asField proxy+  asField :: Proxy a -> Text -> Field+  default asField :: GQLKind a =>+    Proxy a -> Text -> Field+  asField proxy name = Field {fieldName = name, notNull = True, kind = ENUM, fieldType = typeID proxy, asList = False}+  introspect :: Proxy a -> TypeLib -> TypeLib+  default introspect :: (GQLKind a, GDecodeEnum (Rep a)) =>+    Proxy a -> TypeLib -> TypeLib+  introspect = updateLib (enumTypeOf $ getTags (Proxy @(Rep a))) []++instance GQLEnum TypeKind++instance GQLEnum DirectiveLocation
+ src/Data/Morpheus/Kind/GQLInput.hs view
@@ -0,0 +1,109 @@+{-# LANGUAGE AllowAmbiguousTypes   #-}+{-# LANGUAGE DefaultSignatures     #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE TypeApplications      #-}++module Data.Morpheus.Kind.GQLInput+  ( GQLInput(..)+  ) where++import           Data.Morpheus.Error.Internal        (internalArgumentError, internalTypeMismatch)+import           Data.Morpheus.Generics.GDecode      (GDecode (..))+import           Data.Morpheus.Generics.TypeRep      (Selectors (..))+import qualified Data.Morpheus.Kind.GQLEnum          as E (GQLEnum (..))+import           Data.Morpheus.Kind.GQLKind          (GQLKind (..), inputObjectOf, introspectScalar)+import qualified Data.Morpheus.Kind.GQLScalar        as S (GQLScalar (..))+import           Data.Morpheus.Schema.Internal.Types (Field (..), InputField (..), TypeLib)+import           Data.Morpheus.Schema.TypeKind       (TypeKind (..))+import           Data.Morpheus.Types.Describer       (EnumOf (..), ScalarOf (..))+import           Data.Morpheus.Types.Error           (Validation)+import           Data.Morpheus.Types.JSType          (JSType (..), ScalarValue (..))+import qualified Data.Morpheus.Types.MetaInfo        as Meta (MetaInfo (..), initialMeta)+import           Data.Proxy                          (Proxy (..))+import           Data.Text                           (Text)+import           GHC.Generics++instance GQLInput a => GDecode JSType (K1 i a) where+  gDecode meta (JSObject object) =+    case lookup (Meta.key meta) object of+      Nothing    -> internalArgumentError "Missing Argument"+      Just value -> K1 <$> decode value+  gDecode _ isType = internalTypeMismatch "InputObject" isType++class GQLInput a where+  decode :: JSType -> Validation a+  default decode :: (Generic a, GDecode JSType (Rep a)) =>+    JSType -> Validation a+  decode (JSObject x) = to <$> gDecode Meta.initialMeta (JSObject x)+  decode isType       = internalTypeMismatch "InputObject" isType+  asArgument :: Proxy a -> Text -> InputField+  default asArgument :: GQLKind a =>+    Proxy a -> Text -> InputField+  asArgument proxy name =+    InputField $ Field {fieldName = name, notNull = True, asList = False, kind = INPUT_OBJECT, fieldType = typeID proxy}+  introInput :: Proxy a -> TypeLib -> TypeLib+  default introInput :: (GQLKind a, Selectors (Rep a) (Text, InputField)) =>+    Proxy a -> TypeLib -> TypeLib+  introInput = updateLib (inputObjectOf fields) stack+    where+      fieldTypes = getFields (Proxy @(Rep a))+      stack = map snd fieldTypes+      fields = map fst fieldTypes++inputFieldOf :: GQLKind a => Proxy a -> Text -> InputField+inputFieldOf proxy name =+  InputField $ Field {fieldName = name, asList = False, notNull = True, kind = SCALAR, fieldType = typeID proxy}++instance GQLInput Text where+  decode (Scalar (String x)) = pure x+  decode isType              = internalTypeMismatch "String" isType+  asArgument = inputFieldOf+  introInput = introspectScalar++instance GQLInput Bool where+  decode (Scalar (Boolean x)) = pure x+  decode isType               = internalTypeMismatch "Boolean" isType+  asArgument = inputFieldOf+  introInput = introspectScalar++instance GQLInput Int where+  decode (Scalar (Int x)) = pure x+  decode isType           = internalTypeMismatch "Int" isType+  asArgument = inputFieldOf+  introInput = introspectScalar++instance GQLInput Float where+  decode (Scalar (Float x)) = pure x+  decode isType             = internalTypeMismatch "Int" isType+  asArgument = inputFieldOf+  introInput = introspectScalar++instance (GQLInput a, GQLKind a) => GQLInput (Maybe a) where+  decode JSNull = pure Nothing+  decode x      = Just <$> decode x+  asArgument _ name = InputField $ setNullable $ unpackInputField $ asArgument (Proxy @a) name+    where+      setNullable :: Field -> Field+      setNullable x = x {notNull = False}+  introInput _ typeLib = typeLib++instance (E.GQLEnum a, GQLKind a) => GQLInput (EnumOf a) where+  decode (JSEnum text) = pure $ EnumOf (E.decode text)+  decode isType        = internalTypeMismatch "Enum" isType+  asArgument _ = E.asInputField (Proxy @a)+  introInput _ = E.introspect (Proxy @a)++instance (S.GQLScalar a, GQLKind a) => GQLInput (ScalarOf a) where+  decode text = ScalarOf <$> S.decode text+  asArgument _ = S.asInputField (Proxy @a)+  introInput _ = S.introspect (Proxy @a)++instance (GQLInput a, GQLKind a) => GQLInput [a] where+  decode (JSList li) = mapM decode li+  decode isType      = internalTypeMismatch "List" isType+  asArgument _ = asArgument (Proxy @a)+  introInput _ = introInput (Proxy @a) -- TODO: wrap as List
+ src/Data/Morpheus/Kind/GQLKind.hs view
@@ -0,0 +1,98 @@+{-# LANGUAGE DefaultSignatures    #-}+{-# LANGUAGE FlexibleInstances    #-}+{-# LANGUAGE OverloadedStrings    #-}+{-# LANGUAGE ScopedTypeVariables  #-}+{-# LANGUAGE TypeApplications     #-}+{-# LANGUAGE TypeSynonymInstances #-}++module Data.Morpheus.Kind.GQLKind+  ( GQLKind(..)+  , scalarTypeOf+  , asObjectType+  , enumTypeOf+  , inputObjectOf+  , introspectScalar+  ) where++import           Data.Morpheus.Generics.TypeRep         (resolveTypes)+import           Data.Morpheus.Generics.Utils           (typeOf)+import           Data.Morpheus.Schema.Directive         (Directive)+import           Data.Morpheus.Schema.DirectiveLocation (DirectiveLocation)+import           Data.Morpheus.Schema.EnumValue         (EnumValue)+import           Data.Morpheus.Schema.Internal.Types    (Core (..), GObject (..), InputField, Leaf (..), LibType (..),+                                                         ObjectField (..), TypeLib, defineType, isTypeDefined)+import           Data.Morpheus.Schema.Schema            (Schema)+import           Data.Morpheus.Schema.TypeKind          (TypeKind (..))+import           Data.Morpheus.Schema.Utils.Utils       (Field, InputValue, Type)+import           Data.Proxy                             (Proxy (..))+import           Data.Text                              (Text)+import           Data.Typeable                          (Typeable)++scalarTypeOf :: GQLKind a => Proxy a -> LibType+scalarTypeOf = Leaf . LScalar . buildType++enumTypeOf :: GQLKind a => [Text] -> Proxy a -> LibType+enumTypeOf tags = Leaf . LEnum tags . buildType++asObjectType :: GQLKind a => [(Text, ObjectField)] -> Proxy a -> LibType+asObjectType fields = OutputObject . GObject fields . buildType++inputObjectOf :: GQLKind a => [(Text, InputField)] -> Proxy a -> LibType+inputObjectOf inputFields = InputObject . GObject inputFields . buildType++introspectScalar :: GQLKind a => Proxy a -> TypeLib -> TypeLib+introspectScalar = updateLib scalarTypeOf []++class GQLKind a where+  description :: Proxy a -> Text+  description _ = "default selection Description"+  typeID :: Proxy a -> Text+  default typeID :: Typeable a =>+    Proxy a -> Text+  typeID = typeOf+  buildType :: Proxy a -> Core+  buildType proxy = Core {name = typeID proxy, typeDescription = description proxy}+  updateLib :: (Proxy a -> LibType) -> [TypeLib -> TypeLib] -> Proxy a -> TypeLib -> TypeLib+  updateLib typeBuilder stack proxy lib' =+    if isTypeDefined (typeID proxy) lib'+      then lib'+      else resolveTypes lib' (defineType (typeID proxy, typeBuilder proxy) : stack)++instance GQLKind EnumValue where+  typeID _ = "__EnumValue"++instance GQLKind Type where+  typeID _ = "__Type"++instance GQLKind Field where+  typeID _ = "__Field"++instance GQLKind InputValue where+  typeID _ = "__InputValue"++instance GQLKind Schema where+  typeID _ = "__Schema"++instance GQLKind Directive where+  typeID _ = "__Directive"++instance GQLKind TypeKind where+  typeID _ = "__TypeKind"++instance GQLKind DirectiveLocation where+  typeID _ = "__DirectiveLocation"++instance GQLKind Int where+  typeID _ = "Int"++instance GQLKind Float where+  typeID _ = "Int"++instance GQLKind Text where+  typeID _ = "String"++instance GQLKind Bool where+  typeID _ = "Boolean"++instance GQLKind a => GQLKind (Maybe a) where+  typeID _ = typeID (Proxy @a)
+ src/Data/Morpheus/Kind/GQLMutation.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE DefaultSignatures        #-}+{-# LANGUAGE DisambiguateRecordFields #-}+{-# LANGUAGE FlexibleContexts         #-}+{-# LANGUAGE FlexibleInstances        #-}+{-# LANGUAGE MultiParamTypeClasses    #-}+{-# LANGUAGE OverloadedStrings        #-}+{-# LANGUAGE RankNTypes               #-}+{-# LANGUAGE ScopedTypeVariables      #-}+{-# LANGUAGE TypeOperators            #-}++module Data.Morpheus.Kind.GQLMutation+  ( GQLMutation(..)+  ) where++import           Data.Morpheus.Generics.DeriveResolvers (DeriveResolvers (..), resolveBySelection)+import           Data.Morpheus.Generics.TypeRep         (Selectors (..), resolveTypes)+import           Data.Morpheus.Schema.Internal.Types    (Core (..), GObject (..), ObjectField, TypeLib (..))+import           Data.Morpheus.Types.Error              (ResolveIO)+import           Data.Morpheus.Types.JSType             (JSType (..))+import           Data.Morpheus.Types.MetaInfo           (initialMeta)+import           Data.Morpheus.Types.Query.Selection    (SelectionSet)+import           Data.Proxy+import           Data.Text                              (Text)+import           GHC.Generics++class GQLMutation a where+  encodeMutation :: a -> SelectionSet -> ResolveIO JSType+  default encodeMutation :: (Generic a, DeriveResolvers (Rep a)) =>+    a -> SelectionSet -> ResolveIO JSType+  encodeMutation rootResolver sel = resolveBySelection sel $ deriveResolvers initialMeta $ from rootResolver+  mutationSchema :: a -> TypeLib -> TypeLib+  default mutationSchema :: (Selectors (Rep a) (Text, ObjectField)) =>+    a -> TypeLib -> TypeLib+  mutationSchema _ initialType = resolveTypes mutationType types+    where+      mutationType = initialType {mutation = Just ("Mutation", GObject fields $ Core "Mutation" "Description")}+      fieldTypes = getFields (Proxy :: Proxy (Rep a))+      types = map snd fieldTypes+      fields = map fst fieldTypes++instance GQLMutation () where+  encodeMutation _ _ = pure JSNull+  mutationSchema _ = id
+ src/Data/Morpheus/Kind/GQLObject.hs view
@@ -0,0 +1,165 @@+{-# LANGUAGE DefaultSignatures     #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings     #-}+{-# LANGUAGE RankNTypes            #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE TypeApplications      #-}+{-# LANGUAGE TypeOperators         #-}++module Data.Morpheus.Kind.GQLObject+  ( GQLObject(..)+  ) where++import           Control.Monad.Trans                    (lift)+import           Control.Monad.Trans.Except+import           Data.Morpheus.Error.Selection          (fieldNotResolved, subfieldsNotSelected)+import           Data.Morpheus.Generics.DeriveResolvers (DeriveResolvers (..), resolveBySelection)+import           Data.Morpheus.Generics.TypeRep         (Selectors (..), resolveTypes)+import           Data.Morpheus.Generics.Utils           (RecSel, SelOf)+import qualified Data.Morpheus.Kind.GQLArgs             as Args (GQLArgs (..))+import qualified Data.Morpheus.Kind.GQLEnum             as E (GQLEnum (..))+import           Data.Morpheus.Kind.GQLKind             (GQLKind (..), asObjectType, introspectScalar)+import qualified Data.Morpheus.Kind.GQLScalar           as S (GQLScalar (..))+import           Data.Morpheus.Schema.Directive         (Directive)+import           Data.Morpheus.Schema.EnumValue         (EnumValue)+import           Data.Morpheus.Schema.Internal.Types    (ObjectField (..), TypeLib)+import qualified Data.Morpheus.Schema.Internal.Types    as I (Field (..))+import           Data.Morpheus.Schema.Schema            (Schema)+import           Data.Morpheus.Schema.Type              (DeprecationArgs)+import           Data.Morpheus.Schema.TypeKind          (TypeKind (..))+import           Data.Morpheus.Schema.Utils.Utils       (Field, InputValue, Type)+import           Data.Morpheus.Types.Describer          ((::->) (..), EnumOf (..), ScalarOf (..),+                                                         WithDeprecationArgs (..))+import           Data.Morpheus.Types.Error              (ResolveIO, failResolveIO)+import           Data.Morpheus.Types.JSType             (JSType (..), ScalarValue (..))+import qualified Data.Morpheus.Types.MetaInfo           as Meta (MetaInfo (..), initialMeta)+import           Data.Morpheus.Types.Query.Selection    (Selection (..))+import           Data.Proxy+import           Data.Text                              (Text, pack)+import           GHC.Generics++instance GQLObject a => DeriveResolvers (K1 i a) where+  deriveResolvers meta (K1 src) = [(Meta.key meta, (`encode` src))]++instance (Selector s, GQLObject a) => Selectors (RecSel s a) (Text, ObjectField) where+  getFields _ = [((name, fieldType (Proxy @a) name), introspect (Proxy @a))]+    where+      name = pack $ selName (undefined :: SelOf s)++class GQLObject a where+  encode :: (Text, Selection) -> a -> ResolveIO JSType+  default encode :: (Generic a, DeriveResolvers (Rep a)) =>+    (Text, Selection) -> a -> ResolveIO JSType+  encode (_, SelectionSet _ selection _pos) = resolveBySelection selection . deriveResolvers Meta.initialMeta . from+  encode (_, Field _ key pos) = const $ failResolveIO $ subfieldsNotSelected meta -- TODO: must be internal Error+    where+      meta = Meta.MetaInfo {Meta.typeName = "", Meta.key = key, Meta.position = pos}+  fieldType :: Proxy a -> Text -> ObjectField+  default fieldType :: (Selectors (Rep a) (Text, ObjectField), GQLKind a) =>+    Proxy a -> Text -> ObjectField+  fieldType proxy name =+    ObjectField [] $+    I.Field {I.fieldName = name, I.notNull = True, I.asList = False, I.kind = OBJECT, I.fieldType = typeID proxy}+  introspect :: Proxy a -> TypeLib -> TypeLib+  default introspect :: (Selectors (Rep a) (Text, ObjectField), GQLKind a) =>+    Proxy a -> TypeLib -> TypeLib+  introspect = updateLib (asObjectType fields) stack+    where+      fieldTypes = getFields (Proxy @(Rep a))+      fields = map fst fieldTypes+      stack = map snd fieldTypes++liftResolver :: Int -> Text -> IO (Either String a) -> ResolveIO a+liftResolver position' typeName' x = do+  result <- lift x+  case result of+    Left message' -> failResolveIO $ fieldNotResolved position' typeName' (pack message')+    Right value   -> pure value++instance (GQLObject a, Args.GQLArgs p) => GQLObject (p ::-> a) where+  encode (key', SelectionSet gqlArgs body position') (Resolver resolver) =+    (ExceptT $ pure $ Args.decode gqlArgs) >>= liftResolver position' key' . resolver >>=+    encode (key', SelectionSet gqlArgs body position')+  encode (key', Field gqlArgs field position') (Resolver resolver) =+    (ExceptT $ pure $ Args.decode gqlArgs) >>= liftResolver position' key' . resolver >>=+    encode (key', Field gqlArgs field position')+  introspect _ typeLib = resolveTypes typeLib $ args' ++ fields+    where+      args' = map snd $ Args.introspect (Proxy @p)+      fields = [introspect (Proxy @a)]+  fieldType _ name = (fieldType (Proxy @a) name) {args = map fst $ Args.introspect (Proxy @p)}++-- manual deriving of  DeprecationArgs ::-> a+instance GQLObject a => GQLObject (WithDeprecationArgs a) where+  encode sel (WithDeprecationArgs val) = encode sel val+  introspect _ typeLib = resolveTypes typeLib $ args' ++ fields+    where+      args' = map snd $ Args.introspect (Proxy @DeprecationArgs)+      fields = [introspect (Proxy @a)]+  fieldType _ name = (fieldType (Proxy @a) name) {args = map fst $ Args.introspect (Proxy @DeprecationArgs)}++instance GQLObject a => GQLObject (Maybe a) where+  encode _ Nothing          = pure JSNull+  encode query (Just value) = encode query value+  introspect _ = introspect (Proxy @a)+  fieldType _ name = (fType name) {fieldContent = (fieldContent $ fType name) {I.notNull = False}}+    where+      fType = fieldType (Proxy @a)++scalarField :: GQLKind a => Proxy a -> Text -> ObjectField+scalarField proxy name =+  ObjectField+    []+    I.Field {I.fieldName = name, I.notNull = True, I.asList = False, I.kind = SCALAR, I.fieldType = typeID proxy}++instance GQLObject Int where+  encode _ = pure . Scalar . Int+  introspect = introspectScalar+  fieldType = scalarField++instance GQLObject Float where+  encode _ = pure . Scalar . Float+  introspect = introspectScalar+  fieldType = scalarField++instance GQLObject Text where+  encode _ = pure . Scalar . String+  introspect = introspectScalar+  fieldType = scalarField++instance GQLObject Bool where+  encode _ = pure . Scalar . Boolean+  introspect = introspectScalar+  fieldType = scalarField++instance GQLObject a => GQLObject [a] where+  encode (_, Field {}) _ = pure $ JSList []+  encode query list      = JSList <$> mapM (encode query) list+  introspect _ = introspect (Proxy @a)+  fieldType _ name = fType {fieldContent = (fieldContent fType) {I.asList = True}}+    where+      fType = fieldType (Proxy @a) name++instance (Show a, GQLKind a, E.GQLEnum a) => GQLObject (EnumOf a) where+  encode _ = pure . Scalar . String . pack . show . unpackEnum+  fieldType _ = ObjectField [] . E.asField (Proxy @a)+  introspect _ = E.introspect (Proxy @a)++instance S.GQLScalar a => GQLObject (ScalarOf a) where+  encode _ (ScalarOf x) = pure $ Scalar $ S.serialize x+  fieldType _ = ObjectField [] . S.asField (Proxy @a)+  introspect _ = S.introspect (Proxy @a)++instance GQLObject EnumValue++instance GQLObject Type++instance GQLObject Field++instance GQLObject InputValue++instance GQLObject Schema++instance GQLObject Directive
+ src/Data/Morpheus/Kind/GQLQuery.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE DefaultSignatures        #-}+{-# LANGUAGE DisambiguateRecordFields #-}+{-# LANGUAGE FlexibleContexts         #-}+{-# LANGUAGE FlexibleInstances        #-}+{-# LANGUAGE MultiParamTypeClasses    #-}+{-# LANGUAGE OverloadedStrings        #-}+{-# LANGUAGE RankNTypes               #-}+{-# LANGUAGE ScopedTypeVariables      #-}+{-# LANGUAGE TypeApplications         #-}+{-# LANGUAGE TypeOperators            #-}++module Data.Morpheus.Kind.GQLQuery+  ( GQLQuery(..)+  ) where++import           Data.Morpheus.Generics.DeriveResolvers (DeriveResolvers (..), resolveBySelection)+import           Data.Morpheus.Generics.TypeRep         (Selectors (..), resolveTypes)+import           Data.Morpheus.Kind.GQLObject           (GQLObject (..))+import           Data.Morpheus.Schema.Internal.Types    (Core (..), GObject (..), ObjectField, TypeLib, initTypeLib)+import           Data.Morpheus.Schema.Schema            (Schema, initSchema)+import           Data.Morpheus.Types.Error              (ResolveIO)+import           Data.Morpheus.Types.JSType             (JSType (..))+import           Data.Morpheus.Types.MetaInfo           (initialMeta)+import           Data.Morpheus.Types.Query.Selection    (SelectionSet)+import           Data.Proxy+import           Data.Text                              (Text)+import           GHC.Generics++class GQLQuery a where+  encodeQuery :: a -> TypeLib -> SelectionSet -> ResolveIO JSType+  default encodeQuery :: (Generic a, DeriveResolvers (Rep a)) =>+    a -> TypeLib -> SelectionSet -> ResolveIO JSType+  encodeQuery rootResolver types sel = resolveBySelection sel (schemaResolver ++ resolvers)+    where+      schemaResolver = [("__schema", (`encode` initSchema types))]+      resolvers = deriveResolvers initialMeta $ from rootResolver+  querySchema :: a -> TypeLib+  default querySchema :: (Selectors (Rep a) (Text, ObjectField)) =>+    a -> TypeLib+  querySchema _ = resolveTypes typeLib stack+    where+      typeLib = introspect (Proxy @Schema) queryType+      queryType = initTypeLib ("Query", GObject fields (Core "Query" "Description"))+      fieldTypes = getFields (Proxy @(Rep a))+      stack = map snd fieldTypes+      fields = map fst fieldTypes
+ src/Data/Morpheus/Kind/GQLScalar.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE ConstrainedClassMethods #-}+{-# LANGUAGE DefaultSignatures       #-}+{-# LANGUAGE OverloadedStrings       #-}++module Data.Morpheus.Kind.GQLScalar where++import           Control.Monad                       ((>=>))+import           Data.Morpheus.Error.Internal        (internalTypeMismatch)+import           Data.Morpheus.Kind.GQLKind          (GQLKind (..), scalarTypeOf)+import           Data.Morpheus.Schema.Internal.Types (Field (..), InputField (..), TypeLib)+import           Data.Morpheus.Schema.TypeKind       (TypeKind (..))+import           Data.Morpheus.Types.Core            (Key)+import           Data.Morpheus.Types.Error           (Validation)+import           Data.Morpheus.Types.JSType          (JSType (..), ScalarValue (..))+import           Data.Proxy                          (Proxy (..))++toScalar :: JSType -> Validation ScalarValue+toScalar (Scalar x) = pure x+toScalar jsType     = internalTypeMismatch "Scalar" jsType++class GQLScalar a where+  parseValue :: ScalarValue -> Validation a+  decode :: JSType -> Validation a+  decode = toScalar >=> parseValue+  serialize :: a -> ScalarValue+  encode :: a -> JSType+  encode = Scalar . serialize+  asInputField :: GQLKind a => Proxy a -> Key -> InputField+  asInputField proxy = InputField . asField proxy+  asField :: Proxy a -> Key -> Field+  default asField :: GQLKind a =>+    Proxy a -> Key -> Field+  asField proxy name = Field {fieldName = name, notNull = True, asList = False, kind = SCALAR, fieldType = typeID proxy}+  introspect :: Proxy a -> TypeLib -> TypeLib+  default introspect :: GQLKind a =>+    Proxy a -> TypeLib -> TypeLib+  introspect = updateLib scalarTypeOf []
+ src/Data/Morpheus/Parser/Arguments.hs view
@@ -0,0 +1,48 @@+module Data.Morpheus.Parser.Arguments+  ( arguments+  ) where++import           Control.Applicative                    ((<|>))+import           Data.Attoparsec.Text                   (Parser, char, sepBy, skipSpace)+import           Data.Morpheus.Parser.Primitive         (getPosition, jsBool, jsNumber, jsString, token, variable)+import           Data.Morpheus.Types.JSType             (JSType (JSEnum))+import           Data.Morpheus.Types.Query.RawSelection (RawArgument (..), RawArguments)+import           Data.Text                              (Text)++enum :: Parser JSType+enum = JSEnum <$> token++argumentType :: Parser RawArgument+argumentType = do+  pos <- getPosition+  arg <- jsString <|> jsNumber <|> jsBool <|> enum+  pure $ Argument arg pos++variableType :: Parser RawArgument+variableType = do+  pos <- getPosition+  val <- variable+  pure $ VariableReference val pos++inputValue :: Parser RawArgument+inputValue = skipSpace *> argumentType <|> variableType++parameter :: Parser (Text, RawArgument)+parameter = do+  skipSpace+  key <- token+  skipSpace+  _ <- char ':'+  skipSpace+  value <- inputValue+  pure (key, value)++arguments :: Parser RawArguments+arguments = do+  skipSpace+  _ <- char '('+  skipSpace+  parameters <- parameter `sepBy` (skipSpace *> char ',')+  skipSpace+  _ <- char ')'+  pure parameters
+ src/Data/Morpheus/Parser/Body.hs view
@@ -0,0 +1,51 @@+{-# LANGUAGE OverloadedStrings #-}++module Data.Morpheus.Parser.Body+  ( body+  , entries+  ) where++import           Control.Applicative                    (some, (<|>))+import           Data.Attoparsec.Text                   (Parser, char, letter, sepBy, skipSpace,+                                                         string, try)+import           Data.Morpheus.Parser.Arguments         (arguments)+import           Data.Morpheus.Parser.Primitive         (getPosition, separator, token)+import           Data.Morpheus.Types.Query.RawSelection (RawArguments, RawSelection (..),+                                                         RawSelectionSet)+import           Data.Text                              (Text, pack)++spread :: Parser (Text, RawSelection)+spread = do+  skipSpace+  index <- getPosition+  _ <- string "..."+  key <- some (letter <|> char '_')+  return (pack key, Spread (pack key) index)++entry :: Parser (Text, RawSelection)+entry = do+  skipSpace+  index <- getPosition+  key <- token+  args <- try arguments <|> pure []+  value <- try (body args) <|> pure (RawField args key index)+  return (key, value)++separated :: Parser a -> Parser [a]+separated x = x `sepBy` separator++entries :: Parser RawSelectionSet+entries = do+  _ <- char '{'+  skipSpace+  entries' <- separated $ entry <|> spread+  skipSpace+  _ <- char '}'+  return entries'++body :: RawArguments -> Parser RawSelection+body args = do+  skipSpace+  index <- getPosition+  entries' <- entries+  return (RawSelectionSet args entries' index)
+ src/Data/Morpheus/Parser/Fragment.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE OverloadedStrings #-}++module Data.Morpheus.Parser.Fragment+  ( fragment+  ) where++import           Data.Attoparsec.Text               (Parser, skipSpace, string)+import           Data.Morpheus.Parser.Body          (entries)+import           Data.Morpheus.Parser.Primitive     (getPosition, token)+import           Data.Morpheus.Types.Query.Fragment (Fragment (..))+import           Data.Text                          (Text)++fragment :: Parser (Text, Fragment)+fragment = do+  skipSpace+  index <- getPosition+  _ <- string "fragment"+  skipSpace+  name <- token+  skipSpace+  _ <- string "on"+  skipSpace+  targetName <- token+  skipSpace+  fragmentBody <- entries+  pure (name, Fragment {key = name, target = targetName, content = fragmentBody, position = index})
+ src/Data/Morpheus/Parser/Mutation.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE OverloadedStrings #-}++module Data.Morpheus.Parser.Mutation+  ( mutation+  ) where++import           Control.Applicative                ((<|>))+import           Data.Attoparsec.Text               (Parser, skipSpace, string, try)+import           Data.Morpheus.Parser.Body          (entries)+import           Data.Morpheus.Parser.Primitive     (getPosition, token)+import           Data.Morpheus.Parser.RootHead      (rootHeadArguments)+import           Data.Morpheus.Types.Query.Operator (Operator (..), RawOperator)++mutation :: Parser RawOperator+mutation = do+  pos <- getPosition+  _ <- string "mutation "+  skipSpace+  name <- token+  variables <- try (skipSpace *> rootHeadArguments) <|> pure []+  skipSpace+  sel <- entries+  pure $ Mutation name variables sel pos
+ src/Data/Morpheus/Parser/Parser.hs view
@@ -0,0 +1,45 @@+module Data.Morpheus.Parser.Parser+  ( parseGQL+  , parseLineBreaks+  ) where++import           Control.Applicative            (many, (<|>))+import           Data.Attoparsec.Text           (Parser, endOfInput, parseOnly, skipSpace)+import           Data.Map                       (fromList, toList)+import           Data.Maybe                     (fromMaybe)+import           Data.Morpheus.Error.Syntax     (syntaxError)+import           Data.Morpheus.Parser.Fragment  (fragment)+import qualified Data.Morpheus.Parser.Mutation  as M+import           Data.Morpheus.Parser.Primitive (getLines)+import qualified Data.Morpheus.Parser.Query     as Q+import           Data.Morpheus.Types.Error      (Validation)+import           Data.Morpheus.Types.JSType     (JSType (..))+import           Data.Morpheus.Types.Request    (GQLRequest (..))+import           Data.Morpheus.Types.Types      (GQLQueryRoot (..))+import           Data.Text                      (Text, pack)++request :: Parser GQLQueryRoot+request = do+  queryValue <- Q.query <|> M.mutation+  fragmentLib <- fromList <$> many fragment+  skipSpace+  endOfInput+  pure GQLQueryRoot {queryBody = queryValue, fragments = fragmentLib, inputVariables = []}++getVariables :: GQLRequest -> [(Text, JSType)]+getVariables request' = fromMaybe [] (toList <$> variables request')++parseReq :: GQLRequest -> Either String GQLQueryRoot+parseReq requestBody = parseOnly request $ query requestBody++parseLineBreaks :: GQLRequest -> [Int]+parseLineBreaks requestBody =+  case parseOnly getLines $ query requestBody of+    Right x -> x+    Left _  -> []++parseGQL :: GQLRequest -> Validation GQLQueryRoot+parseGQL requestBody =+  case parseReq requestBody of+    Right root      -> Right $ root {inputVariables = getVariables requestBody}+    Left parseError -> Left $ syntaxError (pack $ show parseError) 0
+ src/Data/Morpheus/Parser/Primitive.hs view
@@ -0,0 +1,73 @@+{-# LANGUAGE OverloadedStrings #-}++module Data.Morpheus.Parser.Primitive where++import           Control.Applicative+import           Data.Attoparsec.Text+import           Data.Functor+import           Data.Morpheus.Types.JSType     (JSType (..), ScalarValue (..), decodeScientific)+import qualified Data.Text                      as T (Text, pack)++import qualified Data.Attoparsec.Internal.Types as AT++replaceType :: T.Text -> T.Text+replaceType "type" = "_type"+replaceType x      = x++boolTrue :: Parser JSType+boolTrue = string "true" $> Scalar (Boolean True)++boolFalse :: Parser JSType+boolFalse = string "false" $> Scalar (Boolean False)++jsBool :: Parser JSType+jsBool = boolTrue <|> boolFalse++jsNumber :: Parser JSType+jsNumber = Scalar . decodeScientific <$> scientific++codes :: String+codes = ['b', 'n', 'f', 'r', 't', '\\', '\"', '/']++replacements :: String+replacements = ['\b', '\n', '\f', '\r', '\t', '\\', '\"', '/']++escaped :: Parser Char+escaped = do+  x <- notChar '\"'+  if x == '\\'+    then choice (zipWith escapeChar codes replacements)+    else pure x+  where+    escapeChar code replacement = char code >> return replacement++jsString :: Parser JSType+jsString = do+  _ <- char '"'+  value <- many escaped+  _ <- char '"'+  pure $ Scalar $ String $ T.pack value++token :: Parser T.Text+token = replaceType . T.pack <$> some (letter <|> char '_')++variable :: Parser T.Text+variable = skipSpace *> char '$' *> token++separator :: Parser Char+separator = char ',' <|> char ' ' <|> char '\n' <|> char '\t'++getPosition :: Parser Int+getPosition = AT.Parser internFunc+  where+    internFunc t pos more _ success = success t pos more (AT.fromPos pos)++getNextLine :: Parser Int+getNextLine = do+  _ <- many (notChar '\n')+  index <- getPosition+  _ <- char '\n'+  pure index++getLines :: Parser [Int]+getLines = many getNextLine
+ src/Data/Morpheus/Parser/Query.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE OverloadedStrings #-}++module Data.Morpheus.Parser.Query+  ( query+  ) where++import           Control.Applicative                ((<|>))+import           Data.Attoparsec.Text               (Parser, skipSpace, string, try)+import           Data.Morpheus.Parser.Body          (entries)+import           Data.Morpheus.Parser.Primitive     (getPosition, token)+import           Data.Morpheus.Parser.RootHead      (rootHeadArguments)+import           Data.Morpheus.Types.Query.Operator (Operator (..), RawOperator, VariableDefinitions)+import           Data.Text                          (Text)++queryHead :: Parser (Text, VariableDefinitions)+queryHead = do+  _ <- string "query "+  skipSpace+  queryName <- token+  variables <- try (skipSpace *> rootHeadArguments) <|> pure []+  pure (queryName, variables)++query :: Parser RawOperator+query = do+  pos <- getPosition+  (queryName, args) <- try (skipSpace *> queryHead) <|> pure ("", [])+  skipSpace+  selection <- entries+  pure $ Query queryName args selection pos
+ src/Data/Morpheus/Parser/RootHead.hs view
@@ -0,0 +1,29 @@+module Data.Morpheus.Parser.RootHead+  ( rootHeadArguments+  ) where++import           Data.Attoparsec.Text               (Parser, char, sepBy, skipSpace)+import           Data.Morpheus.Parser.Primitive     (getPosition, token, variable)+import           Data.Morpheus.Types.Query.Operator (Variable (..), VariableDefinitions)+import           Data.Text                          (Text)++rootHeadVariable :: Parser (Text, Variable)+rootHeadVariable = do+  skipSpace+  pos <- getPosition+  variableName <- variable+  skipSpace+  _ <- char ':'+  skipSpace+  variableType <- token+  pure (variableName, Variable variableType pos)++rootHeadArguments :: Parser VariableDefinitions+rootHeadArguments = do+  skipSpace+  _ <- char '('+  skipSpace+  parameters <- rootHeadVariable `sepBy` (skipSpace *> char ',')+  skipSpace+  _ <- char ')'+  pure parameters
+ src/Data/Morpheus/PreProcess/Fragment.hs view
@@ -0,0 +1,51 @@+module Data.Morpheus.PreProcess.Fragment+  ( validateFragments+  ) where++import qualified Data.Map                               as M (toList)+import           Data.Morpheus.Error.Fragment           (cannotSpreadWithinItself)+import           Data.Morpheus.PreProcess.Utils         (existsObjectType)+import           Data.Morpheus.Schema.Internal.Types    (TypeLib)+import           Data.Morpheus.Types.Core               (EnhancedKey (..))+import           Data.Morpheus.Types.Error              (Validation)+import           Data.Morpheus.Types.Query.Fragment     (Fragment (..))+import           Data.Morpheus.Types.Query.RawSelection (RawSelection (..))+import           Data.Morpheus.Types.Types              (GQLQueryRoot (..))+import           Data.Text                              (Text)++type Node = EnhancedKey++type NodeEdges = (Node, [Node])++type Graph = [NodeEdges]++scanForSpread :: TypeLib -> GQLQueryRoot -> (Text, RawSelection) -> [Node]+scanForSpread lib' root (_', RawSelectionSet _ selectors _) = concatMap (scanForSpread lib' root) selectors+scanForSpread _ _ (_, RawField {})                          = []+scanForSpread _ _ (_, Spread value pos)                     = [EnhancedKey value pos]++validateFragment :: TypeLib -> GQLQueryRoot -> (Text, Fragment) -> Validation NodeEdges+validateFragment lib' root (fName, Fragment {content = selection, target = target', position = position'}) =+  existsObjectType position' target' lib' >>+  pure (EnhancedKey fName position', concatMap (scanForSpread lib' root) selection)++validateFragments :: TypeLib -> GQLQueryRoot -> Validation ()+validateFragments lib root = mapM (validateFragment lib root) (M.toList $ fragments root) >>= detectLoopOnFragments++detectLoopOnFragments :: Graph -> Validation ()+detectLoopOnFragments lib = mapM_ checkFragment lib+  where+    checkFragment (fragmentID, _) = checkForCycle lib fragmentID [fragmentID]++checkForCycle :: Graph -> Node -> [Node] -> Validation Graph+checkForCycle lib parentNode history =+  case lookup parentNode lib of+    Just node -> concat <$> mapM checkNode node+    Nothing   -> pure []+  where+    checkNode x =+      if x `elem` history+        then cycleError x+        else recurse x+    recurse node = checkForCycle lib node $ history ++ [node]+    cycleError n = Left $ cannotSpreadWithinItself $ history ++ [n]
+ src/Data/Morpheus/PreProcess/Input/Enum.hs view
@@ -0,0 +1,16 @@+{-# LANGUAGE TypeOperators #-}++module Data.Morpheus.PreProcess.Input.Enum+  ( validateEnum+  ) where++import           Data.List                  (elem)+import           Data.Morpheus.Types.JSType (JSType (..))+import           Data.Text                  (Text)++validateEnum :: error -> [Text] -> JSType -> Either error JSType+validateEnum error' tags' (JSEnum enumValue) =+  if enumValue `elem` tags'+    then pure (JSEnum enumValue)+    else Left error'+validateEnum error' _ _ = Left error'
+ src/Data/Morpheus/PreProcess/Input/Object.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE OverloadedStrings #-}++module Data.Morpheus.PreProcess.Input.Object+  ( validateInputObject+  , validateInput+  ) where++import           Data.Morpheus.Error.Input           (InputError (..), InputValidation, Prop (..))+import           Data.Morpheus.PreProcess.Input.Enum (validateEnum)+import           Data.Morpheus.PreProcess.Utils      (lookupField, lookupType)+import           Data.Morpheus.Schema.Internal.Types (Core (..), Field (..), GObject (..), InputField (..), InputObject,+                                                      InputType, Leaf (..), TypeLib (..))+import qualified Data.Morpheus.Schema.Internal.Types as T (InternalType (..))+import           Data.Morpheus.Types.JSType          (JSType (..), ScalarValue (..))+import           Data.Text                           (Text)++generateError :: JSType -> Text -> [Prop] -> InputError+generateError jsType expected' path' = UnexpectedType path' expected' jsType++existsInputObjectType :: InputError -> TypeLib -> Text -> InputValidation InputObject+existsInputObjectType error' lib' = lookupType error' (inputObject lib')++existsLeafType :: InputError -> TypeLib -> Text -> InputValidation Leaf+existsLeafType error' lib' = lookupType error' (leaf lib')++validateScalarTypes :: Text -> ScalarValue -> [Prop] -> InputValidation ScalarValue+validateScalarTypes "String" (String x)   = pure . const (String x)+validateScalarTypes "String" scalar       = Left . generateError (Scalar scalar) "String"+validateScalarTypes "Int" (Int x)         = pure . const (Int x)+validateScalarTypes "Int" scalar          = Left . generateError (Scalar scalar) "Int"+validateScalarTypes "Boolean" (Boolean x) = pure . const (Boolean x)+validateScalarTypes "Boolean" scalar      = Left . generateError (Scalar scalar) "Boolean"+validateScalarTypes _ scalar              = pure . const scalar++validateEnumType :: Text -> [Text] -> JSType -> [Prop] -> InputValidation JSType+validateEnumType expected' tags jsType props = validateEnum (UnexpectedType props expected' jsType) tags jsType++validateLeaf :: Leaf -> JSType -> [Prop] -> InputValidation JSType+validateLeaf (LEnum tags core) jsType props      = validateEnumType (name core) tags jsType props+validateLeaf (LScalar core) (Scalar found) props = Scalar <$> validateScalarTypes (name core) found props+validateLeaf (LScalar core) jsType props         = Left $ generateError jsType (name core) props++validateInputObject :: [Prop] -> TypeLib -> GObject InputField-> (Text, JSType) -> InputValidation (Text, JSType)+validateInputObject prop' lib' (GObject parentFields _) (_name, JSObject fields) = do+  fieldTypeName' <- fieldType . unpackInputField <$> lookupField _name parentFields (UnknownField prop' _name)+  let currentProp = prop' ++ [Prop _name fieldTypeName']+  let error' = generateError (JSObject fields) fieldTypeName' currentProp+  inputObject' <- existsInputObjectType error' lib' fieldTypeName'+  mapM (validateInputObject currentProp lib' inputObject') fields >>= \x -> pure (_name, JSObject x)+validateInputObject prop' lib' (GObject parentFields _) (_name, jsType) = do+  fieldTypeName' <- fieldType . unpackInputField <$> lookupField _name parentFields (UnknownField prop' _name)+  let currentProp = prop' ++ [Prop _name fieldTypeName']+  let error' = generateError jsType fieldTypeName' currentProp+  fieldType' <- existsLeafType error' lib' fieldTypeName'+  validateLeaf fieldType' jsType currentProp >> pure (_name, jsType)++validateInput :: TypeLib -> InputType -> (Text, JSType) -> InputValidation JSType+validateInput typeLib (T.Object oType) (_, JSObject fields) =+  JSObject <$> mapM (validateInputObject [] typeLib oType) fields+validateInput _ (T.Object (GObject _ core)) (_, jsType) = Left $ generateError jsType (name core) []+validateInput _ (T.Scalar core) (_, jsValue) = validateLeaf (LScalar core) jsValue []+validateInput _ (T.Enum tags core) (_, jsValue) = validateLeaf (LEnum tags core) jsValue []
+ src/Data/Morpheus/PreProcess/PreProcess.hs view
@@ -0,0 +1,72 @@+{-# LANGUAGE FlexibleInstances   #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeOperators       #-}++module Data.Morpheus.PreProcess.PreProcess+  ( preProcessQuery+  ) where++import           Data.Map                                         (fromList)+import           Data.Morpheus.Error.Mutation                     (mutationIsNotDefined)+import           Data.Morpheus.PreProcess.Fragment                (validateFragments)+import           Data.Morpheus.PreProcess.Resolve.ResolveRawQuery (resolveRawQuery)+import           Data.Morpheus.PreProcess.Validate.Validate       (mapSelectorValidation)+import           Data.Morpheus.PreProcess.Variable                (allVariableReferences, resolveOperationVariables)+import           Data.Morpheus.Schema.Internal.Types              (GObject (..), ObjectField (..), OutputObject,+                                                                   TypeLib (..))+import qualified Data.Morpheus.Schema.Internal.Types              as SC (Field (..))+import           Data.Morpheus.Schema.TypeKind                    (TypeKind (..))+import           Data.Morpheus.Types.Error                        (Validation)+import           Data.Morpheus.Types.Query.Operator               (Operator (..), RawOperator, ValidOperator,+                                                                   VariableDefinitions)+import           Data.Morpheus.Types.Query.RawSelection           (RawSelectionSet)+import           Data.Morpheus.Types.Query.Selection              (SelectionSet)+import           Data.Morpheus.Types.Types                        (GQLQueryRoot (..))+import           Data.Text                                        (Text)++updateQuery :: RawOperator -> SelectionSet -> ValidOperator+updateQuery (Query name' _ _ pos) sel    = Query name' [] sel pos+updateQuery (Mutation name' _ _ pos) sel = Mutation name' [] sel pos++fieldSchema :: [(Text, ObjectField)]+fieldSchema =+  [ ( "__schema"+    , ObjectField+        { args = []+        , fieldContent =+            SC.Field+              { SC.fieldName = "__schema"+              , SC.notNull = True+              , SC.asList = False+              , SC.kind = OBJECT+              , SC.fieldType = "__Schema"+              }+        })+  ]++setFieldSchema :: GObject ObjectField -> GObject ObjectField+setFieldSchema (GObject fields core) = GObject (fields ++ fieldSchema) core++getOperator :: RawOperator -> TypeLib -> Validation (OutputObject, VariableDefinitions, RawSelectionSet)+getOperator (Query _ args' sel _) lib' = pure (snd $ query lib', args', sel)+getOperator (Mutation _ args' sel position') lib' =+  case mutation lib' of+    Just (_, mutation') -> pure (mutation', args', sel)+    Nothing             -> Left $ mutationIsNotDefined position'++resolveValues :: TypeLib -> GQLQueryRoot -> Validation (OutputObject, SelectionSet)+resolveValues typesLib root = do+  (query', args', rawSel) <- getOperator (queryBody root) typesLib+  variables' <-+    resolveOperationVariables typesLib (fromList $ inputVariables root) (allVariableReferences [rawSel]) args'+  validateFragments typesLib root+  let operator' = setFieldSchema query'+  selection' <- resolveRawQuery typesLib (fragments root) variables' rawSel operator'+  pure (operator', selection')++preProcessQuery :: TypeLib -> GQLQueryRoot -> Validation ValidOperator+preProcessQuery lib' root' = do+  (operatorType', selection') <- resolveValues lib' root'+  selectors <- mapSelectorValidation lib' operatorType' selection'+  pure $ updateQuery (queryBody root') selectors
+ src/Data/Morpheus/PreProcess/Resolve/Arguments.hs view
@@ -0,0 +1,12 @@+module Data.Morpheus.PreProcess.Resolve.Arguments+  ( resolveArguments+  ) where++import           Data.Morpheus.PreProcess.Variable      (resolveArgumentValue)+import           Data.Morpheus.Types.Error              (Validation)+import qualified Data.Morpheus.Types.Query.RawSelection as Raw (RawArguments)+import           Data.Morpheus.Types.Query.Selection    (Arguments)+import           Data.Morpheus.Types.Types              (Variables)++resolveArguments :: Variables -> Raw.RawArguments -> Validation Arguments+resolveArguments variables' = mapM (resolveArgumentValue variables')
+ src/Data/Morpheus/PreProcess/Resolve/ResolveRawQuery.hs view
@@ -0,0 +1,33 @@+module Data.Morpheus.PreProcess.Resolve.ResolveRawQuery+  ( resolveRawQuery+  ) where++import           Data.Morpheus.PreProcess.Resolve.Arguments (resolveArguments)+import           Data.Morpheus.PreProcess.Resolve.Spread    (resolveSpread)+import           Data.Morpheus.PreProcess.Selection         (lookupSelectionObjectFieldType)+import           Data.Morpheus.Schema.Internal.Types        (GObject (..), ObjectField (..), OutputObject, TypeLib (..))+import           Data.Morpheus.Types.Error                  (Validation)+import           Data.Morpheus.Types.Query.Fragment         (FragmentLib)+import           Data.Morpheus.Types.Query.RawSelection     (RawSelection (..), RawSelectionSet)+import           Data.Morpheus.Types.Query.Selection        (Selection (..), SelectionSet)+import           Data.Morpheus.Types.Types                  (Variables)+import           Data.Text                                  (Text)++resolveVariableAndSpread ::+     TypeLib -> FragmentLib -> Variables -> GObject ObjectField -> (Text, RawSelection) -> Validation SelectionSet+resolveVariableAndSpread lib' fragments' variables' parent' (key', RawSelectionSet rawArgs rawSelectors position') = do+  fieldType' <- lookupSelectionObjectFieldType position' key' lib' parent'+  args' <- resolveArguments variables' rawArgs+  sel <- concat <$> mapM (resolveVariableAndSpread lib' fragments' variables' fieldType') rawSelectors+  pure [(key', SelectionSet args' sel position')]+resolveVariableAndSpread _ _ variables' _ (sKey, RawField rawArgs field sPos) = do+  args' <- resolveArguments variables' rawArgs+  pure [(sKey, Field args' field sPos)]+resolveVariableAndSpread lib' fragments' variables' parent' (spreadID, Spread _ sPos) =+  concat <$> (resolveSpread fragments' parent' sPos spreadID >>= recursiveResolve)+  where+    recursiveResolve = mapM (resolveVariableAndSpread lib' fragments' variables' parent')++resolveRawQuery :: TypeLib -> FragmentLib -> Variables -> RawSelectionSet -> OutputObject -> Validation SelectionSet+resolveRawQuery lib' fragments' variables' sel query' =+  concat <$> mapM (resolveVariableAndSpread lib' fragments' variables' query') sel
+ src/Data/Morpheus/PreProcess/Resolve/Spread.hs view
@@ -0,0 +1,36 @@+module Data.Morpheus.PreProcess.Resolve.Spread+  ( getFragment+  , castFragmentType+  , resolveSpread+  ) where++import qualified Data.Map                               as M (lookup)+import           Data.Morpheus.Error.Spread             (cannotBeSpreadOnType, unknownFragment)+import           Data.Morpheus.Schema.Internal.Types    (Core (..), GObject (..), ObjectField (..))+import           Data.Morpheus.Types.Error              (Validation)+import           Data.Morpheus.Types.MetaInfo           (MetaInfo (..), Position)+import qualified Data.Morpheus.Types.MetaInfo           as Meta (MetaInfo (..))+import           Data.Morpheus.Types.Query.Fragment     (Fragment (..), FragmentLib)+import           Data.Morpheus.Types.Query.RawSelection (RawSelectionSet)+import           Data.Text                              (Text)++getFragment :: Position -> Text -> FragmentLib -> Validation Fragment+getFragment position' id' lib =+  case M.lookup id' lib of+    Nothing       -> Left $ unknownFragment id' position'+    Just fragment -> pure fragment++castFragmentType :: MetaInfo -> GObject ObjectField -> Fragment -> Validation Fragment+castFragmentType spreadMeta (GObject _ core) fragment =+  if name core == target fragment+    then pure fragment+    else Left $ cannotBeSpreadOnType (spreadMeta {typeName = target fragment}) (name core)++resolveSpread :: FragmentLib -> GObject ObjectField -> Position -> Text -> Validation RawSelectionSet+resolveSpread fragments' parentType' position' id' = content <$> (getFragment position' id' fragments' >>= cast)+  where+    cast fragment' =+      castFragmentType+        (MetaInfo {Meta.position = position', Meta.key = id', Meta.typeName = target fragment'})+        parentType'+        fragment'
+ src/Data/Morpheus/PreProcess/Selection.hs view
@@ -0,0 +1,51 @@+module Data.Morpheus.PreProcess.Selection+  ( lookupFieldAsSelectionSet+  , lookupSelectionObjectFieldType+  , mustBeObject+  , notObject+  , lookupSelectionField+  ) where++import           Data.Morpheus.Error.Selection       (cannotQueryField, hasNoSubfields, subfieldsNotSelected)+import           Data.Morpheus.PreProcess.Utils      (lookupField, lookupType)+import           Data.Morpheus.Schema.Internal.Types (Core (..), Field (..), GObject (..), ObjectField (..),+                                                      OutputObject, TypeLib (..))+import           Data.Morpheus.Schema.TypeKind       (TypeKind (..))+import           Data.Morpheus.Types.Error           (Validation)+import           Data.Morpheus.Types.MetaInfo        (MetaInfo (..), Position)+import           Data.Text                           (Text)++isObjectKind :: ObjectField -> Bool+isObjectKind (ObjectField _ field') = OBJECT == kind field'++mustBeObject :: (Text, Position) -> ObjectField -> Validation ObjectField+mustBeObject (key', position') field' =+  if isObjectKind field'+    then pure field'+    else Left $ hasNoSubfields meta+  where+    meta = MetaInfo {position = position', key = key', typeName = fieldType $ fieldContent field'}++notObject :: (Text, Position) -> ObjectField -> Validation ObjectField+notObject (key', position') field' =+  if isObjectKind field'+    then Left $ subfieldsNotSelected meta+    else pure field'+  where+    meta = MetaInfo {position = position', key = key', typeName = fieldType $ fieldContent field'}++lookupFieldAsSelectionSet :: Position -> Text -> TypeLib -> ObjectField -> Validation OutputObject+lookupFieldAsSelectionSet position' key' lib' field' = lookupType error' (object lib') type'+  where+    error' = hasNoSubfields $ MetaInfo {position = position', key = key', typeName = type'}+    type' = fieldType $ fieldContent field'++lookupSelectionField :: Position -> Text -> GObject ObjectField -> Validation ObjectField+lookupSelectionField position' key' (GObject fields' core') = lookupField key' fields' error'+  where+    error' = cannotQueryField $ MetaInfo {position = position', key = key', typeName = name core'}++lookupSelectionObjectFieldType :: Position -> Text -> TypeLib -> GObject ObjectField -> Validation OutputObject+lookupSelectionObjectFieldType position' key' lib' object' =+  lookupSelectionField position' key' object' >>= mustBeObject (key', position') >>=+  lookupFieldAsSelectionSet position' key' lib'
+ src/Data/Morpheus/PreProcess/Utils.hs view
@@ -0,0 +1,69 @@+module Data.Morpheus.PreProcess.Utils+  ( differKeys+  , existsObjectType+  , lookupType+  , getInputType+  , lookupField+  , checkNameCollision+  , checkForUnknownKeys+  ) where++import           Data.List                           ((\\))+import           Data.Morpheus.Error.Variable        (unknownType)+import           Data.Morpheus.Schema.Internal.Types (InputType, InternalType (..), Leaf (..), OutputObject,+                                                      TypeLib (..))+import           Data.Morpheus.Types.Core            (EnhancedKey (..), Key, enhanceKeyWithNull)+import           Data.Morpheus.Types.Error           (Validation)+import           Data.Morpheus.Types.MetaInfo        (Position)+import qualified Data.Set                            as S+import           Data.Text                           (Text)++type GenError error a = error -> Either error a++lookupType :: error -> [(Text, a)] -> Text -> Either error a+lookupType error' lib' typeName' =+  case lookup typeName' lib' of+    Nothing -> Left error'+    Just x  -> pure x++lookupField :: Text -> [(Text, fType)] -> GenError error fType+lookupField id' lib' error' =+  case lookup id' lib' of+    Nothing    -> Left error'+    Just field -> pure field++getInputType :: Text -> TypeLib -> GenError error InputType+getInputType typeName' lib error' =+  case lookup typeName' (inputObject lib) of+    Just x -> pure (Object x)+    Nothing ->+      case lookup typeName' (leaf lib) of+        Nothing          -> Left error'+        Just (LScalar x) -> pure (Scalar x)+        Just (LEnum x y) -> pure (Enum x y)++existsObjectType :: Position -> Text -> TypeLib -> Validation OutputObject+existsObjectType position' typeName' lib = lookupType error' (object lib) typeName'+  where+    error' = unknownType typeName' position'++differKeys :: [EnhancedKey] -> [Key] -> [EnhancedKey]+differKeys enhanced keys = enhanced \\ map enhanceKeyWithNull keys++removeDuplicates :: Ord a => [a] -> [a]+removeDuplicates = S.toList . S.fromList++elementOfKeys :: [Text] -> EnhancedKey -> Bool+elementOfKeys keys' EnhancedKey {uid = id'} = id' `elem` keys'++checkNameCollision :: [EnhancedKey] -> [Text] -> ([EnhancedKey] -> error) -> Either error [EnhancedKey]+checkNameCollision enhancedKeys' keys' errorGenerator' =+  case differKeys enhancedKeys' (removeDuplicates keys') of+    []          -> pure enhancedKeys'+    duplicates' -> Left $ errorGenerator' duplicates'++checkForUnknownKeys :: [EnhancedKey] -> [Text] -> ([EnhancedKey] -> error) -> Either error [EnhancedKey]+checkForUnknownKeys enhancedKeys' keys' errorGenerator' =+  case filter (not . elementOfKeys keys') enhancedKeys' of+    []           -> pure enhancedKeys'+    unknownKeys' -> Left $ errorGenerator' unknownKeys'
+ src/Data/Morpheus/PreProcess/Validate/Arguments.hs view
@@ -0,0 +1,50 @@+module Data.Morpheus.PreProcess.Validate.Arguments+  ( validateArguments+  ) where++import           Data.Morpheus.Error.Arguments         (argumentGotInvalidValue, argumentNameCollision,+                                                        undefinedArgument, unknownArguments)+import           Data.Morpheus.Error.Input             (InputValidation, inputErrorMessage)+import           Data.Morpheus.Error.Internal          (internalUnknownTypeMessage)+import           Data.Morpheus.PreProcess.Input.Object (validateInput)+import           Data.Morpheus.PreProcess.Utils        (checkForUnknownKeys, checkNameCollision, getInputType)+import           Data.Morpheus.Schema.Internal.Types   (Field (..), InputField (..), ObjectField (..), TypeLib)+import           Data.Morpheus.Types.Core              (EnhancedKey (..))+import           Data.Morpheus.Types.Error             (Validation)+import           Data.Morpheus.Types.JSType            (JSType (JSNull))+import           Data.Morpheus.Types.MetaInfo          (Position)+import           Data.Morpheus.Types.Query.Selection   (Argument (..), Arguments)+import           Data.Text                             (Text)++handleInputError :: Text -> Int -> InputValidation a -> Validation ()+handleInputError key' position' (Left error') = Left $ argumentGotInvalidValue key' (inputErrorMessage error') position'+handleInputError _ _ _ = pure ()++validateArgumentValue :: TypeLib -> Text -> (Text, Argument) -> Validation (Text, Argument)+validateArgumentValue lib' typeID' (key', Argument value' position') =+  getInputType typeID' lib' (internalUnknownTypeMessage typeID') >>= checkType >> pure (key', Argument value' position')+  where+    checkType type' = handleInputError key' position' (validateInput lib' type' (key', value'))++validateArgument :: TypeLib -> Position -> Arguments -> (Text, InputField) -> Validation (Text, Argument)+validateArgument types position' requestArgs (key', InputField arg) =+  case lookup key' requestArgs of+    Nothing ->+      if notNull arg+        then Left $ undefinedArgument (EnhancedKey key' position')+        else pure (key', Argument JSNull position')+    Just (Argument value pos) -> validateArgumentValue types (fieldType arg) (key', Argument value pos)++checkForUnknownArguments :: (Text, ObjectField) -> Arguments -> Validation [(Text, InputField)]+checkForUnknownArguments (fieldKey', ObjectField fieldArgs _) args' =+  checkForUnknownKeys enhancedKeys' fieldKeys error' >> checkNameCollision enhancedKeys' fieldKeys argumentNameCollision >>+  pure fieldArgs+  where+    error' = unknownArguments fieldKey'+    enhancedKeys' = map argToKey args'+    argToKey (key', Argument _ pos) = EnhancedKey key' pos+    fieldKeys = map fst fieldArgs++validateArguments :: TypeLib -> (Text, ObjectField) -> Position -> Arguments -> Validation Arguments+validateArguments typeLib inputs pos args' =+  checkForUnknownArguments inputs args' >>= mapM (validateArgument typeLib pos args')
+ src/Data/Morpheus/PreProcess/Validate/Validate.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE FlexibleInstances   #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeOperators       #-}++module Data.Morpheus.PreProcess.Validate.Validate+  ( mapSelectorValidation+  ) where++import           Data.Morpheus.Error.Selection               (duplicateQuerySelections)+import           Data.Morpheus.PreProcess.Selection          (lookupFieldAsSelectionSet, lookupSelectionField,+                                                              mustBeObject, notObject)+import           Data.Morpheus.PreProcess.Utils              (checkNameCollision)+import           Data.Morpheus.PreProcess.Validate.Arguments (validateArguments)+import           Data.Morpheus.Schema.Internal.Types         (Core (..), GObject (..), ObjectField (..), TypeLib (..))+import           Data.Morpheus.Types.Core                    (EnhancedKey (..))+import           Data.Morpheus.Types.Error                   (Validation)+import           Data.Morpheus.Types.Query.Selection         (Selection (..), SelectionSet)+import           Data.Text                                   (Text)++selToKey :: (Text, Selection) -> EnhancedKey+selToKey (sName, Field _ _ pos)        = EnhancedKey sName pos+selToKey (sName, SelectionSet _ _ pos) = EnhancedKey sName pos++checkDuplicatesOn :: GObject ObjectField -> SelectionSet -> Validation SelectionSet+checkDuplicatesOn (GObject _ core) keys = checkNameCollision enhancedKeys (map fst keys) error' >> pure keys+  where+    error' = duplicateQuerySelections (name core)+    enhancedKeys = map selToKey keys++validateBySchema :: TypeLib -> GObject ObjectField -> (Text, Selection) -> Validation (Text, Selection)+validateBySchema lib' parent' (key', SelectionSet args' selectors position') = do+  field' <- lookupSelectionField position' key' parent' >>= mustBeObject (key', position')+  fieldType' <- lookupFieldAsSelectionSet position' key' lib' field'+  arguments' <- validateArguments lib' (key', field') position' args'+  selectorsQS <- mapSelectorValidation lib' fieldType' selectors+  pure (key', SelectionSet arguments' selectorsQS position')+validateBySchema lib' parent' (key', Field args' field position') = do+  field' <- lookupSelectionField position' key' parent' >>= notObject (key', position')+  arguments' <- validateArguments lib' (key', field') position' args'+  pure (key', Field arguments' field position')++mapSelectorValidation :: TypeLib -> GObject ObjectField -> SelectionSet -> Validation SelectionSet+mapSelectorValidation typeLib type' selectors =+  checkDuplicatesOn type' selectors >>= mapM (validateBySchema typeLib type')
+ src/Data/Morpheus/PreProcess/Variable.hs view
@@ -0,0 +1,86 @@+{-# LANGUAGE OverloadedStrings #-}++module Data.Morpheus.PreProcess.Variable+  ( resolveOperationVariables+  , resolveArgumentValue+  , allVariableReferences+  ) where++import           Data.List                              ((\\))+import qualified Data.Map                               as M (fromList, lookup)+import           Data.Morpheus.Error.Input              (InputValidation, inputErrorMessage)+import           Data.Morpheus.Error.Variable           (undefinedVariable, uninitializedVariable, unknownType,+                                                         unusedVariables, variableGotInvalidValue)+import           Data.Morpheus.PreProcess.Input.Object  (validateInput)+import           Data.Morpheus.PreProcess.Utils         (getInputType)+import           Data.Morpheus.Schema.Internal.Types    (InputType, TypeLib)+import           Data.Morpheus.Types.Core               (EnhancedKey (..))+import           Data.Morpheus.Types.Error              (Validation)+import           Data.Morpheus.Types.JSType             (JSType (..))+import           Data.Morpheus.Types.MetaInfo           (Position)+import           Data.Morpheus.Types.Query.Operator     (Variable (..))+import           Data.Morpheus.Types.Query.RawSelection (RawArgument (..), RawSelection (..), RawSelectionSet)+import qualified Data.Morpheus.Types.Query.Selection    as Valid (Argument (..))+import           Data.Morpheus.Types.Types              (Variables)+import           Data.Text                              (Text)++getVariableType :: Text -> Position -> TypeLib -> Validation InputType+getVariableType type' position' lib' = getInputType type' lib' error'+  where+    error' = unknownType type' position'++lookupVariable :: Variables -> Text -> (Text -> error) -> Either error JSType+lookupVariable variables' key' error' =+  case M.lookup key' variables' of+    Nothing    -> Left $ error' key'+    Just value -> pure value++getVariable :: Position -> Variables -> Text -> Validation JSType+getVariable position' variables' key' = lookupVariable variables' key' (undefinedVariable "Query" position')++lookupBodyValue :: Position -> Variables -> Text -> Validation JSType+lookupBodyValue position' variables' key' = lookupVariable variables' key' (uninitializedVariable position')++handleInputError :: Text -> Int -> InputValidation JSType -> Validation (Text, JSType)+handleInputError key' position' (Left error') = Left $ variableGotInvalidValue key' (inputErrorMessage error') position'+handleInputError key' _ (Right value') = pure (key', value')++lookupAndValidateValueOnBody :: TypeLib -> Variables -> (Text, Variable) -> Validation (Text, JSType)+lookupAndValidateValueOnBody typeLib root (key', Variable type' pos) = getVariableType type' pos typeLib >>= checkType+  where+    checkType _type = do+      variableValue <- lookupBodyValue pos root key'+      handleInputError key' pos $ validateInput typeLib _type (key', variableValue)++resolveOperationVariables :: TypeLib -> Variables -> [EnhancedKey] -> [(Text, Variable)] -> Validation Variables+resolveOperationVariables typeLib root references' variables' = do+  checkUnusedVariable references' variables'+  M.fromList <$> mapM (lookupAndValidateValueOnBody typeLib root) variables'++varToKey :: (Text, Variable) -> EnhancedKey+varToKey (key', Variable _ position') = EnhancedKey key' position'++checkUnusedVariable :: [EnhancedKey] -> [(Text, Variable)] -> Validation ()+checkUnusedVariable references' variables' =+  case map varToKey variables' \\ references' of+    []      -> pure ()+    unused' -> Left $ unusedVariables unused'++allVariableReferences :: [RawSelectionSet] -> [EnhancedKey]+allVariableReferences = concatMap (concatMap searchReferencesIn)++referencesFromArgument :: (Text, RawArgument) -> [EnhancedKey]+referencesFromArgument (_, Argument _ _)                       = []+referencesFromArgument (_, VariableReference value' position') = [EnhancedKey value' position']++searchReferencesIn :: (Text, RawSelection) -> [EnhancedKey]+searchReferencesIn (_, RawSelectionSet rawArgs rawSelectors _) =+  concatMap referencesFromArgument rawArgs ++ concatMap searchReferencesIn rawSelectors+searchReferencesIn (_, RawField rawArgs _ _) = concatMap referencesFromArgument rawArgs+searchReferencesIn (_, Spread _ _) = []++resolveArgumentValue :: Variables -> (Text, RawArgument) -> Validation (Text, Valid.Argument)+resolveArgumentValue root (key', VariableReference variableID pos) = do+  value <- getVariable pos root variableID+  pure (key', Valid.Argument value pos)+resolveArgumentValue _ (key', Argument value pos) = pure (key', Valid.Argument value pos)
+ src/Data/Morpheus/Schema/Directive.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric      #-}+{-# LANGUAGE TypeOperators      #-}++module Data.Morpheus.Schema.Directive+  ( Directive(..)+  ) where++import           Data.Data                              (Data)+import           Data.Morpheus.Schema.DirectiveLocation (DirectiveLocation)+import           Data.Morpheus.Schema.Utils.Utils       (InputValue)+import           Data.Morpheus.Types.Describer          (EnumOf (..))+import           Data.Text                              (Text)+import           GHC.Generics++data Directive = Directive+  { name        :: Text+  , description :: Maybe Text+  , locations   :: [EnumOf DirectiveLocation]+  , args        :: [InputValue]+  } deriving (Show, Data, Generic)
+ src/Data/Morpheus/Schema/DirectiveLocation.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric      #-}++module Data.Morpheus.Schema.DirectiveLocation+  ( DirectiveLocation(..)+  ) where++import           Data.Data    (Data)+import           GHC.Generics++data DirectiveLocation+  = QUERY+  | MUTATION+  | SUBSCRIPTION+  | FIELD+  | FRAGMENT_DEFINITION+  | FRAGMENT_SPREAD+  | INLINE_FRAGMENT+  | SCHEMA+  | SCALAR+  | OBJECT+  | FIELD_DEFINITION+  | ARGUMENT_DEFINITION+  | INTERFACE+  | UNION+  | ENUM+  | ENUM_VALUE+  | INPUT_OBJECT+  | INPUT_FIELD_DEFINITION+  deriving (Show, Data, Generic)
+ src/Data/Morpheus/Schema/EnumValue.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric      #-}++module Data.Morpheus.Schema.EnumValue+  ( EnumValue(..)+  , createEnumValue+  , isEnumOf+  ) where++import           Data.Data    (Data)+import           Data.Text    (Text)+import           GHC.Generics++data EnumValue = EnumValue+  { name              :: Text+  , description       :: Maybe Text+  , isDeprecated      :: Bool+  , deprecationReason :: Maybe Text+  } deriving (Show, Data, Generic)++createEnumValue :: Text -> EnumValue+createEnumValue enumName =+  EnumValue {name = enumName, description = Nothing, isDeprecated = False, deprecationReason = Nothing}++isEnumValue :: Text -> EnumValue -> Bool+isEnumValue inpName enum = inpName == name enum++isEnumOf :: Text -> [EnumValue] -> Bool+isEnumOf enumName enumValues =+  case filter (isEnumValue enumName) enumValues of+    [] -> False+    _  -> True
+ src/Data/Morpheus/Schema/Field.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric      #-}++module Data.Morpheus.Schema.Field where++import           Data.Data                       (Data)+import           Data.Morpheus.Schema.InputValue (InputValue)+import           Data.Text                       (Text)+import           GHC.Generics++data Field t = Field+  { name              :: Text+  , description       :: Maybe Text+  , args              :: [InputValue t]+  , _type             :: t+  , isDeprecated      :: Bool+  , deprecationReason :: Maybe Text+  } deriving (Show, Data, Generic)++createFieldWith :: Text -> a -> [InputValue a] -> Field a+createFieldWith _name fieldType fieldArgs =+  Field+    { name = _name+    , description = Nothing+    , args = fieldArgs+    , _type = fieldType+    , isDeprecated = False+    , deprecationReason = Nothing+    }
+ src/Data/Morpheus/Schema/InputValue.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric      #-}++module Data.Morpheus.Schema.InputValue+  ( InputValue(..)+  , createInputValueWith+  ) where++import           Data.Data    (Data)+import           Data.Text    (Text)+import           GHC.Generics++data InputValue t = InputValue+  { name         :: Text+  , description  :: Maybe Text+  , _type        :: t+  , defaultValue :: Maybe Text+  } deriving (Show, Data, Generic)++createInputValueWith :: Text -> a -> InputValue a+createInputValueWith _name ofType =+  InputValue {name = _name, description = Nothing, _type = ofType, defaultValue = Nothing}
+ src/Data/Morpheus/Schema/Internal/Types.hs view
@@ -0,0 +1,100 @@+module Data.Morpheus.Schema.Internal.Types+  ( OutputType+  , InternalType(..)+  , Core(..)+  , Field(..)+  , ObjectField(..)+  , InputType+  , InputField(..)+  , TypeLib(..)+  , GObject(..)+  , Leaf(..)+  , InputObject+  , OutputObject+  , isTypeDefined+  , initTypeLib+  , defineType+  , LibType(..)+  ) where++import           Data.Morpheus.Schema.TypeKind (TypeKind)+import           Data.Text                     (Text)++type EnumValue = Text++newtype InputField = InputField+  { unpackInputField :: Field+  }++data Core = Core+  { name            :: Text+  , typeDescription :: Text+  }++data Field = Field+  { fieldName :: Text+  , notNull   :: Bool+  , kind      :: TypeKind+  , fieldType :: Text+  , asList    :: Bool+  }++data ObjectField = ObjectField+  { args         :: [(Text, InputField)]+  , fieldContent :: Field+  }++data GObject a =+  GObject [(Text, a)]+          Core++data InternalType a+  = Scalar Core+  | Enum [EnumValue]+         Core+  | Object (GObject a)++type OutputType = InternalType ObjectField++type InputType = InternalType InputField++type InputObject = GObject InputField++type OutputObject = GObject ObjectField++data Leaf+  = LScalar Core+  | LEnum [EnumValue]+          Core++data TypeLib = TypeLib+  { leaf        :: [(Text, Leaf)]+  , inputObject :: [(Text, InputObject)]+  , object      :: [(Text, OutputObject)]+  , query       :: (Text, OutputObject)+  , mutation    :: Maybe (Text, OutputObject)+  }++initTypeLib :: (Text, OutputObject) -> TypeLib+initTypeLib query' = TypeLib {leaf = [], inputObject = [], query = query', object = [], mutation = Nothing}++data LibType+  = Leaf Leaf+  | InputObject InputObject+  | OutputObject OutputObject++mutationName :: Maybe (Text, OutputObject) -> [Text]+mutationName (Just (key', _)) = [key']+mutationName Nothing          = []++getAllTypeKeys :: TypeLib -> [Text]+getAllTypeKeys (TypeLib leaf' inputObject' object' (queryName, _) mutation') =+  [queryName] ++ map fst leaf' ++ map fst inputObject' ++ map fst object' ++ mutationName mutation'++isTypeDefined :: Text -> TypeLib -> Bool+isTypeDefined name' lib' = name' `elem` getAllTypeKeys lib'++defineType :: (Text, LibType) -> TypeLib -> TypeLib+defineType (key', Leaf type') lib         = lib {leaf = (key', type') : leaf lib}+defineType (key', InputObject type') lib  = lib {inputObject = (key', type') : inputObject lib}+defineType (key', OutputObject type') lib = lib {object = (key', type') : object lib}
+ src/Data/Morpheus/Schema/Schema.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric      #-}+{-# LANGUAGE OverloadedStrings  #-}++module Data.Morpheus.Schema.Schema where++import           Data.Data                           (Data)+import           Data.Morpheus.Schema.Directive      (Directive)+import           Data.Morpheus.Schema.Internal.Types (OutputObject, TypeLib (..))+import           Data.Morpheus.Schema.Utils.Utils    (Type, createObjectType, typeFromInputObject, typeFromLeaf,+                                                      typeFromObject)+import           Data.Text                           (Text)+import           GHC.Generics                        (Generic)++data Schema = Schema+  { types            :: [Type]+  , queryType        :: Type+  , mutationType     :: Maybe Type+  , subscriptionType :: Maybe Type+  , directives       :: [Directive]+  } deriving (Show, Data, Generic)++convertTypes :: TypeLib -> [Type]+convertTypes lib' =+  [typeFromObject $ query lib'] +++  typeFromMutation (mutation lib') +++  map typeFromObject (object lib') ++ map typeFromInputObject (inputObject lib') ++ map typeFromLeaf (leaf lib')++typeFromMutation :: Maybe (Text, OutputObject) -> [Type]+typeFromMutation (Just x) = [typeFromObject x]+typeFromMutation Nothing  = []++buildSchemaLinkType :: (Text, OutputObject) -> Type+buildSchemaLinkType (key', _) = createObjectType key' "Query Description" []++initSchema :: TypeLib -> Schema+initSchema types' =+  Schema+    { types = convertTypes types'+    , queryType = buildSchemaLinkType $ query types'+    , mutationType = buildSchemaLinkType <$> mutation types'+    , subscriptionType = Nothing+    , directives = []+    }
+ src/Data/Morpheus/Schema/Type.hs view
@@ -0,0 +1,33 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric      #-}+{-# LANGUAGE TypeOperators      #-}++module Data.Morpheus.Schema.Type+  ( Type(..)+  , DeprecationArgs(..)+  ) where++import           Data.Data                       (Data)+import           Data.Morpheus.Schema.EnumValue  (EnumValue)+import qualified Data.Morpheus.Schema.Field      as F (Field (..))+import qualified Data.Morpheus.Schema.InputValue as I (InputValue (..))+import           Data.Morpheus.Schema.TypeKind   (TypeKind)+import           Data.Morpheus.Types.Describer   (EnumOf, WithDeprecationArgs (..))+import           Data.Text                       (Text)+import           GHC.Generics                    (Generic)++data Type = Type+  { kind          :: EnumOf TypeKind+  , name          :: Maybe Text+  , description   :: Maybe Text+  , fields        :: Maybe (WithDeprecationArgs [F.Field Type])+  , ofType        :: Maybe Type+  , interfaces    :: Maybe [Type]+  , possibleTypes :: Maybe [Type]+  , enumValues    :: Maybe (WithDeprecationArgs [EnumValue])+  , inputFields   :: Maybe [I.InputValue Type]+  } deriving (Show, Data, Generic)++newtype DeprecationArgs = DeprecationArgs+  { includeDeprecated :: Maybe Bool+  } deriving (Show, Data, Generic)
+ src/Data/Morpheus/Schema/TypeKind.hs view
@@ -0,0 +1,20 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric      #-}++module Data.Morpheus.Schema.TypeKind+  ( TypeKind(..)+  ) where++import           Data.Data    (Data)+import           GHC.Generics++data TypeKind+  = SCALAR+  | OBJECT+  | INTERFACE+  | UNION+  | ENUM+  | INPUT_OBJECT+  | LIST+  | NON_NULL+  deriving (Show, Eq, Data, Generic)
+ src/Data/Morpheus/Schema/Utils/Utils.hs view
@@ -0,0 +1,122 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeOperators     #-}++module Data.Morpheus.Schema.Utils.Utils+  ( Type+  , Field+  , InputValue+  , createObjectType+  , typeFromObject+  , typeFromInputObject+  , typeFromLeaf+  ) where++import           Data.Morpheus.Schema.EnumValue      (EnumValue, createEnumValue)+import qualified Data.Morpheus.Schema.Field          as F (Field (..), createFieldWith)+import qualified Data.Morpheus.Schema.InputValue     as IN (InputValue (..), createInputValueWith)+import qualified Data.Morpheus.Schema.Internal.Types as I (Core (..), Field (..), GObject (..), InputField (..),+                                                           InputObject, Leaf (..), ObjectField (..), OutputObject)+import           Data.Morpheus.Schema.Type           (Type (..))+import           Data.Morpheus.Schema.TypeKind       (TypeKind (..))+import           Data.Morpheus.Types.Describer       (EnumOf (..), WithDeprecationArgs (..))+import           Data.Text                           (Text)++type InputValue = IN.InputValue Type++type Field = F.Field Type++inputValueFromArg :: (Text, I.InputField) -> InputValue+inputValueFromArg (key', input') = IN.createInputValueWith key' (createInputObjectType input')++createInputObjectType :: I.InputField -> Type+createInputObjectType (I.InputField field') = createType (I.kind field') (I.fieldType field') "" []++wrapNotNull :: I.ObjectField -> Type -> Type+wrapNotNull field' type' =+  if I.notNull $ I.fieldContent field'+    then wrapAs NON_NULL type'+    else type'++wrapList :: I.ObjectField -> Type -> Type+wrapList field' type' =+  if I.asList $ I.fieldContent field'+    then wrapAs LIST type'+    else type'++fieldFromObjectField :: (Text, I.ObjectField) -> Field+fieldFromObjectField (key', field') =+  F.createFieldWith key' (wrapNotNull field' $ wrapList field' $ createObjectType getType "" []) args'+  where+    getType = I.fieldType $ I.fieldContent field'+    args' = map inputValueFromArg $ I.args field'++typeFromLeaf :: (Text, I.Leaf) -> Type+typeFromLeaf (key', I.LScalar (I.Core _ desc'))     = createLeafType SCALAR key' desc' []+typeFromLeaf (key', I.LEnum tags' (I.Core _ desc')) = createLeafType ENUM key' desc' (map createEnumValue tags')++createLeafType :: TypeKind -> Text -> Text -> [EnumValue] -> Type+createLeafType kind' name' desc' enums' =+  Type+    { kind = EnumOf kind'+    , name = Just name'+    , description = Just desc'+    , fields = Nothing+    , ofType = Nothing+    , interfaces = Nothing+    , possibleTypes = Nothing+    , enumValues = Just $ WithDeprecationArgs enums'+    , inputFields = Nothing+    }++typeFromObject :: (Text, I.OutputObject) -> Type+typeFromObject (key', I.GObject fields' (I.Core _ description')) =+  createObjectType key' description' (map fieldFromObjectField fields')++typeFromInputObject :: (Text, I.InputObject) -> Type+typeFromInputObject (key', I.GObject fields' (I.Core _ description')) =+  createInputObject key' description' (map inputValueFromArg fields')++createObjectType :: Text -> Text -> [Field] -> Type+createObjectType = createType OBJECT++createInputObject :: Text -> Text -> [InputValue] -> Type+createInputObject name' desc' fields' =+  Type+    { kind = EnumOf INPUT_OBJECT+    , name = Just name'+    , description = Just desc'+    , fields = Just $ WithDeprecationArgs []+    , ofType = Nothing+    , interfaces = Nothing+    , possibleTypes = Nothing+    , enumValues = Nothing+    , inputFields = Just fields'+    }++createType :: TypeKind -> Text -> Text -> [Field] -> Type+createType kind' name' desc' fields' =+  Type+    { kind = EnumOf kind'+    , name = Just name'+    , description = Just desc'+    , fields = Just $ WithDeprecationArgs fields'+    , ofType = Nothing+    , interfaces = Just []+    , possibleTypes = Just []+    , enumValues = Just $ WithDeprecationArgs []+    , inputFields = Just []+    }++wrapAs :: TypeKind -> Type -> Type+wrapAs kind' contentType =+  Type+    { kind = EnumOf kind'+    , name = Nothing+    , description = Nothing+    , fields = Nothing+    , ofType = Just contentType+    , interfaces = Nothing+    , possibleTypes = Nothing+    , enumValues = Nothing+    , inputFields = Nothing+    }
+ src/Data/Morpheus/Types/Core.hs view
@@ -0,0 +1,24 @@+module Data.Morpheus.Types.Core+  ( Key+  , Collection+  , EnhancedKey(..)+  , enhanceKeyWithNull+  ) where++import           Data.Text (Text)++type Key = Text++type Collection a = [(Key, a)]++-- Text value that includes position for debugging, where EnhancedKey "a" 1 === EnhancedKey "a" 3+data EnhancedKey = EnhancedKey+  { uid      :: Text+  , location :: Int+  }++instance Eq EnhancedKey where+  (EnhancedKey id1 _) == (EnhancedKey id2 _) = id1 == id2++enhanceKeyWithNull :: Key -> EnhancedKey+enhanceKeyWithNull text = EnhancedKey {uid = text, location = 0}
+ src/Data/Morpheus/Types/Describer.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric      #-}+{-# LANGUAGE OverloadedStrings  #-}+{-# LANGUAGE TypeOperators      #-}++module Data.Morpheus.Types.Describer+  ( (::->)(..)+  , WithDeprecationArgs(..)+  , EnumOf(..)+  , ScalarOf(..)+  ) where++import           Data.Data    (Constr, Data, DataType, Fixity (Prefix), dataTypeOf, gfoldl, gunfold, mkConstr,+                               mkDataType, toConstr)+import           GHC.Generics (Generic)++newtype EnumOf a = EnumOf+  { unpackEnum :: a+  } deriving (Show, Generic, Data)++instance Functor EnumOf where+  fmap f (EnumOf x) = EnumOf (f x)++instance Applicative EnumOf where+  pure = EnumOf+  (<*>) (EnumOf x) y = x <$> y++newtype ScalarOf a = ScalarOf+  { unpackScalar :: a+  } deriving (Show, Generic, Data)++newtype WithDeprecationArgs a = WithDeprecationArgs+  { unpackDeprecationArgs :: a+  } deriving (Show, Generic, Data)++newtype a ::-> b =+  Resolver (a -> IO (Either String b))+  deriving (Generic)++instance Show (a ::-> b) where+  show _ = "Resolver"++instance (Data a, Data b) => Data (a ::-> b) where+  gfoldl _ z (Resolver _) = z (Resolver $ const undefined)+  gunfold _ z _ = z (Resolver $ const undefined)+  toConstr _ = conResolved+  dataTypeOf _ = tyResolver++conResolved :: Constr+conResolved = mkConstr tyResolver "Resolved" [] Prefix++tyResolver :: DataType+tyResolver = mkDataType "Module.Resolver" [conResolved]
+ src/Data/Morpheus/Types/Error.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric  #-}++module Data.Morpheus.Types.Error+  ( GQLError(..)+  , ErrorLocation(..)+  , GQLErrors+  , JSONError(..)+  , Validation+  , ResolveIO+  , failResolveIO+  ) where++import           Control.Monad.Trans.Except (ExceptT (..))+import           Data.Aeson                 (ToJSON)+import           Data.Text                  (Text)+import           GHC.Generics               (Generic)++data GQLError = GQLError+  { desc     :: Text+  , posIndex :: [Int]+  } deriving (Show)++type GQLErrors = [GQLError]++data ErrorLocation = ErrorLocation+  { line   :: Int+  , column :: Int+  } deriving (Show, Generic, ToJSON)++data JSONError = JSONError+  { message   :: Text+  , locations :: [ErrorLocation]+  } deriving (Show, Generic, ToJSON)++type Validation a = Either GQLErrors a++type ResolveIO = ExceptT GQLErrors IO++failResolveIO :: GQLErrors -> ResolveIO a+failResolveIO = ExceptT . pure . Left
+ src/Data/Morpheus/Types/JSType.hs view
@@ -0,0 +1,69 @@+{-# LANGUAGE DeriveGeneric     #-}+{-# LANGUAGE OverloadedStrings #-}++module Data.Morpheus.Types.JSType+  ( JSType(..)+  , ScalarValue(..)+  , decodeScientific+  ) where++import qualified Data.Aeson          as A (FromJSON (..), ToJSON (..), Value (..), pairs, (.=))+import qualified Data.HashMap.Strict as M (toList)+import           Data.Scientific     (Scientific, floatingOrInteger)+import           Data.Text           (Text)+import qualified Data.Vector         as V (toList)+import           GHC.Generics        (Generic)++replaceType :: Text -> Text+replaceType "_type" = "type"+replaceType x       = x++data ScalarValue+  = Int Int+  | Float Float+  | String Text+  | Boolean Bool+  deriving (Show, Generic)++instance A.ToJSON ScalarValue where+  toEncoding (Float x)   = A.toEncoding x+  toEncoding (Int x)     = A.toEncoding x+  toEncoding (Boolean x) = A.toEncoding x+  toEncoding (String x)  = A.toEncoding x++data JSType+  = JSObject [(Text, JSType)]+  | JSList [JSType]+  | JSEnum Text+  | Scalar ScalarValue+  | JSNull+  deriving (Show, Generic)++instance A.ToJSON JSType where+  toEncoding JSNull = A.toEncoding A.Null+  toEncoding (JSEnum x) = A.toEncoding x+  toEncoding (JSList x) = A.toEncoding x+  toEncoding (Scalar x) = A.toEncoding x+  toEncoding (JSObject x) = A.pairs $ foldl1 (<>) $ map encodeField x+    where+      encodeField (key, value) = replaceType key A..= value++replace :: (a, A.Value) -> (a, JSType)+replace (key, val) = (key, replaceValue val)++decodeScientific :: Scientific -> ScalarValue+decodeScientific v =+  case floatingOrInteger v of+    Left float -> Float float+    Right int  -> Int int++replaceValue :: A.Value -> JSType+replaceValue (A.Bool v)   = Scalar $ Boolean v+replaceValue (A.Number v) = Scalar $ decodeScientific v+replaceValue (A.String v) = Scalar $ String v+replaceValue (A.Object v) = JSObject $ map replace (M.toList v)+replaceValue (A.Array li) = JSList (map replaceValue (V.toList li))+replaceValue A.Null       = JSNull++instance A.FromJSON JSType where+  parseJSON = pure . replaceValue
+ src/Data/Morpheus/Types/MetaInfo.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE OverloadedStrings #-}++module Data.Morpheus.Types.MetaInfo+  ( MetaInfo(..)+  , initialMeta+  , Position+  , LineBreaks+  ) where++import           Data.Text (Text)++initialMeta :: MetaInfo+initialMeta = MetaInfo {position = 0, typeName = "", key = ""}++type LineBreaks = [Position]++type Position = Int++data MetaInfo = MetaInfo+  { position :: Position+  , typeName :: Text+  , key      :: Text+  }
+ src/Data/Morpheus/Types/Query/Fragment.hs view
@@ -0,0 +1,18 @@+module Data.Morpheus.Types.Query.Fragment+  ( Fragment(..)+  , FragmentLib+  ) where++import           Data.Map                               (Map)+import           Data.Morpheus.Types.Core               (Key)+import           Data.Morpheus.Types.MetaInfo           (Position)+import           Data.Morpheus.Types.Query.RawSelection (RawSelectionSet)++data Fragment = Fragment+  { key     :: Key+  , target  :: Key+  , position     :: Position+  , content :: RawSelectionSet+  } deriving (Show)++type FragmentLib = Map Key Fragment
+ src/Data/Morpheus/Types/Query/Operator.hs view
@@ -0,0 +1,32 @@+module Data.Morpheus.Types.Query.Operator+  ( Operator(..)+  , ValidOperator+  , RawOperator+  , Variable(..)+  , VariableDefinitions+  ) where++import           Data.Morpheus.Types.Core               (Collection, Key)+import           Data.Morpheus.Types.MetaInfo           (Position)+import           Data.Morpheus.Types.Query.RawSelection (RawSelectionSet)+import           Data.Morpheus.Types.Query.Selection    (Arguments, SelectionSet)++type ValidOperator = Operator Arguments SelectionSet++data Variable =+  Variable Key+           Position++type VariableDefinitions = Collection Variable++type RawOperator = Operator VariableDefinitions RawSelectionSet++data Operator args sel+  = Query Key+          args+          sel+          Position+  | Mutation Key+             args+             sel+             Position
+ src/Data/Morpheus/Types/Query/RawSelection.hs view
@@ -0,0 +1,32 @@+module Data.Morpheus.Types.Query.RawSelection+  ( RawArgument(..)+  , RawArguments+  , RawSelectionSet+  , RawSelection(..)+  ) where++import           Data.Morpheus.Types.Core     (Collection, Key)+import           Data.Morpheus.Types.JSType   (JSType)+import           Data.Morpheus.Types.MetaInfo (Position)++data RawArgument+  = VariableReference Key+                      Position+  | Argument JSType+             Position+  deriving (Show)++type RawArguments = Collection RawArgument++type RawSelectionSet = Collection RawSelection++data RawSelection+  = RawSelectionSet RawArguments+                    RawSelectionSet+                    Position+  | RawField RawArguments+             Key+             Position+  | Spread Key+           Position+  deriving (Show)
+ src/Data/Morpheus/Types/Query/Selection.hs view
@@ -0,0 +1,28 @@+module Data.Morpheus.Types.Query.Selection+  ( Argument(..)+  , Arguments+  , SelectionSet+  , Selection(..)+  ) where++import           Data.Morpheus.Types.Core     (Collection, Key)+import           Data.Morpheus.Types.JSType   (JSType)+import           Data.Morpheus.Types.MetaInfo (Position)++data Argument =+  Argument JSType+           Position+  deriving (Show)++type Arguments = Collection Argument++type SelectionSet = Collection Selection++data Selection+  = SelectionSet Arguments+                 SelectionSet+                 Position+  | Field Arguments+          Key+          Position+  deriving (Show)
+ src/Data/Morpheus/Types/Request.hs view
@@ -0,0 +1,16 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric  #-}++module Data.Morpheus.Types.Request where++import           Data.Aeson                 (FromJSON (..))+import           Data.Map                   (Map)+import           Data.Morpheus.Types.Core   (Key)+import           Data.Morpheus.Types.JSType (JSType)+import           GHC.Generics               (Generic)++data GQLRequest = GQLRequest+  { query         :: Key+  , operationName :: Maybe Key+  , variables     :: Maybe (Map Key JSType)+  } deriving (Show, Generic, FromJSON)
+ src/Data/Morpheus/Types/Response.hs view
@@ -0,0 +1,18 @@+{-# LANGUAGE DeriveGeneric     #-}+{-# LANGUAGE OverloadedStrings #-}++module Data.Morpheus.Types.Response where++import           Data.Aeson                 (ToJSON (..), pairs, (.=))+import           Data.Morpheus.Types.Error  (JSONError (..))+import           Data.Morpheus.Types.JSType (JSType)+import           GHC.Generics               (Generic)++data GQLResponse+  = Data JSType+  | Errors [JSONError]+  deriving (Show, Generic)++instance ToJSON GQLResponse where+  toEncoding (Data _data)     = pairs $ "data" .= _data+  toEncoding (Errors _errors) = pairs $ "errors" .= _errors
+ src/Data/Morpheus/Types/Types.hs view
@@ -0,0 +1,24 @@+module Data.Morpheus.Types.Types+  ( GQLQueryRoot(..)+  , Variables+  , GQLRoot(..)+  ) where++import           Data.Map                           (Map)+import           Data.Morpheus.Types.Core           (Key)+import           Data.Morpheus.Types.JSType         (JSType)+import           Data.Morpheus.Types.Query.Fragment (FragmentLib)+import           Data.Morpheus.Types.Query.Operator (RawOperator)++type Variables = Map Key JSType++data GQLQueryRoot = GQLQueryRoot+  { fragments      :: FragmentLib+  , queryBody      :: RawOperator+  , inputVariables :: [(Key, JSType)]+  }++data GQLRoot a b = GQLRoot+  { query    :: a+  , mutation :: b+  }
+ src/Data/Morpheus/Wrapper.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE MultiParamTypeClasses #-}++module Data.Morpheus.Wrapper+  ( GQLRoot(..)+  , EnumOf+  , ScalarOf+  , (::->)(..)+  , wrap+  , unwrap+  ) where++import           Data.Morpheus.Types.Describer ((::->) (Resolver), EnumOf (..), ScalarOf (..))+import           Data.Morpheus.Types.Types     (GQLRoot (..))++class Wrapper m where+  wrap :: a -> m a+  unwrap :: m a -> a++instance Wrapper EnumOf where+  wrap = EnumOf+  unwrap (EnumOf x) = x++instance Wrapper ScalarOf where+  wrap = ScalarOf+  unwrap (ScalarOf x) = x