{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
module Data.Greskell.Greskell
(
Greskell
, ToGreskell (..)
, toGremlin
, toGremlinLazy
, string
, true
, false
, list
, single
, number
, value
, valueInt
, gvalue
, gvalueInt
, unsafeGreskell
, unsafeGreskellLazy
, unsafeFunCall
, unsafeMethodCall
, examples
) where
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
import Data.Greskell.GraphSON (GValue, GValueBody (..), nonTypedGValue)
newtype Greskell a
= Greskell { forall a. Greskell a -> Text
unGreskell :: TL.Text }
deriving (Greskell a -> Greskell a -> Bool
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, 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
Ord, Int -> Greskell a -> ShowS
forall a. Int -> Greskell a -> ShowS
forall a. [Greskell a] -> ShowS
forall a. Greskell a -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Greskell a] -> ShowS
$cshowList :: forall a. [Greskell a] -> ShowS
show :: Greskell a -> [Char]
$cshow :: forall a. Greskell a -> [Char]
showsPrec :: Int -> Greskell a -> ShowS
$cshowsPrec :: forall a. Int -> Greskell a -> ShowS
Show)
instance IsString a => IsString (Greskell a) where
fromString :: [Char] -> Greskell a
fromString = forall a. Text -> Greskell a
Greskell forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
TL.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
escapeDQuotes
instance Functor Greskell where
fmap :: forall a b. (a -> b) -> Greskell a -> Greskell b
fmap a -> b
_ = forall a. Text -> Greskell a
Greskell forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Greskell a -> Text
unGreskell
instance Num a => Num (Greskell a) where
+ :: Greskell a -> Greskell a -> Greskell a
(+) = forall a. Text -> Greskell a -> Greskell a -> Greskell a
biOp Text
"+"
(-) = forall a. Text -> Greskell a -> Greskell a -> Greskell a
biOp 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) = forall a. Text -> Greskell a
Greskell (Text
"-" forall a. Semigroup a => a -> a -> a
<> Text -> Text
paren Text
a)
abs :: Greskell a -> Greskell a
abs (Greskell Text
a) = forall a. Text -> Greskell a
Greskell (Text
"java.lang.Math.abs" forall a. Semigroup a => a -> a -> a
<> Text -> Text
paren Text
a)
signum :: Greskell a -> Greskell a
signum (Greskell Text
a) = forall a. Text -> Greskell a
Greskell (Text
"java.lang.Long.signum" forall a. Semigroup a => a -> a -> a
<> Text -> Text
paren Text
a)
fromInteger :: Integer -> Greskell a
fromInteger Integer
val = forall a. Text -> Greskell a
Greskell ([Char] -> Text
TL.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show Integer
val)
instance Fractional a => Fractional (Greskell a) where
/ :: 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) = forall a. Text -> Greskell a
Greskell (Text
"1.0/" forall a. Semigroup a => a -> a -> a
<> Text -> Text
paren Text
a)
fromRational :: Rational -> Greskell a
fromRational Rational
rat = forall a. Text -> Greskell a
Greskell forall a b. (a -> b) -> a -> b
$ (Rational -> Integer) -> Text
scriptOf forall a. Ratio a -> a
numerator forall a. Semigroup a => a -> a -> a
<> Text
".0/" forall a. Semigroup a => a -> a -> a
<> (Rational -> Integer) -> Text
scriptOf forall a. Ratio a -> a
denominator
where
scriptOf :: (Rational -> Integer) -> Text
scriptOf Rational -> Integer
accessor = [Char] -> Text
TL.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show forall a b. (a -> b) -> a -> b
$ Rational -> Integer
accessor Rational
rat
instance IsString a => Semigroup (Greskell a) where
<> :: Greskell a -> Greskell a -> Greskell a
(<>) = forall a. Text -> Greskell a -> Greskell a -> Greskell a
biOp Text
"+"
instance IsString a => Monoid (Greskell a) where
mempty :: Greskell a
mempty = forall a. IsString a => [Char] -> a
fromString [Char]
""
mappend :: Greskell a -> Greskell a -> Greskell a
mappend = forall a. Semigroup a => a -> a -> a
(<>)
class ToGreskell a where
type GreskellReturn a
toGreskell :: a -> Greskell (GreskellReturn a)
instance ToGreskell (Greskell a) where
type GreskellReturn (Greskell a) = a
toGreskell :: Greskell a -> Greskell (GreskellReturn (Greskell a))
toGreskell = forall a. a -> a
id
biOp :: TL.Text -> Greskell a -> Greskell a -> Greskell a
biOp :: forall a. Text -> Greskell a -> Greskell a -> Greskell a
biOp Text
operator (Greskell Text
a) (Greskell Text
b) = forall a. Text -> Greskell a
Greskell (Text -> Text
paren Text
a forall a. Semigroup a => a -> a -> a
<> Text
operator forall a. Semigroup a => a -> a -> a
<> Text -> Text
paren Text
b)
paren :: TL.Text -> TL.Text
paren :: Text -> Text
paren Text
t = Text
"(" forall a. Semigroup a => a -> a -> a
<> Text
t forall a. Semigroup a => a -> a -> a
<> Text
")"
escapeDQuotes :: String -> String
escapeDQuotes :: ShowS
escapeDQuotes [Char]
orig = (Char
'"' forall a. a -> [a] -> [a]
: (Char -> [Char]
esc forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Char]
orig)) forall a. [a] -> [a] -> [a]
++ [Char]
"\""
where
esc :: Char -> [Char]
esc Char
c = case Char
c of
Char
'\n' -> [Char]
"\\n"
Char
'\r' -> [Char]
"\\r"
Char
'\t' -> [Char]
"\\t"
Char
'\\' -> [Char]
"\\\\"
Char
'"' -> [Char]
"\\\""
Char
'$' -> [Char]
"\\$"
Char
x -> [Char
x]
unsafeGreskell :: Text
-> Greskell a
unsafeGreskell :: forall a. Text -> Greskell a
unsafeGreskell = forall a. Text -> Greskell a
Greskell forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.fromStrict
unsafeGreskellLazy :: TL.Text
-> Greskell a
unsafeGreskellLazy :: forall a. Text -> Greskell a
unsafeGreskellLazy = forall a. Text -> Greskell a
Greskell
string :: Text -> Greskell Text
string :: Text -> Greskell Text
string = forall a. IsString a => [Char] -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
unpack
true :: Greskell Bool
true :: Greskell Bool
true = forall a. Text -> Greskell a
unsafeGreskell Text
"true"
false :: Greskell Bool
false :: Greskell Bool
false = forall a. Text -> Greskell a
unsafeGreskell Text
"false"
list :: [Greskell a] -> Greskell [a]
list :: forall a. [Greskell a] -> Greskell [a]
list [Greskell a]
gs = forall a. Text -> Greskell a
unsafeGreskellLazy forall a b. (a -> b) -> a -> b
$ (Text
"[" forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
TL.intercalate Text
"," [Text]
gs_txt forall a. Semigroup a => a -> a -> a
<> Text
"]")
where
gs_txt :: [Text]
gs_txt = forall a b. (a -> b) -> [a] -> [b]
map forall a. ToGreskell a => a -> Text
toGremlinLazy [Greskell a]
gs
single :: Greskell a -> Greskell [a]
single :: forall a. Greskell a -> Greskell [a]
single Greskell a
g = forall a. [Greskell a] -> Greskell [a]
list [Greskell a
g]
number :: Scientific -> Greskell Scientific
number :: Scientific -> Greskell Scientific
number = forall a. Text -> Greskell a
unsafeGreskell forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show
value :: Value -> Greskell Value
value :: Value -> Greskell Value
value Value
Aeson.Null = forall a. Text -> Greskell a
unsafeGreskellLazy Text
"null"
value (Aeson.Bool Bool
b) = forall a. Greskell a -> Greskell Value
unsafeToValue (if Bool
b then Greskell Bool
true else Greskell Bool
false)
value (Aeson.Number Scientific
sci) = forall a. Greskell a -> Greskell Value
unsafeToValue forall a b. (a -> b) -> a -> b
$ Scientific -> Greskell Scientific
number Scientific
sci
value (Aeson.String Text
s) = forall a. Greskell a -> Greskell Value
unsafeToValue forall a b. (a -> b) -> a -> b
$ Text -> Greskell Text
string Text
s
value (Aeson.Array Array
v) = forall a. Greskell a -> Greskell Value
unsafeToValue forall a b. (a -> b) -> a -> b
$ forall a. [Greskell a] -> Greskell [a]
list forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Value -> Greskell Value
value forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Array
v
value (Aeson.Object Object
obj)
| forall v. KeyMap v -> Bool
KM.null Object
obj = forall a. Text -> Greskell a
unsafeGreskellLazy Text
"[:]"
| Bool
otherwise = forall a. Text -> Greskell a
unsafeGreskellLazy forall a b. (a -> b) -> a -> b
$ [(Key, Value)] -> Text
toGroovyMap forall a b. (a -> b) -> a -> b
$ forall v. KeyMap v -> [(Key, v)]
KM.toList Object
obj
where
toGroovyMap :: [(Key, Value)] -> Text
toGroovyMap [(Key, Value)]
pairs = Text
"[" forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
TL.intercalate Text
"," (forall a b. (a -> b) -> [a] -> [b]
map (Key, Value) -> Text
toPairText [(Key, Value)]
pairs) forall a. Semigroup a => a -> a -> a
<> Text
"]"
toPairText :: (Key, Value) -> Text
toPairText (Key
key, Value
val) = (forall a. ToGreskell a => a -> Text
toGremlinLazy forall a b. (a -> b) -> a -> b
$ Text -> Greskell Text
string forall a b. (a -> b) -> a -> b
$ Key -> Text
Key.toText Key
key) forall a. Semigroup a => a -> a -> a
<> Text
":" forall a. Semigroup a => a -> a -> a
<> (forall a. ToGreskell a => a -> Text
toGremlinLazy forall a b. (a -> b) -> a -> b
$ Value -> Greskell Value
value Value
val)
valueInt :: Integral a => a -> Greskell Value
valueInt :: forall a. Integral a => a -> Greskell Value
valueInt a
n = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Value
toValue forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n
where
toValue :: Integer -> Value
toValue :: Integer -> Value
toValue = forall a b. a -> b -> a
const Value
Aeson.Null
gvalue :: Value -> Greskell GValue
gvalue :: Value -> Greskell GValue
gvalue = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {p}. p -> GValue
phantomToGValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Greskell Value
value
where
phantomToGValue :: p -> GValue
phantomToGValue p
_ = GValueBody -> GValue
nonTypedGValue forall a b. (a -> b) -> a -> b
$ GValueBody
GNull
gvalueInt :: Integral a => a -> Greskell GValue
gvalueInt :: forall a. Integral a => a -> Greskell GValue
gvalueInt a
n = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> GValue
toGValue forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n
where
toGValue :: Integer -> GValue
toGValue :: Integer -> GValue
toGValue = forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ GValueBody -> GValue
nonTypedGValue forall a b. (a -> b) -> a -> b
$ GValueBody
GNull
unsafeToValue :: Greskell a -> Greskell Value
unsafeToValue :: forall a. Greskell a -> Greskell Value
unsafeToValue = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. a -> b -> a
const Value
Aeson.Null)
toGremlin :: ToGreskell a => a -> Text
toGremlin :: forall a. ToGreskell a => a -> Text
toGremlin = Text -> Text
TL.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Greskell a -> Text
unGreskell forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToGreskell a => a -> Greskell (GreskellReturn a)
toGreskell
toGremlinLazy :: ToGreskell a => a -> TL.Text
toGremlinLazy :: forall a. ToGreskell a => a -> Text
toGremlinLazy = forall a. Greskell a -> Text
unGreskell forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall a. Semigroup a => a -> a -> a
<> Text
"(" forall a. Semigroup a => a -> a -> a
<> Text
args_g forall a. Semigroup a => a -> a -> a
<> Text
")"
where
args_g :: Text
args_g = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a]
intersperse Text
"," [Text]
args
unsafeFunCall :: Text
-> [Text]
-> Greskell a
unsafeFunCall :: forall a. Text -> [Text] -> Greskell a
unsafeFunCall Text
fun_name [Text]
args = forall a. Text -> Greskell a
unsafeGreskell forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
unsafeFunCallText Text
fun_name [Text]
args
unsafeMethodCall :: Greskell a
-> Text
-> [Text]
-> Greskell b
unsafeMethodCall :: forall a b. Greskell a -> Text -> [Text] -> Greskell b
unsafeMethodCall Greskell a
target Text
name [Text]
args = forall a. Text -> Greskell a
unsafeGreskell (Text
"(" forall a. Semigroup a => a -> a -> a
<> forall a. ToGreskell a => a -> Text
toGremlin Greskell a
target forall a. Semigroup a => a -> a -> a
<> Text
")." forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
unsafeFunCallText Text
name [Text]
args)
examples :: [(Text, Text)]
examples :: [(Text, Text)]
examples =
[ (forall a. ToGreskell a => a -> Text
toGremlin forall a b. (a -> b) -> a -> b
$ forall a. Text -> Greskell a
unsafeGreskell Text
"x + 100", Text
"x + 100")
, (forall a. ToGreskell a => a -> Text
toGremlin forall a b. (a -> b) -> a -> b
$ Text -> Greskell Text
string Text
"foo bar", Text
"\"foo bar\"")
, (forall a. ToGreskell a => a -> Text
toGremlin forall a b. (a -> b) -> a -> b
$ Text -> Greskell Text
string Text
"escape newline\n escape dollar $", Text
"\"escape newline\\n escape dollar \\$\"")
, (forall a. ToGreskell a => a -> Text
toGremlin Greskell Bool
true, Text
"true")
, (forall a. ToGreskell a => a -> Text
toGremlin Greskell Bool
false, Text
"false")
, (forall a. ToGreskell a => a -> Text
toGremlin forall a b. (a -> b) -> a -> b
$ forall a. [Greskell a] -> Greskell [a]
list ([Greskell Int
100, Greskell Int
200, Greskell Int
300] :: [Greskell Int]), Text
"[100,200,300]")
, (forall a. ToGreskell a => a -> Text
toGremlin forall a b. (a -> b) -> a -> b
$ forall a. Greskell a -> Greskell [a]
single (Greskell Text
"hoge" :: Greskell Text), Text
"[\"hoge\"]")
, (forall a. ToGreskell a => a -> Text
toGremlin forall a b. (a -> b) -> a -> b
$ Scientific -> Greskell Scientific
number Scientific
123e8, Text
"1.23e10")
, (forall a. ToGreskell a => a -> Text
toGremlin forall a b. (a -> b) -> a -> b
$ Value -> Greskell Value
value Value
Aeson.Null, Text
"null")
, (forall a. ToGreskell a => a -> Text
toGremlin forall a b. (a -> b) -> a -> b
$ Value -> Greskell Value
value forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> Value
Aeson.toJSON forall a b. (a -> b) -> a -> b
$ ([Int
10, Int
20, Int
30] :: [Int]), Text
"[10.0,20.0,30.0]")
, (forall a. ToGreskell a => a -> Text
toGremlin forall a b. (a -> b) -> a -> b
$ Value -> Greskell Value
value forall a b. (a -> b) -> a -> b
$ Object -> Value
Aeson.Object forall a. Monoid a => a
mempty, Text
"[:]")
, (forall a. ToGreskell a => a -> Text
toGremlin forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> Greskell Value
valueInt (Int
100 :: Int), Text
"100")
, (forall a. ToGreskell a => a -> Text
toGremlin forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> Greskell GValue
gvalueInt (Int
256 :: Int), Text
"256")
, (forall a. ToGreskell a => a -> Text
toGremlin forall a b. (a -> b) -> a -> b
$ forall a. Text -> [Text] -> Greskell a
unsafeFunCall Text
"add" [Text
"10", Text
"20"], Text
"add(10,20)")
, (forall a. ToGreskell a => a -> Text
toGremlin forall a b. (a -> b) -> a -> b
$ forall a b. Greskell a -> Text -> [Text] -> Greskell b
unsafeMethodCall (Greskell Text
"foobar" :: Greskell Text) Text
"length" [], Text
"(\"foobar\").length()")
]