{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DeriveTraversable          #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE TypeFamilies               #-}
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
-- |
-- Module: Data.Greskell.Graph
-- Description: Haskell counterpart of Gremlin graph structure data types
-- Maintainer: Toshio Ito <debug.ito@gmail.com>
--
-- This module defines types and functions about TinkerPop graph
-- structure API.
module Data.Greskell.Graph
    ( -- * Element
      Element (..)
    , ElementData (..)
    , ElementID (..)
    , unsafeCastElementID
    , Vertex
    , Edge
      -- * Property
    , Property (..)
      -- * T Enum
    , T
    , tId
    , tKey
    , tLabel
    , tValue
      -- * Cardinality Enum
    , Cardinality
    , cList
    , cSet
    , cSingle
      -- * Typed Key (accessor of a Property)
    , Key (..)
    , key
    , unsafeCastKey
      -- ** Key-value pair
    , KeyValue (..)
    , (=:)
      -- ** Heterogeneous list of keys
    , Keys (..)
    , singletonKeys
    , toGremlinKeys
    , (-:)
      -- * Path
    , Path (..)
    , PathEntry (..)
    , pathToPMap
    , makePathEntry
      -- * Concrete data types
      -- $concrete_types
      -- ** Vertex
    , AVertex (..)
      -- ** Edge
    , AEdge (..)
      -- ** VertexProperty
    , AVertexProperty (..)
      -- ** Property
    , AProperty (..)
      -- * Examples
    , examples
    ) where

import           Control.Applicative           (empty, (<$>), (<*>), (<|>))
import           Control.Monad                 (when)
import           Data.Aeson                    (FromJSON (..), ToJSON (..), Value (..))
import           Data.Aeson.Types              (Parser)
import           Data.Foldable                 (Foldable (foldr), foldlM, toList)
import           Data.Hashable                 (Hashable)
import qualified Data.HashMap.Strict           as HM
import           Data.HashSet                  (HashSet)
import qualified Data.HashSet                  as HS
import           Data.Kind                     (Type)
import           Data.List.NonEmpty            (NonEmpty (..))
import qualified Data.List.NonEmpty            as NL
import           Data.Maybe                    (listToMaybe)
import           Data.Monoid                   (Monoid (..))
import           Data.Semigroup                (Semigroup, (<>))
import qualified Data.Semigroup                as Semigroup
import           Data.String                   (IsString (..))
import           Data.Text                     (Text)
import           Data.Traversable              (Traversable (traverse))
import           Data.Vector                   (Vector)
import           GHC.Generics                  (Generic)

import           Data.Greskell.AsIterator      (AsIterator (..))
import           Data.Greskell.AsLabel         (AsLabel (..), unsafeCastAsLabel)
import           Data.Greskell.GraphSON        (FromGraphSON (..), GValue, GValueBody (..),
                                                GraphSON (..), GraphSONTyped (..),
                                                parseJSONViaGValue, (.:))
import           Data.Greskell.GraphSON.GValue (gValueBody, gValueType)
import           Data.Greskell.Greskell        (Greskell, ToGreskell (..), string, toGremlin,
                                                unsafeGreskellLazy)
import           Data.Greskell.NonEmptyLike    (NonEmptyLike)
import           Data.Greskell.PMap            (Multi, PMap, PMapKey (..), Single, pMapInsert)

-- | ID of a graph element @e@ (vertex, edge and vertex property).
--
-- Although the internal of 'ElementID' is exposed, you should treat it as an opaque value. That's
-- because it depends on graph implementation.
--
-- @since 1.0.0.0
newtype ElementID e
  = ElementID { forall e. ElementID e -> GValue
unElementID :: GValue }
  deriving (ElementID e -> ElementID e -> Bool
(ElementID e -> ElementID e -> Bool)
-> (ElementID e -> ElementID e -> Bool) -> Eq (ElementID e)
forall e. ElementID e -> ElementID e -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall e. ElementID e -> ElementID e -> Bool
== :: ElementID e -> ElementID e -> Bool
$c/= :: forall e. ElementID e -> ElementID e -> Bool
/= :: ElementID e -> ElementID e -> Bool
Eq, GValue -> Parser (ElementID e)
(GValue -> Parser (ElementID e)) -> FromGraphSON (ElementID e)
forall e. GValue -> Parser (ElementID e)
forall a. (GValue -> Parser a) -> FromGraphSON a
$cparseGraphSON :: forall e. GValue -> Parser (ElementID e)
parseGraphSON :: GValue -> Parser (ElementID e)
FromGraphSON, Maybe (ElementID e)
Value -> Parser [ElementID e]
Value -> Parser (ElementID e)
(Value -> Parser (ElementID e))
-> (Value -> Parser [ElementID e])
-> Maybe (ElementID e)
-> FromJSON (ElementID e)
forall e. Maybe (ElementID e)
forall e. Value -> Parser [ElementID e]
forall e. Value -> Parser (ElementID e)
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: forall e. Value -> Parser (ElementID e)
parseJSON :: Value -> Parser (ElementID e)
$cparseJSONList :: forall e. Value -> Parser [ElementID e]
parseJSONList :: Value -> Parser [ElementID e]
$comittedField :: forall e. Maybe (ElementID e)
omittedField :: Maybe (ElementID e)
FromJSON, (forall x. ElementID e -> Rep (ElementID e) x)
-> (forall x. Rep (ElementID e) x -> ElementID e)
-> Generic (ElementID e)
forall x. Rep (ElementID e) x -> ElementID e
forall x. ElementID e -> Rep (ElementID e) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall e x. Rep (ElementID e) x -> ElementID e
forall e x. ElementID e -> Rep (ElementID e) x
$cfrom :: forall e x. ElementID e -> Rep (ElementID e) x
from :: forall x. ElementID e -> Rep (ElementID e) x
$cto :: forall e x. Rep (ElementID e) x -> ElementID e
to :: forall x. Rep (ElementID e) x -> ElementID e
Generic, Eq (ElementID e)
Eq (ElementID e) =>
(Int -> ElementID e -> Int)
-> (ElementID e -> Int) -> Hashable (ElementID e)
Int -> ElementID e -> Int
ElementID e -> Int
forall e. Eq (ElementID e)
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
forall e. Int -> ElementID e -> Int
forall e. ElementID e -> Int
$chashWithSalt :: forall e. Int -> ElementID e -> Int
hashWithSalt :: Int -> ElementID e -> Int
$chash :: forall e. ElementID e -> Int
hash :: ElementID e -> Int
Hashable, Int -> ElementID e -> ShowS
[ElementID e] -> ShowS
ElementID e -> String
(Int -> ElementID e -> ShowS)
-> (ElementID e -> String)
-> ([ElementID e] -> ShowS)
-> Show (ElementID e)
forall e. Int -> ElementID e -> ShowS
forall e. [ElementID e] -> ShowS
forall e. ElementID e -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall e. Int -> ElementID e -> ShowS
showsPrec :: Int -> ElementID e -> ShowS
$cshow :: forall e. ElementID e -> String
show :: ElementID e -> String
$cshowList :: forall e. [ElementID e] -> ShowS
showList :: [ElementID e] -> ShowS
Show, [ElementID e] -> Value
[ElementID e] -> Encoding
ElementID e -> Bool
ElementID e -> Value
ElementID e -> Encoding
(ElementID e -> Value)
-> (ElementID e -> Encoding)
-> ([ElementID e] -> Value)
-> ([ElementID e] -> Encoding)
-> (ElementID e -> Bool)
-> ToJSON (ElementID e)
forall e. [ElementID e] -> Value
forall e. [ElementID e] -> Encoding
forall e. ElementID e -> Bool
forall e. ElementID e -> Value
forall e. ElementID e -> Encoding
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: forall e. ElementID e -> Value
toJSON :: ElementID e -> Value
$ctoEncoding :: forall e. ElementID e -> Encoding
toEncoding :: ElementID e -> Encoding
$ctoJSONList :: forall e. [ElementID e] -> Value
toJSONList :: [ElementID e] -> Value
$ctoEncodingList :: forall e. [ElementID e] -> Encoding
toEncodingList :: [ElementID e] -> Encoding
$comitField :: forall e. ElementID e -> Bool
omitField :: ElementID e -> Bool
ToJSON)

-- | Unsafely convert the element type.
instance Functor ElementID where
  fmap :: forall a b. (a -> b) -> ElementID a -> ElementID b
fmap a -> b
_ ElementID a
e = ElementID a -> ElementID b
forall a b. ElementID a -> ElementID b
unsafeCastElementID ElementID a
e

-- | Unsafely cast the phantom type of 'ElementID'.
--
-- @since 1.0.0.0
unsafeCastElementID :: ElementID a -> ElementID b
unsafeCastElementID :: forall a b. ElementID a -> ElementID b
unsafeCastElementID (ElementID GValue
e) = GValue -> ElementID b
forall e. GValue -> ElementID e
ElementID GValue
e

-- | Types that keep reference to TinkerPop graph Elements.
--
-- @since 1.0.0.0
class ElementData e where
  -- | ID of this Element.
  elementId :: e -> ElementID e
  -- | Label of this Element.
  elementLabel :: e -> Text

-- | @org.apache.tinkerpop.gremlin.structure.Element@ interface in a
-- TinkerPop graph.
--
-- Since greskell-1.0.0.0, 'ElementData' is a super-class of
-- 'Element'.
class ElementData e => Element e where
  -- | Property type of the 'Element'. It should be of 'Property'
  -- class.
  type ElementProperty e :: Type -> Type

  -- | Container type of the properties of the 'Element'. It should be
  -- of 'NonEmptyLike' class.
  --
  -- @since 1.0.0.0
  type ElementPropertyContainer e :: Type -> Type

-- | @org.apache.tinkerpop.gremlin.structure.Vertex@ interface in a
-- TinkerPop graph.
class (Element v) => Vertex v

-- | @org.apache.tinkerpop.gremlin.structure.Edge@ interface in a
-- TinkerPop graph.
class (Element e) => Edge e

-- | @org.apache.tinkerpop.gremlin.structure.Property@ interface in a
-- TinkerPop graph.
class Property p where
  -- | Get key of this property.
  propertyKey :: p v -> Text
  -- | Get value of this property.
  propertyValue :: p v -> v

-- | @org.apache.tinkerpop.gremlin.structure.T@ enum.
--
-- 'T' is a token to get data @b@ from an Element @a@.
data T a b

instance GraphSONTyped (T a b) where
  gsonTypeFor :: T a b -> Text
gsonTypeFor T a b
_ = Text
"g:T"


-- | @T.id@ token.
tId :: Element a => Greskell (T a (ElementID a))
tId :: forall a. Element a => Greskell (T a (ElementID a))
tId = Text -> Greskell (T a (ElementID a))
forall a. Text -> Greskell a
unsafeGreskellLazy Text
"T.id"

-- | @T.key@ token.
tKey :: (Element (p v), Property p) => Greskell (T (p v) Text)
tKey :: forall (p :: * -> *) v.
(Element (p v), Property p) =>
Greskell (T (p v) Text)
tKey = Text -> Greskell (T (p v) Text)
forall a. Text -> Greskell a
unsafeGreskellLazy Text
"T.key"

-- | @T.label@ token.
tLabel :: Element a => Greskell (T a Text)
tLabel :: forall a. Element a => Greskell (T a Text)
tLabel = Text -> Greskell (T a Text)
forall a. Text -> Greskell a
unsafeGreskellLazy Text
"T.label"

-- | @T.value@ token.
tValue :: (Element (p v), Property p) => Greskell (T (p v) v)
tValue :: forall (p :: * -> *) v.
(Element (p v), Property p) =>
Greskell (T (p v) v)
tValue = Text -> Greskell (T (p v) v)
forall a. Text -> Greskell a
unsafeGreskellLazy Text
"T.value"

-- | @org.apache.tinkerpop.gremlin.structure.VertexProperty.Cardinality@ enum.
--
-- @since 0.2.0.0
data Cardinality

-- Developer note: while 'tId' creates a Greskell of "T.id", 'cList'
-- creates just "list", not "VertexProperty.Cardinality.list". This is
-- because Neptune (Amazon's cloud-based graph database) happens to
-- support "list" but not "VertexProperty.Cardinality.list" (it
-- supports "T.id", though.)
-- See https://docs.aws.amazon.com/neptune/latest/userguide/access-graph-gremlin-differences.html
--
-- Future versions of greskell may support some configuration
-- mechanism to control how to format Gremlin symbols such as those in
-- Cardinality, T, Order, P, Direction etc.

-- | @list@ Cardinality.
--
-- @since 0.2.0.0
cList :: Greskell Cardinality
cList :: Greskell Cardinality
cList = Text -> Greskell Cardinality
forall a. Text -> Greskell a
unsafeGreskellLazy Text
"list"

-- | @set@ Cardinality.
--
-- @since 0.2.0.0
cSet :: Greskell Cardinality
cSet :: Greskell Cardinality
cSet = Text -> Greskell Cardinality
forall a. Text -> Greskell a
unsafeGreskellLazy Text
"set"

-- | @single@ Cardinality.
--
-- @since 0.2.0.0
cSingle :: Greskell Cardinality
cSingle :: Greskell Cardinality
cSingle = Text -> Greskell Cardinality
forall a. Text -> Greskell a
unsafeGreskellLazy Text
"single"

-- | A property key accessing value @b@ in an Element @a@. In Gremlin,
-- it's just a String type.
--
-- Since greskell-1.0.0.0, 'Key' is newtype of 'Text'. Before that, it
-- was newtype of 'Greskell' 'Text'.
newtype Key a b
  = Key { forall a b. Key a b -> Text
unKey :: Text }
  deriving (Key a b -> Key a b -> Bool
(Key a b -> Key a b -> Bool)
-> (Key a b -> Key a b -> Bool) -> Eq (Key a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. Key a b -> Key a b -> Bool
$c== :: forall a b. Key a b -> Key a b -> Bool
== :: Key a b -> Key a b -> Bool
$c/= :: forall a b. Key a b -> Key a b -> Bool
/= :: Key a b -> Key a b -> Bool
Eq, Int -> Key a b -> ShowS
[Key a b] -> ShowS
Key a b -> String
(Int -> Key a b -> ShowS)
-> (Key a b -> String) -> ([Key a b] -> ShowS) -> Show (Key a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. Int -> Key a b -> ShowS
forall a b. [Key a b] -> ShowS
forall a b. Key a b -> String
$cshowsPrec :: forall a b. Int -> Key a b -> ShowS
showsPrec :: Int -> Key a b -> ShowS
$cshow :: forall a b. Key a b -> String
show :: Key a b -> String
$cshowList :: forall a b. [Key a b] -> ShowS
showList :: [Key a b] -> ShowS
Show)

-- | Unsafely convert the value type @b@.
instance Functor (Key a) where
  fmap :: forall a b. (a -> b) -> Key a a -> Key a b
fmap a -> b
_ (Key Text
t) = Text -> Key a b
forall a b. Text -> Key a b
Key Text
t

instance IsString (Key a b) where
  fromString :: String -> Key a b
fromString = Text -> Key a b
forall a b. Text -> Key a b
Key (Text -> Key a b) -> (String -> Text) -> String -> Key a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. IsString a => String -> a
fromString

-- | Return Gremlin String literal.
instance ToGreskell (Key a b) where
  type GreskellReturn (Key a b) = Text
  toGreskell :: Key a b -> Greskell (GreskellReturn (Key a b))
toGreskell = Text -> Greskell Text
string (Text -> Greskell Text)
-> (Key a b -> Text) -> Key a b -> Greskell Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key a b -> Text
forall a b. Key a b -> Text
unKey

-- | @since 1.0.0.0
instance PMapKey (Key a b) where
  type PMapValue (Key a b) = b
  keyText :: Key a b -> Text
keyText (Key Text
t) = Text
t

-- | Create a 'Key' a text.
key :: Text -> Key a b
key :: forall a b. Text -> Key a b
key = Text -> Key a b
forall a b. Text -> Key a b
Key

-- | Unsafely cast the type signature of the 'Key'.
--
-- @since 1.0.0.0
unsafeCastKey :: Key a1 b1 -> Key a2 b2
unsafeCastKey :: forall a1 b1 a2 b2. Key a1 b1 -> Key a2 b2
unsafeCastKey = Text -> Key a2 b2
forall a b. Text -> Key a b
Key (Text -> Key a2 b2)
-> (Key a1 b1 -> Text) -> Key a1 b1 -> Key a2 b2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key a1 b1 -> Text
forall a b. Key a b -> Text
unKey

-- | Pair of 'Key' and its value. Mainly used for writing properties
-- into the database.
--
-- Type @a@ is the type of 'Element' that keeps the 'KeyValue'
-- pair. It drops the type of the value, so that you can construct a
-- heterogeneous list of key-value pairs for a given 'Element'.
--
-- @since 0.2.0.0
data KeyValue a where
  -- | Key and value
  KeyValue :: Key a b -> Greskell b -> KeyValue a
  -- | Key without value
  --
  -- @since 1.0.0.0
  KeyNoValue :: Key a b -> KeyValue a

-- | Constructor operator of 'KeyValue'.
--
-- @since 0.2.0.0
(=:) :: Key a b -> Greskell b -> KeyValue a
=: :: forall a b. Key a b -> Greskell b -> KeyValue a
(=:) = Key a b -> Greskell b -> KeyValue a
forall a b. Key a b -> Greskell b -> KeyValue a
KeyValue

-- | Heterogeneous list of 'Key's. It keeps the parent type @a@, but
-- discards the value type @b@.
--
-- @since 1.0.0.0
data Keys a where
  -- | Empty 'Keys'.
  KeysNil :: Keys a
  -- | Add a 'Key' to 'Keys'.
  KeysCons :: Key a b -> Keys a -> Keys a

instance Semigroup (Keys a) where
  Keys a
a <> :: Keys a -> Keys a -> Keys a
<> Keys a
b =
    case Keys a
a of
      Keys a
KeysNil         -> Keys a
b
      KeysCons Key a b
x Keys a
rest -> Key a b -> Keys a -> Keys a
forall a b. Key a b -> Keys a -> Keys a
KeysCons Key a b
x (Keys a
rest Keys a -> Keys a -> Keys a
forall a. Semigroup a => a -> a -> a
<> Keys a
b)

instance Monoid (Keys a) where
  mempty :: Keys a
mempty = Keys a
forall a. Keys a
KeysNil
  mappend :: Keys a -> Keys a -> Keys a
mappend = Keys a -> Keys a -> Keys a
forall a. Semigroup a => a -> a -> a
(<>)

-- | 'Keys' with a single 'Key'.
--
-- @since 1.0.0.0
singletonKeys :: Key a b -> Keys a
singletonKeys :: forall a b. Key a b -> Keys a
singletonKeys Key a b
k = Key a b -> Keys a -> Keys a
forall a b. Key a b -> Keys a -> Keys a
KeysCons Key a b
k Keys a
forall a. Keys a
KeysNil

-- | Convert 'Keys' to a list of Gremlin scripts.
--
-- @since 2.0.1.0
toGremlinKeys :: Keys a -> [Text]
toGremlinKeys :: forall a. Keys a -> [Text]
toGremlinKeys Keys a
KeysNil           = []
toGremlinKeys (KeysCons Key a b
k Keys a
rest) = Key a b -> Text
forall a. ToGreskell a => a -> Text
toGremlin Key a b
k Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Keys a -> [Text]
forall a. Keys a -> [Text]
toGremlinKeys Keys a
rest

-- | Prepend a 'Key' to 'Keys'.
--
-- @since 1.0.0.0
(-:) :: Key a b -> Keys a -> Keys a
-: :: forall a b. Key a b -> Keys a -> Keys a
(-:) = Key a b -> Keys a -> Keys a
forall a b. Key a b -> Keys a -> Keys a
KeysCons

infixr 5 -:

-- $concrete_types
-- Graph structure data types based on Aeson.
--
-- You can use those types directly in your programs. You can also
-- define your own graph types by wrapping those with @newtype@. See
-- [README.md](https://github.com/debug-ito/greskell#make-your-own-graph-structure-types)
-- for detail.
--
-- Historical note:
--
-- - Since version 1.0.0.0, the concrete data types don't keep
--   properties, and IDs are of 'ElementID' type.
-- - In version 0.1.1.0 and before, these conrete data types were
--   based on @GraphSON Value@. In version 0.2.0.0, this was changed to
--   'GValue', so that it can parse nested data structures encoded in
--   GraphSON.

-- | General vertex type you can use for 'Vertex' class.
data AVertex
  = AVertex
      { AVertex -> ElementID AVertex
avId    :: ElementID AVertex
        -- ^ ID of this vertex
      , AVertex -> Text
avLabel :: Text
        -- ^ Label of this vertex
      }
  deriving (AVertex -> AVertex -> Bool
(AVertex -> AVertex -> Bool)
-> (AVertex -> AVertex -> Bool) -> Eq AVertex
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AVertex -> AVertex -> Bool
== :: AVertex -> AVertex -> Bool
$c/= :: AVertex -> AVertex -> Bool
/= :: AVertex -> AVertex -> Bool
Eq, Int -> AVertex -> ShowS
[AVertex] -> ShowS
AVertex -> String
(Int -> AVertex -> ShowS)
-> (AVertex -> String) -> ([AVertex] -> ShowS) -> Show AVertex
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AVertex -> ShowS
showsPrec :: Int -> AVertex -> ShowS
$cshow :: AVertex -> String
show :: AVertex -> String
$cshowList :: [AVertex] -> ShowS
showList :: [AVertex] -> ShowS
Show)

-- | @since 1.0.0.0
instance ElementData AVertex where
  elementId :: AVertex -> ElementID AVertex
elementId = AVertex -> ElementID AVertex
avId
  elementLabel :: AVertex -> Text
elementLabel = AVertex -> Text
avLabel

instance Element AVertex where
  type ElementProperty AVertex = AVertexProperty
  type ElementPropertyContainer AVertex = Multi

instance Vertex AVertex

instance GraphSONTyped AVertex where
  gsonTypeFor :: AVertex -> Text
gsonTypeFor AVertex
_ = Text
"g:Vertex"

instance FromJSON AVertex where
  parseJSON :: Value -> Parser AVertex
parseJSON = Value -> Parser AVertex
forall a. FromGraphSON a => Value -> Parser a
parseJSONViaGValue

instance FromGraphSON AVertex where
  parseGraphSON :: GValue -> Parser AVertex
parseGraphSON GValue
gv = case GValue -> GValueBody
gValueBody GValue
gv of
    GObject KeyMap GValue
o -> ElementID AVertex -> Text -> AVertex
AVertex
                 (ElementID AVertex -> Text -> AVertex)
-> Parser (ElementID AVertex) -> Parser (Text -> AVertex)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (KeyMap GValue
o KeyMap GValue -> Key -> Parser (ElementID AVertex)
forall a. FromGraphSON a => KeyMap GValue -> Key -> Parser a
.: Key
"id")
                 Parser (Text -> AVertex) -> Parser Text -> Parser AVertex
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (KeyMap GValue
o KeyMap GValue -> Key -> Parser Text
forall a. FromGraphSON a => KeyMap GValue -> Key -> Parser a
.: Key
"label")
    GValueBody
_ -> Parser AVertex
forall a. Parser a
forall (f :: * -> *) a. Alternative f => f a
empty

-- | General edge type you can use for 'Edge' class.
data AEdge
  = AEdge
      { AEdge -> ElementID AEdge
aeId    :: ElementID AEdge
        -- ^ ID of this edge.
      , AEdge -> Text
aeLabel :: Text
        -- ^ Label of this edge.
      }
  deriving (AEdge -> AEdge -> Bool
(AEdge -> AEdge -> Bool) -> (AEdge -> AEdge -> Bool) -> Eq AEdge
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AEdge -> AEdge -> Bool
== :: AEdge -> AEdge -> Bool
$c/= :: AEdge -> AEdge -> Bool
/= :: AEdge -> AEdge -> Bool
Eq, Int -> AEdge -> ShowS
[AEdge] -> ShowS
AEdge -> String
(Int -> AEdge -> ShowS)
-> (AEdge -> String) -> ([AEdge] -> ShowS) -> Show AEdge
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AEdge -> ShowS
showsPrec :: Int -> AEdge -> ShowS
$cshow :: AEdge -> String
show :: AEdge -> String
$cshowList :: [AEdge] -> ShowS
showList :: [AEdge] -> ShowS
Show)

-- | @since 1.0.0.0
instance ElementData AEdge where
  elementId :: AEdge -> ElementID AEdge
elementId = AEdge -> ElementID AEdge
aeId
  elementLabel :: AEdge -> Text
elementLabel = AEdge -> Text
aeLabel

instance Element AEdge where
  type ElementProperty AEdge = AProperty
  type ElementPropertyContainer AEdge = Single

instance Edge AEdge

instance GraphSONTyped AEdge where
  gsonTypeFor :: AEdge -> Text
gsonTypeFor AEdge
_ = Text
"g:Edge"

instance FromJSON AEdge where
  parseJSON :: Value -> Parser AEdge
parseJSON = Value -> Parser AEdge
forall a. FromGraphSON a => Value -> Parser a
parseJSONViaGValue

instance FromGraphSON AEdge where
  parseGraphSON :: GValue -> Parser AEdge
parseGraphSON GValue
gv = case GValue -> GValueBody
gValueBody GValue
gv of
    GObject KeyMap GValue
o -> ElementID AEdge -> Text -> AEdge
AEdge
                 (ElementID AEdge -> Text -> AEdge)
-> Parser (ElementID AEdge) -> Parser (Text -> AEdge)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (KeyMap GValue
o KeyMap GValue -> Key -> Parser (ElementID AEdge)
forall a. FromGraphSON a => KeyMap GValue -> Key -> Parser a
.: Key
"id")
                 Parser (Text -> AEdge) -> Parser Text -> Parser AEdge
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (KeyMap GValue
o KeyMap GValue -> Key -> Parser Text
forall a. FromGraphSON a => KeyMap GValue -> Key -> Parser a
.: Key
"label")
    GValueBody
_ -> Parser AEdge
forall a. Parser a
forall (f :: * -> *) a. Alternative f => f a
empty

-- | General simple property type you can use for 'Property' class.
--
-- If you are not sure about the type @v@, just use 'GValue'.
data AProperty v
  = AProperty
      { forall v. AProperty v -> Text
apKey   :: Text
      , forall v. AProperty v -> v
apValue :: v
      }
  deriving (AProperty v -> AProperty v -> Bool
(AProperty v -> AProperty v -> Bool)
-> (AProperty v -> AProperty v -> Bool) -> Eq (AProperty v)
forall v. Eq v => AProperty v -> AProperty v -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall v. Eq v => AProperty v -> AProperty v -> Bool
== :: AProperty v -> AProperty v -> Bool
$c/= :: forall v. Eq v => AProperty v -> AProperty v -> Bool
/= :: AProperty v -> AProperty v -> Bool
Eq, Eq (AProperty v)
Eq (AProperty v) =>
(AProperty v -> AProperty v -> Ordering)
-> (AProperty v -> AProperty v -> Bool)
-> (AProperty v -> AProperty v -> Bool)
-> (AProperty v -> AProperty v -> Bool)
-> (AProperty v -> AProperty v -> Bool)
-> (AProperty v -> AProperty v -> AProperty v)
-> (AProperty v -> AProperty v -> AProperty v)
-> Ord (AProperty v)
AProperty v -> AProperty v -> Bool
AProperty v -> AProperty v -> Ordering
AProperty v -> AProperty v -> AProperty v
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 v. Ord v => Eq (AProperty v)
forall v. Ord v => AProperty v -> AProperty v -> Bool
forall v. Ord v => AProperty v -> AProperty v -> Ordering
forall v. Ord v => AProperty v -> AProperty v -> AProperty v
$ccompare :: forall v. Ord v => AProperty v -> AProperty v -> Ordering
compare :: AProperty v -> AProperty v -> Ordering
$c< :: forall v. Ord v => AProperty v -> AProperty v -> Bool
< :: AProperty v -> AProperty v -> Bool
$c<= :: forall v. Ord v => AProperty v -> AProperty v -> Bool
<= :: AProperty v -> AProperty v -> Bool
$c> :: forall v. Ord v => AProperty v -> AProperty v -> Bool
> :: AProperty v -> AProperty v -> Bool
$c>= :: forall v. Ord v => AProperty v -> AProperty v -> Bool
>= :: AProperty v -> AProperty v -> Bool
$cmax :: forall v. Ord v => AProperty v -> AProperty v -> AProperty v
max :: AProperty v -> AProperty v -> AProperty v
$cmin :: forall v. Ord v => AProperty v -> AProperty v -> AProperty v
min :: AProperty v -> AProperty v -> AProperty v
Ord, Int -> AProperty v -> ShowS
[AProperty v] -> ShowS
AProperty v -> String
(Int -> AProperty v -> ShowS)
-> (AProperty v -> String)
-> ([AProperty v] -> ShowS)
-> Show (AProperty v)
forall v. Show v => Int -> AProperty v -> ShowS
forall v. Show v => [AProperty v] -> ShowS
forall v. Show v => AProperty v -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall v. Show v => Int -> AProperty v -> ShowS
showsPrec :: Int -> AProperty v -> ShowS
$cshow :: forall v. Show v => AProperty v -> String
show :: AProperty v -> String
$cshowList :: forall v. Show v => [AProperty v] -> ShowS
showList :: [AProperty v] -> ShowS
Show)

-- | Parse Property of GraphSON 1.0.
--
-- In version 0.1.1.0 and before, the constraint was @FromJSON v@.
-- This has changed.
instance FromGraphSON v => FromJSON (AProperty v) where
  parseJSON :: Value -> Parser (AProperty v)
parseJSON = Value -> Parser (AProperty v)
forall a. FromGraphSON a => Value -> Parser a
parseJSONViaGValue

-- | Parse Property of GraphSON 1.0.
instance FromGraphSON v => FromGraphSON (AProperty v) where
  parseGraphSON :: GValue -> Parser (AProperty v)
parseGraphSON GValue
gv = case GValue -> GValueBody
gValueBody GValue
gv of
    GObject KeyMap GValue
o -> Text -> v -> AProperty v
forall v. Text -> v -> AProperty v
AProperty (Text -> v -> AProperty v)
-> Parser Text -> Parser (v -> AProperty v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (KeyMap GValue
o KeyMap GValue -> Key -> Parser Text
forall a. FromGraphSON a => KeyMap GValue -> Key -> Parser a
.: Key
"key") Parser (v -> AProperty v) -> Parser v -> Parser (AProperty v)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (KeyMap GValue
o KeyMap GValue -> Key -> Parser v
forall a. FromGraphSON a => KeyMap GValue -> Key -> Parser a
.: Key
"value")
    GValueBody
_         -> Parser (AProperty v)
forall a. Parser a
forall (f :: * -> *) a. Alternative f => f a
empty

instance Property AProperty where
  propertyKey :: forall v. AProperty v -> Text
propertyKey = AProperty v -> Text
forall v. AProperty v -> Text
apKey
  propertyValue :: forall v. AProperty v -> v
propertyValue = AProperty v -> v
forall v. AProperty v -> v
apValue

instance GraphSONTyped (AProperty v) where
  gsonTypeFor :: AProperty v -> Text
gsonTypeFor AProperty v
_ = Text
"g:Property"

instance Functor AProperty where
  fmap :: forall a b. (a -> b) -> AProperty a -> AProperty b
fmap a -> b
f AProperty a
sp = AProperty a
sp { apValue = f $ apValue sp }

instance Foldable AProperty where
  foldr :: forall a b. (a -> b -> b) -> b -> AProperty a -> b
foldr a -> b -> b
f b
start AProperty a
sp = a -> b -> b
f (AProperty a -> a
forall v. AProperty v -> v
apValue AProperty a
sp) b
start

instance Traversable AProperty where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> AProperty a -> f (AProperty b)
traverse a -> f b
f AProperty a
sp = (b -> AProperty b) -> f b -> f (AProperty b)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\b
v -> AProperty a
sp { apValue = v } ) (f b -> f (AProperty b)) -> f b -> f (AProperty b)
forall a b. (a -> b) -> a -> b
$ a -> f b
f (a -> f b) -> a -> f b
forall a b. (a -> b) -> a -> b
$ AProperty a -> a
forall v. AProperty v -> v
apValue AProperty a
sp

-- | General vertex property type you can use for VertexProperty.
--
-- If you are not sure about the type @v@, just use 'GValue'.
data AVertexProperty v
  = AVertexProperty
      { forall v. AVertexProperty v -> ElementID (AVertexProperty v)
avpId    :: ElementID (AVertexProperty v)
        -- ^ ID of this vertex property.
      , forall v. AVertexProperty v -> Text
avpLabel :: Text
        -- ^ Label and key of this vertex property.
      , forall v. AVertexProperty v -> v
avpValue :: v
        -- ^ Value of this vertex property.
      }
  deriving (AVertexProperty v -> AVertexProperty v -> Bool
(AVertexProperty v -> AVertexProperty v -> Bool)
-> (AVertexProperty v -> AVertexProperty v -> Bool)
-> Eq (AVertexProperty v)
forall v. Eq v => AVertexProperty v -> AVertexProperty v -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall v. Eq v => AVertexProperty v -> AVertexProperty v -> Bool
== :: AVertexProperty v -> AVertexProperty v -> Bool
$c/= :: forall v. Eq v => AVertexProperty v -> AVertexProperty v -> Bool
/= :: AVertexProperty v -> AVertexProperty v -> Bool
Eq, Int -> AVertexProperty v -> ShowS
[AVertexProperty v] -> ShowS
AVertexProperty v -> String
(Int -> AVertexProperty v -> ShowS)
-> (AVertexProperty v -> String)
-> ([AVertexProperty v] -> ShowS)
-> Show (AVertexProperty v)
forall v. Show v => Int -> AVertexProperty v -> ShowS
forall v. Show v => [AVertexProperty v] -> ShowS
forall v. Show v => AVertexProperty v -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall v. Show v => Int -> AVertexProperty v -> ShowS
showsPrec :: Int -> AVertexProperty v -> ShowS
$cshow :: forall v. Show v => AVertexProperty v -> String
show :: AVertexProperty v -> String
$cshowList :: forall v. Show v => [AVertexProperty v] -> ShowS
showList :: [AVertexProperty v] -> ShowS
Show)

-- | In version 0.1.1.0 and before, the constraint was @FromJSON v@.
-- This has changed.
instance FromGraphSON v => FromJSON (AVertexProperty v) where
  parseJSON :: Value -> Parser (AVertexProperty v)
parseJSON = Value -> Parser (AVertexProperty v)
forall a. FromGraphSON a => Value -> Parser a
parseJSONViaGValue

instance FromGraphSON v => FromGraphSON (AVertexProperty v) where
  parseGraphSON :: GValue -> Parser (AVertexProperty v)
parseGraphSON GValue
gv = case GValue -> GValueBody
gValueBody GValue
gv of
    GObject KeyMap GValue
o -> ElementID (AVertexProperty v) -> Text -> v -> AVertexProperty v
forall v.
ElementID (AVertexProperty v) -> Text -> v -> AVertexProperty v
AVertexProperty
                 (ElementID (AVertexProperty v) -> Text -> v -> AVertexProperty v)
-> Parser (ElementID (AVertexProperty v))
-> Parser (Text -> v -> AVertexProperty v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (KeyMap GValue
o KeyMap GValue -> Key -> Parser (ElementID (AVertexProperty v))
forall a. FromGraphSON a => KeyMap GValue -> Key -> Parser a
.: Key
"id")
                 Parser (Text -> v -> AVertexProperty v)
-> Parser Text -> Parser (v -> AVertexProperty v)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (KeyMap GValue
o KeyMap GValue -> Key -> Parser Text
forall a. FromGraphSON a => KeyMap GValue -> Key -> Parser a
.: Key
"label")
                 Parser (v -> AVertexProperty v)
-> Parser v -> Parser (AVertexProperty v)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (KeyMap GValue
o KeyMap GValue -> Key -> Parser v
forall a. FromGraphSON a => KeyMap GValue -> Key -> Parser a
.: Key
"value")
    GValueBody
_ -> Parser (AVertexProperty v)
forall a. Parser a
forall (f :: * -> *) a. Alternative f => f a
empty

instance GraphSONTyped (AVertexProperty v) where
  gsonTypeFor :: AVertexProperty v -> Text
gsonTypeFor AVertexProperty v
_ = Text
"g:VertexProperty"

-- | @since 1.0.0.0
instance ElementData (AVertexProperty v) where
  elementId :: AVertexProperty v -> ElementID (AVertexProperty v)
elementId = AVertexProperty v -> ElementID (AVertexProperty v)
forall v. AVertexProperty v -> ElementID (AVertexProperty v)
avpId
  elementLabel :: AVertexProperty v -> Text
elementLabel = AVertexProperty v -> Text
forall v. AVertexProperty v -> Text
avpLabel

instance Element (AVertexProperty v) where
  type ElementProperty (AVertexProperty v) = AProperty
  type ElementPropertyContainer (AVertexProperty v) = Single

instance Property AVertexProperty where
  propertyKey :: forall v. AVertexProperty v -> Text
propertyKey = AVertexProperty v -> Text
forall v. AVertexProperty v -> Text
avpLabel
  propertyValue :: forall v. AVertexProperty v -> v
propertyValue = AVertexProperty v -> v
forall v. AVertexProperty v -> v
avpValue

-- | Map the property value.
instance Functor AVertexProperty where
  fmap :: forall a b. (a -> b) -> AVertexProperty a -> AVertexProperty b
fmap a -> b
f AVertexProperty a
vp = AVertexProperty a
vp { avpValue = f $ avpValue vp,
                   avpId = unsafeCastElementID $ avpId vp
                 }

instance Foldable AVertexProperty where
  foldr :: forall a b. (a -> b -> b) -> b -> AVertexProperty a -> b
foldr a -> b -> b
f b
start AVertexProperty a
vp = a -> b -> b
f (AVertexProperty a -> a
forall v. AVertexProperty v -> v
avpValue AVertexProperty a
vp) b
start

-- | Traverse the property value.
instance Traversable AVertexProperty where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> AVertexProperty a -> f (AVertexProperty b)
traverse a -> f b
f AVertexProperty a
vp = (b -> AVertexProperty b) -> f b -> f (AVertexProperty b)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> AVertexProperty b
setValue (f b -> f (AVertexProperty b)) -> f b -> f (AVertexProperty b)
forall a b. (a -> b) -> a -> b
$ a -> f b
f (a -> f b) -> a -> f b
forall a b. (a -> b) -> a -> b
$ AVertexProperty a -> a
forall v. AVertexProperty v -> v
avpValue AVertexProperty a
vp
    where
      setValue :: b -> AVertexProperty b
setValue b
v = AVertexProperty a
vp { avpValue = v, avpId = unsafeCastElementID $ avpId vp }


-- | @org.apache.tinkerpop.gremlin.process.traversal.Path@ interface.
--
-- @since 1.1.0.0
newtype Path a
  = Path { forall a. Path a -> [PathEntry a]
unPath :: [PathEntry a] }
  deriving (Path a -> Path a -> Bool
(Path a -> Path a -> Bool)
-> (Path a -> Path a -> Bool) -> Eq (Path a)
forall a. Eq a => Path a -> Path a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Path a -> Path a -> Bool
== :: Path a -> Path a -> Bool
$c/= :: forall a. Eq a => Path a -> Path a -> Bool
/= :: Path a -> Path a -> Bool
Eq, (forall m. Monoid m => Path m -> m)
-> (forall m a. Monoid m => (a -> m) -> Path a -> m)
-> (forall m a. Monoid m => (a -> m) -> Path a -> m)
-> (forall a b. (a -> b -> b) -> b -> Path a -> b)
-> (forall a b. (a -> b -> b) -> b -> Path a -> b)
-> (forall b a. (b -> a -> b) -> b -> Path a -> b)
-> (forall b a. (b -> a -> b) -> b -> Path a -> b)
-> (forall a. (a -> a -> a) -> Path a -> a)
-> (forall a. (a -> a -> a) -> Path a -> a)
-> (forall a. Path a -> [a])
-> (forall a. Path a -> Bool)
-> (forall a. Path a -> Int)
-> (forall a. Eq a => a -> Path a -> Bool)
-> (forall a. Ord a => Path a -> a)
-> (forall a. Ord a => Path a -> a)
-> (forall a. Num a => Path a -> a)
-> (forall a. Num a => Path a -> a)
-> Foldable Path
forall a. Eq a => a -> Path a -> Bool
forall a. Num a => Path a -> a
forall a. Ord a => Path a -> a
forall m. Monoid m => Path m -> m
forall a. Path a -> Bool
forall a. Path a -> Int
forall a. Path a -> [a]
forall a. (a -> a -> a) -> Path a -> a
forall m a. Monoid m => (a -> m) -> Path a -> m
forall b a. (b -> a -> b) -> b -> Path a -> b
forall a b. (a -> b -> b) -> b -> Path a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => Path m -> m
fold :: forall m. Monoid m => Path m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Path a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Path a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Path a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Path a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Path a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Path a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Path a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Path a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Path a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Path a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Path a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Path a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Path a -> a
foldr1 :: forall a. (a -> a -> a) -> Path a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Path a -> a
foldl1 :: forall a. (a -> a -> a) -> Path a -> a
$ctoList :: forall a. Path a -> [a]
toList :: forall a. Path a -> [a]
$cnull :: forall a. Path a -> Bool
null :: forall a. Path a -> Bool
$clength :: forall a. Path a -> Int
length :: forall a. Path a -> Int
$celem :: forall a. Eq a => a -> Path a -> Bool
elem :: forall a. Eq a => a -> Path a -> Bool
$cmaximum :: forall a. Ord a => Path a -> a
maximum :: forall a. Ord a => Path a -> a
$cminimum :: forall a. Ord a => Path a -> a
minimum :: forall a. Ord a => Path a -> a
$csum :: forall a. Num a => Path a -> a
sum :: forall a. Num a => Path a -> a
$cproduct :: forall a. Num a => Path a -> a
product :: forall a. Num a => Path a -> a
Foldable, (forall a b. (a -> b) -> Path a -> Path b)
-> (forall a b. a -> Path b -> Path a) -> Functor Path
forall a b. a -> Path b -> Path a
forall a b. (a -> b) -> Path a -> Path 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) -> Path a -> Path b
fmap :: forall a b. (a -> b) -> Path a -> Path b
$c<$ :: forall a b. a -> Path b -> Path a
<$ :: forall a b. a -> Path b -> Path a
Functor, Semigroup (Path a)
Path a
Semigroup (Path a) =>
Path a
-> (Path a -> Path a -> Path a)
-> ([Path a] -> Path a)
-> Monoid (Path a)
[Path a] -> Path a
Path a -> Path a -> Path a
forall a. Semigroup (Path a)
forall a. Path a
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall a. [Path a] -> Path a
forall a. Path a -> Path a -> Path a
$cmempty :: forall a. Path a
mempty :: Path a
$cmappend :: forall a. Path a -> Path a -> Path a
mappend :: Path a -> Path a -> Path a
$cmconcat :: forall a. [Path a] -> Path a
mconcat :: [Path a] -> Path a
Monoid, Eq (Path a)
Eq (Path a) =>
(Path a -> Path a -> Ordering)
-> (Path a -> Path a -> Bool)
-> (Path a -> Path a -> Bool)
-> (Path a -> Path a -> Bool)
-> (Path a -> Path a -> Bool)
-> (Path a -> Path a -> Path a)
-> (Path a -> Path a -> Path a)
-> Ord (Path a)
Path a -> Path a -> Bool
Path a -> Path a -> Ordering
Path a -> Path a -> Path 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. Ord a => Eq (Path a)
forall a. Ord a => Path a -> Path a -> Bool
forall a. Ord a => Path a -> Path a -> Ordering
forall a. Ord a => Path a -> Path a -> Path a
$ccompare :: forall a. Ord a => Path a -> Path a -> Ordering
compare :: Path a -> Path a -> Ordering
$c< :: forall a. Ord a => Path a -> Path a -> Bool
< :: Path a -> Path a -> Bool
$c<= :: forall a. Ord a => Path a -> Path a -> Bool
<= :: Path a -> Path a -> Bool
$c> :: forall a. Ord a => Path a -> Path a -> Bool
> :: Path a -> Path a -> Bool
$c>= :: forall a. Ord a => Path a -> Path a -> Bool
>= :: Path a -> Path a -> Bool
$cmax :: forall a. Ord a => Path a -> Path a -> Path a
max :: Path a -> Path a -> Path a
$cmin :: forall a. Ord a => Path a -> Path a -> Path a
min :: Path a -> Path a -> Path a
Ord, NonEmpty (Path a) -> Path a
Path a -> Path a -> Path a
(Path a -> Path a -> Path a)
-> (NonEmpty (Path a) -> Path a)
-> (forall b. Integral b => b -> Path a -> Path a)
-> Semigroup (Path a)
forall b. Integral b => b -> Path a -> Path a
forall a. NonEmpty (Path a) -> Path a
forall a. Path a -> Path a -> Path a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall a b. Integral b => b -> Path a -> Path a
$c<> :: forall a. Path a -> Path a -> Path a
<> :: Path a -> Path a -> Path a
$csconcat :: forall a. NonEmpty (Path a) -> Path a
sconcat :: NonEmpty (Path a) -> Path a
$cstimes :: forall a b. Integral b => b -> Path a -> Path a
stimes :: forall b. Integral b => b -> Path a -> Path a
Semigroup, Int -> Path a -> ShowS
[Path a] -> ShowS
Path a -> String
(Int -> Path a -> ShowS)
-> (Path a -> String) -> ([Path a] -> ShowS) -> Show (Path a)
forall a. Show a => Int -> Path a -> ShowS
forall a. Show a => [Path a] -> ShowS
forall a. Show a => Path a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Path a -> ShowS
showsPrec :: Int -> Path a -> ShowS
$cshow :: forall a. Show a => Path a -> String
show :: Path a -> String
$cshowList :: forall a. Show a => [Path a] -> ShowS
showList :: [Path a] -> ShowS
Show, Functor Path
Foldable Path
(Functor Path, Foldable Path) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> Path a -> f (Path b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Path (f a) -> f (Path a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Path a -> m (Path b))
-> (forall (m :: * -> *) a. Monad m => Path (m a) -> m (Path a))
-> Traversable Path
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Path (m a) -> m (Path a)
forall (f :: * -> *) a. Applicative f => Path (f a) -> f (Path a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Path a -> m (Path b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Path a -> f (Path b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Path a -> f (Path b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Path a -> f (Path b)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Path (f a) -> f (Path a)
sequenceA :: forall (f :: * -> *) a. Applicative f => Path (f a) -> f (Path a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Path a -> m (Path b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Path a -> m (Path b)
$csequence :: forall (m :: * -> *) a. Monad m => Path (m a) -> m (Path a)
sequence :: forall (m :: * -> *) a. Monad m => Path (m a) -> m (Path a)
Traversable)

instance GraphSONTyped (Path a) where
  gsonTypeFor :: Path a -> Text
gsonTypeFor Path a
_ = Text
"g:Path"

-- | @Path@ is an @Iterable@ that emits its objects of type @a@.
instance AsIterator (Path a) where
  type IteratorItem (Path a) = a

instance FromGraphSON a => FromJSON (Path a) where
  parseJSON :: Value -> Parser (Path a)
parseJSON = Value -> Parser (Path a)
forall a. FromGraphSON a => Value -> Parser a
parseJSONViaGValue

instance FromGraphSON a => FromGraphSON (Path a) where
  parseGraphSON :: GValue -> Parser (Path a)
parseGraphSON GValue
gv =
    case GValue -> GValueBody
gValueBody GValue
gv of
      GObject KeyMap GValue
o -> KeyMap GValue -> Parser (Path a)
forall {a}. FromGraphSON a => KeyMap GValue -> Parser (Path a)
parseObj KeyMap GValue
o
      GValueBody
_         -> Parser (Path a)
forall a. Parser a
forall (f :: * -> *) a. Alternative f => f a
empty
    where
      parseObj :: KeyMap GValue -> Parser (Path a)
parseObj KeyMap GValue
o = do
        [HashSet Text]
labels <- KeyMap GValue
o KeyMap GValue -> Key -> Parser [HashSet Text]
forall a. FromGraphSON a => KeyMap GValue -> Key -> Parser a
.: Key
"labels"
        [a]
objects <- KeyMap GValue
o KeyMap GValue -> Key -> Parser [a]
forall a. FromGraphSON a => KeyMap GValue -> Key -> Parser a
.: Key
"objects"
        let nlabels :: Int
nlabels = [HashSet Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [HashSet Text]
labels
            nobjects :: Int
nobjects = [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
objects
        Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
nlabels Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
nobjects) (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ do
          String -> Parser ()
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ( String
"Different number of labels and objects: "
                 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
nlabels String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" labels, "
                 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
nobjects String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" objects."
               )
        Path a -> Parser (Path a)
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Path a -> Parser (Path a)) -> Path a -> Parser (Path a)
forall a b. (a -> b) -> a -> b
$ [PathEntry a] -> Path a
forall a. [PathEntry a] -> Path a
Path ([PathEntry a] -> Path a) -> [PathEntry a] -> Path a
forall a b. (a -> b) -> a -> b
$ ((HashSet (AsLabel a), a) -> PathEntry a)
-> [(HashSet (AsLabel a), a)] -> [PathEntry a]
forall a b. (a -> b) -> [a] -> [b]
map ((HashSet (AsLabel a) -> a -> PathEntry a)
-> (HashSet (AsLabel a), a) -> PathEntry a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry HashSet (AsLabel a) -> a -> PathEntry a
forall a. HashSet (AsLabel a) -> a -> PathEntry a
PathEntry) ([(HashSet (AsLabel a), a)] -> [PathEntry a])
-> [(HashSet (AsLabel a), a)] -> [PathEntry a]
forall a b. (a -> b) -> a -> b
$ [HashSet (AsLabel a)] -> [a] -> [(HashSet (AsLabel a), a)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((HashSet Text -> HashSet (AsLabel a))
-> [HashSet Text] -> [HashSet (AsLabel a)]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> AsLabel a) -> HashSet Text -> HashSet (AsLabel a)
forall b a.
(Hashable b, Eq b) =>
(a -> b) -> HashSet a -> HashSet b
HS.map Text -> AsLabel a
forall a. Text -> AsLabel a
AsLabel) [HashSet Text]
labels) [a]
objects

-- | An entry in a 'Path'.
--
-- @since 1.1.0.0
data PathEntry a
  = PathEntry
      { forall a. PathEntry a -> HashSet (AsLabel a)
peLabels :: HashSet (AsLabel a)
      , forall a. PathEntry a -> a
peObject :: a
      }
  deriving (PathEntry a -> PathEntry a -> Bool
(PathEntry a -> PathEntry a -> Bool)
-> (PathEntry a -> PathEntry a -> Bool) -> Eq (PathEntry a)
forall a. Eq a => PathEntry a -> PathEntry a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => PathEntry a -> PathEntry a -> Bool
== :: PathEntry a -> PathEntry a -> Bool
$c/= :: forall a. Eq a => PathEntry a -> PathEntry a -> Bool
/= :: PathEntry a -> PathEntry a -> Bool
Eq, Eq (PathEntry a)
Eq (PathEntry a) =>
(PathEntry a -> PathEntry a -> Ordering)
-> (PathEntry a -> PathEntry a -> Bool)
-> (PathEntry a -> PathEntry a -> Bool)
-> (PathEntry a -> PathEntry a -> Bool)
-> (PathEntry a -> PathEntry a -> Bool)
-> (PathEntry a -> PathEntry a -> PathEntry a)
-> (PathEntry a -> PathEntry a -> PathEntry a)
-> Ord (PathEntry a)
PathEntry a -> PathEntry a -> Bool
PathEntry a -> PathEntry a -> Ordering
PathEntry a -> PathEntry a -> PathEntry 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. Ord a => Eq (PathEntry a)
forall a. Ord a => PathEntry a -> PathEntry a -> Bool
forall a. Ord a => PathEntry a -> PathEntry a -> Ordering
forall a. Ord a => PathEntry a -> PathEntry a -> PathEntry a
$ccompare :: forall a. Ord a => PathEntry a -> PathEntry a -> Ordering
compare :: PathEntry a -> PathEntry a -> Ordering
$c< :: forall a. Ord a => PathEntry a -> PathEntry a -> Bool
< :: PathEntry a -> PathEntry a -> Bool
$c<= :: forall a. Ord a => PathEntry a -> PathEntry a -> Bool
<= :: PathEntry a -> PathEntry a -> Bool
$c> :: forall a. Ord a => PathEntry a -> PathEntry a -> Bool
> :: PathEntry a -> PathEntry a -> Bool
$c>= :: forall a. Ord a => PathEntry a -> PathEntry a -> Bool
>= :: PathEntry a -> PathEntry a -> Bool
$cmax :: forall a. Ord a => PathEntry a -> PathEntry a -> PathEntry a
max :: PathEntry a -> PathEntry a -> PathEntry a
$cmin :: forall a. Ord a => PathEntry a -> PathEntry a -> PathEntry a
min :: PathEntry a -> PathEntry a -> PathEntry a
Ord, Int -> PathEntry a -> ShowS
[PathEntry a] -> ShowS
PathEntry a -> String
(Int -> PathEntry a -> ShowS)
-> (PathEntry a -> String)
-> ([PathEntry a] -> ShowS)
-> Show (PathEntry a)
forall a. Show a => Int -> PathEntry a -> ShowS
forall a. Show a => [PathEntry a] -> ShowS
forall a. Show a => PathEntry a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> PathEntry a -> ShowS
showsPrec :: Int -> PathEntry a -> ShowS
$cshow :: forall a. Show a => PathEntry a -> String
show :: PathEntry a -> String
$cshowList :: forall a. Show a => [PathEntry a] -> ShowS
showList :: [PathEntry a] -> ShowS
Show)

instance Functor PathEntry where
  fmap :: forall a b. (a -> b) -> PathEntry a -> PathEntry b
fmap a -> b
f PathEntry a
pe = PathEntry { peLabels :: HashSet (AsLabel b)
peLabels = (AsLabel a -> AsLabel b)
-> HashSet (AsLabel a) -> HashSet (AsLabel b)
forall b a.
(Hashable b, Eq b) =>
(a -> b) -> HashSet a -> HashSet b
HS.map ((a -> b) -> AsLabel a -> AsLabel b
forall a b. (a -> b) -> AsLabel a -> AsLabel b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) (HashSet (AsLabel a) -> HashSet (AsLabel b))
-> HashSet (AsLabel a) -> HashSet (AsLabel b)
forall a b. (a -> b) -> a -> b
$ PathEntry a -> HashSet (AsLabel a)
forall a. PathEntry a -> HashSet (AsLabel a)
peLabels PathEntry a
pe,
                          peObject :: b
peObject = a -> b
f (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ PathEntry a -> a
forall a. PathEntry a -> a
peObject PathEntry a
pe
                        }

instance Foldable PathEntry where
  foldr :: forall a b. (a -> b -> b) -> b -> PathEntry a -> b
foldr a -> b -> b
f b
acc PathEntry a
pe = a -> b -> b
f (PathEntry a -> a
forall a. PathEntry a -> a
peObject PathEntry a
pe) b
acc

instance Traversable PathEntry where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PathEntry a -> f (PathEntry b)
traverse a -> f b
f PathEntry a
pe = (b -> PathEntry b) -> f b -> f (PathEntry b)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> PathEntry b
mkPE (f b -> f (PathEntry b)) -> f b -> f (PathEntry b)
forall a b. (a -> b) -> a -> b
$ a -> f b
f (a -> f b) -> a -> f b
forall a b. (a -> b) -> a -> b
$ PathEntry a -> a
forall a. PathEntry a -> a
peObject PathEntry a
pe
    where
      mkPE :: b -> PathEntry b
mkPE b
obj =
        PathEntry { peLabels :: HashSet (AsLabel b)
peLabels = (AsLabel a -> AsLabel b)
-> HashSet (AsLabel a) -> HashSet (AsLabel b)
forall b a.
(Hashable b, Eq b) =>
(a -> b) -> HashSet a -> HashSet b
HS.map AsLabel a -> AsLabel b
forall a b. AsLabel a -> AsLabel b
unsafeCastAsLabel (HashSet (AsLabel a) -> HashSet (AsLabel b))
-> HashSet (AsLabel a) -> HashSet (AsLabel b)
forall a b. (a -> b) -> a -> b
$ PathEntry a -> HashSet (AsLabel a)
forall a. PathEntry a -> HashSet (AsLabel a)
peLabels PathEntry a
pe,
                    peObject :: b
peObject = b
obj
                  }

-- | Convert a 'Path' into 'PMap'.
--
-- In the result 'PMap', the keys are the labels in the 'Path', and
-- the values are the objects associated with the labels. The values
-- are stored in the same order in the 'Path'. Objects without any
-- label are discarded.
--
-- @since 1.1.0.0
pathToPMap :: Path a -> PMap Multi a
pathToPMap :: forall a. Path a -> PMap Multi a
pathToPMap (Path [PathEntry a]
entries) = (PathEntry a -> PMap Multi a -> PMap Multi a)
-> PMap Multi a -> [PathEntry a] -> PMap Multi a
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr PathEntry a -> PMap Multi a -> PMap Multi a
forall {c :: * -> *} {a}.
NonEmptyLike c =>
PathEntry a -> PMap c a -> PMap c a
fentry PMap Multi a
forall a. Monoid a => a
mempty [PathEntry a]
entries
  where
    fentry :: PathEntry a -> PMap c a -> PMap c a
fentry PathEntry a
entry PMap c a
pm = (AsLabel a -> PMap c a -> PMap c a)
-> PMap c a -> HashSet (AsLabel a) -> PMap c a
forall a b. (a -> b -> b) -> b -> HashSet a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (a -> AsLabel a -> PMap c a -> PMap c a
forall {c :: * -> *} {v} {a}.
NonEmptyLike c =>
v -> AsLabel a -> PMap c v -> PMap c v
flabel (a -> AsLabel a -> PMap c a -> PMap c a)
-> a -> AsLabel a -> PMap c a -> PMap c a
forall a b. (a -> b) -> a -> b
$ PathEntry a -> a
forall a. PathEntry a -> a
peObject PathEntry a
entry) PMap c a
pm (HashSet (AsLabel a) -> PMap c a)
-> HashSet (AsLabel a) -> PMap c a
forall a b. (a -> b) -> a -> b
$ PathEntry a -> HashSet (AsLabel a)
forall a. PathEntry a -> HashSet (AsLabel a)
peLabels PathEntry a
entry
    flabel :: v -> AsLabel a -> PMap c v -> PMap c v
flabel v
obj AsLabel a
label PMap c v
pm = Text -> v -> PMap c v -> PMap c v
forall (c :: * -> *) v.
NonEmptyLike c =>
Text -> v -> PMap c v -> PMap c v
pMapInsert (AsLabel a -> Text
forall a. AsLabel a -> Text
unAsLabel AsLabel a
label) v
obj PMap c v
pm

-- | Make a 'PathEntry'.
--
-- @since 1.1.0.0
makePathEntry :: [AsLabel a] -- ^ labels
              -> a -- ^ object
              -> PathEntry a
makePathEntry :: forall a. [AsLabel a] -> a -> PathEntry a
makePathEntry [AsLabel a]
ls a
obj = HashSet (AsLabel a) -> a -> PathEntry a
forall a. HashSet (AsLabel a) -> a -> PathEntry a
PathEntry ([AsLabel a] -> HashSet (AsLabel a)
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList [AsLabel a]
ls) a
obj

-- | Examples of using this module. See the source. The 'fst' of the output is the testee, while the
-- 'snd' is the expectation.
examples :: [(Text, Text)]
examples :: [(Text, Text)]
examples =
  [ (Greskell Cardinality -> Text
forall a. ToGreskell a => a -> Text
toGremlin Greskell Cardinality
cList, Text
"list")
  , (Key AVertex Int -> Text
forall a. ToGreskell a => a -> Text
toGremlin (Key AVertex Int
"age" :: Key AVertex Int), Text
"\"age\"")
  , (Key AEdge Text -> Text
forall a. ToGreskell a => a -> Text
toGremlin (Text -> Key AEdge Text
forall a b. Text -> Key a b
key Text
"created_at" :: Key AEdge Text), Text
"\"created_at\"")
  , (Key AVertex Text -> Text
forall k. PMapKey k => k -> Text
keyText (Key AVertex Text
"name" :: Key AVertex Text), Text
"name")
  ]