{-# 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