{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}
-- |
-- Module: Data.Greskell.Binder
-- Description: Binder monad to make binding between Gremlin variables and JSON values
-- Maintainer: Toshio Ito <debug.ito@gmail.com>
--
--
module Data.Greskell.Binder
    ( -- * Types
      Binder
    , Binding
      -- * Actions
    , newBind
    , newAsLabel
      -- * Runners
    , runBinder
    ) where

import           Control.Monad.Trans.State (State)
import qualified Control.Monad.Trans.State as State
import           Data.Aeson                (Object, ToJSON (toJSON), Value)
import qualified Data.Aeson.Key            as Key
import qualified Data.Aeson.KeyMap         as KM
import           Data.Monoid               ((<>))
import qualified Data.Text                 as T
import qualified Data.Text.Lazy            as TL

import           Data.Greskell.AsLabel     (AsLabel (..))
import           Data.Greskell.Greskell    (Greskell, unsafeGreskellLazy)

-- | State in the 'Binder'.
data BinderS
  = BinderS
      { BinderS -> PlaceHolderIndex
varIndex     :: PlaceHolderIndex
      , BinderS -> [Value]
varBindings  :: [Value]
      , BinderS -> PlaceHolderIndex
asLabelIndex :: PlaceHolderIndex
      }
  deriving (BinderS -> BinderS -> Bool
(BinderS -> BinderS -> Bool)
-> (BinderS -> BinderS -> Bool) -> Eq BinderS
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BinderS -> BinderS -> Bool
== :: BinderS -> BinderS -> Bool
$c/= :: BinderS -> BinderS -> Bool
/= :: BinderS -> BinderS -> Bool
Eq, PlaceHolderIndex -> BinderS -> ShowS
[BinderS] -> ShowS
BinderS -> [Char]
(PlaceHolderIndex -> BinderS -> ShowS)
-> (BinderS -> [Char]) -> ([BinderS] -> ShowS) -> Show BinderS
forall a.
(PlaceHolderIndex -> a -> ShowS)
-> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: PlaceHolderIndex -> BinderS -> ShowS
showsPrec :: PlaceHolderIndex -> BinderS -> ShowS
$cshow :: BinderS -> [Char]
show :: BinderS -> [Char]
$cshowList :: [BinderS] -> ShowS
showList :: [BinderS] -> ShowS
Show)

initBinderS :: BinderS
initBinderS :: BinderS
initBinderS =
  BinderS
  { varIndex :: PlaceHolderIndex
varIndex = PlaceHolderIndex
0,
    varBindings :: [Value]
varBindings = [],
    asLabelIndex :: PlaceHolderIndex
asLabelIndex = PlaceHolderIndex
0
  }

-- | A Monad that manages binding variables and labels to values.
newtype Binder a
  = Binder { forall a. Binder a -> State BinderS a
unBinder :: State BinderS a }
  deriving (Functor Binder
Functor Binder =>
(forall a. a -> Binder a)
-> (forall a b. Binder (a -> b) -> Binder a -> Binder b)
-> (forall a b c.
    (a -> b -> c) -> Binder a -> Binder b -> Binder c)
-> (forall a b. Binder a -> Binder b -> Binder b)
-> (forall a b. Binder a -> Binder b -> Binder a)
-> Applicative Binder
forall a. a -> Binder a
forall a b. Binder a -> Binder b -> Binder a
forall a b. Binder a -> Binder b -> Binder b
forall a b. Binder (a -> b) -> Binder a -> Binder b
forall a b c. (a -> b -> c) -> Binder a -> Binder b -> Binder c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> Binder a
pure :: forall a. a -> Binder a
$c<*> :: forall a b. Binder (a -> b) -> Binder a -> Binder b
<*> :: forall a b. Binder (a -> b) -> Binder a -> Binder b
$cliftA2 :: forall a b c. (a -> b -> c) -> Binder a -> Binder b -> Binder c
liftA2 :: forall a b c. (a -> b -> c) -> Binder a -> Binder b -> Binder c
$c*> :: forall a b. Binder a -> Binder b -> Binder b
*> :: forall a b. Binder a -> Binder b -> Binder b
$c<* :: forall a b. Binder a -> Binder b -> Binder a
<* :: forall a b. Binder a -> Binder b -> Binder a
Applicative, (forall a b. (a -> b) -> Binder a -> Binder b)
-> (forall a b. a -> Binder b -> Binder a) -> Functor Binder
forall a b. a -> Binder b -> Binder a
forall a b. (a -> b) -> Binder a -> Binder b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Binder a -> Binder b
fmap :: forall a b. (a -> b) -> Binder a -> Binder b
$c<$ :: forall a b. a -> Binder b -> Binder a
<$ :: forall a b. a -> Binder b -> Binder a
Functor, Applicative Binder
Applicative Binder =>
(forall a b. Binder a -> (a -> Binder b) -> Binder b)
-> (forall a b. Binder a -> Binder b -> Binder b)
-> (forall a. a -> Binder a)
-> Monad Binder
forall a. a -> Binder a
forall a b. Binder a -> Binder b -> Binder b
forall a b. Binder a -> (a -> Binder b) -> Binder b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b. Binder a -> (a -> Binder b) -> Binder b
>>= :: forall a b. Binder a -> (a -> Binder b) -> Binder b
$c>> :: forall a b. Binder a -> Binder b -> Binder b
>> :: forall a b. Binder a -> Binder b -> Binder b
$creturn :: forall a. a -> Binder a
return :: forall a. a -> Binder a
Monad)

-- | Binding between Gremlin variable names and JSON values.
type Binding = Object

-- | Create a new Gremlin variable bound to the given value.
--
-- The value @v@ is kept in the monadic context. The returned
-- 'Greskell' is a Gremlin variable pointing to the @v@. The Gremlin
-- variable is guaranteed to be unique in the current monadic context.
newBind :: ToJSON v
        => v -- ^ bound value
        -> Binder (Greskell v) -- ^ variable
newBind :: forall v. ToJSON v => v -> Binder (Greskell v)
newBind v
val = State BinderS (Greskell v) -> Binder (Greskell v)
forall a. State BinderS a -> Binder a
Binder (State BinderS (Greskell v) -> Binder (Greskell v))
-> State BinderS (Greskell v) -> Binder (Greskell v)
forall a b. (a -> b) -> a -> b
$ do
  BinderS
state <- StateT BinderS Identity BinderS
forall (m :: * -> *) s. Monad m => StateT s m s
State.get
  let next_index :: PlaceHolderIndex
next_index = BinderS -> PlaceHolderIndex
varIndex BinderS
state
      values :: [Value]
values = BinderS -> [Value]
varBindings BinderS
state
  BinderS -> StateT BinderS Identity ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
State.put (BinderS -> StateT BinderS Identity ())
-> BinderS -> StateT BinderS Identity ()
forall a b. (a -> b) -> a -> b
$ BinderS
state { varIndex = succ next_index,
                      varBindings = values ++ [toJSON val]
                    }
  Greskell v -> State BinderS (Greskell v)
forall a. a -> StateT BinderS Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Greskell v -> State BinderS (Greskell v))
-> Greskell v -> State BinderS (Greskell v)
forall a b. (a -> b) -> a -> b
$ PlaceHolderIndex -> Greskell v
forall a. PlaceHolderIndex -> Greskell a
unsafePlaceHolder PlaceHolderIndex
next_index

-- | Execute the given 'Binder' monad to obtain 'Binding'.
runBinder :: Binder a -> (a, Binding)
runBinder :: forall a. Binder a -> (a, Binding)
runBinder Binder a
binder = (a
ret, Binding
binding)
  where
    (a
ret, BinderS
state) = State BinderS a -> BinderS -> (a, BinderS)
forall s a. State s a -> s -> (a, s)
State.runState (Binder a -> State BinderS a
forall a. Binder a -> State BinderS a
unBinder Binder a
binder) BinderS
initBinderS
    values :: [Value]
values = BinderS -> [Value]
varBindings BinderS
state
    binding :: Binding
binding = [(Key, Value)] -> Binding
forall v. [(Key, v)] -> KeyMap v
KM.fromList ([(Key, Value)] -> Binding) -> [(Key, Value)] -> Binding
forall a b. (a -> b) -> a -> b
$ [Key] -> [Value] -> [(Key, Value)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((PlaceHolderIndex -> Key) -> [PlaceHolderIndex] -> [Key]
forall a b. (a -> b) -> [a] -> [b]
map PlaceHolderIndex -> Key
toPlaceHolderVariableKey [PlaceHolderIndex
0 ..]) ([Value] -> [(Key, Value)]) -> [Value] -> [(Key, Value)]
forall a b. (a -> b) -> a -> b
$ [Value]
values
    toPlaceHolderVariableKey :: PlaceHolderIndex -> Key
toPlaceHolderVariableKey = Text -> Key
Key.fromText (Text -> Key)
-> (PlaceHolderIndex -> Text) -> PlaceHolderIndex -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.toStrict (Text -> Text)
-> (PlaceHolderIndex -> Text) -> PlaceHolderIndex -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlaceHolderIndex -> Text
toPlaceHolderVariable

-- | __This type is only for internal use.__
type PlaceHolderIndex = Int

-- | __This function is only for internal use.__
--
-- Unsafely create a placeholder variable of arbitrary type with the
-- given index.
unsafePlaceHolder :: PlaceHolderIndex -> Greskell a
unsafePlaceHolder :: forall a. PlaceHolderIndex -> Greskell a
unsafePlaceHolder = Text -> Greskell a
forall a. Text -> Greskell a
unsafeGreskellLazy (Text -> Greskell a)
-> (PlaceHolderIndex -> Text) -> PlaceHolderIndex -> Greskell a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
forall {a}. (Semigroup a, IsString a) => a -> a
wrapWithParens  (Text -> Text)
-> (PlaceHolderIndex -> Text) -> PlaceHolderIndex -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlaceHolderIndex -> Text
toPlaceHolderVariable
  where
    wrapWithParens :: a -> a
wrapWithParens a
v = a
"((" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
v a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"))"
    -- This is necessary to ensure the v is always treated as a varible name (NOT a type name) in Groovy script.
    -- See https://github.com/debug-ito/greskell/issues/18

-- | __This function is only for internal use.__
--
-- Create placeholder variable string from the index.
toPlaceHolderVariable :: PlaceHolderIndex -> TL.Text
toPlaceHolderVariable :: PlaceHolderIndex -> Text
toPlaceHolderVariable PlaceHolderIndex
i = [Char] -> Text
TL.pack ([Char]
"__v" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ PlaceHolderIndex -> [Char]
forall a. Show a => a -> [Char]
show PlaceHolderIndex
i)

-- | Create a new 'AsLabel'.
--
-- The returned 'AsLabel' is guaranteed to be unique in the current
-- monadic context.
--
-- @since 0.2.2.0
newAsLabel :: Binder (AsLabel a)
newAsLabel :: forall a. Binder (AsLabel a)
newAsLabel = State BinderS (AsLabel a) -> Binder (AsLabel a)
forall a. State BinderS a -> Binder a
Binder (State BinderS (AsLabel a) -> Binder (AsLabel a))
-> State BinderS (AsLabel a) -> Binder (AsLabel a)
forall a b. (a -> b) -> a -> b
$ do
  BinderS
state <- StateT BinderS Identity BinderS
forall (m :: * -> *) s. Monad m => StateT s m s
State.get
  let label_index :: PlaceHolderIndex
label_index = BinderS -> PlaceHolderIndex
asLabelIndex BinderS
state
      label :: [Char]
label = [Char]
"__a" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ PlaceHolderIndex -> [Char]
forall a. Show a => a -> [Char]
show PlaceHolderIndex
label_index
  BinderS -> StateT BinderS Identity ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
State.put (BinderS -> StateT BinderS Identity ())
-> BinderS -> StateT BinderS Identity ()
forall a b. (a -> b) -> a -> b
$ BinderS
state { asLabelIndex = succ label_index }
  AsLabel a -> State BinderS (AsLabel a)
forall a. a -> StateT BinderS Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (AsLabel a -> State BinderS (AsLabel a))
-> AsLabel a -> State BinderS (AsLabel a)
forall a b. (a -> b) -> a -> b
$ Text -> AsLabel a
forall a. Text -> AsLabel a
AsLabel (Text -> AsLabel a) -> Text -> AsLabel a
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack [Char]
label