{-# LANGUAGE OverloadedStrings #-}

module Data.GraphQL.Utils
  ( get
  , getInt
  , getFloat
  , getText
  , getEnum
  , getBool
  , getObject
  , getList
  , value
  , value'
  , pick
  ) where

import           Control.Applicative   (Alternative (..))
import qualified Data.Aeson            as A (Value (..))
import qualified Data.Aeson.Helper     as J (pick)
import           Data.GraphQL.AST      (Name)
import           Data.GraphQL.AST.Core (ObjectField)
import           Data.GraphQL.Schema   (Argument (..), Resolver, Value (..),
                                        array, object, scalar, scalarA)
import qualified Data.HashMap.Strict   as HM (toList)
import           Data.Maybe            (fromMaybe, mapMaybe)
import           Data.Text             (Text)
import qualified Data.Vector           as V (Vector, head, null, toList)

get :: Name -> [Argument] -> Maybe Value
get :: Name -> [Argument] -> Maybe Value
get _ [] = Maybe Value
forall a. Maybe a
Nothing
get k :: Name
k (Argument n :: Name
n v :: Value
v:xs :: [Argument]
xs) | Name
k Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
n = Value -> Maybe Value
forall a. a -> Maybe a
Just Value
v
                        | Bool
otherwise = Name -> [Argument] -> Maybe Value
get Name
k [Argument]
xs

getInt :: Num a => Name -> [Argument] -> Maybe a
getInt :: Name -> [Argument] -> Maybe a
getInt n :: Name
n argv :: [Argument]
argv =
  case Name -> [Argument] -> Maybe Value
get Name
n [Argument]
argv of
    (Just (ValueInt v :: Int32
v)) -> a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ Int32 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
v
    _                   -> Maybe a
forall a. Maybe a
Nothing

getFloat :: Name -> [Argument] -> Maybe Double
getFloat :: Name -> [Argument] -> Maybe Double
getFloat n :: Name
n argv :: [Argument]
argv =
  case Name -> [Argument] -> Maybe Value
get Name
n [Argument]
argv of
    (Just (ValueFloat v :: Double
v)) -> Double -> Maybe Double
forall a. a -> Maybe a
Just Double
v
    _                     -> Maybe Double
forall a. Maybe a
Nothing

getBool :: Name -> [Argument] -> Maybe Bool
getBool :: Name -> [Argument] -> Maybe Bool
getBool n :: Name
n argv :: [Argument]
argv =
  case Name -> [Argument] -> Maybe Value
get Name
n [Argument]
argv of
    (Just (ValueBoolean v :: Bool
v)) -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
v
    _                       -> Maybe Bool
forall a. Maybe a
Nothing

getText :: Name -> [Argument] -> Maybe Text
getText :: Name -> [Argument] -> Maybe Name
getText n :: Name
n argv :: [Argument]
argv =
  case Name -> [Argument] -> Maybe Value
get Name
n [Argument]
argv of
    (Just (ValueString v :: Name
v)) -> Name -> Maybe Name
forall a. a -> Maybe a
Just Name
v
    _                      -> Maybe Name
forall a. Maybe a
Nothing

getEnum :: Name -> [Argument] -> Maybe Name
getEnum :: Name -> [Argument] -> Maybe Name
getEnum n :: Name
n argv :: [Argument]
argv =
  case Name -> [Argument] -> Maybe Value
get Name
n [Argument]
argv of
    (Just (ValueEnum v :: Name
v)) -> Name -> Maybe Name
forall a. a -> Maybe a
Just Name
v
    _                    -> Maybe Name
forall a. Maybe a
Nothing

getObject :: Name -> [Argument] -> Maybe [ObjectField]
getObject :: Name -> [Argument] -> Maybe [ObjectField]
getObject n :: Name
n argv :: [Argument]
argv =
  case Name -> [Argument] -> Maybe Value
get Name
n [Argument]
argv of
    (Just (ValueObject v :: [ObjectField]
v)) -> [ObjectField] -> Maybe [ObjectField]
forall a. a -> Maybe a
Just [ObjectField]
v
    _                      -> Maybe [ObjectField]
forall a. Maybe a
Nothing

getList :: Name -> [Argument] -> Maybe [Value]
getList :: Name -> [Argument] -> Maybe [Value]
getList n :: Name
n argv :: [Argument]
argv =
  case Name -> [Argument] -> Maybe Value
get Name
n [Argument]
argv of
    (Just (ValueList v :: [Value]
v)) -> [Value] -> Maybe [Value]
forall a. a -> Maybe a
Just [Value]
v
    _                    -> Maybe [Value]
forall a. Maybe a
Nothing

value :: Alternative f => Name -> A.Value -> Resolver f
value :: Name -> Value -> Resolver f
value k :: Name
k (A.Object v :: Object
v) = Name -> Resolvers f -> Resolver f
forall (f :: * -> *).
Alternative f =>
Name -> Resolvers f -> Resolver f
object Name
k (Resolvers f -> Resolver f)
-> ([(Name, Value)] -> Resolvers f)
-> [(Name, Value)]
-> Resolver f
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Name, Value)] -> Resolvers f
forall (f :: * -> *).
Alternative f =>
[(Name, Value)] -> [Resolver f]
listToResolver ([(Name, Value)] -> Resolver f) -> [(Name, Value)] -> Resolver f
forall a b. (a -> b) -> a -> b
$ Object -> [(Name, Value)]
forall k v. HashMap k v -> [(k, v)]
HM.toList Object
v
value k :: Name
k (A.Array v :: Array
v)  = if Array -> Bool
isO Array
v then Name -> [Resolvers f] -> Resolver f
forall (f :: * -> *).
Alternative f =>
Name -> [Resolvers f] -> Resolver f
array Name
k ((Value -> Resolvers f) -> [Value] -> [Resolvers f]
forall a b. (a -> b) -> [a] -> [b]
map Value -> Resolvers f
forall (f :: * -> *). Alternative f => Value -> [Resolver f]
value' ([Value] -> [Resolvers f]) -> [Value] -> [Resolvers f]
forall a b. (a -> b) -> a -> b
$ Array -> [Value]
forall a. Vector a -> [a]
V.toList Array
v)
                                else Name -> Array -> Resolver f
forall (f :: * -> *) a.
(Alternative f, ToJSON a) =>
Name -> a -> Resolver f
scalar Name
k Array
v
value k :: Name
k v :: Value
v            = Name -> Value -> Resolver f
forall (f :: * -> *) a.
(Alternative f, ToJSON a) =>
Name -> a -> Resolver f
scalar Name
k Value
v

isOv :: A.Value -> Bool
isOv :: Value -> Bool
isOv (A.Object _) = Bool
True
isOv _            = Bool
False

isO :: V.Vector A.Value -> Bool
isO :: Array -> Bool
isO v :: Array
v | Array -> Bool
forall a. Vector a -> Bool
V.null Array
v  = Bool
False
      | Bool
otherwise = Value -> Bool
isOv (Value -> Bool) -> Value -> Bool
forall a b. (a -> b) -> a -> b
$ Array -> Value
forall a. Vector a -> a
V.head Array
v

value' :: Alternative f => A.Value -> [Resolver f]
value' :: Value -> [Resolver f]
value' (A.Object v :: Object
v) = [(Name, Value)] -> [Resolver f]
forall (f :: * -> *).
Alternative f =>
[(Name, Value)] -> [Resolver f]
listToResolver ([(Name, Value)] -> [Resolver f])
-> [(Name, Value)] -> [Resolver f]
forall a b. (a -> b) -> a -> b
$ Object -> [(Name, Value)]
forall k v. HashMap k v -> [(k, v)]
HM.toList Object
v
value' _            = []

listToResolver :: Alternative f => [(Text, A.Value)] -> [Resolver f]
listToResolver :: [(Name, Value)] -> [Resolver f]
listToResolver []          = []
listToResolver ((k :: Name
k, v :: Value
v):xs :: [(Name, Value)]
xs) = Name -> Value -> Resolver f
forall (f :: * -> *). Alternative f => Name -> Value -> Resolver f
value Name
k Value
v Resolver f -> [Resolver f] -> [Resolver f]
forall a. a -> [a] -> [a]
: [(Name, Value)] -> [Resolver f]
forall (f :: * -> *).
Alternative f =>
[(Name, Value)] -> [Resolver f]
listToResolver [(Name, Value)]
xs

pick :: Alternative f => Name -> A.Value -> Resolver f
pick :: Name -> Value -> Resolver f
pick n :: Name
n v :: Value
v = Name -> ([Argument] -> f Value) -> Resolver f
forall (f :: * -> *) a.
(Alternative f, ToJSON a) =>
Name -> ([Argument] -> f a) -> Resolver f
scalarA Name
n (([Argument] -> f Value) -> Resolver f)
-> ([Argument] -> f Value) -> Resolver f
forall a b. (a -> b) -> a -> b
$ \args :: [Argument]
args -> Value -> f Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> f Value) -> Value -> f Value
forall a b. (a -> b) -> a -> b
$ [Name] -> Value -> Value
J.pick ([Argument] -> [Name]
keys [Argument]
args) Value
v
  where keys :: [Argument] -> [Text]
        keys :: [Argument] -> [Name]
keys args :: [Argument]
args = (Value -> Maybe Name) -> [Value] -> [Name]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Value -> Maybe Name
getText' ([Value] -> Maybe [Value] -> [Value]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [Value] -> [Value]) -> Maybe [Value] -> [Value]
forall a b. (a -> b) -> a -> b
$ Name -> [Argument] -> Maybe [Value]
getList "keys" [Argument]
args)

        getText' :: Value -> Maybe Text
        getText' :: Value -> Maybe Name
getText' (ValueString k :: Name
k) = Name -> Maybe Name
forall a. a -> Maybe a
Just Name
k
        getText' _               = Maybe Name
forall a. Maybe a
Nothing