{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies #-} -- | -- Module: Data.Greskell.GraphSON -- Description: Encoding and decoding GraphSON -- Maintainer: Toshio Ito -- -- module Data.Greskell.GraphSON ( -- * GraphSON GraphSON (..) , GraphSONTyped (..) -- ** constructors , nonTypedGraphSON , typedGraphSON , typedGraphSON' -- ** parser support , parseTypedGraphSON -- * GValue , GValue , GValueBody (..) -- ** constructors , nonTypedGValue , typedGValue' -- * FromGraphSON , FromGraphSON (..) -- ** parser support , Parser , parseEither , parseUnwrapAll , parseUnwrapList , (.:) , parseJSONViaGValue -- * Examples , examples ) where import Control.Applicative ((<$>), (<*>), (<|>)) import Control.Monad (when) import Data.Aeson (FromJSON (parseJSON), FromJSONKey, ToJSON (toJSON), Value (..), object, (.=)) import qualified Data.Aeson as Aeson import Data.Aeson.Key (Key) import qualified Data.Aeson.Key as Key import Data.Aeson.KeyMap (KeyMap) import qualified Data.Aeson.KeyMap as KM import Data.Aeson.Types (Parser) import qualified Data.Aeson.Types as Aeson (parseEither) import Data.Foldable (Foldable (foldr)) import Data.Functor.Identity (Identity (..)) import Data.Hashable (Hashable (..)) import qualified Data.HashMap.Lazy as L (HashMap) import Data.HashMap.Strict (HashMap) import Data.HashSet (HashSet) import Data.Int (Int16, Int32, Int64, Int8) import qualified Data.IntMap.Lazy as L (IntMap) import qualified Data.IntMap.Lazy as LIntMap import Data.IntSet (IntSet) import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.Map.Lazy as L (Map) import qualified Data.Map.Lazy as LMap import Data.Monoid (mempty) import qualified Data.Monoid as M import Data.Ratio (Ratio) import Data.Scientific (Scientific) import qualified Data.Semigroup as S import Data.Sequence (Seq) import Data.Set (Set) import Data.Text (Text, unpack) import qualified Data.Text.Lazy as TL import Data.Traversable (Traversable (traverse)) import Data.UUID (UUID) import qualified Data.UUID as UUID import Data.Vector (Vector) import Data.Word (Word16, Word32, Word64, Word8) import GHC.Exts (IsList (Item)) import qualified GHC.Exts as List (fromList, toList) import GHC.Generics (Generic) import Numeric.Natural (Natural) import Data.Greskell.GMap (FlattenedMap, GMap, GMapEntry, parseToFlattenedMap, parseToGMap, parseToGMapEntry, unGMap) -- re-exports import Data.Greskell.GraphSON.Core import Data.Greskell.GraphSON.GraphSONTyped (GraphSONTyped (..)) import Data.Greskell.GraphSON.GValue -- | Types that can be constructed from 'GValue'. This is analogous to -- 'FromJSON' class. -- -- Instances of basic types are implemented based on the following -- rule. -- -- - Simple scalar types (e.g. 'Int' and 'Text'): use 'parseUnwrapAll'. -- - List-like types (e.g. @[]@, 'Vector' and 'Set'): use -- 'parseUnwrapList'. -- - Map-like types (e.g. 'L.HashMap' and 'L.Map'): parse into 'GMap' -- first, then unwrap the 'GMap' wrapper. That way, all versions of -- GraphSON formats are handled properly. -- - Trivial wrapper types (e.g. 'Identity'): just parse the item inside. -- - Other types: see the individual instance documentation. -- -- Note that 'Char' does not have 'FromGraphSON' instance. This is -- intentional. As stated in the document of -- 'Data.Greskell.AsIterator.AsIterator', using 'String' in greskell -- is an error in most cases. To prevent you from using 'String', -- 'Char' (and thus 'String') don't have 'FromGraphSON' instances. -- -- @since 0.1.2.0 class FromGraphSON a where parseGraphSON :: GValue -> Parser a -- | Unwrap the given 'GValue' with 'unwrapAll', and just parse the -- result with 'parseJSON'. -- -- Useful to implement 'FromGraphSON' instances for scalar types. -- -- @since 0.1.2.0 parseUnwrapAll :: FromJSON a => GValue -> Parser a parseUnwrapAll gv = parseJSON $ unwrapAll gv ---- Looks like we don't need this. -- -- | Unwrap the given 'GValue' with 'unwrapOne', parse the result to -- -- @(t GValue)@, and recursively parse the children with -- -- 'parseGraphSON'. -- -- -- -- Useful to implement 'FromGraphSON' instances for 'Traversable' -- -- types. -- parseUnwrapTraversable :: (Traversable t, FromJSON (t GValue), FromGraphSON a) -- => GValue -> Parser (t a) -- parseUnwrapTraversable gv = traverse parseGraphSON =<< (parseJSON $ unwrapOne gv) -- | Extract 'GArray' from the given 'GValue', parse the items in the -- array, and gather them by 'List.fromList'. -- -- Useful to implement 'FromGraphSON' instances for 'IsList' types. -- -- @since 0.1.2.0 parseUnwrapList :: (IsList a, i ~ Item a, FromGraphSON i) => GValue -> Parser a parseUnwrapList (GValue (GraphSON _ (GArray v))) = fmap List.fromList $ traverse parseGraphSON $ List.toList v parseUnwrapList (GValue (GraphSON _ body)) = fail ("Expects GArray, but got " ++ show body) -- | Parse 'GValue' into 'FromGraphSON'. -- -- @since 0.1.2.0 parseEither :: FromGraphSON a => GValue -> Either String a parseEither = Aeson.parseEither parseGraphSON -- | Like Aeson's 'Aeson..:', but for 'FromGraphSON'. -- -- @since 1.0.0.0 (.:) :: FromGraphSON a => KeyMap GValue -> Key -> Parser a go .: label = maybe failure parseGraphSON $ KM.lookup label go where failure = fail ("Cannot find field " ++ Key.toString label) -- | Implementation of 'parseJSON' based on 'parseGraphSON'. The input -- 'Value' is first converted to 'GValue', and it's parsed to the -- output type. -- -- @since 0.1.2.0 parseJSONViaGValue :: FromGraphSON a => Value -> Parser a parseJSONViaGValue v = parseGraphSON =<< parseJSON v ---- Trivial instances instance FromGraphSON GValue where parseGraphSON = return instance FromGraphSON Int where parseGraphSON = parseUnwrapAll instance FromGraphSON Text where parseGraphSON = parseUnwrapAll instance FromGraphSON TL.Text where parseGraphSON = parseUnwrapAll instance FromGraphSON Bool where parseGraphSON = parseUnwrapAll instance FromGraphSON Double where parseGraphSON = parseUnwrapAll instance FromGraphSON Float where parseGraphSON = parseUnwrapAll instance FromGraphSON Int8 where parseGraphSON = parseUnwrapAll instance FromGraphSON Int16 where parseGraphSON = parseUnwrapAll instance FromGraphSON Int32 where parseGraphSON = parseUnwrapAll instance FromGraphSON Int64 where parseGraphSON = parseUnwrapAll instance FromGraphSON Integer where parseGraphSON = parseUnwrapAll instance FromGraphSON Natural where parseGraphSON = parseUnwrapAll instance (FromJSON a, Integral a) => FromGraphSON (Ratio a) where parseGraphSON = parseUnwrapAll instance FromGraphSON Word where parseGraphSON = parseUnwrapAll instance FromGraphSON Word8 where parseGraphSON = parseUnwrapAll instance FromGraphSON Word16 where parseGraphSON = parseUnwrapAll instance FromGraphSON Word32 where parseGraphSON = parseUnwrapAll instance FromGraphSON Word64 where parseGraphSON = parseUnwrapAll instance FromGraphSON Scientific where parseGraphSON = parseUnwrapAll instance FromGraphSON IntSet where parseGraphSON = parseUnwrapAll -- | First convert to 'Text', and convert to 'Key'. -- -- @since 1.0.0.0 instance FromGraphSON Key where parseGraphSON = fmap Key.fromText . parseGraphSON ---- List instances instance FromGraphSON a => FromGraphSON [a] where parseGraphSON = parseUnwrapList instance FromGraphSON a => FromGraphSON (Vector a) where parseGraphSON = parseUnwrapList instance FromGraphSON a => FromGraphSON (Seq a) where parseGraphSON = parseUnwrapList -- | @since 0.1.3.0 instance FromGraphSON a => FromGraphSON (NonEmpty a) where parseGraphSON gv = do list <- parseGraphSON gv case list of [] -> fail ("Empty list.") (a : rest) -> return (a :| rest) ---- Set instances instance (FromGraphSON a, Ord a) => FromGraphSON (Set a) where parseGraphSON = parseUnwrapList instance (FromGraphSON a, Eq a, Hashable a) => FromGraphSON (HashSet a) where parseGraphSON = parseUnwrapList ---- Trivial wrapper type instances -- | @since 0.1.3.0 instance FromGraphSON a => FromGraphSON (Identity a) where parseGraphSON = fmap Identity . parseGraphSON -- | @since 0.1.3.0 instance FromGraphSON a => FromGraphSON (S.Min a) where parseGraphSON = fmap S.Min . parseGraphSON -- | @since 0.1.3.0 instance FromGraphSON a => FromGraphSON (S.Max a) where parseGraphSON = fmap S.Max . parseGraphSON -- | @since 0.1.3.0 instance FromGraphSON a => FromGraphSON (S.First a) where parseGraphSON = fmap S.First . parseGraphSON -- | @since 0.1.3.0 instance FromGraphSON a => FromGraphSON (S.Last a) where parseGraphSON = fmap S.Last . parseGraphSON -- | @since 0.1.3.0 instance FromGraphSON a => FromGraphSON (S.WrappedMonoid a) where parseGraphSON = fmap S.WrapMonoid . parseGraphSON -- | @since 0.1.3.0 instance FromGraphSON a => FromGraphSON (S.Dual a) where parseGraphSON = fmap S.Dual . parseGraphSON -- | @since 0.1.3.0 instance FromGraphSON a => FromGraphSON (M.Sum a) where parseGraphSON = fmap M.Sum . parseGraphSON -- | @since 0.1.3.0 instance FromGraphSON a => FromGraphSON (M.Product a) where parseGraphSON = fmap M.Product . parseGraphSON -- | @since 0.1.3.0 instance FromGraphSON M.All where parseGraphSON = fmap M.All . parseGraphSON -- | @since 0.1.3.0 instance FromGraphSON M.Any where parseGraphSON = fmap M.Any . parseGraphSON ---- GMap and others -- | Use 'parseToFlattenedMap'. instance (FromGraphSON k, FromGraphSON v, IsList (c k v), Item (c k v) ~ (k,v)) => FromGraphSON (FlattenedMap c k v) where parseGraphSON gv = case gValueBody gv of GArray a -> parseToFlattenedMap parseGraphSON parseGraphSON a b -> fail ("Expects GArray, but got " ++ show b) parseGObjectToTraversal :: (Traversable t, FromJSON (t GValue), FromGraphSON v) => KeyMap GValue -> Parser (t v) parseGObjectToTraversal o = traverse parseGraphSON =<< (parseJSON $ Object $ fmap toJSON o) -- | Use 'parseToGMap'. instance (FromGraphSON k, FromGraphSON v, IsList (c k v), Item (c k v) ~ (k,v), Traversable (c k), FromJSON (c k GValue)) => FromGraphSON (GMap c k v) where parseGraphSON gv = case gValueBody gv of GObject o -> parse $ Left o GArray a -> parse $ Right a other -> fail ("Expects GObject or GArray, but got " ++ show other) where parse = parseToGMap parseGraphSON parseGraphSON parseObject -- parseObject = parseUnwrapTraversable . GValue . nonTypedGraphSON . GObject --- Too many wrapping and unwrappings!!! parseObject = parseGObjectToTraversal -- | Use 'parseToGMapEntry'. instance (FromGraphSON k, FromGraphSON v, FromJSONKey k) => FromGraphSON (GMapEntry k v) where parseGraphSON val = case gValueBody val of GObject o -> parse $ Left o GArray a -> parse $ Right a other -> fail ("Expects GObject or GArray, but got " ++ show other) where parse = parseToGMapEntry parseGraphSON parseGraphSON ---- Map instances instance (FromGraphSON v, Eq k, Hashable k, FromJSONKey k, FromGraphSON k) => FromGraphSON (L.HashMap k v) where parseGraphSON = fmap unGMap . parseGraphSON instance (FromGraphSON v, Ord k, FromJSONKey k, FromGraphSON k) => FromGraphSON (L.Map k v) where parseGraphSON = fmap unGMap . parseGraphSON -- IntMap cannot be used with GMap directly.. instance FromGraphSON v => FromGraphSON (L.IntMap v) where parseGraphSON = fmap (mapToIntMap . unGMap) . parseGraphSON where mapToIntMap :: L.Map Int v -> L.IntMap v mapToIntMap = LMap.foldrWithKey LIntMap.insert mempty -- | First convert to 'L.Map' with 'Text' key, and convert to 'KeyMap'. -- -- @since 1.0.0.0 instance FromGraphSON v => FromGraphSON (KeyMap v) where parseGraphSON = fmap KM.fromMap . parseGraphSON ---- Maybe and Either -- | Parse 'GNull' into 'Nothing'. instance FromGraphSON a => FromGraphSON (Maybe a) where parseGraphSON (GValue (GraphSON _ GNull)) = return Nothing parseGraphSON gv = fmap Just $ parseGraphSON gv -- | Try 'Left', then 'Right'. instance (FromGraphSON a, FromGraphSON b) => FromGraphSON (Either a b) where parseGraphSON gv = (fmap Left $ parseGraphSON gv) <|> (fmap Right $ parseGraphSON gv) ---- Trivial wrapper for Maybe -- | @since 0.1.3.0 instance FromGraphSON a => FromGraphSON (M.First a) where parseGraphSON = fmap M.First . parseGraphSON -- | @since 0.1.3.0 instance FromGraphSON a => FromGraphSON (M.Last a) where parseGraphSON = fmap M.Last . parseGraphSON ---- Others -- | Call 'unwrapAll' to remove all GraphSON wrappers. instance FromGraphSON Value where parseGraphSON = return . unwrapAll instance FromGraphSON UUID where parseGraphSON gv = case gValueBody gv of GString t -> maybe failure return $ UUID.fromText t where failure = fail ("Failed to parse into UUID: " ++ unpack t) b -> fail ("Expected GString, but got " ++ show b) -- | For any input 'GValue', 'parseGraphSON' returns @()@. For -- example, you can use it to ignore data you get from the Gremlin -- server. instance FromGraphSON () where parseGraphSON _ = return () -- | Examples of using this module. See the source. The 'fst' of the output is the testee, while the -- 'snd' is the expectation. examples :: [(String, String)] examples = [ (show (Aeson.decode "1000" :: Maybe (GraphSON Int32)), "Just (GraphSON {gsonType = Nothing, gsonValue = 1000})") , (show (Aeson.decode "{\"@type\": \"g:Int32\", \"@value\": 1000}" :: Maybe (GraphSON Int32)), "Just (GraphSON {gsonType = Just \"g:Int32\", gsonValue = 1000})") , (show (nonTypedGraphSON (10 :: Int)), "GraphSON {gsonType = Nothing, gsonValue = 10}") , (show (typedGraphSON (10 :: Int32)), "GraphSON {gsonType = Just \"g:Int32\", gsonValue = 10}") , (show (typedGraphSON' "g:Int32" (10 :: Int)), "GraphSON {gsonType = Just \"g:Int32\", gsonValue = 10}") ]