greskell-core 0.1.3.7 → 1.0.0.8
raw patch · 15 files changed
Files
- ChangeLog.md +49/−0
- greskell-core.cabal +24/−30
- src/Data/Greskell/AsIterator.hs +19/−19
- src/Data/Greskell/GMap.hs +118/−118
- src/Data/Greskell/GraphSON.hs +116/−94
- src/Data/Greskell/GraphSON/Core.hs +31/−50
- src/Data/Greskell/GraphSON/GValue.hs +48/−50
- src/Data/Greskell/GraphSON/GraphSONTyped.hs +19/−19
- src/Data/Greskell/Greskell.hs +73/−92
- test/Data/Greskell/GMapSpec.hs +27/−13
- test/Data/Greskell/GraphSONSpec.hs +35/−33
- test/Data/Greskell/GreskellSpec.hs +13/−14
- test/Data/Greskell/Test/QuickCheck.hs +4/−3
- test/DocTest.hs +0/−1
- test/ExamplesSpec.hs +23/−0
ChangeLog.md view
@@ -1,5 +1,54 @@ # Revision history for greskell-core +## 1.0.0.8 -- 2026-05-25++- Support aeson-2.3.++## 1.0.0.7 -- 2026-04-21++- Bump dependency version bounds.++## 1.0.0.6 -- 2025-06-18++* Fix build-depends.++## 1.0.0.5 -- 2025-06-18++* Support QuickCheck-2.16++## 1.0.0.4 -- 2025-01-30++* Support ghc-9.12 (base-4.21).++## 1.0.0.3 -- 2024-11-05++* Bump dependency version bounds.++## 1.0.0.2 -- 2024-09-12++* Update dependency version bounds with cabal-plan-bounds.+ This adds support for new packages, while drops support for old ones.++## 1.0.0.1 -- 2022-11-24++* Confirm test with ghc-9.2.5, vector-0.13.0.0 and aeson-2.1.0.0.+* Remove doctests. This is because it's so difficult to maintain doctests with recent GHCs and cabals.+ * doctests have been moved to `examples` function defined in some modules.+* Use stylish-haskell to format codes.++## 1.0.0.0 -- 2021-12-28++* **BREAKING CHANGE**: `GObject` variant of `GValueBody` is now based on `KeyMap` from `aeson-2.0`.+ Before, it was based on `HashMap Text`.+ As a result, signature of the following functions has been changed.+ * `parseToGMap`+ * `parseToGMapEntry`+ * `(.:)`+* **BREAKING CHANGE**: Remove `FromGraphSON` instance for `Data.Semigroup.Option`, which is deprecated.+* Add `FromGraphSON` instance to `KeyMap` and `Key` from `aeson-2.0`.+* Confirm test with `aeson-2.0.2.0`, `semigroups-0.20` and `hashable-1.4.0.1`, `doctest-0.19.0`, `doctest-0.20.0`.++ ## 0.1.3.7 -- 2021-11-08 * Confirm test with `base-4.15.0.0`
greskell-core.cabal view
@@ -1,5 +1,5 @@ name: greskell-core-version: 0.1.3.7+version: 1.0.0.8 author: Toshio Ito <debug.ito@gmail.com> maintainer: Toshio Ito <debug.ito@gmail.com> license: BSD3@@ -10,7 +10,7 @@ . This package contains only core data types and tools used commonly by other related packages. category: Data-cabal-version: >= 1.10+cabal-version: 2.0 build-type: Simple extra-source-files: README.md, ChangeLog.md homepage: https://github.com/debug-ito/greskell/@@ -30,47 +30,41 @@ Data.Greskell.AsIterator other-modules: Data.Greskell.GraphSON.GraphSONTyped, Data.Greskell.GraphSON.Core- build-depends: base >=4.9.0.0 && <4.16,- aeson >=1.0.2.1 && <1.6,- unordered-containers >=0.2.7.1 && <0.3,- hashable >=1.2.6.1 && <1.4,- scientific >=0.3.4.9 && <0.4,- text >=1.2.2.1 && <1.3,- semigroups >=0.18.2 && <0.20,- vector >=0.12.0.1 && <0.13,- containers >=0.5.7.1 && <0.7,- uuid >=1.3.13 && <1.4+ build-depends: base ^>=4.13.0 || ^>=4.14.0 || ^>=4.15.0 || ^>=4.16.0 || ^>=4.17.0 || ^>=4.18.0 || ^>=4.19.0 || ^>=4.20.0 || ^>=4.21.0 || ^>=4.22.0,+ aeson ^>=2.0.2 || ^>=2.1.0 || ^>=2.2.3 || ^>=2.3.0,+ unordered-containers ^>=0.2.15,+ hashable ^>=1.4.0 || ^>=1.5.0,+ scientific ^>=0.3.7,+ text ^>=1.2.3 || ^>=2.0.2 || ^>=2.1,+ semigroups ^>=0.20,+ vector ^>=0.12.3 || ^>=0.13.0,+ containers ^>=0.6.2 || ^>=0.7 || ^>=0.8,+ uuid ^>=1.3.15,+ bytestring ^>=0.10.9 || ^>=0.11.3 || ^>=0.12.0 test-suite spec type: exitcode-stdio-1.0 default-language: Haskell2010 hs-source-dirs: test- ghc-options: -Wall -fno-warn-unused-imports "-with-rtsopts=-M512m"+ ghc-options: -Wall -fno-warn-unused-imports -fno-warn-incomplete-uni-patterns "-with-rtsopts=-M512m" main-is: Spec.hs -- default-extensions: other-extensions: OverloadedStrings, NoMonomorphismRestriction, CPP other-modules: Data.Greskell.GreskellSpec, Data.Greskell.GraphSONSpec, Data.Greskell.GMapSpec,- Data.Greskell.Test.QuickCheck+ Data.Greskell.Test.QuickCheck,+ ExamplesSpec build-tool-depends: hspec-discover:hspec-discover- build-depends: base, text, aeson, unordered-containers, vector,+ build-depends: base ^>=4.13.0 || ^>=4.14.0 || ^>=4.15.0 || ^>=4.16.0 || ^>=4.17.0 || ^>=4.18.0 || ^>=4.19.0 || ^>=4.20.0 || ^>=4.21.0 || ^>=4.22.0,+ text ^>=1.2.3 || ^>=2.0.2 || ^>=2.1,+ aeson ^>=2.0.2 || ^>=2.1.0 || ^>=2.2.3 || ^>=2.3.0,+ unordered-containers ^>=0.2.15,+ vector ^>=0.12.3 || ^>=0.13.0,+ bytestring ^>=0.10.9 || ^>=0.11.3 || ^>=0.12.0, greskell-core,- hspec >=2.2.3,- QuickCheck >=2.8.2 && <2.15,- bytestring >=0.10.8.1 && <0.11--test-suite doctest- type: exitcode-stdio-1.0- default-language: Haskell2010- hs-source-dirs: test- ghc-options: -Wall -fno-warn-unused-imports "-with-rtsopts=-M512m"- main-is: DocTest.hs- build-tool-depends: doctest-discover:doctest-discover- build-depends: base,- doctest >=0.11 && <0.19,- doctest-discover >=0.1.0.7 && <0.3-+ hspec ^>=2.9.1 || ^>=2.10.6 || ^>=2.11.9,+ QuickCheck ^>=2.14.2 || ^>=2.15.0 || ^>=2.16.0 || ^>=2.18.0 source-repository head type: git
src/Data/Greskell/AsIterator.hs view
@@ -6,27 +6,27 @@ -- -- @since 0.1.2.0 module Data.Greskell.AsIterator- ( AsIterator(..)- ) where+ ( AsIterator (..)+ ) where -import qualified Data.HashMap.Lazy as L (HashMap)-import Data.HashSet (HashSet)-import Data.List.NonEmpty (NonEmpty)-import Data.Int (Int8, Int16, Int32, Int64)-import qualified Data.IntMap.Lazy as L (IntMap)-import Data.IntSet (IntSet)-import qualified Data.Map.Lazy as L (Map)-import Data.Ratio (Ratio)-import Data.Scientific (Scientific)-import Data.Sequence (Seq)-import Data.Set (Set)-import Data.Text (Text)-import qualified Data.Text.Lazy as TL-import Data.Vector (Vector)-import Data.Word (Word8, Word16, Word32, Word64)-import Numeric.Natural (Natural)+import qualified Data.HashMap.Lazy as L (HashMap)+import Data.HashSet (HashSet)+import Data.Int (Int16, Int32, Int64, Int8)+import qualified Data.IntMap.Lazy as L (IntMap)+import Data.IntSet (IntSet)+import Data.List.NonEmpty (NonEmpty)+import qualified Data.Map.Lazy as L (Map)+import Data.Ratio (Ratio)+import Data.Scientific (Scientific)+import Data.Sequence (Seq)+import Data.Set (Set)+import Data.Text (Text)+import qualified Data.Text.Lazy as TL+import Data.Vector (Vector)+import Data.Word (Word16, Word32, Word64, Word8)+import Numeric.Natural (Natural) -import Data.Greskell.GMap (GMap, GMapEntry)+import Data.Greskell.GMap (GMap, GMapEntry) -- | Types that are converted to an iterator by -- @org.apache.tinkerpop.gremlin.util.iterator.IteratorUtils.asIterator@
src/Data/Greskell/GMap.hs view
@@ -1,4 +1,8 @@-{-# LANGUAGE TypeFamilies, OverloadedStrings, GeneralizedNewtypeDeriving, DeriveTraversable, CPP #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeFamilies #-} -- | -- Module: Data.Greskell.GMap -- Description: data type for g:Map@@ -10,57 +14,58 @@ -- object. Usually users only have to use 'GMapEntry', because other -- types are just used internally to implement GraphSON parsers. module Data.Greskell.GMap- ( -- * FlattenedMap- FlattenedMap(..),- parseToFlattenedMap,- -- * GMap- GMap(..),- unGMap,- singleton,- toList,- parseToGMap,- -- * GMapEntry- GMapEntry(..),- unGMapEntry,- parseToGMapEntry- ) where+ ( -- * FlattenedMap+ FlattenedMap (..)+ , parseToFlattenedMap+ -- * GMap+ , GMap (..)+ , unGMap+ , singleton+ , toList+ , parseToGMap+ -- * GMapEntry+ , GMapEntry (..)+ , unGMapEntry+ , parseToGMapEntry+ -- * Examples+ , examples+ ) where -import Control.Applicative ((<$>), (<*>), (<|>), empty)-import Data.Aeson- ( FromJSON(..), ToJSON(..), Value(..),- FromJSONKey, fromJSONKey, FromJSONKeyFunction(..), ToJSONKey- )-import Data.Aeson.Types (Parser)-import Data.Foldable (length, Foldable)-import Data.Hashable (Hashable)-import Data.HashMap.Strict (HashMap)-import qualified Data.HashMap.Strict as HM-import qualified Data.Map as M-import Data.Text (Text, intercalate, unpack)-import Data.Traversable (Traversable, traverse)-import Data.Vector ((!), Vector)-import qualified Data.Vector as V-import GHC.Exts (IsList(Item))-import qualified GHC.Exts as List (IsList(fromList, toList))+import Control.Applicative (empty, (<$>), (<*>), (<|>))+import Data.Aeson (FromJSON (..), FromJSONKey,+ FromJSONKeyFunction (..), ToJSON (..),+ ToJSONKey, Value (..), fromJSONKey)+import qualified Data.Aeson as Aeson+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.ByteString.Lazy.Char8 as BSLC+import Data.Either (isLeft)+import Data.Foldable (Foldable, length)+import Data.Hashable (Hashable)+import Data.HashMap.Strict (HashMap)+import qualified Data.HashMap.Strict as HashMap+import Data.List (sort)+import qualified Data.Map as M+import Data.Text (Text, intercalate, unpack)+import Data.Traversable (Traversable, traverse)+import Data.Vector (Vector, (!))+import qualified Data.Vector as V+import GHC.Exts (IsList (Item))+import qualified GHC.Exts as List (IsList (fromList, toList)) + #if MIN_VERSION_aeson(1,5,0)-import Data.Coerce (coerce)+import Data.Coerce (coerce) #else-import Unsafe.Coerce (unsafeCoerce)+import Unsafe.Coerce (unsafeCoerce) #endif -import Data.Greskell.GraphSON.GraphSONTyped (GraphSONTyped(..))---- $setup--- >>> :set -XOverloadedStrings--- >>> import qualified Data.Aeson as Aeson--- >>> import Data.HashMap.Strict (HashMap)--- >>> import qualified Data.HashMap.Strict as HashMap--- >>> import Data.List (sort)--- >>> import Data.Either (isLeft)+import Data.Greskell.GraphSON.GraphSONTyped (GraphSONTyped (..)) -- | JSON encoding of a map as an array of flattened key-value pairs.--- +-- -- 'ToJSON' instance of this type encodes the internal map as an array -- of keys and values. 'FromJSON' instance of this type parses that -- flattened map.@@ -69,29 +74,18 @@ -- 'Data.HashMap.Strict.HashMap'). -- - type @k@: key of the map. -- - type @v@: value of the map.------ >>> let decode s = Aeson.eitherDecode s :: Either String (FlattenedMap HashMap Int String)--- >>> let toSortedList = sort . HashMap.toList . unFlattenedMap--- >>> fmap toSortedList $ decode "[10, \"ten\", 11, \"eleven\"]"--- Right [(10,"ten"),(11,"eleven")]--- >>> fmap toSortedList $ decode "[]"--- Right []--- >>> let (Left err_msg) = decode "[10, \"ten\", 11]"--- >>> err_msg--- ...odd number of elements...--- >>> Aeson.encode $ FlattenedMap $ (HashMap.fromList [(10, "ten")] :: HashMap Int String)--- "[10,\"ten\"]"-newtype FlattenedMap c k v = FlattenedMap { unFlattenedMap :: c k v }- deriving (Show,Eq,Ord,Foldable,Traversable,Functor)+newtype FlattenedMap c k v+ = FlattenedMap { unFlattenedMap :: c k v }+ deriving (Eq, Foldable, Functor, Ord, Show, Traversable) -- | Use 'parseToFlattenedMap'. instance (FromJSON k, FromJSON v, IsList (c k v), Item (c k v) ~ (k,v)) => FromJSON (FlattenedMap c k v) where parseJSON (Array v) = parseToFlattenedMap parseJSON parseJSON v- parseJSON v = fail ("Expects Array, but got " ++ show v)+ parseJSON v = fail ("Expects Array, but got " ++ show v) -- | Parse a flattened key-values to an associative Vector. parseToAVec :: (s -> Parser k) -> (s -> Parser v) -> Vector s -> Parser (Vector (k,v))-parseToAVec parseKey parseValue v = +parseToAVec parseKey parseValue v = if odd vlen then fail "Fail to parse a list into an associative list because there are odd number of elements." else traverse parsePair pairVec@@ -130,41 +124,32 @@ -- 'Data.HashMap.Strict.HashMap'). -- - type @k@: key of the map. -- - type @v@: value of the map.------ >>> Aeson.eitherDecode "{\"ten\": 10}" :: Either String (GMap HashMap Text Int)--- Right (GMap {gmapFlat = False, gmapValue = fromList [("ten",10)]})--- >>> Aeson.eitherDecode "[\"ten\", 10]" :: Either String (GMap HashMap Text Int)--- Right (GMap {gmapFlat = True, gmapValue = fromList [("ten",10)]})--- >>> Aeson.encode $ GMap False (HashMap.fromList [(9, "nine")] :: HashMap Int Text)--- "{\"9\":\"nine\"}"--- >>> Aeson.encode $ GMap True (HashMap.fromList [(9, "nine")] :: HashMap Int Text)--- "[9,\"nine\"]"-data GMap c k v =- GMap- { gmapFlat :: !Bool,- -- ^ If 'True', the map is encoded as an array. If 'False', it's- -- encoded as a JSON Object.- gmapValue :: !(c k v)- -- ^ Map implementation.- }- deriving (Show,Eq,Foldable,Traversable,Functor)+data GMap c k v+ = GMap+ { gmapFlat :: !Bool+ -- ^ If 'True', the map is encoded as an array. If 'False', it's+ -- encoded as a JSON Object.+ , gmapValue :: !(c k v)+ -- ^ Map implementation.+ }+ deriving (Eq, Foldable, Functor, Show, Traversable) -- | General parser for 'GMap'. parseToGMap :: (IsList (c k v), Item (c k v) ~ (k,v)) => (s -> Parser k) -- ^ key parser -> (s -> Parser v) -- ^ value parser- -> (HashMap Text s -> Parser (c k v)) -- ^ object parser- -> Either (HashMap Text s) (Vector s) -- ^ input object or flattened key-values.+ -> (KeyMap s -> Parser (c k v)) -- ^ object parser+ -> Either (KeyMap s) (Vector s) -- ^ input object or flattened key-values. -> Parser (GMap c k v)-parseToGMap _ _ op (Left o) = fmap (GMap False) $ op o+parseToGMap _ _ op (Left o) = fmap (GMap False) $ op o parseToGMap kp vp _ (Right v) = fmap (GMap True . unFlattenedMap) $ parseToFlattenedMap kp vp v -- | Use 'parseToGMap'. instance (FromJSON k, FromJSON v, IsList (c k v), Item (c k v) ~ (k,v), FromJSON (c k v)) => FromJSON (GMap c k v) where parseJSON v = case v of Object o -> parse $ Left o- Array a -> parse $ Right a- other -> fail ("Expects Object or Array, but got " ++ show other)+ Array a -> parse $ Right a+ other -> fail ("Expects Object or Array, but got " ++ show other) where parse = parseToGMap parseJSON parseJSON (parseJSON . Object) @@ -187,40 +172,28 @@ -- @Map@ with a single entry. Thus its encoded form is either a JSON -- object or a flattened key-values, as explained in 'GMap'. ----- >>> Aeson.eitherDecode "{\"1\": \"one\"}" :: Either String (GMapEntry Int Text)--- Right (GMapEntry {gmapEntryFlat = False, gmapEntryKey = 1, gmapEntryValue = "one"})--- >>> Aeson.eitherDecode "[1, \"one\"]" :: Either String (GMapEntry Int Text)--- Right (GMapEntry {gmapEntryFlat = True, gmapEntryKey = 1, gmapEntryValue = "one"})--- >>> Aeson.encode (GMapEntry False "one" 1 :: GMapEntry Text Int)--- "{\"one\":1}"--- >>> Aeson.encode (GMapEntry True "one" 1 :: GMapEntry Text Int)--- "[\"one\",1]"--- -- In old versions of TinkerPop, @Map.Entry@ is encoded as a JSON -- object with \"key\" and \"value\" fields. 'FromJSON' instance of -- 'GMapEntry' supports this format as well, but 'ToJSON' instance -- doesn't support it.------ >>> Aeson.eitherDecode "{\"key\":1, \"value\": \"one\"}" :: Either String (GMapEntry Int Text)--- Right (GMapEntry {gmapEntryFlat = False, gmapEntryKey = 1, gmapEntryValue = "one"})-data GMapEntry k v =- GMapEntry- { gmapEntryFlat :: !Bool,- gmapEntryKey :: !k,- gmapEntryValue :: !v- }- deriving (Show,Eq,Ord,Foldable,Traversable,Functor)+data GMapEntry k v+ = GMapEntry+ { gmapEntryFlat :: !Bool+ , gmapEntryKey :: !k+ , gmapEntryValue :: !v+ }+ deriving (Eq, Foldable, Functor, Ord, Show, Traversable) parseKeyValueToEntry :: (s -> Parser k) -> (s -> Parser v)- -> HashMap Text s+ -> KeyMap s -> Parser (Maybe (GMapEntry k v)) parseKeyValueToEntry kp vp o = if length o /= 2 then return Nothing else do- mk <- parseIfPresent kp $ HM.lookup "key" o- mv <- parseIfPresent vp $ HM.lookup "value" o+ mk <- parseIfPresent kp $ KM.lookup "key" o+ mv <- parseIfPresent vp $ KM.lookup "value" o return $ GMapEntry False <$> mk <*> mv where parseIfPresent :: (a -> Parser v) -> Maybe a -> Parser (Maybe v)@@ -228,12 +201,12 @@ parseSingleEntryObjectToEntry :: FromJSONKey k => (s -> Parser v)- -> HashMap Text s+ -> KeyMap s -> Parser (Maybe (GMapEntry k v)) parseSingleEntryObjectToEntry vp o =- case HM.toList o of+ case KM.toList o of [(raw_key, raw_val)] -> do- key <- parseKey raw_key+ key <- parseKey $ Key.toText raw_key val <- vp raw_val return $ Just $ GMapEntry False key val _ -> return Nothing@@ -248,24 +221,20 @@ ++ " It expects that the entry key is parsed from the text key in JSON Object," ++ " but the key type does not support it." )-#if MIN_VERSION_aeson(1,5,0) FromJSONKeyCoerce -> return $ fmap return coerce-#else- FromJSONKeyCoerce _ -> return $ fmap return unsafeCoerce-#endif orElseM :: Monad m => m (Maybe a) -> m (Maybe a) -> m (Maybe a) orElseM act_a act_b = do ma <- act_a case ma of- Just a -> return $ Just a+ Just a -> return $ Just a Nothing -> act_b -- | General parser for 'GMapEntry'. parseToGMapEntry :: FromJSONKey k => (s -> Parser k) -- ^ key parser -> (s -> Parser v) -- ^ value parser- -> Either (HashMap Text s) (Vector s) -- ^ input object or flattened key-values+ -> Either (KeyMap s) (Vector s) -- ^ input object or flattened key-values -> Parser (GMapEntry k v) parseToGMapEntry kp vp (Right vec) = do avec <- parseToAVec kp vp vec@@ -276,7 +245,7 @@ m_ret <- parseKeyValueToEntry kp vp o `orElseM` parseSingleEntryObjectToEntry vp o case m_ret of Just ret -> return ret- Nothing -> fail ("Unexpected structure of Object: got keys: " ++ (unpack $ intercalate ", " $ HM.keys o))+ Nothing -> fail ("Unexpected structure of Object: got keys: " ++ (unpack $ intercalate ", " $ map Key.toText $ KM.keys o)) -- | Map to \"g:Map\". instance GraphSONTyped (GMapEntry k v) where@@ -286,8 +255,8 @@ instance (FromJSON k, FromJSONKey k, FromJSON v) => FromJSON (GMapEntry k v) where parseJSON val = case val of Object o -> parse $ Left o- Array a -> parse $ Right a- other -> fail ("Expects Object or Array, but got " ++ show other)+ Array a -> parse $ Right a+ other -> fail ("Expects Object or Array, but got " ++ show other) where parse = parseToGMapEntry parseJSON parseJSON @@ -296,7 +265,7 @@ where singleton' :: (Ord k) => GMapEntry k v -> GMap M.Map k v singleton' = singleton- + -- | Get the key-value pair from 'GMapEntry'. unGMapEntry :: GMapEntry k v -> (k, v) unGMapEntry e = (gmapEntryKey e, gmapEntryValue e)@@ -312,3 +281,34 @@ toList gm = map toEntry $ List.toList $ gmapValue gm where toEntry (k, v) = GMapEntry (gmapFlat gm) k v++-- | 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 = forFlattenedMap ++ forGMap ++ forGMapEntry+ where+ forFlattenedMap =+ [ (show $ fmap toSortedList $ decode "[10, \"ten\", 11, \"eleven\"]", "Right [(10,\"ten\"),(11,\"eleven\")]")+ , (show $ fmap toSortedList $ decode "[]", "Right []")+ , (BSLC.unpack $ Aeson.encode $ FlattenedMap $ (HashMap.fromList [(10, "ten")] :: HashMap Int String), "[10,\"ten\"]")+ ]+ where+ decode s = Aeson.eitherDecode s :: Either String (FlattenedMap HashMap Int String)+ toSortedList = sort . HashMap.toList . unFlattenedMap+ forGMap =+ [ (show $ decode "{\"ten\": 10}", "Right (GMap {gmapFlat = False, gmapValue = fromList [(\"ten\",10)]})")+ , (show $ decode "[\"ten\", 10]", "Right (GMap {gmapFlat = True, gmapValue = fromList [(\"ten\",10)]})")+ , (BSLC.unpack $ Aeson.encode $ GMap False (HashMap.fromList [(9, "nine")] :: HashMap Int Text), "{\"9\":\"nine\"}")+ , (BSLC.unpack $ Aeson.encode $ GMap True (HashMap.fromList [(9, "nine")] :: HashMap Int Text), "[9,\"nine\"]")+ ]+ where+ decode s = Aeson.eitherDecode s :: Either String (GMap HashMap Text Int)+ forGMapEntry =+ [ (show $ decode "{\"1\": \"one\"}", "Right (GMapEntry {gmapEntryFlat = False, gmapEntryKey = 1, gmapEntryValue = \"one\"})")+ , (show $ decode "[1, \"one\"]", "Right (GMapEntry {gmapEntryFlat = True, gmapEntryKey = 1, gmapEntryValue = \"one\"})")+ , (BSLC.unpack $ Aeson.encode (GMapEntry False "one" 1 :: GMapEntry Text Int), "{\"one\":1}")+ , (BSLC.unpack $ Aeson.encode (GMapEntry True "one" 1 :: GMapEntry Text Int), "[\"one\",1]")+ , (show $ decode "{\"key\":1, \"value\": \"one\"}", "Right (GMapEntry {gmapEntryFlat = False, gmapEntryKey = 1, gmapEntryValue = \"one\"})")+ ]+ where+ decode s = Aeson.eitherDecode s :: Either String (GMapEntry Int Text)
src/Data/Greskell/GraphSON.hs view
@@ -1,94 +1,95 @@-{-# LANGUAGE OverloadedStrings, DeriveGeneric, TypeFamilies #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeFamilies #-} -- | -- Module: Data.Greskell.GraphSON -- Description: Encoding and decoding GraphSON -- Maintainer: Toshio Ito <debug.ito@gmail.com> ----- +-- 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- ) where+ ( -- * 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- ( ToJSON(toJSON), FromJSON(parseJSON), FromJSONKey,- object, (.=), Value(..)- )-import qualified Data.Aeson as Aeson-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.HashMap.Strict (HashMap)-import qualified Data.HashMap.Strict as HM-import qualified Data.HashMap.Lazy as L (HashMap)-import Data.HashSet (HashSet)-import Data.Hashable (Hashable(..))-import Data.List.NonEmpty (NonEmpty(..))-import Data.Int (Int8, Int16, Int32, Int64)-import qualified Data.IntMap.Lazy as L (IntMap)-import qualified Data.IntMap.Lazy as LIntMap-import Data.IntSet (IntSet)-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 (Word8, Word16, Word32, Word64)-import Numeric.Natural (Natural)-import GHC.Exts (IsList(Item))-import qualified GHC.Exts as List (fromList, toList)-import GHC.Generics (Generic)+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- ( GMap, GMapEntry, unGMap,- FlattenedMap, parseToFlattenedMap, parseToGMap, parseToGMapEntry- )+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+import Data.Greskell.GraphSON.Core+import Data.Greskell.GraphSON.GraphSONTyped (GraphSONTyped (..))+import Data.Greskell.GraphSON.GValue --- $--- >>> :set -XOverloadedStrings- -- | Types that can be constructed from 'GValue'. This is analogous to -- 'FromJSON' class. --@@ -118,7 +119,7 @@ -- 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@@ -153,11 +154,11 @@ -- | Like Aeson's 'Aeson..:', but for 'FromGraphSON'. ----- @since 0.1.2.0-(.:) :: FromGraphSON a => HashMap Text GValue -> Text -> Parser a-go .: label = maybe failure parseGraphSON $ HM.lookup label go+-- @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 " ++ unpack label)+ 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@@ -212,6 +213,12 @@ 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@@ -225,7 +232,7 @@ parseGraphSON gv = do list <- parseGraphSON gv case list of- [] -> fail ("Empty list.")+ [] -> fail ("Empty list.") (a : rest) -> return (a :| rest) ---- Set instances@@ -280,10 +287,10 @@ 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)+ b -> fail ("Expects GArray, but got " ++ show b) parseGObjectToTraversal :: (Traversable t, FromJSON (t GValue), FromGraphSON v)- => HashMap Text GValue+ => KeyMap GValue -> Parser (t v) parseGObjectToTraversal o = traverse parseGraphSON =<< (parseJSON $ Object $ fmap toJSON o) @@ -292,8 +299,8 @@ => 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)+ 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!!!@@ -303,8 +310,8 @@ 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)+ GArray a -> parse $ Right a+ other -> fail ("Expects GObject or GArray, but got " ++ show other) where parse = parseToGMapEntry parseGraphSON parseGraphSON @@ -322,12 +329,18 @@ 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+ parseGraphSON gv = fmap Just $ parseGraphSON gv -- | Try 'Left', then 'Right'. instance (FromGraphSON a, FromGraphSON b) => FromGraphSON (Either a b) where@@ -336,9 +349,6 @@ ---- Trivial wrapper for Maybe -- | @since 0.1.3.0-instance FromGraphSON a => FromGraphSON (S.Option a) where- parseGraphSON = fmap S.Option . parseGraphSON--- | @since 0.1.3.0 instance FromGraphSON a => FromGraphSON (M.First a) where parseGraphSON = fmap M.First . parseGraphSON -- | @since 0.1.3.0@@ -364,3 +374,15 @@ -- 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}")+ ]
src/Data/Greskell/GraphSON/Core.hs view
@@ -1,60 +1,50 @@-{-# LANGUAGE OverloadedStrings, DeriveGeneric #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-} -- | -- Module: Data.Greskell.GraphSON.Core--- Description: +-- Description: -- Maintainer: Toshio Ito <debug.ito@gmail.com> -- -- __Internal module.__ Definition of 'GraphSON' type. module Data.Greskell.GraphSON.Core- ( GraphSON(..),- nonTypedGraphSON,- typedGraphSON,- typedGraphSON',- parseTypedGraphSON,- parseTypedGraphSON'- ) where--import Control.Applicative ((<$>), (<*>))-import Control.Monad (when)-import Data.Aeson- ( ToJSON(toJSON), FromJSON(parseJSON),- object, (.=), Value(..)- )-import qualified Data.Aeson as Aeson-import Data.Aeson.Types (Parser)-import Data.Foldable (Foldable(foldr))-import Data.Hashable (Hashable(..))-import Data.Text (Text)-import Data.Traversable (Traversable(traverse))-import GHC.Generics (Generic)+ ( GraphSON (..)+ , nonTypedGraphSON+ , typedGraphSON+ , typedGraphSON'+ , parseTypedGraphSON+ , parseTypedGraphSON'+ ) where -import Data.Greskell.GraphSON.GraphSONTyped (GraphSONTyped(..))+import Control.Applicative ((<$>), (<*>))+import Control.Monad (when)+import Data.Aeson (FromJSON (parseJSON), ToJSON (toJSON),+ Value (..), object, (.=))+import qualified Data.Aeson as Aeson+import Data.Aeson.Types (Parser)+import Data.Foldable (Foldable (foldr))+import Data.Hashable (Hashable (..))+import Data.Text (Text)+import Data.Traversable (Traversable (traverse))+import GHC.Generics (Generic) --- $setup--- >>> :set -XOverloadedStrings--- >>> import Data.Int (Int32)+import Data.Greskell.GraphSON.GraphSONTyped (GraphSONTyped (..)) -- | Wrapper for \"typed JSON object\" introduced in GraphSON version -- 2. See http://tinkerpop.apache.org/docs/current/dev/io/#graphson -- -- This data type is useful for encoding/decoding GraphSON text.--- --- >>> Aeson.decode "1000" :: Maybe (GraphSON Int32)--- Just (GraphSON {gsonType = Nothing, gsonValue = 1000})--- >>> Aeson.decode "{\"@type\": \"g:Int32\", \"@value\": 1000}" :: Maybe (GraphSON Int32)--- Just (GraphSON {gsonType = Just "g:Int32", gsonValue = 1000}) -- -- Note that encoding of the \"g:Map\" type is inconsistent between -- GraphSON v1 and v2, v3. To handle the encoding, use -- "Data.Greskell.GMap".-data GraphSON v =- GraphSON- { gsonType :: Maybe Text,- -- ^ Type ID, corresponding to @\@type@ field.- gsonValue :: v- -- ^ Value, correspoding to @\@value@ field.- }- deriving (Show,Eq,Ord,Generic)+data GraphSON v+ = GraphSON+ { gsonType :: Maybe Text+ -- ^ Type ID, corresponding to @\@type@ field.+ , gsonValue :: v+ -- ^ Value, correspoding to @\@value@ field.+ }+ deriving (Eq, Generic, Ord, Show) instance Functor GraphSON where fmap f gs = gs { gsonValue = f $ gsonValue gs }@@ -96,23 +86,14 @@ -- | Create a 'GraphSON' without 'gsonType'.------ >>> nonTypedGraphSON (10 :: Int)--- GraphSON {gsonType = Nothing, gsonValue = 10} nonTypedGraphSON :: v -> GraphSON v nonTypedGraphSON = GraphSON Nothing -- | Create a 'GraphSON' with its type ID.------ >>> typedGraphSON (10 :: Int32)--- GraphSON {gsonType = Just "g:Int32", gsonValue = 10} typedGraphSON :: GraphSONTyped v => v -> GraphSON v typedGraphSON v = GraphSON (Just $ gsonTypeFor v) v -- | Create a 'GraphSON' with the given type ID.------ >>> typedGraphSON' "g:Int32" (10 :: Int)--- GraphSON {gsonType = Just "g:Int32", gsonValue = 10} typedGraphSON' :: Text -> v -> GraphSON v typedGraphSON' t = GraphSON (Just t) @@ -144,7 +125,7 @@ Nothing -> return $ Left ("Not a valid typed JSON object.") Just got_type -> do goal <- parseJSON $ gsonValue graphsonv- let exp_type = gsonTypeFor goal + let exp_type = gsonTypeFor goal when (got_type /= exp_type) $ do fail ("Expected @type of " ++ show exp_type ++ ", but got " ++ show got_type) return $ Right $ graphsonv { gsonValue = goal }
src/Data/Greskell/GraphSON/GValue.hs view
@@ -10,36 +10,33 @@ -- -- @since 0.1.2.0 module Data.Greskell.GraphSON.GValue- ( -- * GValue type- GValue(..),- GValueBody(..),- -- ** constructors- nonTypedGValue,- typedGValue',- -- ** deconstructors- -- $caveat_decon- unwrapAll,- unwrapOne,- gValueBody,- gValueType- ) where+ ( -- * GValue type+ GValue (..)+ , GValueBody (..)+ -- ** constructors+ , nonTypedGValue+ , typedGValue'+ -- ** deconstructors+ -- $caveat_decon+ , unwrapAll+ , unwrapOne+ , gValueBody+ , gValueType+ ) where -import Control.Applicative ((<$>), (<*>))-import Data.Aeson- ( ToJSON(toJSON), FromJSON(parseJSON), Value(..)- )-import Data.Aeson.Types (Parser)-import Data.Foldable (foldl')-import Data.Hashable (Hashable(..))-import Data.HashMap.Strict (HashMap)-import Data.Scientific (Scientific)-import Data.Text (Text)-import Data.Vector (Vector)-import GHC.Generics (Generic)+import Control.Applicative ((<$>), (<*>))+import Data.Aeson (FromJSON (parseJSON), ToJSON (toJSON), Value (..))+import Data.Aeson.KeyMap (KeyMap)+import Data.Aeson.Types (Parser)+import Data.Foldable (foldl')+import Data.Hashable (Hashable (..))+import Data.HashMap.Strict (HashMap)+import Data.Scientific (Scientific)+import Data.Text (Text)+import Data.Vector (Vector)+import GHC.Generics (Generic) -import Data.Greskell.GraphSON.Core- ( nonTypedGraphSON, typedGraphSON', GraphSON(..)- )+import Data.Greskell.GraphSON.Core (GraphSON (..), nonTypedGraphSON, typedGraphSON') -- | An Aeson 'Value' wrapped in 'GraphSON' wrapper type. Basically -- this type is the Haskell representaiton of a GraphSON-encoded@@ -47,33 +44,34 @@ -- -- This type is used to parse GraphSON documents. See also -- 'Data.Greskell.GraphSON.FromGraphSON' class.--- +-- -- @since 0.1.2.0-newtype GValue = GValue { unGValue :: GraphSON GValueBody }- deriving (Show,Eq,Generic)+newtype GValue+ = GValue { unGValue :: GraphSON GValueBody }+ deriving (Eq, Generic, Show) instance Hashable GValue -- | 'GValue' without the top-level 'GraphSON' wrapper. ----- @since 0.1.2.0-data GValueBody =- GObject !(HashMap Text GValue)+-- @since 1.0.0.0+data GValueBody+ = GObject !(KeyMap GValue) | GArray !(Vector GValue) | GString !Text | GNumber !Scientific | GBool !Bool | GNull- deriving (Show,Eq,Generic)+ deriving (Eq, Generic, Show) instance Hashable GValueBody where -- See Data.Aeson.Types.Internal- hashWithSalt s (GObject o) = s `hashWithSalt` (0::Int) `hashWithSalt` o- hashWithSalt s (GArray a) = foldl' hashWithSalt (s `hashWithSalt` (1::Int)) a+ hashWithSalt s (GObject o) = s `hashWithSalt` (0::Int) `hashWithSalt` o+ hashWithSalt s (GArray a) = foldl' hashWithSalt (s `hashWithSalt` (1::Int)) a hashWithSalt s (GString str) = s `hashWithSalt` (2::Int) `hashWithSalt` str- hashWithSalt s (GNumber n) = s `hashWithSalt` (3::Int) `hashWithSalt` n- hashWithSalt s (GBool b) = s `hashWithSalt` (4::Int) `hashWithSalt` b- hashWithSalt s GNull = s `hashWithSalt` (5::Int)+ hashWithSalt s (GNumber n) = s `hashWithSalt` (3::Int) `hashWithSalt` n+ hashWithSalt s (GBool b) = s `hashWithSalt` (4::Int) `hashWithSalt` b+ hashWithSalt s GNull = s `hashWithSalt` (5::Int) -- | Parse 'GraphSON' wrappers recursively in 'Value', making it into -- 'GValue'.@@ -85,11 +83,11 @@ where recurse :: Value -> Parser GValueBody recurse (Object o) = GObject <$> traverse parseJSON o- recurse (Array a) = GArray <$> traverse parseJSON a+ recurse (Array a) = GArray <$> traverse parseJSON a recurse (String s) = return $ GString s recurse (Number n) = return $ GNumber n- recurse (Bool b) = return $ GBool b- recurse Null = return GNull+ recurse (Bool b) = return $ GBool b+ recurse Null = return GNull -- | Reconstruct 'Value' from 'GValue'. It preserves all GraphSON -- wrappers.@@ -98,14 +96,14 @@ instance ToJSON GValueBody where toJSON (GObject o) = toJSON o- toJSON (GArray a) = toJSON a+ toJSON (GArray a) = toJSON a toJSON (GString s) = String s toJSON (GNumber n) = Number n- toJSON (GBool b) = Bool b- toJSON GNull = Null+ toJSON (GBool b) = Bool b+ toJSON GNull = Null -- | Create a 'GValue' without \"@type\" field.--- +-- -- @since 0.1.2.0 nonTypedGValue :: GValueBody -> GValue nonTypedGValue = GValue . nonTypedGraphSON@@ -149,11 +147,11 @@ unwrapBase :: (GValue -> Value) -> GValue -> Value unwrapBase mapChild (GValue gson_body) = unwrapBody $ gsonValue gson_body where- unwrapBody GNull = Null- unwrapBody (GBool b) = Bool b+ unwrapBody GNull = Null+ unwrapBody (GBool b) = Bool b unwrapBody (GNumber n) = Number n unwrapBody (GString s) = String s- unwrapBody (GArray a) = Array $ fmap mapChild a+ unwrapBody (GArray a) = Array $ fmap mapChild a unwrapBody (GObject o) = Object $ fmap mapChild o -- | Get the 'GValueBody' from 'GValue'.
src/Data/Greskell/GraphSON/GraphSONTyped.hs view
@@ -1,29 +1,29 @@ {-# LANGUAGE OverloadedStrings #-} -- | -- Module: Data.Greskell.GraphSON.GraphSONTyped--- Description: +-- Description: -- Maintainer: Toshio Ito <debug.ito@gmail.com> -- -- __Internal module.__ Just to resolve cyclic dependency between -- GraphSON and GMap. module Data.Greskell.GraphSON.GraphSONTyped- ( GraphSONTyped(..)- ) where+ ( GraphSONTyped (..)+ ) where -import Data.Text (Text)-import Data.Vector (Vector)-import qualified Data.HashMap.Lazy as L (HashMap)+import qualified Data.HashMap.Lazy as L (HashMap) import qualified Data.HashMap.Strict as S (HashMap)-import Data.HashSet (HashSet)-import Data.Int (Int8, Int16, Int32, Int64)-import qualified Data.IntMap.Lazy as L (IntMap)-import qualified Data.IntMap.Strict as S (IntMap)-import Data.IntSet (IntSet)-import qualified Data.Map.Lazy as L (Map)-import qualified Data.Map.Strict as S (Map)-import Data.Scientific (Scientific)-import Data.Sequence (Seq)-import Data.Set (Set)+import Data.HashSet (HashSet)+import Data.Int (Int16, Int32, Int64, Int8)+import qualified Data.IntMap.Lazy as L (IntMap)+import qualified Data.IntMap.Strict as S (IntMap)+import Data.IntSet (IntSet)+import qualified Data.Map.Lazy as L (Map)+import qualified Data.Map.Strict as S (Map)+import Data.Scientific (Scientific)+import Data.Sequence (Seq)+import Data.Set (Set)+import Data.Text (Text)+import Data.Vector (Vector) -- | Types that have an intrinsic type ID for 'gsonType' field.@@ -91,13 +91,13 @@ gsonTypeFor _= "g:Map" -- -- Implementation of Lazy and Strict types are the same.--- +-- -- instance GraphSONTyped (S.HashMap k v) where -- gsonTypeFor _ = "g:Map"--- +-- -- instance GraphSONTyped (S.Map k v) where -- gsonTypeFor _= "g:Map"--- +-- -- instance GraphSONTyped (S.IntMap v) where -- gsonTypeFor _= "g:Map"
src/Data/Greskell/Greskell.hs view
@@ -1,56 +1,57 @@-{-# LANGUAGE OverloadedStrings, TypeFamilies #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -fno-warn-redundant-constraints #-} -- | -- Module: Data.Greskell.Greskell -- Description: Low-level Gremlin script data type -- Maintainer: Toshio Ito <debug.ito@gmail.com> ----- +-- module Data.Greskell.Greskell- ( -- * Type- Greskell,- ToGreskell(..),- -- * Conversions- toGremlin,- toGremlinLazy,- -- * Literals- --- -- $literals- string,- true,- false,- list,- single,- number,- value,- valueInt,- gvalue,- gvalueInt,- -- * Unsafe constructors- unsafeGreskell,- unsafeGreskellLazy,- unsafeFunCall,- unsafeMethodCall- ) where--import Data.Aeson (Value)-import qualified Data.Aeson as Aeson-import Data.Bifunctor (bimap)-import Data.Foldable (toList)-import qualified Data.HashMap.Lazy as HM-import Data.Monoid (Monoid(..))-import Data.Ratio (numerator, denominator, Rational)-import Data.Scientific (Scientific, coefficient, base10Exponent)-import Data.Semigroup (Semigroup(..))-import Data.String (IsString(..))-import Data.List (intersperse)-import Data.Text (Text, pack, unpack)-import qualified Data.Text.Lazy as TL+ ( -- * Type+ Greskell+ , ToGreskell (..)+ -- * Conversions+ , toGremlin+ , toGremlinLazy+ -- * Literals+ --+ -- $literals+ , string+ , true+ , false+ , list+ , single+ , number+ , value+ , valueInt+ , gvalue+ , gvalueInt+ -- * Unsafe constructors+ , unsafeGreskell+ , unsafeGreskellLazy+ , unsafeFunCall+ , unsafeMethodCall+ -- * Examples+ , examples+ ) where -import Data.Greskell.GraphSON (GValue, GValueBody(..), nonTypedGValue)+import Data.Aeson (Value)+import qualified Data.Aeson as Aeson+import qualified Data.Aeson.Key as Key+import qualified Data.Aeson.KeyMap as KM+import Data.Bifunctor (bimap)+import Data.Foldable (toList)+import Data.List (intersperse)+import Data.Monoid (Monoid (..))+import Data.Ratio (Rational, denominator, numerator)+import Data.Scientific (Scientific, base10Exponent, coefficient)+import Data.Semigroup (Semigroup (..))+import Data.String (IsString (..))+import Data.Text (Text, pack, unpack)+import qualified Data.Text.Lazy as TL --- $--- >>> :set -XOverloadedStrings+import Data.Greskell.GraphSON (GValue, GValueBody (..), nonTypedGValue) -- | Gremlin expression of type @a@. --@@ -60,8 +61,9 @@ -- -- 'Eq' and 'Ord' instances compare Gremlin scripts, NOT the values -- they evaluate to.-newtype Greskell a = Greskell { unGreskell :: TL.Text }- deriving (Show,Eq,Ord)+newtype Greskell a+ = Greskell { unGreskell :: TL.Text }+ deriving (Eq, Ord, Show) -- | Same as 'string' except for the input and output type. instance IsString a => IsString (Greskell a) where@@ -80,7 +82,7 @@ abs (Greskell a) = Greskell ("java.lang.Math.abs" <> paren a) signum (Greskell a) = Greskell ("java.lang.Long.signum" <> paren a) fromInteger val = Greskell (TL.pack $ show val)- + -- | Floating-point number literals and numeric operation in Gremlin instance Fractional a => Fractional (Greskell a) where (/) = biOp "/"@@ -135,9 +137,6 @@ -- | Unsafely create a 'Greskell' of arbitrary type. The given Gremlin -- script is printed as-is.------ >>> toGremlin $ unsafeGreskell "x + 100"--- "x + 100" unsafeGreskell :: Text -- ^ Gremlin script -> Greskell a unsafeGreskell = Greskell . TL.fromStrict@@ -156,32 +155,18 @@ -- | Create a String literal in Gremlin script. The content is -- automatically escaped.------ >>> toGremlin $ string "foo bar"--- "\"foo bar\""--- >>> toGremlin $ string "escape newline\n escape dollar $"--- "\"escape newline\\n escape dollar \\$\"" string :: Text -> Greskell Text string = fromString . unpack -- | Boolean @true@ literal.------ >>> toGremlin true--- "true" true :: Greskell Bool true = unsafeGreskell "true" -- | Boolean @false@ literal.------ >>> toGremlin false--- "false" false :: Greskell Bool false = unsafeGreskell "false" -- | List literal.------ >>> toGremlin $ list ([100, 200, 300] :: [Greskell Int])--- "[100,200,300]" list :: [Greskell a] -> Greskell [a] list gs = unsafeGreskellLazy $ ("[" <> TL.intercalate "," gs_txt <> "]") where@@ -189,28 +174,15 @@ -- | Make a list with a single object. Useful to prevent the Gremlin -- Server from automatically iterating the result object.------ >>> toGremlin $ single ("hoge" :: Greskell Text)--- "[\"hoge\"]" single :: Greskell a -> Greskell [a] single g = list [g] -- | Arbitrary precision number literal, like \"123e8\".------ >>> toGremlin $ number 123e8--- "1.23e10" number :: Scientific -> Greskell Scientific number = unsafeGreskell . pack . show -- | Aeson 'Value' literal. ----- >>> toGremlin $ value Aeson.Null--- "null"--- >>> toGremlin $ value $ Aeson.toJSON $ ([10, 20, 30] :: [Int])--- "[10.0,20.0,30.0]"--- >>> toGremlin $ value $ Aeson.Object mempty--- "[:]"--- -- Note that 'Aeson.Number' does not distinguish integers from -- floating-point numbers, so 'value' function may format an integer -- as a floating-point number. To ensure formatting as integers, use@@ -222,17 +194,14 @@ value (Aeson.String s) = unsafeToValue $ string s value (Aeson.Array v) = unsafeToValue $ list $ map value $ toList v value (Aeson.Object obj)- | HM.null obj = unsafeGreskellLazy "[:]"- | otherwise = unsafeGreskellLazy $ toGroovyMap $ HM.toList obj+ | KM.null obj = unsafeGreskellLazy "[:]"+ | otherwise = unsafeGreskellLazy $ toGroovyMap $ KM.toList obj where toGroovyMap pairs = "[" <> TL.intercalate "," (map toPairText pairs) <> "]"- toPairText (key, val) = (toGremlinLazy $ string key) <> ":" <> (toGremlinLazy $ value val)+ toPairText (key, val) = (toGremlinLazy $ string $ Key.toText key) <> ":" <> (toGremlinLazy $ value val) -- | Integer literal as 'Value' type. ----- >>> toGremlin $ valueInt (100 :: Int)--- "100"--- -- @since 0.1.2.0 valueInt :: Integral a => a -> Greskell Value valueInt n = fmap toValue $ fromIntegral n@@ -250,9 +219,6 @@ -- | Integer literal as 'GValue' type. ----- >>> toGremlin $ gvalueInt (256 :: Int)--- "256"--- -- @since 0.1.2.0 gvalueInt :: Integral a => a -> Greskell GValue gvalueInt n = fmap toGValue $ fromIntegral n@@ -278,9 +244,6 @@ -- | Unsafely create a 'Greskell' that calls the given function with -- the given arguments.------ >>> toGremlin $ unsafeFunCall "add" ["10", "20"]--- "add(10,20)" unsafeFunCall :: Text -- ^ function name -> [Text] -- ^ arguments -> Greskell a -- ^ return value of the function call@@ -288,11 +251,29 @@ -- | Unsafely create a 'Greskell' that calls the given object method -- call with the given target and arguments.------ >>> toGremlin $ unsafeMethodCall ("foobar" :: Greskell Text) "length" []--- "(\"foobar\").length()" unsafeMethodCall :: Greskell a -- ^ target object -> Text -- ^ method name -> [Text] -- ^ arguments -> Greskell b -- ^ return value of the method call unsafeMethodCall target name args = unsafeGreskell ("(" <> toGremlin target <> ")." <> unsafeFunCallText name args)++-- | Examples of using this module. See the source. The 'fst' of the output is the testee, while the+-- 'snd' is the expectation.+examples :: [(Text, Text)]+examples =+ [ (toGremlin $ unsafeGreskell "x + 100", "x + 100")+ , (toGremlin $ string "foo bar", "\"foo bar\"")+ , (toGremlin $ string "escape newline\n escape dollar $", "\"escape newline\\n escape dollar \\$\"")+ , (toGremlin true, "true")+ , (toGremlin false, "false")+ , (toGremlin $ list ([100, 200, 300] :: [Greskell Int]), "[100,200,300]")+ , (toGremlin $ single ("hoge" :: Greskell Text), "[\"hoge\"]")+ , (toGremlin $ number 123e8, "1.23e10")+ , (toGremlin $ value Aeson.Null, "null")+ , (toGremlin $ value $ Aeson.toJSON $ ([10, 20, 30] :: [Int]), "[10.0,20.0,30.0]")+ , (toGremlin $ value $ Aeson.Object mempty, "[:]")+ , (toGremlin $ valueInt (100 :: Int), "100")+ , (toGremlin $ gvalueInt (256 :: Int), "256")+ , (toGremlin $ unsafeFunCall "add" ["10", "20"], "add(10,20)")+ , (toGremlin $ unsafeMethodCall ("foobar" :: Greskell Text) "length" [], "(\"foobar\").length()")+ ]
test/Data/Greskell/GMapSpec.hs view
@@ -1,26 +1,40 @@ {-# LANGUAGE OverloadedStrings #-}-module Data.Greskell.GMapSpec (main,spec) where+module Data.Greskell.GMapSpec+ ( main+ , spec+ ) where -import Data.Aeson (eitherDecode, object, (.=), toJSON, Value(..))-import Data.HashMap.Strict (HashMap)-import qualified Data.HashMap.Strict as HM-import Data.List (isInfixOf)-import Data.Monoid (mempty)-import Data.Vector ((!), Vector)-import qualified Data.Vector as Vec-import Test.Hspec+import Data.Aeson (Value (..), eitherDecode, object, toJSON, (.=))+import qualified Data.Aeson.KeyMap as KM+import Data.HashMap.Strict (HashMap)+import qualified Data.HashMap.Strict as HM+import Data.List (isInfixOf)+import Data.Monoid (mempty)+import Data.Vector (Vector, (!))+import qualified Data.Vector as Vec+import Test.Hspec -import Data.Greskell.GraphSON (GraphSON(..), typedGraphSON, nonTypedGraphSON)-import Data.Greskell.GMap (GMap(..), GMapEntry(..))+import Data.Greskell.GMap (FlattenedMap, GMap (..), GMapEntry (..))+import Data.Greskell.GraphSON (GraphSON (..), nonTypedGraphSON, typedGraphSON) main :: IO () main = hspec spec spec :: Spec spec = do+ spec_FlattenedMap spec_GMap spec_GMapEntry +spec_FlattenedMap :: Spec+spec_FlattenedMap = describe "FlattenedMap" $ do+ specify "decode an array with odd number of elements" $ do+ let got :: Either String (FlattenedMap HashMap Int String)+ got = eitherDecode "[10, \"ten\", 11]"+ case got of+ Right _ -> expectationFailure ("should be Left, but got " ++ show got)+ Left err -> err `shouldContain` "odd number of elements"+ spec_GMap :: Spec spec_GMap = describe "GraphSON GMap" $ do describe "non-flat" $ do@@ -51,8 +65,8 @@ String "a", Number 1 ] (Object got) = toJSON val- HM.lookup "@type" got `shouldBe` (Just $ String "g:Map")- let (Just (Array got_flat)) = HM.lookup "@value" got+ KM.lookup "@type" got `shouldBe` (Just $ String "g:Map")+ let (Just (Array got_flat)) = KM.lookup "@value" got pairList got_flat `shouldMatchList` pairList exp_flat specify "FromJSON empty" $ do let val_empty :: GraphSON (GMap HashMap String Int)
test/Data/Greskell/GraphSONSpec.hs view
@@ -1,30 +1,32 @@-{-# LANGUAGE OverloadedStrings, NoMonomorphismRestriction, CPP #-}-module Data.Greskell.GraphSONSpec (main,spec) where+{-# LANGUAGE CPP #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE OverloadedStrings #-}+module Data.Greskell.GraphSONSpec+ ( main+ , spec+ ) where -import Data.Aeson (object, (.=), ToJSON(..), FromJSON(..), Value(..))-import qualified Data.Aeson as Aeson-import Data.Aeson.Types (parseEither, Value(..), Parser)-import qualified Data.ByteString.Lazy as BSL-import Data.Either (isLeft)-import Data.HashMap.Strict (HashMap)-import qualified Data.HashMap.Strict as HM-import Data.List (isInfixOf)-import Data.Int (Int32)-import Data.Monoid ((<>))-import Data.Text (Text)-import qualified Data.Vector as V-import Test.Hspec+import Data.Aeson (FromJSON (..), ToJSON (..), Value (..), object,+ (.=))+import qualified Data.Aeson as Aeson+import qualified Data.Aeson.KeyMap as KM+import Data.Aeson.Types (Parser, Value (..), parseEither)+import qualified Data.ByteString.Lazy as BSL+import Data.Either (isLeft)+import Data.HashMap.Strict (HashMap)+import qualified Data.HashMap.Strict as HM+import Data.Int (Int32)+import Data.List (isInfixOf)+import Data.Monoid ((<>))+import Data.Text (Text)+import qualified Data.Vector as V+import Test.Hspec -import Data.Greskell.GMap (GMapEntry(..), unGMapEntry)-import Data.Greskell.GraphSON- ( GraphSON, parseTypedGraphSON,- -- parseTypedGraphSON',- typedGraphSON', nonTypedGraphSON,- nonTypedGValue, typedGValue',- GValue, GValueBody(..),- FromGraphSON(..)- )-import Data.Greskell.GraphSON.GValue (unwrapAll, unwrapOne)+import Data.Greskell.GMap (GMapEntry (..), unGMapEntry)+import Data.Greskell.GraphSON (FromGraphSON (..), GValue, GValueBody (..),+ GraphSON, nonTypedGValue, nonTypedGraphSON,+ parseTypedGraphSON, typedGValue', typedGraphSON')+import Data.Greskell.GraphSON.GValue (unwrapAll, unwrapOne) main :: IO () main = hspec spec@@ -189,9 +191,9 @@ fromToJSON "wrapped array" (gson "g:List" "[null, \"foo\", 100]") (wrapped "g:List" $ GArray $ fmap bare $ V.fromList [GNull, GString "foo", GNumber 100]) fromToJSON "bare object" "{\"foo\": \"bar\", \"hoge\": 99, \"quux\": null}"- (bare $ GObject $ fmap bare $ HM.fromList [("foo", GString "bar"), ("hoge", GNumber 99), ("quux", GNull)])+ (bare $ GObject $ fmap bare $ KM.fromList [("foo", GString "bar"), ("hoge", GNumber 99), ("quux", GNull)]) fromToJSON "wrapped object" (gson "g:Map" "{\"foo\": \"bar\", \"hoge\": 99, \"quux\": null}")- (wrapped "g:Map" $ GObject $ fmap bare $ HM.fromList [("foo", GString "bar"), ("hoge", GNumber 99), ("quux", GNull)])+ (wrapped "g:Map" $ GObject $ fmap bare $ KM.fromList [("foo", GString "bar"), ("hoge", GNumber 99), ("quux", GNull)]) nested_spec double_wrap_spec decode_error_spec@@ -208,7 +210,7 @@ nested_spec = fromToJSON "mixed nested" nestedSample expected where expected = wrapped "g:List" $ GArray $ V.fromList [ bare $ GNumber 100, exp_a, exp_b ]- exp_a = wrapped "g:Map" $ GObject $ HM.fromList+ exp_a = wrapped "g:Map" $ GObject $ KM.fromList [ ("foo", bare $ GNumber 100), ("bar", wrapped "g:Int" $ GNumber 200) ]@@ -218,7 +220,7 @@ exp_c, wrapped "g:Boolean" $ GBool False ]- exp_c = bare $ GObject $ HM.fromList+ exp_c = bare $ GObject $ KM.fromList [ ("xxx", wrapped "g:Int" $ GNumber 200), ("yyy", bare $ GBool True) ]@@ -230,7 +232,7 @@ double_wrap_spec = fromToJSON "double wrapped" input expected where input = gson "g:Object" $ gson "g:Int" "100"- expected = wrapped "g:Object" $ GObject $ HM.fromList+ expected = wrapped "g:Object" $ GObject $ KM.fromList [ ("@type", bare $ GString "g:Int"), ("@value", bare $ GNumber 100) ]@@ -251,7 +253,7 @@ forceDecode :: FromJSON a => BSL.ByteString -> a forceDecode json = case Aeson.eitherDecode json of Left err -> error ("Unexpected decode failure: " <> err)- Right a -> a+ Right a -> a fromToJSON :: String -> BSL.ByteString -> GValue -> Spec fromToJSON label input_json expected = specify label $ do@@ -262,7 +264,7 @@ decoded = forceDecode input_json encoded = Aeson.toJSON decoded exp_enc = forceDecode input_json- + bare :: GValueBody -> GValue bare = nonTypedGValue @@ -274,7 +276,7 @@ fromLeft' :: (Show a, Show b) => Either a b -> a fromLeft' (Left a) = a-fromLeft' e = error ("Expecting Left, but got " ++ show e)+fromLeft' e = error ("Expecting Left, but got " ++ show e) unwrap_spec :: Spec unwrap_spec = do
test/Data/Greskell/GreskellSpec.hs view
@@ -1,20 +1,19 @@ {-# LANGUAGE OverloadedStrings #-}-module Data.Greskell.GreskellSpec (main,spec) where+module Data.Greskell.GreskellSpec+ ( main+ , spec+ ) where -import qualified Data.Aeson as Aeson-import Data.String (fromString)-import Data.Text (Text, pack)-import Test.Hspec-import Test.QuickCheck (property)+import qualified Data.Aeson as Aeson+import Data.String (fromString)+import Data.Text (Text, pack)+import Test.Hspec+import Test.QuickCheck (property) -import Data.Greskell.Greskell- ( unsafeGreskell, toGremlin,- unsafeFunCall,- string, list, true, false, number, value,- Greskell- )+import Data.Greskell.Greskell (Greskell, false, list, number, string, toGremlin,+ true, unsafeFunCall, unsafeGreskell, value) -import Data.Greskell.Test.QuickCheck ()+import Data.Greskell.Test.QuickCheck () main :: IO () main = hspec spec@@ -108,7 +107,7 @@ toGremlin (value $ Aeson.toJSON [(5 :: Int), 6, 7]) `shouldBe` "[5.0,6.0,7.0]" specify "empty Object" $ do toGremlin (value $ Aeson.object []) `shouldBe` "[:]"- + checkStringLiteral :: String -> Text -> Expectation checkStringLiteral input expected = do
test/Data/Greskell/Test/QuickCheck.hs view
@@ -1,10 +1,11 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} -- | QuickCheck orphan instances and other utility. module Data.Greskell.Test.QuickCheck- () where+ (+ ) where -import Data.Text (Text, pack)-import Test.QuickCheck (Arbitrary(..))+import Data.Text (Text, pack)+import Test.QuickCheck (Arbitrary (..)) instance Arbitrary Text where arbitrary = fmap pack arbitrary
− test/DocTest.hs
@@ -1,1 +0,0 @@-{-# OPTIONS_GHC -F -pgmF doctest-discover #-}
+ test/ExamplesSpec.hs view
@@ -0,0 +1,23 @@+module ExamplesSpec+ ( main+ , spec+ ) where++import qualified Data.Greskell.GMap as GMap+import qualified Data.Greskell.GraphSON as GraphSON+import qualified Data.Greskell.Greskell as Greskell++import Control.Monad (forM_)+import Test.Hspec++main :: IO ()+main = hspec spec++spec :: Spec+spec = describe "examples" $ do+ makeSpec "GraphSON" GraphSON.examples+ makeSpec "Greskell" Greskell.examples+ makeSpec "GMap" GMap.examples++makeSpec :: (Show a) => String -> [(a, a)] -> Spec+makeSpec label exs = describe label $ forM_ exs $ \(got, expected) -> specify (show expected) $ show got `shouldBe` show expected