diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,5 @@ +# Revision history for greskell-core + +## 0.1.0.0 -- 2018-03-12 + +* First version. Released on an unsuspecting world. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2017, Toshio Ito + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Toshio Ito nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,9 @@ +# greskell-core + +Haskell binding for Gremlin query language. + +See the package description, or [project README](https://github.com/debug-ito/greskell/blob/master/README.md). + +## Author + +Toshio Ito diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/greskell-core.cabal b/greskell-core.cabal new file mode 100644 --- /dev/null +++ b/greskell-core.cabal @@ -0,0 +1,63 @@ +name: greskell-core +version: 0.1.0.0 +author: Toshio Ito +maintainer: Toshio Ito +license: BSD3 +license-file: LICENSE +synopsis: Haskell binding for Gremlin graph query language - core data types and tools +description: Haskell binding for [Gremlin graph query language](http://tinkerpop.apache.org/gremlin.html). + See [README.md](https://github.com/debug-ito/greskell/blob/master/README.md) for detail. + . + This package contains only core data types and tools used commonly by other related packages. +category: Data +cabal-version: >= 1.10 +build-type: Simple +extra-source-files: README.md, ChangeLog.md +homepage: https://github.com/debug-ito/greskell/ +bug-reports: https://github.com/debug-ito/greskell/issues/ + +library + default-language: Haskell2010 + hs-source-dirs: src + ghc-options: -Wall -fno-warn-unused-imports + -- default-extensions: + other-extensions: OverloadedStrings, TypeFamilies + exposed-modules: Data.Greskell.Greskell, + Data.Greskell.GraphSON + -- other-modules: + build-depends: base >=4.9.0.0 && <4.11, + aeson >=0.11.2.1 && <1.4, + unordered-containers >=0.2.7.1 && <0.3, + scientific >=0.3.4.9 && <0.4, + text >=1.2.2.1 && <1.3 + +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" + main-is: Spec.hs + -- default-extensions: + other-extensions: OverloadedStrings + other-modules: Data.Greskell.GreskellSpec, + Data.Greskell.Test.QuickCheck + build-depends: base, text, aeson, + greskell-core, + hspec >=2.2.3, + QuickCheck >=2.8.2 && <2.12 + +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-depends: base, + doctest >=0.11 && <0.15, + doctest-discover >=0.1.0.7 && <0.2 + + + +source-repository head + type: git + location: https://github.com/debug-ito/greskell.git diff --git a/src/Data/Greskell/GraphSON.hs b/src/Data/Greskell/GraphSON.hs new file mode 100644 --- /dev/null +++ b/src/Data/Greskell/GraphSON.hs @@ -0,0 +1,164 @@ +{-# LANGUAGE OverloadedStrings #-} +-- | +-- Module: Data.Greskell.GraphSON +-- Description: Encoding and decoding GraphSON +-- Maintainer: Toshio Ito +-- +-- +module Data.Greskell.GraphSON + ( -- * Type + GraphSON(..), + GraphSONTyped(..), + -- * Constructors + nonTypedGraphSON, + typedGraphSON, + typedGraphSON', + -- * Parser support + parseTypedGraphSON + ) where + +import Control.Applicative ((<$>), (<*>)) +import Control.Monad (when) +import Data.Aeson (ToJSON(toJSON), FromJSON(parseJSON), object, (.=), Value(Object), (.:?)) +import qualified Data.Aeson as Aeson +import Data.Aeson.Types (Parser) +import Data.Foldable (Foldable(foldr)) +import qualified Data.HashMap.Lazy as HML +import Data.HashSet (HashSet) +import Data.Int (Int8, Int16, Int32, Int64) +import Data.Scientific (Scientific) +import Data.Text (Text) +import Data.Traversable (Traversable(traverse)) + +-- $ +-- >>> :set -XOverloadedStrings + +-- | 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}) +data GraphSON v = + GraphSON + { gsonType :: Maybe Text, + -- ^ Type ID, corresponding to @\@type@ field. + gsonValue :: v + -- ^ Value, correspoding to @\@value@ field. + } + deriving (Show,Eq,Ord) + +instance Functor GraphSON where + fmap f gs = gs { gsonValue = f $ gsonValue gs } + +instance Foldable GraphSON where + foldr f start gs = f (gsonValue gs) start + +instance Traversable GraphSON where + traverse f gs = fmap (\v -> gs { gsonValue = v }) $ f $ gsonValue gs + +-- | 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) + +-- | If 'gsonType' is 'Just', the 'GraphSON' is encoded as a typed +-- JSON object. If 'gsonType' is 'Nothing', the 'gsonValue' is +-- directly encoded. +instance ToJSON v => ToJSON (GraphSON v) where + toJSON gson = case gsonType gson of + Nothing -> toJSON $ gsonValue gson + Just t -> object [ "@type" .= t, + "@value" .= gsonValue gson + ] + +-- | If the given 'Value' is a typed JSON object, 'gsonType' field of +-- the result is 'Just'. Otherwise, the given 'Value' is directly +-- parsed into 'gsonValue', and 'gsonType' is 'Nothing'. +instance FromJSON v => FromJSON (GraphSON v) where + parseJSON v@(Object o) = do + if length o /= 2 + then parseDirect v + else do + mtype <- o .:? "@type" + mvalue <- o .:? "@value" + maybe (parseDirect v) return $ typedGraphSON' <$> mtype <*> mvalue + parseJSON v = parseDirect v + +parseDirect :: FromJSON v => Value -> Parser (GraphSON v) +parseDirect v = GraphSON Nothing <$> parseJSON v + + +-- | Types that have an intrinsic type ID for 'gsonType' field. +class GraphSONTyped a where + gsonTypeFor :: a -> Text + -- ^ Type ID for 'gsonType'. + +instance GraphSONTyped Char where + gsonTypeFor _ = "gx:Char" + +-- | Map to \"gx:Byte\". Note that Java's Byte is signed. +instance GraphSONTyped Int8 where + gsonTypeFor _ = "gx:Byte" + +instance GraphSONTyped Int16 where + gsonTypeFor _ = "gx:Int16" + +instance GraphSONTyped Int32 where + gsonTypeFor _ = "g:Int32" + +instance GraphSONTyped Int64 where + gsonTypeFor _ = "g:Int64" + +instance GraphSONTyped Float where + gsonTypeFor _ = "g:Float" + +instance GraphSONTyped Double where + gsonTypeFor _ = "g:Double" + +instance GraphSONTyped [a] where + gsonTypeFor _ = "g:List" + +-- | Map to \"g:Double\". +instance GraphSONTyped Scientific where + gsonTypeFor _ = "g:Double" + +-- | Note that Lazy HashMap and Strict HashMap are the same data type. +instance GraphSONTyped (HML.HashMap k v) where + gsonTypeFor _ = "g:Map" + +instance GraphSONTyped (HashSet a) where + gsonTypeFor _ = "g:Set" + + +-- | Parse @GraphSON v@, but it checks 'gsonType'. If 'gsonType' is +-- 'Nothing' or it's not equal to 'gsonTypeFor', the 'Parser' fails. +parseTypedGraphSON :: (GraphSONTyped v, FromJSON v) => Value -> Parser (GraphSON v) +parseTypedGraphSON v = checkType =<< parseJSON v + where + checkType gson = do + let exp_type = gsonTypeFor $ gsonValue gson + mgot_type = gsonType gson + when (mgot_type /= Just exp_type) $ do + fail ("Expected @type of " ++ show exp_type ++ ", but got " ++ show mgot_type) + return gson + diff --git a/src/Data/Greskell/Greskell.hs b/src/Data/Greskell/Greskell.hs new file mode 100644 --- /dev/null +++ b/src/Data/Greskell/Greskell.hs @@ -0,0 +1,251 @@ +{-# LANGUAGE OverloadedStrings, TypeFamilies #-} +{-# OPTIONS_GHC -fno-warn-redundant-constraints #-} +-- | +-- Module: Data.Greskell.Greskell +-- Description: Low-level Gremlin script data type +-- Maintainer: Toshio Ito +-- +-- +module Data.Greskell.Greskell + ( -- * Type + Greskell, + ToGreskell(..), + -- * Conversions + toGremlin, + toGremlinLazy, + -- * Literals + -- + -- $literals + string, + true, + false, + list, + single, + number, + value, + -- * 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.String (IsString(..)) +import Data.List (intersperse) +import Data.Text (Text, pack, unpack) +import qualified Data.Text.Lazy as TL + +-- $ +-- >>> :set -XOverloadedStrings + +-- | Gremlin expression of type @a@. +-- +-- 'Greskell' is essentially just a piece of Gremlin script with a +-- phantom type. The type @a@ represents the type of data that the +-- script is supposed to evaluate to. +-- +-- 'Eq' and 'Ord' instances compare Gremlin scripts, NOT the values +-- they evaluate to. +newtype Greskell a = Greskell { unGreskell :: TL.Text } + deriving (Show,Eq,Ord) + +-- | Same as 'string' except for the input and output type. +instance IsString a => IsString (Greskell a) where + fromString = Greskell . TL.pack . escapeDQuotes + +-- | Unsafely convert the phantom type. +instance Functor Greskell where + fmap _ = Greskell . unGreskell + +-- | Integer literals and numeric operation in Gremlin +instance Num a => Num (Greskell a) where + (+) = biOp "+" + (-) = biOp "-" + (*) = biOp "*" + negate (Greskell a) = Greskell ("-" <> paren a) + 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 "/" + recip (Greskell a) = Greskell ("1.0/" <> paren a) + fromRational rat = Greskell $ scriptOf numerator <> ".0/" <> scriptOf denominator + where + scriptOf accessor = TL.pack $ show $ accessor rat + +-- | Monoidal operations on 'Greskell' assumes @String@ operations in +-- Gremlin. 'mempty' is the empty String, and 'mappend' is String +-- concatenation. +instance IsString a => Monoid (Greskell a) where + mempty = fromString "" + mappend = biOp "+" + +-- | Something that can convert to 'Greskell'. +class ToGreskell a where + type GreskellReturn a + -- ^ type of return value by Greskell. + toGreskell :: a -> Greskell (GreskellReturn a) + +-- | It's just 'id'. +instance ToGreskell (Greskell a) where + type GreskellReturn (Greskell a) = a + toGreskell = id + + +biOp :: TL.Text -> Greskell a -> Greskell a -> Greskell a +biOp operator (Greskell a) (Greskell b) = Greskell (paren a <> operator <> paren b) + +paren :: TL.Text -> TL.Text +paren t = "(" <> t <> ")" + +escapeDQuotes :: String -> String +escapeDQuotes orig = ('"' : (esc =<< orig)) ++ "\"" + where + esc c = case c of + '\n' -> "\\n" + '\r' -> "\\r" + '\t' -> "\\t" + '\\' -> "\\\\" + '"' -> "\\\"" + '$' -> "\\$" + x -> [x] + -- do we have to espace other characters? + + +-- | 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 + +-- | Same as 'unsafeGreskell', but it takes lazy 'TL.Text'. +unsafeGreskellLazy :: TL.Text -- ^ Gremlin script + -> Greskell a +unsafeGreskellLazy = Greskell + + +-- $literals +-- +-- Functions to create literals in Gremlin script. Use 'fromInteger' +-- to create integer literals. Use 'fromRational' or 'number' to +-- create floating-point data literals. + +-- | 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 + gs_txt = map toGremlinLazy gs + +-- | Make a list with a single object. Useful to prevent the Gremlin +-- Server from automatically iterating the result object. +-- +-- >>> toGremlin $ single ("hoge" :: Greskell String) +-- "[\"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 +-- "[:]" +value :: Value -> Greskell Value +value Aeson.Null = unsafeGreskellLazy "null" +value (Aeson.Bool b) = unsafeToValue (if b then true else false) +value (Aeson.Number sci) = unsafeToValue $ number sci +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 + where + toGroovyMap pairs = "[" <> TL.intercalate "," (map toPairText pairs) <> "]" + toPairText (key, val) = (toGremlinLazy $ string key) <> ":" <> (toGremlinLazy $ value val) + + +unsafeToValue :: Greskell a -> Greskell Value +unsafeToValue = fmap (const Aeson.Null) + +-- | Create a readable Gremlin script from 'Greskell'. +toGremlin :: ToGreskell a => a -> Text +toGremlin = TL.toStrict . unGreskell . toGreskell + +-- | Same as 'toGremlin' except that this returns lazy 'TL.Text'. +toGremlinLazy :: ToGreskell a => a -> TL.Text +toGremlinLazy = unGreskell . toGreskell + +unsafeFunCallText :: Text -> [Text] -> Text +unsafeFunCallText fun_name args = fun_name <> "(" <> args_g <> ")" + where + args_g = mconcat $ intersperse "," args + +-- | 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 +unsafeFunCall fun_name args = unsafeGreskell $ unsafeFunCallText fun_name args + +-- | Unsafely create a 'Greskell' that calls the given object method +-- call with the given target and arguments. +-- +-- >>> toGremlin $ unsafeMethodCall ("foobar" :: Greskell String) "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) diff --git a/test/Data/Greskell/GreskellSpec.hs b/test/Data/Greskell/GreskellSpec.hs new file mode 100644 --- /dev/null +++ b/test/Data/Greskell/GreskellSpec.hs @@ -0,0 +1,117 @@ +{-# LANGUAGE OverloadedStrings #-} +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 Data.Greskell.Greskell + ( unsafeGreskell, toGremlin, + unsafeFunCall, + string, list, true, false, number, value, + Greskell + ) + +import Data.Greskell.Test.QuickCheck () + +main :: IO () +main = hspec spec + +spec :: Spec +spec = do + spec_literals + spec_other + +spec_other :: Spec +spec_other = do + describe "unsafeGreskell" $ it "should be just a raw script text" $ property $ \t -> + (toGremlin $ unsafeGreskell t) `shouldBe` t + describe "Num" $ do + specify "integer" $ do + let x = 123 :: Greskell Int + toGremlin x `shouldBe` "123" + specify "negative integer" $ do + let x = -56 :: Greskell Int + toGremlin x `shouldBe` "-(56)" + specify "operations" $ do + let x = (30 + 15 * 20 - 10) :: Greskell Int + toGremlin x `shouldBe` "((30)+((15)*(20)))-(10)" + specify "abs, signum" $ do + let x = (signum $ abs (-100)) :: Greskell Int + toGremlin x `shouldBe` "java.lang.Long.signum(java.lang.Math.abs(-(100)))" + describe "Fractional" $ do + specify "floating point literal" $ do + let x = 92.12 :: Greskell Double + (toGremlin x) `shouldBe` "2303.0/25" + specify "operations" $ do + let x = (100.5 * recip 30.0 / 20.2) :: Greskell Double + toGremlin x `shouldBe` "((201.0/2)*(1.0/(30.0/1)))/(101.0/5)" + describe "Monoid" $ do + specify "mempty" $ do + let got = mempty :: Greskell Text + toGremlin got `shouldBe` "\"\"" + specify "mappend" $ do + let got = (mappend "foo" "bar") :: Greskell Text + toGremlin got `shouldBe` "(\"foo\")+(\"bar\")" + describe "unsafeFunCall" $ do + it "should make function call" $ do + (toGremlin $ unsafeFunCall "fun" ["foo", "bar"]) `shouldBe` "fun(foo,bar)" + +spec_literals :: Spec +spec_literals = do + describe "string and fromString" $ do + specify "empty" $ checkStringLiteral "" "\"\"" + specify "words" $ checkStringLiteral "hoge foo bar" "\"hoge foo bar\"" + specify "escaped" $ checkStringLiteral "foo 'aaa \n \t \\ \"bar\"" "\"foo 'aaa \\n \\t \\\\ \\\"bar\\\"\"" + describe "list" $ do + specify "empty" $ do + toGremlin (list []) `shouldBe` "[]" + specify "num" $ do + toGremlin (list $ [(10 :: Greskell Int), 20, 30]) `shouldBe` "[10,20,30]" + specify "list of lists" $ do + toGremlin (list $ map list $ [[("" :: Greskell Text)], ["foo", "bar"], ["buzz"]]) + `shouldBe` "[[\"\"],[\"foo\",\"bar\"],[\"buzz\"]]" + describe "boolean" $ do + specify "true" $ do + toGremlin true `shouldBe` "true" + specify "false" $ do + toGremlin false `shouldBe` "false" + describe "number" $ do + specify "zero" $ do + toGremlin (number 0) `shouldBe` "0.0" + specify "positive integer" $ do + toGremlin (number 1234) `shouldBe` "1234.0" + specify "negative integer" $ do + toGremlin (number (-292)) `shouldBe` "-292.0" + specify "positive floating" $ do + toGremlin (number 32.123) `shouldBe` "32.123" + specify "negative floating" $ do + toGremlin (number (-0.0943)) `shouldBe` "-9.43e-2" + specify "big positive integer" $ do + toGremlin (number 3.23e9) `shouldBe` "3.23e9" + describe "value" $ do + specify "null" $ do + toGremlin (value Aeson.Null) `shouldBe` "null" + specify "bool" $ do + toGremlin (value $ Aeson.Bool False) `shouldBe` "false" + specify "integer" $ do + toGremlin (value $ Aeson.Number 100) `shouldBe` "100.0" + specify "floating-point number" $ do + toGremlin (value $ Aeson.Number 10.23) `shouldBe` "10.23" + specify "String" $ do + toGremlin (value $ Aeson.String "foobar") `shouldBe` "\"foobar\"" + specify "empty Array" $ do + toGremlin (value $ Aeson.toJSON ([] :: [Int])) `shouldBe` "[]" + specify "non-empty Array" $ do + 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 + let input' = fromString input :: Greskell Text + (toGremlin $ input') `shouldBe` expected + (toGremlin $ string $ pack input) `shouldBe` expected diff --git a/test/Data/Greskell/Test/QuickCheck.hs b/test/Data/Greskell/Test/QuickCheck.hs new file mode 100644 --- /dev/null +++ b/test/Data/Greskell/Test/QuickCheck.hs @@ -0,0 +1,12 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +-- | QuickCheck orphan instances and other utility. +module Data.Greskell.Test.QuickCheck + () where + +import Data.Text (Text, pack) +import Test.QuickCheck (Arbitrary(..)) + +instance Arbitrary Text where + arbitrary = fmap pack arbitrary + + diff --git a/test/DocTest.hs b/test/DocTest.hs new file mode 100644 --- /dev/null +++ b/test/DocTest.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF doctest-discover #-} diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-}