{-# LANGUAGE OverloadedStrings, FlexibleInstances, FlexibleContexts, MultiParamTypeClasses, TypeFamilies, GADTs #-}
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
module Data.Greskell.GTraversal
(
GTraversal(..),
GraphTraversal,
ToGTraversal(..),
Walk,
GraphTraversalSource,
WalkType,
Filter,
Transform,
SideEffect,
Lift,
Split,
source,
sV,
sV',
sE,
sE',
sAddV,
sAddV',
(&.),
($.),
(<$.>),
(<*.>),
unsafeGTraversal,
unsafeWalk,
modulateWith,
gIdentity,
gIdentity',
gFilter,
gHas1,
gHas1',
gHas2,
gHas2',
gHas2P,
gHas2P',
gHasLabel,
gHasLabel',
gHasLabelP,
gHasLabelP',
gHasId,
gHasId',
gHasIdP,
gHasIdP',
gHasKey,
gHasKey',
gHasKeyP,
gHasKeyP',
gHasValue,
gHasValue',
gHasValueP,
gHasValueP',
gAnd,
gOr,
gNot,
gOrder,
gRange,
gLimit,
gTail,
gSkip,
gFlatMap,
gV,
gV',
gAs,
gValues,
gProperties,
gId,
gLabel,
gSelect1,
gSelectN,
gSelectBy1,
gSelectByN,
gFold,
gCount,
gOut,
gOut',
gOutE,
gOutE',
gOutV,
gOutV',
gIn,
gIn',
gInE,
gInE',
gInV,
gInV',
gSideEffect,
gSideEffect',
gAddV,
gAddV',
gAddE,
gAddE',
AddAnchor,
gFrom,
gTo,
gDrop,
gDropP,
gProperty,
gPropertyV,
ByProjection(..),
ProjectionLike(..),
ByComparator(..),
gBy,
gBy1,
gBy2
) where
import Control.Applicative ((<$>), (<*>))
import Control.Category (Category, (>>>))
import qualified Control.Category as Category
import Data.Aeson (Value)
import Data.Bifunctor (Bifunctor(bimap))
import Data.List.NonEmpty (NonEmpty(..))
import Data.Monoid ((<>), mconcat, Monoid(..))
import Data.Semigroup (Semigroup, sconcat)
import qualified Data.Semigroup as Semigroup
import Data.String (IsString(..))
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import Data.Greskell.Graph
( Element(..), Vertex, Edge, Property(..),
AVertex, AEdge,
T, Key, Cardinality,
KeyValue(..)
)
import Data.Greskell.GraphSON (GValue)
import Data.Greskell.Gremlin
( Comparator(..),
P
)
import Data.Greskell.Greskell
( Greskell, ToGreskell(..), unsafeGreskellLazy, unsafeGreskell, unsafeFunCall,
toGremlinLazy, toGremlin
)
import Data.Greskell.AsIterator (AsIterator(IteratorItem))
import Data.Greskell.AsLabel (AsLabel, SelectedMap)
newtype GTraversal c s e = GTraversal { unGTraversal :: Greskell (GraphTraversal c s e) }
deriving (Show)
instance Functor (GTraversal c s) where
fmap f (GTraversal g) = GTraversal $ fmap (fmap f) g
instance Bifunctor (GTraversal c) where
bimap f1 f2 (GTraversal g) = GTraversal $ fmap (bimap f1 f2) g
instance ToGreskell (GTraversal c s e) where
type GreskellReturn (GTraversal c s e) = GraphTraversal c s e
toGreskell = unGTraversal
data GraphTraversal c s e = GraphTraversal
deriving (Show)
instance AsIterator (GraphTraversal c s e) where
type IteratorItem (GraphTraversal c s e) = e
instance Functor (GraphTraversal c s) where
fmap _ GraphTraversal = GraphTraversal
instance Bifunctor (GraphTraversal c) where
bimap _ _ GraphTraversal = GraphTraversal
class ToGTraversal g where
toGTraversal :: WalkType c => g c s e -> GTraversal c s e
liftWalk :: (WalkType from, WalkType to, Lift from to) => g from s e -> g to s e
instance ToGTraversal GTraversal where
toGTraversal = id
liftWalk (GTraversal g) = GTraversal $ unsafeGreskellLazy $ toGremlinLazy g
newtype Walk c s e = Walk TL.Text
deriving (Show)
instance WalkType c => Category (Walk c) where
id = gIdentity
(Walk bc) . (Walk ab) = Walk (ab <> bc)
instance WalkType c => Semigroup (Walk c s s) where
(<>) = (Category.>>>)
instance WalkType c => Monoid (Walk c s s) where
mempty = Category.id
mappend = (Semigroup.<>)
instance Functor (Walk c s) where
fmap _ (Walk t) = Walk t
instance Bifunctor (Walk c) where
bimap _ _ (Walk t) = Walk t
instance ToGTraversal Walk where
toGTraversal (Walk t) = GTraversal $ unsafeGreskellLazy ("__" <> t)
liftWalk (Walk t) = Walk t
instance WalkType c => ToGreskell (Walk c s e) where
type GreskellReturn (Walk c s e) = GraphTraversal c s e
toGreskell = toGreskell . toGTraversal
class WalkType t
data Filter
instance WalkType Filter
data Transform
instance WalkType Transform
data SideEffect
instance WalkType SideEffect
class Lift from to
instance (WalkType c) => Lift Filter c
instance Lift Transform Transform
instance Lift Transform SideEffect
instance Lift SideEffect SideEffect
class Split c p
instance (WalkType p) => Split Filter p
instance (WalkType p) => Split Transform p
instance Split SideEffect SideEffect
data GraphTraversalSource = GraphTraversalSource
deriving (Show)
source :: Text
-> Greskell GraphTraversalSource
source = unsafeGreskell
sourceMethod :: Text -> [Greskell a] -> Greskell GraphTraversalSource -> Greskell b
sourceMethod method_name args src =
unsafeGreskellLazy $ (toGremlinLazy src <> methodCallText method_name (map toGremlin args))
sV :: Vertex v
=> [Greskell (ElementID v)]
-> Greskell GraphTraversalSource
-> GTraversal Transform () v
sV ids src = GTraversal $ sourceMethod "V" ids src
sV' :: [Greskell GValue]
-> Greskell GraphTraversalSource
-> GTraversal Transform () AVertex
sV' = sV
sE :: Edge e
=> [Greskell (ElementID e)]
-> Greskell GraphTraversalSource
-> GTraversal Transform () e
sE ids src = GTraversal $ sourceMethod "E" ids src
sE' :: [Greskell GValue]
-> Greskell GraphTraversalSource
-> GTraversal Transform () AEdge
sE' = sE
sAddV :: Vertex v
=> Greskell Text
-> Greskell GraphTraversalSource
-> GTraversal SideEffect () v
sAddV label src = GTraversal $ sourceMethod "addV" [label] src
sAddV' :: Greskell Text -> Greskell GraphTraversalSource -> GTraversal SideEffect () AVertex
sAddV' = sAddV
unsafeGTraversal :: Text -> GTraversal c s e
unsafeGTraversal = GTraversal . unsafeGreskell
infixl 1 &.
(&.) :: GTraversal c a b -> Walk c b d -> GTraversal c a d
(GTraversal gt) &. (Walk twalk) = GTraversal $ unsafeGreskellLazy (toGremlinLazy gt <> twalk)
infixr 0 $.
($.) :: Walk c b d -> GTraversal c a b -> GTraversal c a d
gs $. gt = gt &. gs
infixr 0 <$.>
(<$.>) :: Functor f => Walk c b d -> f (GTraversal c a b) -> f (GTraversal c a d)
gs <$.> gt = ($.) gs <$> gt
infixr 0 <*.>
(<*.>) :: Applicative f => f (Walk c b d) -> f (GTraversal c a b) -> f (GTraversal c a d)
gs <*.> gt = ($.) <$> gs <*> gt
methodCallText :: Text
-> [Text]
-> TL.Text
methodCallText name args = ("." <>) $ toGremlinLazy $ unsafeFunCall name args
unsafeWalk :: WalkType c
=> Text
-> [Text]
-> Walk c s e
unsafeWalk name args = Walk $ methodCallText name args
modulateWith :: (WalkType c)
=> Walk c s e
-> [Walk c e e]
-> Walk c s e
modulateWith w [] = w
modulateWith w (m:rest) = w >>> sconcat (m :| rest)
gIdentity :: WalkType c => Walk c s s
gIdentity = liftWalk $ gIdentity'
gIdentity' :: Walk Filter s s
gIdentity' = unsafeWalk "identity" []
travToG :: (ToGTraversal g, WalkType c) => g c s e -> Text
travToG = toGremlin . unGTraversal . toGTraversal
gFilter :: (ToGTraversal g, WalkType c, WalkType p, Split c p) => g c s e -> Walk p s s
gFilter walk = unsafeWalk "filter" [travToG walk]
gHas1 :: (WalkType c, Element s)
=> Key s v
-> Walk c s s
gHas1 = liftWalk . gHas1'
gHas1' :: (Element s) => Key s v -> Walk Filter s s
gHas1' key = unsafeWalk "has" [toGremlin key]
gHas2 :: (WalkType c, Element s) => Key s v -> Greskell v -> Walk c s s
gHas2 k v = liftWalk $ gHas2' k v
gHas2' :: (Element s) => Key s v -> Greskell v -> Walk Filter s s
gHas2' k v = unsafeWalk "has" [toGremlin k, toGremlin v]
gHas2P :: (WalkType c, Element s)
=> Key s v
-> Greskell (P v)
-> Walk c s s
gHas2P k p = liftWalk $ gHas2P' k p
gHas2P' :: (Element s) => Key s v -> Greskell (P v) -> Walk Filter s s
gHas2P' key p = unsafeWalk "has" [toGremlin key, toGremlin p]
gHasLabel :: (Element s, WalkType c) => Greskell Text -> Walk c s s
gHasLabel = liftWalk . gHasLabel'
gHasLabel' :: (Element s) => Greskell Text -> Walk Filter s s
gHasLabel' l = unsafeWalk "hasLabel" [toGremlin l]
gHasLabelP :: (Element s, WalkType c)
=> Greskell (P Text)
-> Walk c s s
gHasLabelP = liftWalk . gHasLabelP'
gHasLabelP' :: Element s
=> Greskell (P Text)
-> Walk Filter s s
gHasLabelP' p = unsafeWalk "hasLabel" [toGremlin p]
gHasId :: (Element s, WalkType c) => Greskell (ElementID s) -> Walk c s s
gHasId = liftWalk . gHasId'
gHasId' :: Element s => Greskell (ElementID s) -> Walk Filter s s
gHasId' i = unsafeWalk "hasId" [toGremlin i]
gHasIdP :: (Element s, WalkType c)
=> Greskell (P (ElementID s))
-> Walk c s s
gHasIdP = liftWalk . gHasIdP'
gHasIdP' :: Element s
=> Greskell (P (ElementID s))
-> Walk Filter s s
gHasIdP' p = unsafeWalk "hasId" [toGremlin p]
gHasKey :: (Element (p v), Property p, WalkType c) => Greskell Text -> Walk c (p v) (p v)
gHasKey = liftWalk . gHasKey'
gHasKey' :: (Element (p v), Property p) => Greskell Text -> Walk Filter (p v) (p v)
gHasKey' k = unsafeWalk "hasKey" [toGremlin k]
gHasKeyP :: (Element (p v), Property p, WalkType c)
=> Greskell (P Text)
-> Walk c (p v) (p v)
gHasKeyP = liftWalk . gHasKeyP'
gHasKeyP' :: (Element (p v), Property p) => Greskell (P Text) -> Walk Filter (p v) (p v)
gHasKeyP' p = unsafeWalk "hasKey" [toGremlin p]
gHasValue :: (Element (p v), Property p, WalkType c) => Greskell v -> Walk c (p v) (p v)
gHasValue = liftWalk . gHasValue'
gHasValue' :: (Element (p v), Property p) => Greskell v -> Walk Filter (p v) (p v)
gHasValue' v = unsafeWalk "hasValue" [toGremlin v]
gHasValueP :: (Element (p v), Property p, WalkType c)
=> Greskell (P v)
-> Walk c (p v) (p v)
gHasValueP = liftWalk . gHasValueP'
gHasValueP' :: (Element (p v), Property p) => Greskell (P v) -> Walk Filter (p v) (p v)
gHasValueP' p = unsafeWalk "hasValue" [toGremlin p]
multiLogic :: (ToGTraversal g, WalkType c, WalkType p, Split c p)
=> Text
-> [g c s e]
-> Walk p s s
multiLogic method_name = unsafeWalk method_name . map travToG
gAnd :: (ToGTraversal g, WalkType c, WalkType p, Split c p) => [g c s e] -> Walk p s s
gAnd = multiLogic "and"
gOr :: (ToGTraversal g, WalkType c, WalkType p, Split c p) => [g c s e] -> Walk p s s
gOr = multiLogic "or"
gNot :: (ToGTraversal g, WalkType c, WalkType p, Split c p) => g c s e -> Walk p s s
gNot cond = unsafeWalk "not" [travToG cond]
gRange :: Greskell Int
-> Greskell Int
-> Walk Transform s s
gRange min_g max_g = unsafeWalk "range" $ map toGremlin [min_g, max_g]
gLimit :: Greskell Int -> Walk Transform s s
gLimit num = unsafeWalk "limit" [toGremlin num]
gTail :: Greskell Int -> Walk Transform s s
gTail num = unsafeWalk "tail" [toGremlin num]
gSkip :: Greskell Int -> Walk Transform s s
gSkip num = unsafeWalk "skip" [toGremlin num]
class ProjectionLike p where
type ProjectionLikeStart p
type ProjectionLikeEnd p
instance ProjectionLike (Walk Filter s e) where
type ProjectionLikeStart (Walk Filter s e) = s
type ProjectionLikeEnd (Walk Filter s e) = e
instance ProjectionLike (GTraversal Filter s e) where
type ProjectionLikeStart (GTraversal Filter s e) = s
type ProjectionLikeEnd (GTraversal Filter s e) = e
instance ProjectionLike (Greskell (GraphTraversal Filter s e)) where
type ProjectionLikeStart (Greskell (GraphTraversal Filter s e)) = s
type ProjectionLikeEnd (Greskell (GraphTraversal Filter s e)) = e
instance ProjectionLike (Walk Transform s e) where
type ProjectionLikeStart (Walk Transform s e) = s
type ProjectionLikeEnd (Walk Transform s e) = e
instance ProjectionLike (GTraversal Transform s e) where
type ProjectionLikeStart (GTraversal Transform s e) = s
type ProjectionLikeEnd (GTraversal Transform s e) = e
instance ProjectionLike (Greskell (GraphTraversal Transform s e)) where
type ProjectionLikeStart (Greskell (GraphTraversal Transform s e)) = s
type ProjectionLikeEnd (Greskell (GraphTraversal Transform s e)) = e
instance ProjectionLike (Key s e) where
type ProjectionLikeStart (Key s e) = s
type ProjectionLikeEnd (Key s e) = e
instance ProjectionLike (Greskell (T s e)) where
type ProjectionLikeStart (Greskell (T s e)) = s
type ProjectionLikeEnd (Greskell (T s e)) = e
instance ProjectionLike (Greskell (s -> e)) where
type ProjectionLikeStart (Greskell (s -> e)) = s
type ProjectionLikeEnd (Greskell (s -> e)) = e
instance ProjectionLike (ByProjection s e) where
type ProjectionLikeStart (ByProjection s e) = s
type ProjectionLikeEnd (ByProjection s e) = e
data ByProjection s e where
ByProjection :: (ProjectionLike p, ToGreskell p) => p -> ByProjection (ProjectionLikeStart p) (ProjectionLikeEnd p)
instance IsString (ByProjection s e) where
fromString = ByProjection . toKey
where
toKey :: String -> Key s e
toKey = fromString
gBy :: (ProjectionLike p, ToGreskell p) => p -> ByProjection (ProjectionLikeStart p) (ProjectionLikeEnd p)
gBy = ByProjection
data ByComparator s where
ByComparatorProj :: ByProjection s e -> ByComparator s
ByComparatorComp :: Comparator comp => Greskell comp -> ByComparator (CompareArg comp)
ByComparatorProjComp :: Comparator comp => ByProjection s (CompareArg comp) -> Greskell comp -> ByComparator s
instance IsString (ByComparator s) where
fromString = ByComparatorProj . fromString
gBy1 :: (ProjectionLike p, ToGreskell p) => p -> ByComparator (ProjectionLikeStart p)
gBy1 = ByComparatorProj . gBy
gBy2 :: (ProjectionLike p, ToGreskell p, Comparator comp, ProjectionLikeEnd p ~ CompareArg comp)
=> p
-> Greskell comp
-> ByComparator (ProjectionLikeStart p)
gBy2 p c = ByComparatorProjComp (gBy p) c
gOrder :: [ByComparator s]
-> Walk Transform s s
gOrder bys = modulateWith order_step by_steps
where
order_step = unsafeWalk "order" []
by_steps = map (unsafeWalk "by" . toByArgs) bys
toByArgs :: ByComparator s -> [Text]
toByArgs bc = case bc of
ByComparatorProj (ByProjection p) -> [toGremlin p]
ByComparatorComp comp -> [toGremlin comp]
ByComparatorProjComp (ByProjection p) comp -> [toGremlin p, toGremlin comp]
gFlatMap :: (ToGTraversal g) => g Transform s e -> Walk Transform s e
gFlatMap gt = unsafeWalk "flatMap" [travToG gt]
gV :: Vertex v => [Greskell (ElementID v)] -> Walk Transform s v
gV ids = unsafeWalk "V" $ map toGremlin ids
gV' :: [Greskell GValue] -> Walk Transform s AVertex
gV' = gV
gAs :: AsLabel a -> Walk Transform a a
gAs l = unsafeWalk "as" [toGremlin l]
gValues :: Element s
=> [Key s e]
-> Walk Transform s e
gValues = unsafeWalk "values" . map toGremlin
gProperties :: (Element s, Property p, ElementProperty s ~ p)
=> [Key s v]
-> Walk Transform s (p v)
gProperties = unsafeWalk "properties" . map toGremlin
gId :: Element s => Walk Transform s (ElementID s)
gId = unsafeWalk "id" []
gLabel :: Element s => Walk Transform s Text
gLabel = unsafeWalk "label" []
gSelect1 :: AsLabel a -> Walk Transform s a
gSelect1 l = unsafeWalk "select" [toGremlin l]
gSelectN :: AsLabel a -> AsLabel b -> [AsLabel c] -> Walk Transform s (SelectedMap GValue)
gSelectN l1 l2 ls = unsafeWalk "select" ([toGremlin l1, toGremlin l2] ++ map toGremlin ls)
unsafeChangeEnd :: Walk c a b -> Walk c a b'
unsafeChangeEnd (Walk t) = Walk t
byStep :: ByProjection a b -> Walk Transform c c
byStep (ByProjection p) = unsafeWalk "by" [toGremlin p]
gSelectBy1 :: AsLabel a -> ByProjection a b -> Walk Transform s b
gSelectBy1 l bp = modulateWith (unsafeChangeEnd $ gSelect1 l) [byStep bp]
gSelectByN :: AsLabel a -> AsLabel a -> [AsLabel a] -> ByProjection a b -> Walk Transform s (SelectedMap b)
gSelectByN l1 l2 ls bp = modulateWith (unsafeChangeEnd $ gSelectN l1 l2 ls) [byStep bp]
gFold :: Walk Transform a [a]
gFold = unsafeWalk "fold" []
gCount :: Walk Transform a Int
gCount = unsafeWalk "count" []
genericTraversalWalk :: Vertex v => Text -> [Greskell Text] -> Walk Transform v e
genericTraversalWalk method_name = unsafeWalk method_name . map toGremlin
gOut :: (Vertex v1, Vertex v2)
=> [Greskell Text]
-> Walk Transform v1 v2
gOut = genericTraversalWalk "out"
gOut' :: (Vertex v)
=> [Greskell Text]
-> Walk Transform v AVertex
gOut' = gOut
gOutE :: (Vertex v, Edge e)
=> [Greskell Text]
-> Walk Transform v e
gOutE = genericTraversalWalk "outE"
gOutE' :: (Vertex v)
=> [Greskell Text]
-> Walk Transform v AEdge
gOutE' = gOutE
gOutV :: (Edge e, Vertex v) => Walk Transform e v
gOutV = unsafeWalk "outV" []
gOutV' :: Edge e => Walk Transform e AVertex
gOutV' = gOutV
gIn :: (Vertex v1, Vertex v2)
=> [Greskell Text]
-> Walk Transform v1 v2
gIn = genericTraversalWalk "in"
gIn' :: (Vertex v)
=> [Greskell Text]
-> Walk Transform v AVertex
gIn' = gIn
gInE :: (Vertex v, Edge e)
=> [Greskell Text]
-> Walk Transform v e
gInE = genericTraversalWalk "inE"
gInE' :: (Vertex v)
=> [Greskell Text]
-> Walk Transform v AEdge
gInE' = gInE
gInV :: (Edge e, Vertex v) => Walk Transform e v
gInV = unsafeWalk "inV" []
gInV' :: Edge e => Walk Transform e AVertex
gInV' = gInV
gSideEffect :: (ToGTraversal g, WalkType c, WalkType p, Split c p) => g c s e -> Walk p s s
gSideEffect walk = unsafeWalk "sideEffect" [travToG walk]
gSideEffect' :: (ToGTraversal g, WalkType c, Split c SideEffect) => g c s e -> Walk SideEffect s s
gSideEffect' w = gSideEffect w
gAddV :: Vertex v => Greskell Text -> Walk SideEffect a v
gAddV label = unsafeWalk "addV" [toGremlin label]
gAddV' :: Greskell Text -> Walk SideEffect a AVertex
gAddV' = gAddV
gDrop :: Element e => Walk SideEffect e e
gDrop = unsafeWalk "drop" []
gDropP :: Property p => Walk SideEffect (p a) (p a)
gDropP = unsafeWalk "drop" []
gProperty :: Element e
=> Key e v
-> Greskell v
-> Walk SideEffect e e
gProperty key val = unsafeWalk "property" [toGremlin key, toGremlin val]
gPropertyV :: (Vertex e, vp ~ ElementProperty e, Property vp, Element (vp v))
=> Maybe (Greskell Cardinality)
-> Key e v
-> Greskell v
-> [KeyValue (vp v)]
-> Walk SideEffect e e
gPropertyV mcard key val metaprops = unsafeWalk "property" (arg_card ++ arg_keyval ++ arg_metaprops)
where
arg_card = maybe [] (\card -> [toGremlin card]) mcard
arg_keyval = [toGremlin key, toGremlin val]
arg_metaprops = expand =<< metaprops
where
expand (KeyValue meta_key meta_val) = [toGremlin meta_key, toGremlin meta_val]
data AddAnchor s e = AddAnchor Text (GTraversal Transform s e)
anchorStep :: WalkType c => AddAnchor s e -> Walk c edge edge
anchorStep (AddAnchor step_name subtraversal) = unsafeWalk step_name [toGremlin subtraversal]
gFrom :: (ToGTraversal g) => g Transform s e -> AddAnchor s e
gFrom = AddAnchor "from" . toGTraversal
gTo :: (ToGTraversal g) => g Transform s e -> AddAnchor s e
gTo = AddAnchor "to" . toGTraversal
gAddE :: (Vertex vs, Vertex ve, Edge e)
=> Greskell Text
-> AddAnchor vs ve
-> Walk SideEffect vs e
gAddE label anch = (unsafeWalk "addE" [toGremlin label]) >>> anchorStep anch
gAddE' :: Greskell Text -> AddAnchor AVertex AVertex -> Walk SideEffect AVertex AEdge
gAddE' = gAddE