{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE OverloadedStrings #-}
-- |
-- Module: Data.Greskell.Extra
-- Description: Extra utility functions implemented by Greskell
-- Maintainer: Toshio Ito <debug.ito@gmail.com>
--
-- Extra utility functions implemented by Greskell.
--
-- @since 0.2.3.0
module Data.Greskell.Extra
    ( -- * Property readers
      -- $readers
      lookupAs
    , lookupAs'
    , lookupListAs
    , lookupListAs'
    , pMapToFail
      -- * Property writers
    , writeKeyValues
    , (<=:>)
    , (<=?>)
    , writePropertyKeyValues
    , writePMapProperties
      -- * Control idioms
    , gWhenEmptyInput
      -- * Examples
    , examples
    ) where

import           Control.Category         ((<<<), (>>>))
import           Data.Aeson               (ToJSON)
import qualified Data.Aeson.KeyMap        as KeyMap
import           Data.Foldable            (Foldable)
import           Data.Function            ((&))
import           Data.Greskell.Binder     (Binder, newBind, runBinder)
import           Data.Greskell.Graph      (AVertex, Element, Key, KeyValue (..), Property (..),
                                           (=:))
import qualified Data.Greskell.Graph      as Graph
import           Data.Greskell.Greskell   (Greskell, toGremlin)
import           Data.Greskell.GTraversal (GTraversal, Lift, SideEffect, Split, ToGTraversal (..),
                                           Transform, Walk, WalkType, gAddV, gCoalesce, gFold,
                                           gHas2, gProperty, gUnfold, liftWalk, sV', source, (&.))
import           Data.Greskell.PMap       (PMap, lookupAs, lookupAs', lookupListAs, lookupListAs',
                                           pMapToFail, pMapToList)
import           Data.List                (sortBy)
import           Data.Monoid              (mconcat)
import           Data.Ord                 (comparing)
import           Data.Text                (Text, unpack)


-- $readers
--
-- Re-export property readers.
--
-- @since 1.0.0.0

-- | Make a series of @.property@ steps to write the given key-value
-- pairs as properties.
--
-- @since 0.2.3.0
writePropertyKeyValues :: (ToJSON v, Element e) => [(Text, v)] -> Binder (Walk SideEffect e e)
writePropertyKeyValues :: forall v e.
(ToJSON v, Element e) =>
[(Text, v)] -> Binder (Walk SideEffect e e)
writePropertyKeyValues [(Text, v)]
pairs = ([KeyValue e] -> Walk SideEffect e e)
-> Binder [KeyValue e] -> Binder (Walk SideEffect e e)
forall a b. (a -> b) -> Binder a -> Binder b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [KeyValue e] -> Walk SideEffect e e
forall e. Element e => [KeyValue e] -> Walk SideEffect e e
writeKeyValues (Binder [KeyValue e] -> Binder (Walk SideEffect e e))
-> Binder [KeyValue e] -> Binder (Walk SideEffect e e)
forall a b. (a -> b) -> a -> b
$ ((Text, v) -> Binder (KeyValue e))
-> [(Text, v)] -> Binder [KeyValue e]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Text, v) -> Binder (KeyValue e)
forall {b} {a}. ToJSON b => (Text, b) -> Binder (KeyValue a)
toKeyValue [(Text, v)]
pairs
  where
    toKeyValue :: (Text, b) -> Binder (KeyValue a)
toKeyValue (Text
key, b
value) = Text -> Key a b
forall a b. Text -> Key a b
Graph.key Text
key Key a b -> b -> Binder (KeyValue a)
forall b a. ToJSON b => Key a b -> b -> Binder (KeyValue a)
<=:> b
value

-- | Make a series of @.property@ steps to write the given key-value
-- pairs as properties. Use '<=:>' and '<=?>' to make a 'KeyValue'
-- within 'Binder'.
--
-- @since 1.0.0.0
writeKeyValues :: Element e => [KeyValue e] -> Walk SideEffect e e
writeKeyValues :: forall e. Element e => [KeyValue e] -> Walk SideEffect e e
writeKeyValues [KeyValue e]
pairs = [Walk SideEffect e e] -> Walk SideEffect e e
forall a. Monoid a => [a] -> a
mconcat ([Walk SideEffect e e] -> Walk SideEffect e e)
-> [Walk SideEffect e e] -> Walk SideEffect e e
forall a b. (a -> b) -> a -> b
$ KeyValue e -> [Walk SideEffect e e]
forall {a}. Element a => KeyValue a -> [Walk SideEffect a a]
toPropStep (KeyValue e -> [Walk SideEffect e e])
-> [KeyValue e] -> [Walk SideEffect e e]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [KeyValue e]
pairs
  where
    toPropStep :: KeyValue a -> [Walk SideEffect a a]
toPropStep (KeyValue Key a b
k Greskell b
v) = [Key a b -> Greskell b -> Walk SideEffect a a
forall e v.
Element e =>
Key e v -> Greskell v -> Walk SideEffect e e
gProperty Key a b
k Greskell b
v]
    toPropStep (KeyNoValue Key a b
_) = []

-- | Make a series of @.property@ steps to write all properties in the
-- given 'PMap'.
--
-- @since 1.0.0.0
writePMapProperties :: (Foldable c, ToJSON v, Element e)
                    => PMap c v -> Binder (Walk SideEffect e e)
writePMapProperties :: forall (c :: * -> *) v e.
(Foldable c, ToJSON v, Element e) =>
PMap c v -> Binder (Walk SideEffect e e)
writePMapProperties = [(Text, v)] -> Binder (Walk SideEffect e e)
forall v e.
(ToJSON v, Element e) =>
[(Text, v)] -> Binder (Walk SideEffect e e)
writePropertyKeyValues ([(Text, v)] -> Binder (Walk SideEffect e e))
-> (PMap c v -> [(Text, v)])
-> PMap c v
-> Binder (Walk SideEffect e e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PMap c v -> [(Text, v)]
forall (c :: * -> *) v. Foldable c => PMap c v -> [(Text, v)]
pMapToList

-- | Like '=:', but this one takes a real value, binds it into a
-- 'Greskell' value and returns 'KeyValue'.
--
-- @since 1.0.0.0
(<=:>) :: ToJSON b => Key a b -> b -> Binder (KeyValue a)
<=:> :: forall b a. ToJSON b => Key a b -> b -> Binder (KeyValue a)
(<=:>) Key a b
k b
v = Key a b -> Greskell b -> KeyValue a
forall a b. Key a b -> Greskell b -> KeyValue a
(=:) Key a b
k (Greskell b -> KeyValue a)
-> Binder (Greskell b) -> Binder (KeyValue a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> Binder (Greskell b)
forall v. ToJSON v => v -> Binder (Greskell v)
newBind b
v

-- | Like '<=:>', but this one is for an optional property. If the
-- value is 'Just', it's equivalent to '<=:>'. If the value is
-- 'Nothing', it returns 'KeyNoValue'.
--
-- @since 1.0.0.0
(<=?>) :: ToJSON b => Key a (Maybe b) -> Maybe b -> Binder (KeyValue a)
<=?> :: forall b a.
ToJSON b =>
Key a (Maybe b) -> Maybe b -> Binder (KeyValue a)
(<=?>) Key a (Maybe b)
k v :: Maybe b
v@(Just b
_) = Key a (Maybe b)
k Key a (Maybe b) -> Maybe b -> Binder (KeyValue a)
forall b a. ToJSON b => Key a b -> b -> Binder (KeyValue a)
<=:> Maybe b
v
(<=?>) Key a (Maybe b)
k Maybe b
Nothing    = KeyValue a -> Binder (KeyValue a)
forall a. a -> Binder a
forall (m :: * -> *) a. Monad m => a -> m a
return (KeyValue a -> Binder (KeyValue a))
-> KeyValue a -> Binder (KeyValue a)
forall a b. (a -> b) -> a -> b
$ Key a (Maybe b) -> KeyValue a
forall a b. Key a b -> KeyValue a
KeyNoValue Key a (Maybe b)
k

-- | The result 'Walk' emits the input elements as-is when there is at
-- least one input element. If there is no input element, it runs the
-- body traversal once and outputs its result.
--
-- You can use this function to implement \"upsert\" a vertex
-- (i.e. add a vertex if not exist).
--
-- See also: https://stackoverflow.com/questions/46027444/
--
-- @since 1.1.0.0
gWhenEmptyInput :: (ToGTraversal g, Split cc c, Lift Transform cc, Lift Transform c, WalkType c, WalkType cc)
                => g cc [s] s -- ^ the body traversal
                -> Walk c s s -- ^ the result walk
gWhenEmptyInput :: forall (g :: * -> * -> * -> *) cc c s.
(ToGTraversal g, Split cc c, Lift Transform cc, Lift Transform c,
 WalkType c, WalkType cc) =>
g cc [s] s -> Walk c s s
gWhenEmptyInput g cc [s] s
body = [GTraversal cc [s] s] -> Walk c [s] s
forall (g :: * -> * -> * -> *) cc c s e.
(ToGTraversal g, Split cc c, Lift Transform c, WalkType c,
 WalkType cc) =>
[g cc s e] -> Walk c s e
gCoalesce
                       [ GTraversal Transform [s] s -> GTraversal cc [s] s
forall from to s e.
(WalkType from, WalkType to, Lift from to) =>
GTraversal from s e -> GTraversal to s e
forall (g :: * -> * -> * -> *) from to s e.
(ToGTraversal g, WalkType from, WalkType to, Lift from to) =>
g from s e -> g to s e
liftWalk (GTraversal Transform [s] s -> GTraversal cc [s] s)
-> GTraversal Transform [s] s -> GTraversal cc [s] s
forall a b. (a -> b) -> a -> b
$ Walk Transform [s] s -> GTraversal Transform [s] s
forall c s e. WalkType c => Walk c s e -> GTraversal c s e
forall (g :: * -> * -> * -> *) c s e.
(ToGTraversal g, WalkType c) =>
g c s e -> GTraversal c s e
toGTraversal Walk Transform [s] s
Walk Transform [s] (IteratorItem [s])
forall a. AsIterator a => Walk Transform a (IteratorItem a)
gUnfold,
                         g cc [s] s -> GTraversal cc [s] s
forall c s e. WalkType c => g c s e -> GTraversal c s e
forall (g :: * -> * -> * -> *) c s e.
(ToGTraversal g, WalkType c) =>
g c s e -> GTraversal c s e
toGTraversal g cc [s] s
body
                       ] Walk c [s] s -> Walk c s [s] -> Walk c s s
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< Walk Transform s [s] -> Walk c s [s]
forall from to s e.
(WalkType from, WalkType to, Lift from to) =>
Walk from s e -> Walk to s e
forall (g :: * -> * -> * -> *) from to s e.
(ToGTraversal g, WalkType from, WalkType to, Lift from to) =>
g from s e -> g to s e
liftWalk Walk Transform s [s]
forall a. Walk Transform a [a]
gFold

-- | Examples of using this module. See the source. The 'fst' of the output is the testee, while the
-- 'snd' is the expectation.
examples :: [(String, String)]
examples :: [(String, String)]
examples = [(String, String)]
for_writePropertyKeyValues [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. [a] -> [a] -> [a]
++ [(String, String)]
for_writeKeyValues [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. [a] -> [a] -> [a]
++ [(String, String)]
for_operators [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. [a] -> [a] -> [a]
++ [(String, String)]
for_gWhenEmptyInput
  where
    for_writePropertyKeyValues :: [(String, String)]
for_writePropertyKeyValues =
      let binder :: Binder (Walk SideEffect AVertex AVertex)
binder = ([(Text, Int)] -> Binder (Walk SideEffect AVertex AVertex)
forall v e.
(ToJSON v, Element e) =>
[(Text, v)] -> Binder (Walk SideEffect e e)
writePropertyKeyValues [(Text
"age", (Int
21 :: Int))] :: Binder (Walk SideEffect AVertex AVertex))
          (Walk SideEffect AVertex AVertex
walk, Binding
binding) = Binder (Walk SideEffect AVertex AVertex)
-> (Walk SideEffect AVertex AVertex, Binding)
forall a. Binder a -> (a, Binding)
runBinder Binder (Walk SideEffect AVertex AVertex)
binder
      in [ (Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Walk SideEffect AVertex AVertex -> Text
forall a. ToGreskell a => a -> Text
toGremlin Walk SideEffect AVertex AVertex
walk, String
"__.property(\"age\",((__v0))).identity()")
         , ([(Key, Value)] -> String
forall a. Show a => a -> String
show ([(Key, Value)] -> String) -> [(Key, Value)] -> String
forall a b. (a -> b) -> a -> b
$ ((Key, Value) -> (Key, Value) -> Ordering)
-> [(Key, Value)] -> [(Key, Value)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((Key, Value) -> Key) -> (Key, Value) -> (Key, Value) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Key, Value) -> Key
forall a b. (a, b) -> a
fst) ([(Key, Value)] -> [(Key, Value)])
-> [(Key, Value)] -> [(Key, Value)]
forall a b. (a -> b) -> a -> b
$ Binding -> [(Key, Value)]
forall v. KeyMap v -> [(Key, v)]
KeyMap.toList Binding
binding, String
"[(\"__v0\",Number 21.0)]")
         ]
    for_writeKeyValues :: [(String, String)]
for_writeKeyValues =
      let keyAge :: Key AVertex Int
keyAge = (Key AVertex Int
"age" :: Key AVertex Int)
          keyName :: Key AVertex Text
keyName = (Key AVertex Text
"name" :: Key AVertex Text)
          (Walk SideEffect AVertex AVertex
walk, Binding
binding) = Binder (Walk SideEffect AVertex AVertex)
-> (Walk SideEffect AVertex AVertex, Binding)
forall a. Binder a -> (a, Binding)
runBinder (Binder (Walk SideEffect AVertex AVertex)
 -> (Walk SideEffect AVertex AVertex, Binding))
-> Binder (Walk SideEffect AVertex AVertex)
-> (Walk SideEffect AVertex AVertex, Binding)
forall a b. (a -> b) -> a -> b
$ [KeyValue AVertex] -> Walk SideEffect AVertex AVertex
forall e. Element e => [KeyValue e] -> Walk SideEffect e e
writeKeyValues ([KeyValue AVertex] -> Walk SideEffect AVertex AVertex)
-> Binder [KeyValue AVertex]
-> Binder (Walk SideEffect AVertex AVertex)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Binder (KeyValue AVertex)] -> Binder [KeyValue AVertex]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [Key AVertex Int
keyAge Key AVertex Int -> Int -> Binder (KeyValue AVertex)
forall b a. ToJSON b => Key a b -> b -> Binder (KeyValue a)
<=:> Int
21, Key AVertex Text
keyName Key AVertex Text -> Text -> Binder (KeyValue AVertex)
forall b a. ToJSON b => Key a b -> b -> Binder (KeyValue a)
<=:> Text
"Josh"]
      in [ (Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Walk SideEffect AVertex AVertex -> Text
forall a. ToGreskell a => a -> Text
toGremlin Walk SideEffect AVertex AVertex
walk, String
"__.property(\"age\",((__v0))).property(\"name\",((__v1))).identity()")
         , ([(Key, Value)] -> String
forall a. Show a => a -> String
show ([(Key, Value)] -> String) -> [(Key, Value)] -> String
forall a b. (a -> b) -> a -> b
$ ((Key, Value) -> (Key, Value) -> Ordering)
-> [(Key, Value)] -> [(Key, Value)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((Key, Value) -> Key) -> (Key, Value) -> (Key, Value) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Key, Value) -> Key
forall a b. (a, b) -> a
fst) ([(Key, Value)] -> [(Key, Value)])
-> [(Key, Value)] -> [(Key, Value)]
forall a b. (a -> b) -> a -> b
$ Binding -> [(Key, Value)]
forall v. KeyMap v -> [(Key, v)]
KeyMap.toList Binding
binding, String
"[(\"__v0\",Number 21.0),(\"__v1\",String \"Josh\")]")
         ]
    for_operators :: [(String, String)]
for_operators =
      let keyNName :: Key AVertex (Maybe Text)
keyNName = (Key AVertex (Maybe Text)
"nickname" :: Key AVertex (Maybe Text))
          keyCompany :: Key AVertex (Maybe Text)
keyCompany = (Key AVertex (Maybe Text)
"company" :: Key AVertex (Maybe Text))
          (Walk SideEffect AVertex AVertex
walk, Binding
binding) = Binder (Walk SideEffect AVertex AVertex)
-> (Walk SideEffect AVertex AVertex, Binding)
forall a. Binder a -> (a, Binding)
runBinder (Binder (Walk SideEffect AVertex AVertex)
 -> (Walk SideEffect AVertex AVertex, Binding))
-> Binder (Walk SideEffect AVertex AVertex)
-> (Walk SideEffect AVertex AVertex, Binding)
forall a b. (a -> b) -> a -> b
$ [KeyValue AVertex] -> Walk SideEffect AVertex AVertex
forall e. Element e => [KeyValue e] -> Walk SideEffect e e
writeKeyValues ([KeyValue AVertex] -> Walk SideEffect AVertex AVertex)
-> Binder [KeyValue AVertex]
-> Binder (Walk SideEffect AVertex AVertex)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Binder (KeyValue AVertex)] -> Binder [KeyValue AVertex]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [Key AVertex (Maybe Text)
keyNName Key AVertex (Maybe Text) -> Maybe Text -> Binder (KeyValue AVertex)
forall b a.
ToJSON b =>
Key a (Maybe b) -> Maybe b -> Binder (KeyValue a)
<=?> Maybe Text
forall a. Maybe a
Nothing, Key AVertex (Maybe Text)
keyCompany Key AVertex (Maybe Text) -> Maybe Text -> Binder (KeyValue AVertex)
forall b a.
ToJSON b =>
Key a (Maybe b) -> Maybe b -> Binder (KeyValue a)
<=?> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"foobar.com"]
      in [ (Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Walk SideEffect AVertex AVertex -> Text
forall a. ToGreskell a => a -> Text
toGremlin Walk SideEffect AVertex AVertex
walk, String
"__.property(\"company\",((__v0))).identity()")
         , ([(Key, Value)] -> String
forall a. Show a => a -> String
show ([(Key, Value)] -> String) -> [(Key, Value)] -> String
forall a b. (a -> b) -> a -> b
$ ((Key, Value) -> (Key, Value) -> Ordering)
-> [(Key, Value)] -> [(Key, Value)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((Key, Value) -> Key) -> (Key, Value) -> (Key, Value) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Key, Value) -> Key
forall a b. (a, b) -> a
fst) ([(Key, Value)] -> [(Key, Value)])
-> [(Key, Value)] -> [(Key, Value)]
forall a b. (a -> b) -> a -> b
$ Binding -> [(Key, Value)]
forall v. KeyMap v -> [(Key, v)]
KeyMap.toList Binding
binding, String
"[(\"__v0\",String \"foobar.com\")]")
         ]
    for_gWhenEmptyInput :: [(String, String)]
for_gWhenEmptyInput =
      let nameMarko :: Greskell Text
nameMarko = Greskell Text
"marko" :: Greskell Text
          getMarko :: GTraversal Transform () AVertex
getMarko = (Text -> Greskell GraphTraversalSource
source Text
"g" Greskell GraphTraversalSource
-> (Greskell GraphTraversalSource
    -> GTraversal Transform () AVertex)
-> GTraversal Transform () AVertex
forall a b. a -> (a -> b) -> b
& [Greskell (ElementID AVertex)]
-> Greskell GraphTraversalSource -> GTraversal Transform () AVertex
sV' [] GTraversal Transform () AVertex
-> Walk Transform AVertex AVertex
-> GTraversal Transform () AVertex
forall c a b d. GTraversal c a b -> Walk c b d -> GTraversal c a d
&. Key AVertex Text -> Greskell Text -> Walk Transform AVertex AVertex
forall c s v.
(WalkType c, Element s) =>
Key s v -> Greskell v -> Walk c s s
gHas2 Key AVertex Text
"name" Greskell Text
nameMarko :: GTraversal Transform () AVertex)
          upsertMarko :: GTraversal SideEffect () AVertex
upsertMarko = (GTraversal Transform () AVertex -> GTraversal SideEffect () AVertex
forall from to s e.
(WalkType from, WalkType to, Lift from to) =>
GTraversal from s e -> GTraversal to s e
forall (g :: * -> * -> * -> *) from to s e.
(ToGTraversal g, WalkType from, WalkType to, Lift from to) =>
g from s e -> g to s e
liftWalk GTraversal Transform () AVertex
getMarko GTraversal SideEffect () AVertex
-> Walk SideEffect AVertex AVertex
-> GTraversal SideEffect () AVertex
forall c a b d. GTraversal c a b -> Walk c b d -> GTraversal c a d
&. Walk SideEffect [AVertex] AVertex
-> Walk SideEffect AVertex AVertex
forall (g :: * -> * -> * -> *) cc c s.
(ToGTraversal g, Split cc c, Lift Transform cc, Lift Transform c,
 WalkType c, WalkType cc) =>
g cc [s] s -> Walk c s s
gWhenEmptyInput (Greskell Text -> Walk SideEffect [AVertex] AVertex
forall v a. Vertex v => Greskell Text -> Walk SideEffect a v
gAddV Greskell Text
"person" Walk SideEffect [AVertex] AVertex
-> Walk SideEffect AVertex AVertex
-> Walk SideEffect [AVertex] AVertex
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Key AVertex Text
-> Greskell Text -> Walk SideEffect AVertex AVertex
forall e v.
Element e =>
Key e v -> Greskell v -> Walk SideEffect e e
gProperty Key AVertex Text
"name" Greskell Text
nameMarko) :: GTraversal SideEffect () AVertex)
      in [ (Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ GTraversal SideEffect () AVertex -> Text
forall a. ToGreskell a => a -> Text
toGremlin GTraversal SideEffect () AVertex
upsertMarko, String
"g.V().has(\"name\",\"marko\").fold().coalesce(__.unfold(),__.addV(\"person\").property(\"name\",\"marko\"))")
         ]