{-# 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 _ [] = Nothing get k (Argument n v:xs) | k == n = Just v | otherwise = get k xs getInt :: Num a => Name -> [Argument] -> Maybe a getInt n argv = case get n argv of (Just (ValueInt v)) -> Just $ fromIntegral v _ -> Nothing getFloat :: Name -> [Argument] -> Maybe Double getFloat n argv = case get n argv of (Just (ValueFloat v)) -> Just v _ -> Nothing getBool :: Name -> [Argument] -> Maybe Bool getBool n argv = case get n argv of (Just (ValueBoolean v)) -> Just v _ -> Nothing getText :: Name -> [Argument] -> Maybe Text getText n argv = case get n argv of (Just (ValueString v)) -> Just v _ -> Nothing getEnum :: Name -> [Argument] -> Maybe Name getEnum n argv = case get n argv of (Just (ValueEnum v)) -> Just v _ -> Nothing getObject :: Name -> [Argument] -> Maybe [ObjectField] getObject n argv = case get n argv of (Just (ValueObject v)) -> Just v _ -> Nothing getList :: Name -> [Argument] -> Maybe [Value] getList n argv = case get n argv of (Just (ValueList v)) -> Just v _ -> Nothing value :: Alternative f => Name -> A.Value -> Resolver f value k (A.Object v) = object k . listToResolver $ HM.toList v value k (A.Array v) = if isO v then array k (map value' $ V.toList v) else scalar k v value k v = scalar k v isOv :: A.Value -> Bool isOv (A.Object _) = True isOv _ = False isO :: V.Vector A.Value -> Bool isO v | V.null v = False | otherwise = isOv $ V.head v value' :: Alternative f => A.Value -> [Resolver f] value' (A.Object v) = listToResolver $ HM.toList v value' _ = [] listToResolver :: Alternative f => [(Text, A.Value)] -> [Resolver f] listToResolver [] = [] listToResolver ((k, v):xs) = value k v : listToResolver xs pick :: Alternative f => Name -> A.Value -> Resolver f pick n v = scalarA n $ \args -> pure $ J.pick (keys args) v where keys :: [Argument] -> [Text] keys args = mapMaybe getText' (fromMaybe [] $ getList "keys" args) getText' :: Value -> Maybe Text getText' (ValueString k) = Just k getText' _ = Nothing