1 files changed, 31 insertions, 47 deletions

diff --git a/src/Language/GraphQL/Validate.hs b/src/Language/GraphQL/Validate.hs
index 5768615..53dc6f9 100644
--- a/src/Language/GraphQL/Validate.hs
+++ b/src/Language/GraphQL/Validate.hs
@@ -13,73 +13,50 @@ module Language.GraphQL.Validate
     , module Language.GraphQL.Validate.Rules
     ) where
 
-import Control.Monad.Trans.Reader (Reader, asks, runReader)
+import Control.Monad (foldM)
+import Control.Monad.Trans.Reader (Reader, asks, mapReaderT, runReader)
 import Data.Foldable (foldrM)
 import Data.Sequence (Seq(..), (><), (|>))
 import qualified Data.Sequence as Seq
-import Data.Text (Text)
 import Language.GraphQL.AST.Document
-import Language.GraphQL.Type.Schema
+import Language.GraphQL.Type.Internal
+import Language.GraphQL.Type.Schema (Schema(..))
 import Language.GraphQL.Validate.Rules
+import Language.GraphQL.Validate.Validation
 
-data Context m = Context
-    { ast :: Document
-    , schema :: Schema m
-    , rules :: [Rule]
-    }
-
-type ValidateT m = Reader (Context m) (Seq Error)
-
--- | If an error can be associated to a particular field in the GraphQL result,
--- it must contain an entry with the key path that details the path of the
--- response field which experienced the error. This allows clients to identify
--- whether a null result is intentional or caused by a runtime error.
-data Path
-    = Segment Text -- ^ Field name.
-    | Index Int -- ^ List index if a field returned a list.
-    deriving (Eq, Show)
-
--- | Validation error.
-data Error = Error
-    { message :: String
-    , locations :: [Location]
-    , path :: [Path]
-    } deriving (Eq, Show)
+type ValidateT m = Reader (Validation m) (Seq Error)
 
 -- | Validates a document and returns a list of found errors. If the returned
 -- list is empty, the document is valid.
-document :: forall m. Schema m -> [Rule] -> Document -> Seq Error
+document :: forall m. Schema m -> [Rule m] -> Document -> Seq Error
 document schema' rules' document' =
     runReader (foldrM go Seq.empty document') context
   where
-    context = Context
+    context = Validation
         { ast = document'
         , schema = schema'
+        , types = collectReferencedTypes schema'
         , rules = rules'
         }
     go definition' accumulator = (accumulator ><) <$> definition definition'
 
 definition :: forall m. Definition -> ValidateT m
 definition = \case
-    definition'@(ExecutableDefinition executableDefinition' _) -> do
+    definition'@(ExecutableDefinition executableDefinition') -> do
         applied <- applyRules definition'
         children <- executableDefinition executableDefinition'
         pure $ children >< applied
     definition' -> applyRules definition'
   where
-    applyRules definition' = foldr (ruleFilter definition') Seq.empty
-        <$> asks rules
-    ruleFilter definition' (DefinitionRule rule) accumulator
-        | Just message' <- rule definition' =
-            accumulator |> Error
-                { message = message'
-                , locations = [definitionLocation definition']
-                , path = []
-                }
-        | otherwise = accumulator
-    definitionLocation (ExecutableDefinition _ location) = location
-    definitionLocation (TypeSystemDefinition _ location) = location
-    definitionLocation (TypeSystemExtension _ location) = location
+    applyRules definition' =
+        asks rules >>= foldM (ruleFilter definition') Seq.empty
+    ruleFilter definition' accumulator (DefinitionRule rule) =
+        mapReaderT (runRule accumulator) $ rule definition'
+    ruleFilter _ accumulator _ = pure accumulator
+
+runRule :: Applicative f => Seq Error -> Maybe Error -> f (Seq Error)
+runRule accumulator (Just error') = pure $ accumulator |> error'
+runRule accumulator Nothing = pure accumulator
 
 executableDefinition :: forall m. ExecutableDefinition -> ValidateT m
 executableDefinition (DefinitionOperation definition') =
@@ -88,10 +65,17 @@ executableDefinition (DefinitionFragment definition') =
     fragmentDefinition definition'
 
 operationDefinition :: forall m. OperationDefinition -> ValidateT m
-operationDefinition (SelectionSet _operation) =
-    pure Seq.empty
-operationDefinition (OperationDefinition _type _name _variables _directives _selection) =
-    pure Seq.empty
+operationDefinition operation =
+    asks rules >>= foldM ruleFilter Seq.empty
+  where
+    ruleFilter accumulator (OperationDefinitionRule rule) =
+        mapReaderT (runRule accumulator) $ rule operation
+    ruleFilter accumulator _ = pure accumulator
 
 fragmentDefinition :: forall m. FragmentDefinition -> ValidateT m
-fragmentDefinition _fragment = pure Seq.empty
+fragmentDefinition fragment =
+    asks rules >>= foldM ruleFilter Seq.empty
+  where
+    ruleFilter accumulator (FragmentDefinitionRule rule) =
+        mapReaderT (runRule accumulator) $ rule fragment
+    ruleFilter accumulator _ = pure accumulator