module Data.Greskell.Greskell
(
Greskell,
ToGreskell(..),
toGremlin,
toGremlinLazy,
string,
true,
false,
list,
single,
number,
value,
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
newtype Greskell a = Greskell { unGreskell :: TL.Text }
deriving (Show,Eq,Ord)
instance IsString a => IsString (Greskell a) where
fromString = Greskell . TL.pack . escapeDQuotes
instance Functor Greskell where
fmap _ = Greskell . unGreskell
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)
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
instance IsString a => Monoid (Greskell a) where
mempty = fromString ""
mappend = biOp "+"
class ToGreskell a where
type GreskellReturn a
toGreskell :: a -> Greskell (GreskellReturn a)
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]
unsafeGreskell :: Text
-> Greskell a
unsafeGreskell = Greskell . TL.fromStrict
unsafeGreskellLazy :: TL.Text
-> Greskell a
unsafeGreskellLazy = Greskell
string :: Text -> Greskell Text
string = fromString . unpack
true :: Greskell Bool
true = unsafeGreskell "true"
false :: Greskell Bool
false = unsafeGreskell "false"
list :: [Greskell a] -> Greskell [a]
list gs = unsafeGreskellLazy $ ("[" <> TL.intercalate "," gs_txt <> "]")
where
gs_txt = map toGremlinLazy gs
single :: Greskell a -> Greskell [a]
single g = list [g]
number :: Scientific -> Greskell Scientific
number = unsafeGreskell . pack . show
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)
toGremlin :: ToGreskell a => a -> Text
toGremlin = TL.toStrict . unGreskell . toGreskell
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
unsafeFunCall :: Text
-> [Text]
-> Greskell a
unsafeFunCall fun_name args = unsafeGreskell $ unsafeFunCallText fun_name args
unsafeMethodCall :: Greskell a
-> Text
-> [Text]
-> Greskell b
unsafeMethodCall target name args = unsafeGreskell ("(" <> toGremlin target <> ")." <> unsafeFunCallText name args)