{-# LANGUAGE OverloadedStrings, 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

import Data.Greskell.GraphSON (GValue, GValueBody(..), nonTypedGValue)

-- $
-- >>> :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 { Greskell a -> Text
unGreskell :: TL.Text }
                   deriving (Int -> Greskell a -> ShowS
[Greskell a] -> ShowS
Greskell a -> String
(Int -> Greskell a -> ShowS)
-> (Greskell a -> String)
-> ([Greskell a] -> ShowS)
-> Show (Greskell a)
forall a. Int -> Greskell a -> ShowS
forall a. [Greskell a] -> ShowS
forall a. Greskell a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Greskell a] -> ShowS
$cshowList :: forall a. [Greskell a] -> ShowS
show :: Greskell a -> String
$cshow :: forall a. Greskell a -> String
showsPrec :: Int -> Greskell a -> ShowS
$cshowsPrec :: forall a. Int -> Greskell a -> ShowS
Show,Greskell a -> Greskell a -> Bool
(Greskell a -> Greskell a -> Bool)
-> (Greskell a -> Greskell a -> Bool) -> Eq (Greskell a)
forall a. Greskell a -> Greskell a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Greskell a -> Greskell a -> Bool
$c/= :: forall a. Greskell a -> Greskell a -> Bool
== :: Greskell a -> Greskell a -> Bool
$c== :: forall a. Greskell a -> Greskell a -> Bool
Eq,Eq (Greskell a)
Eq (Greskell a)
-> (Greskell a -> Greskell a -> Ordering)
-> (Greskell a -> Greskell a -> Bool)
-> (Greskell a -> Greskell a -> Bool)
-> (Greskell a -> Greskell a -> Bool)
-> (Greskell a -> Greskell a -> Bool)
-> (Greskell a -> Greskell a -> Greskell a)
-> (Greskell a -> Greskell a -> Greskell a)
-> Ord (Greskell a)
Greskell a -> Greskell a -> Bool
Greskell a -> Greskell a -> Ordering
Greskell a -> Greskell a -> Greskell a
forall a. Eq (Greskell a)
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Greskell a -> Greskell a -> Bool
forall a. Greskell a -> Greskell a -> Ordering
forall a. Greskell a -> Greskell a -> Greskell a
min :: Greskell a -> Greskell a -> Greskell a
$cmin :: forall a. Greskell a -> Greskell a -> Greskell a
max :: Greskell a -> Greskell a -> Greskell a
$cmax :: forall a. Greskell a -> Greskell a -> Greskell a
>= :: Greskell a -> Greskell a -> Bool
$c>= :: forall a. Greskell a -> Greskell a -> Bool
> :: Greskell a -> Greskell a -> Bool
$c> :: forall a. Greskell a -> Greskell a -> Bool
<= :: Greskell a -> Greskell a -> Bool
$c<= :: forall a. Greskell a -> Greskell a -> Bool
< :: Greskell a -> Greskell a -> Bool
$c< :: forall a. Greskell a -> Greskell a -> Bool
compare :: Greskell a -> Greskell a -> Ordering
$ccompare :: forall a. Greskell a -> Greskell a -> Ordering
$cp1Ord :: forall a. Eq (Greskell a)
Ord)

-- | Same as 'string' except for the input and output type.
instance IsString a => IsString (Greskell a) where
  fromString :: String -> Greskell a
fromString = Text -> Greskell a
forall a. Text -> Greskell a
Greskell (Text -> Greskell a) -> (String -> Text) -> String -> Greskell a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
TL.pack (String -> Text) -> ShowS -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
escapeDQuotes

-- | Unsafely convert the phantom type.
instance Functor Greskell where
  fmap :: (a -> b) -> Greskell a -> Greskell b
fmap a -> b
_ = Text -> Greskell b
forall a. Text -> Greskell a
Greskell (Text -> Greskell b)
-> (Greskell a -> Text) -> Greskell a -> Greskell b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Greskell a -> Text
forall a. Greskell a -> Text
unGreskell

-- | Integer literals and numeric operation in Gremlin
instance Num a => Num (Greskell a) where
  + :: Greskell a -> Greskell a -> Greskell a
(+) = Text -> Greskell a -> Greskell a -> Greskell a
forall a. Text -> Greskell a -> Greskell a -> Greskell a
biOp Text
"+"
  (-) = Text -> Greskell a -> Greskell a -> Greskell a
forall a. Text -> Greskell a -> Greskell a -> Greskell a
biOp Text
"-"
  * :: Greskell a -> Greskell a -> Greskell a
(*) = Text -> Greskell a -> Greskell a -> Greskell a
forall a. Text -> Greskell a -> Greskell a -> Greskell a
biOp Text
"*"
  negate :: Greskell a -> Greskell a
negate (Greskell Text
a) = Text -> Greskell a
forall a. Text -> Greskell a
Greskell (Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
paren Text
a)
  abs :: Greskell a -> Greskell a
abs (Greskell Text
a) = Text -> Greskell a
forall a. Text -> Greskell a
Greskell (Text
"java.lang.Math.abs" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
paren Text
a)
  signum :: Greskell a -> Greskell a
signum (Greskell Text
a) = Text -> Greskell a
forall a. Text -> Greskell a
Greskell (Text
"java.lang.Long.signum" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
paren Text
a)
  fromInteger :: Integer -> Greskell a
fromInteger Integer
val = Text -> Greskell a
forall a. Text -> Greskell a
Greskell (String -> Text
TL.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show Integer
val)
  
-- | Floating-point number literals and numeric operation in Gremlin
instance Fractional a => Fractional (Greskell a) where
  / :: Greskell a -> Greskell a -> Greskell a
(/) = Text -> Greskell a -> Greskell a -> Greskell a
forall a. Text -> Greskell a -> Greskell a -> Greskell a
biOp Text
"/"
  recip :: Greskell a -> Greskell a
recip (Greskell Text
a) = Text -> Greskell a
forall a. Text -> Greskell a
Greskell (Text
"1.0/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
paren Text
a)
  fromRational :: Rational -> Greskell a
fromRational Rational
rat = Text -> Greskell a
forall a. Text -> Greskell a
Greskell (Text -> Greskell a) -> Text -> Greskell a
forall a b. (a -> b) -> a -> b
$ (Rational -> Integer) -> Text
scriptOf Rational -> Integer
forall a. Ratio a -> a
numerator Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".0/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Rational -> Integer) -> Text
scriptOf Rational -> Integer
forall a. Ratio a -> a
denominator
    where
      scriptOf :: (Rational -> Integer) -> Text
scriptOf Rational -> Integer
accessor = String -> Text
TL.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show (Integer -> String) -> Integer -> String
forall a b. (a -> b) -> a -> b
$ Rational -> Integer
accessor Rational
rat

-- | Semigroup operator '<>' on 'Greskell' assumes @String@
-- concatenation on Gremlin.
instance IsString a => Semigroup (Greskell a) where
  <> :: Greskell a -> Greskell a -> Greskell a
(<>) = Text -> Greskell a -> Greskell a -> Greskell a
forall a. Text -> Greskell a -> Greskell a -> Greskell a
biOp Text
"+"

-- | 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 :: Greskell a
mempty = String -> Greskell a
forall a. IsString a => String -> a
fromString String
""
  mappend :: Greskell a -> Greskell a -> Greskell a
mappend = Greskell a -> Greskell a -> Greskell a
forall a. Semigroup a => a -> a -> a
(<>)

-- | 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 :: Greskell a -> Greskell (GreskellReturn (Greskell a))
toGreskell = Greskell a -> Greskell (GreskellReturn (Greskell a))
forall a. a -> a
id


biOp :: TL.Text -> Greskell a -> Greskell a -> Greskell a
biOp :: Text -> Greskell a -> Greskell a -> Greskell a
biOp Text
operator (Greskell Text
a) (Greskell Text
b) = Text -> Greskell a
forall a. Text -> Greskell a
Greskell (Text -> Text
paren Text
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
operator Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
paren Text
b)

paren :: TL.Text -> TL.Text
paren :: Text -> Text
paren Text
t = Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"

escapeDQuotes :: String -> String
escapeDQuotes :: ShowS
escapeDQuotes String
orig = (Char
'"' Char -> ShowS
forall a. a -> [a] -> [a]
: (Char -> String
esc (Char -> String) -> ShowS
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String
orig)) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\""
  where
    esc :: Char -> String
esc Char
c = case Char
c of
      Char
'\n' -> String
"\\n"
      Char
'\r' -> String
"\\r"
      Char
'\t' -> String
"\\t"
      Char
'\\' -> String
"\\\\"
      Char
'"'  -> String
"\\\""
      Char
'$'  -> String
"\\$"
      Char
x    -> [Char
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 :: Text -> Greskell a
unsafeGreskell = Text -> Greskell a
forall a. Text -> Greskell a
Greskell (Text -> Greskell a) -> (Text -> Text) -> Text -> Greskell a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.fromStrict

-- | Same as 'unsafeGreskell', but it takes lazy 'TL.Text'.
unsafeGreskellLazy :: TL.Text -- ^ Gremlin script
                   -> Greskell a
unsafeGreskellLazy :: Text -> Greskell a
unsafeGreskellLazy = Text -> Greskell a
forall a. Text -> Greskell a
Greskell


-- $literals
--
-- Functions to create literals in Gremlin script. Use 'fromInteger',
-- 'valueInt' or 'gvalueInt' 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 :: Text -> Greskell Text
string = String -> Greskell Text
forall a. IsString a => String -> a
fromString (String -> Greskell Text)
-> (Text -> String) -> Text -> Greskell Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack

-- | Boolean @true@ literal.
--
-- >>> toGremlin true
-- "true"
true :: Greskell Bool
true :: Greskell Bool
true = Text -> Greskell Bool
forall a. Text -> Greskell a
unsafeGreskell Text
"true"

-- | Boolean @false@ literal.
--
-- >>> toGremlin false
-- "false"
false :: Greskell Bool
false :: Greskell Bool
false = Text -> Greskell Bool
forall a. Text -> Greskell a
unsafeGreskell Text
"false"

-- | List literal.
--
-- >>> toGremlin $ list ([100, 200, 300] :: [Greskell Int])
-- "[100,200,300]"
list :: [Greskell a] -> Greskell [a]
list :: [Greskell a] -> Greskell [a]
list [Greskell a]
gs = Text -> Greskell [a]
forall a. Text -> Greskell a
unsafeGreskellLazy (Text -> Greskell [a]) -> Text -> Greskell [a]
forall a b. (a -> b) -> a -> b
$ (Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
TL.intercalate Text
"," [Text]
gs_txt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]")
  where
    gs_txt :: [Text]
gs_txt = (Greskell a -> Text) -> [Greskell a] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Greskell a -> Text
forall a. ToGreskell a => a -> Text
toGremlinLazy [Greskell a]
gs

-- | 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 :: Greskell a -> Greskell [a]
single Greskell a
g = [Greskell a] -> Greskell [a]
forall a. [Greskell a] -> Greskell [a]
list [Greskell a
g]

-- | Arbitrary precision number literal, like \"123e8\".
--
-- >>> toGremlin $ number 123e8
-- "1.23e10"
number :: Scientific -> Greskell Scientific
number :: Scientific -> Greskell Scientific
number = Text -> Greskell Scientific
forall a. Text -> Greskell a
unsafeGreskell (Text -> Greskell Scientific)
-> (Scientific -> Text) -> Scientific -> Greskell Scientific
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack (String -> Text) -> (Scientific -> String) -> Scientific -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> String
forall a. Show a => a -> String
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
-- 'valueInt'.
value :: Value -> Greskell Value
value :: Value -> Greskell Value
value Value
Aeson.Null = Text -> Greskell Value
forall a. Text -> Greskell a
unsafeGreskellLazy Text
"null"
value (Aeson.Bool Bool
b) = Greskell Bool -> Greskell Value
forall a. Greskell a -> Greskell Value
unsafeToValue (if Bool
b then Greskell Bool
true else Greskell Bool
false)
value (Aeson.Number Scientific
sci) = Greskell Scientific -> Greskell Value
forall a. Greskell a -> Greskell Value
unsafeToValue (Greskell Scientific -> Greskell Value)
-> Greskell Scientific -> Greskell Value
forall a b. (a -> b) -> a -> b
$ Scientific -> Greskell Scientific
number Scientific
sci
value (Aeson.String Text
s) = Greskell Text -> Greskell Value
forall a. Greskell a -> Greskell Value
unsafeToValue (Greskell Text -> Greskell Value)
-> Greskell Text -> Greskell Value
forall a b. (a -> b) -> a -> b
$ Text -> Greskell Text
string Text
s
value (Aeson.Array Array
v) = Greskell [Value] -> Greskell Value
forall a. Greskell a -> Greskell Value
unsafeToValue (Greskell [Value] -> Greskell Value)
-> Greskell [Value] -> Greskell Value
forall a b. (a -> b) -> a -> b
$ [Greskell Value] -> Greskell [Value]
forall a. [Greskell a] -> Greskell [a]
list ([Greskell Value] -> Greskell [Value])
-> [Greskell Value] -> Greskell [Value]
forall a b. (a -> b) -> a -> b
$ (Value -> Greskell Value) -> [Value] -> [Greskell Value]
forall a b. (a -> b) -> [a] -> [b]
map Value -> Greskell Value
value ([Value] -> [Greskell Value]) -> [Value] -> [Greskell Value]
forall a b. (a -> b) -> a -> b
$ Array -> [Value]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Array
v
value (Aeson.Object Object
obj)
  | Object -> Bool
forall k v. HashMap k v -> Bool
HM.null Object
obj = Text -> Greskell Value
forall a. Text -> Greskell a
unsafeGreskellLazy Text
"[:]"
  | Bool
otherwise = Text -> Greskell Value
forall a. Text -> Greskell a
unsafeGreskellLazy (Text -> Greskell Value) -> Text -> Greskell Value
forall a b. (a -> b) -> a -> b
$ [(Text, Value)] -> Text
toGroovyMap ([(Text, Value)] -> Text) -> [(Text, Value)] -> Text
forall a b. (a -> b) -> a -> b
$ Object -> [(Text, Value)]
forall k v. HashMap k v -> [(k, v)]
HM.toList Object
obj
  where
    toGroovyMap :: [(Text, Value)] -> Text
toGroovyMap [(Text, Value)]
pairs = Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
TL.intercalate Text
"," (((Text, Value) -> Text) -> [(Text, Value)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Value) -> Text
toPairText [(Text, Value)]
pairs) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"
    toPairText :: (Text, Value) -> Text
toPairText (Text
key, Value
val) = (Greskell Text -> Text
forall a. ToGreskell a => a -> Text
toGremlinLazy (Greskell Text -> Text) -> Greskell Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Greskell Text
string Text
key) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Greskell Value -> Text
forall a. ToGreskell a => a -> Text
toGremlinLazy (Greskell Value -> Text) -> Greskell Value -> Text
forall a b. (a -> b) -> a -> b
$ Value -> Greskell Value
value Value
val)

-- | Integer literal as 'Value' type.
--
-- >>> toGremlin $ valueInt (100 :: Int)
-- "100"
--
-- @since 0.1.2.0
valueInt :: Integral a => a -> Greskell Value
valueInt :: a -> Greskell Value
valueInt a
n = (Integer -> Value) -> Greskell Integer -> Greskell Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Value
toValue (Greskell Integer -> Greskell Value)
-> Greskell Integer -> Greskell Value
forall a b. (a -> b) -> a -> b
$ a -> Greskell Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n
  where
    toValue :: Integer -> Value
    toValue :: Integer -> Value
toValue = Value -> Integer -> Value
forall a b. a -> b -> a
const Value
Aeson.Null

-- | 'Value' literal as 'GValue' type.
--
-- @since 0.1.2.0
gvalue :: Value -> Greskell GValue
gvalue :: Value -> Greskell GValue
gvalue = (Value -> GValue) -> Greskell Value -> Greskell GValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> GValue
forall p. p -> GValue
phantomToGValue (Greskell Value -> Greskell GValue)
-> (Value -> Greskell Value) -> Value -> Greskell GValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Greskell Value
value
  where
    phantomToGValue :: p -> GValue
phantomToGValue p
_ = GValueBody -> GValue
nonTypedGValue (GValueBody -> GValue) -> GValueBody -> GValue
forall a b. (a -> b) -> a -> b
$ GValueBody
GNull

-- | Integer literal as 'GValue' type.
--
-- >>> toGremlin $ gvalueInt (256 :: Int)
-- "256"
--
-- @since 0.1.2.0
gvalueInt :: Integral a => a -> Greskell GValue
gvalueInt :: a -> Greskell GValue
gvalueInt a
n = (Integer -> GValue) -> Greskell Integer -> Greskell GValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> GValue
toGValue (Greskell Integer -> Greskell GValue)
-> Greskell Integer -> Greskell GValue
forall a b. (a -> b) -> a -> b
$ a -> Greskell Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n
  where
    toGValue :: Integer -> GValue
    toGValue :: Integer -> GValue
toGValue = GValue -> Integer -> GValue
forall a b. a -> b -> a
const (GValue -> Integer -> GValue) -> GValue -> Integer -> GValue
forall a b. (a -> b) -> a -> b
$ GValueBody -> GValue
nonTypedGValue (GValueBody -> GValue) -> GValueBody -> GValue
forall a b. (a -> b) -> a -> b
$ GValueBody
GNull

unsafeToValue :: Greskell a -> Greskell Value
unsafeToValue :: Greskell a -> Greskell Value
unsafeToValue = (a -> Value) -> Greskell a -> Greskell Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Value -> a -> Value
forall a b. a -> b -> a
const Value
Aeson.Null)

-- | Create a readable Gremlin script from 'Greskell'.
toGremlin :: ToGreskell a => a -> Text
toGremlin :: a -> Text
toGremlin = Text -> Text
TL.toStrict (Text -> Text) -> (a -> Text) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Greskell (GreskellReturn a) -> Text
forall a. Greskell a -> Text
unGreskell (Greskell (GreskellReturn a) -> Text)
-> (a -> Greskell (GreskellReturn a)) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Greskell (GreskellReturn a)
forall a. ToGreskell a => a -> Greskell (GreskellReturn a)
toGreskell

-- | Same as 'toGremlin' except that this returns lazy 'TL.Text'.
toGremlinLazy :: ToGreskell a => a -> TL.Text
toGremlinLazy :: a -> Text
toGremlinLazy = Greskell (GreskellReturn a) -> Text
forall a. Greskell a -> Text
unGreskell (Greskell (GreskellReturn a) -> Text)
-> (a -> Greskell (GreskellReturn a)) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Greskell (GreskellReturn a)
forall a. ToGreskell a => a -> Greskell (GreskellReturn a)
toGreskell

unsafeFunCallText :: Text -> [Text] -> Text
unsafeFunCallText :: Text -> [Text] -> Text
unsafeFunCallText Text
fun_name [Text]
args = Text
fun_name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
args_g Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
  where
    args_g :: Text
args_g = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
intersperse Text
"," [Text]
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 :: Text -> [Text] -> Greskell a
unsafeFunCall Text
fun_name [Text]
args = Text -> Greskell a
forall a. Text -> Greskell a
unsafeGreskell (Text -> Greskell a) -> Text -> Greskell a
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
unsafeFunCallText Text
fun_name [Text]
args

-- | 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 :: Greskell a -> Text -> [Text] -> Greskell b
unsafeMethodCall Greskell a
target Text
name [Text]
args = Text -> Greskell b
forall a. Text -> Greskell a
unsafeGreskell (Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Greskell a -> Text
forall a. ToGreskell a => a -> Text
toGremlin Greskell a
target Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
unsafeFunCallText Text
name [Text]
args)