src/Language/GraphQL/Execute/Directive.hs


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50

{-# LANGUAGE OverloadedStrings #-}

module Language.GraphQL.Execute.Directive
    ( selection
    ) where

import qualified Data.HashMap.Strict as HashMap
import Language.GraphQL.AST.Core

-- | Directive processing status.
data Status
    = Skip -- ^ Skip the selection and stop directive processing
    | Include Directive -- ^ The directive was processed, try other handlers
    | Continue Directive -- ^ Directive handler mismatch, try other handlers

-- | Takes a list of directives, handles supported directives and excludes them
--   from the result. If the selection should be skipped, returns 'Nothing'.
selection :: [Directive] -> Maybe [Directive]
selection = foldr go (Just [])
  where
    go directive' directives' =
        case (skip . include) (Continue directive') of
            (Include _) -> directives'
            Skip -> Nothing
            (Continue x) -> (x :) <$> directives'

handle :: (Directive -> Status) -> Status -> Status
handle _ Skip = Skip
handle handler (Continue directive) = handler directive
handle handler (Include directive) = handler directive

-- * Directive implementations

skip :: Status -> Status
skip = handle skip'
  where
    skip' directive'@(Directive "skip" (Arguments arguments)) =
        case HashMap.lookup "if" arguments of
            (Just (Boolean True)) -> Skip
            _ -> Include directive'
    skip' directive' = Continue directive'

include :: Status -> Status
include = handle include'
  where
    include' directive'@(Directive "include" (Arguments arguments)) =
        case HashMap.lookup "if" arguments of
            (Just (Boolean True)) -> Include directive'
            _ -> Skip
    include' directive' = Continue directive'