summaryrefslogtreecommitdiff
path: root/src/Language/GraphQL
diff options
context:
space:
mode:
Diffstat (limited to 'src/Language/GraphQL')
-rw-r--r--src/Language/GraphQL/Class.hs105
1 files changed, 105 insertions, 0 deletions
diff --git a/src/Language/GraphQL/Class.hs b/src/Language/GraphQL/Class.hs
new file mode 100644
index 0000000..66a0b2b
--- /dev/null
+++ b/src/Language/GraphQL/Class.hs
@@ -0,0 +1,105 @@
+{- This Source Code Form is subject to the terms of the Mozilla Public License,
+ v. 2.0. If a copy of the MPL was not distributed with this file, You can
+ obtain one at https://mozilla.org/MPL/2.0/. -}
+
+{-# LANGUAGE OverloadedStrings #-}
+
+-- | ToGraphQL and FromGraphQL typeclasses used for user-defined type
+-- conversion.
+module Language.GraphQL.Class
+ ( FromGraphQL(..)
+ , ToGraphQL(..)
+ ) where
+
+import Data.Foldable (toList)
+import Data.Int (Int8, Int16, Int32, Int64)
+import Data.Text (Text)
+import qualified Data.Text.Read as Text.Read
+import Data.Vector (Vector)
+import qualified Data.Vector as Vector
+import qualified Language.GraphQL.Type as Type
+
+fromGraphQLToIntegral :: Integral a => Type.Value -> Maybe a
+fromGraphQLToIntegral (Type.Int value) = Just $ fromIntegral value
+fromGraphQLToIntegral (Type.String value) =
+ case Text.Read.decimal value of
+ Right (converted, "") -> Just converted
+ _ -> Nothing
+fromGraphQLToIntegral _ = Nothing
+
+-- | Instances of this typeclass can be converted to GraphQL internal
+-- representation.
+class ToGraphQL a where
+ toGraphQL :: a -> Type.Value
+
+instance ToGraphQL Text where
+ toGraphQL = Type.String
+
+instance ToGraphQL Int where
+ toGraphQL = Type.Int . fromIntegral
+
+instance ToGraphQL Int8 where
+ toGraphQL = Type.Int . fromIntegral
+
+instance ToGraphQL Int16 where
+ toGraphQL = Type.Int . fromIntegral
+
+instance ToGraphQL Int32 where
+ toGraphQL = Type.Int
+
+instance ToGraphQL Int64 where
+ toGraphQL = Type.Int . fromIntegral
+
+instance ToGraphQL a => ToGraphQL [a] where
+ toGraphQL = Type.List . fmap toGraphQL
+
+instance ToGraphQL a => ToGraphQL (Vector a) where
+ toGraphQL = Type.List . toList . fmap toGraphQL
+
+instance ToGraphQL a => ToGraphQL (Maybe a) where
+ toGraphQL (Just justValue) = toGraphQL justValue
+ toGraphQL Nothing = Type.Null
+
+instance ToGraphQL Bool where
+ toGraphQL = Type.Boolean
+
+-- | Instances of this typeclass can be used to convert GraphQL internal
+-- representation to user-defined type.
+class FromGraphQL a where
+ fromGraphQL :: Type.Value -> Maybe a
+
+instance FromGraphQL Text where
+ fromGraphQL (Type.String value) = Just value
+ fromGraphQL _ = Nothing
+
+instance FromGraphQL Int where
+ fromGraphQL = fromGraphQLToIntegral
+
+instance FromGraphQL Int8 where
+ fromGraphQL = fromGraphQLToIntegral
+
+instance FromGraphQL Int16 where
+ fromGraphQL = fromGraphQLToIntegral
+
+instance FromGraphQL Int32 where
+ fromGraphQL = fromGraphQLToIntegral
+
+instance FromGraphQL Int64 where
+ fromGraphQL = fromGraphQLToIntegral
+
+instance FromGraphQL a => FromGraphQL [a] where
+ fromGraphQL (Type.List value) = traverse fromGraphQL value
+ fromGraphQL _ = Nothing
+
+instance FromGraphQL a => FromGraphQL (Vector a) where
+ fromGraphQL (Type.List value) = Vector.fromList
+ <$> traverse fromGraphQL value
+ fromGraphQL _ = Nothing
+
+instance FromGraphQL a => FromGraphQL (Maybe a) where
+ fromGraphQL Type.Null = Just Nothing
+ fromGraphQL value = Just <$> fromGraphQL value
+
+instance FromGraphQL Bool where
+ fromGraphQL (Type.Boolean value) = Just value
+ fromGraphQL _ = Nothing