{-# LANGUAGE TypeFamilies, OverloadedStrings, FlexibleInstances, GeneralizedNewtypeDeriving, DeriveTraversable, GADTs, DeriveGeneric #-}
{-# 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,
         (-:),

         -- * Path
         Path(..),
         PathEntry(..),
         pathToPMap,
         makePathEntry,

         -- * Concrete data types
         -- $concrete_types
         
         -- ** Vertex
         AVertex(..),
         -- ** Edge
         AEdge(..),
         -- ** VertexProperty
         AVertexProperty(..),
         -- ** Property
         AProperty(..)
       ) where

import Control.Applicative (empty, (<$>), (<*>), (<|>))
import Control.Monad (when)
import Data.Aeson (Value(..), FromJSON(..), ToJSON(..))
import Data.Aeson.Types (Parser)
import Data.Foldable (toList, Foldable(foldr), foldlM)
import Data.Hashable (Hashable)
import Data.HashSet (HashSet)
import qualified Data.HashSet as HS
import qualified Data.HashMap.Strict as HM
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, unpack)
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
  ( GraphSON(..), GraphSONTyped(..), FromGraphSON(..),
    (.:), GValue, GValueBody(..),
    parseJSONViaGValue
  )
import Data.Greskell.GraphSON.GValue (gValueBody, gValueType)
import Data.Greskell.Greskell
  ( Greskell, unsafeGreskellLazy, string,
    ToGreskell(..)
  )
import Data.Greskell.NonEmptyLike (NonEmptyLike)
import Data.Greskell.PMap (PMapKey(..), Single, Multi, PMap, pMapInsert)

-- $setup
--
-- >>> import Data.Greskell.Greskell (toGremlin)

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

-- | Unsafely convert the element type.
instance Functor ElementID where
  fmap :: (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 :: 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 :: * -> *

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

-- | @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 :: 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 :: 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 :: 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 :: 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.
--
-- >>> toGremlin cList
-- "list"
--
-- @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.
--
-- >>> toGremlin ("age" :: Key AVertex Int)
-- "\"age\""
-- >>> toGremlin (key "created_at" :: Key AEdge Text)
-- "\"created_at\""
-- >>> keyText ("name" :: Key AVertex Text)
-- "name"
--
-- Since greskell-1.0.0.0, 'Key' is newtype of 'Text'. Before that, it
-- was newtype of 'Greskell' 'Text'.
newtype Key a b = Key { Key a b -> Text
unKey :: Text }
                deriving (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
showList :: [Key a b] -> ShowS
$cshowList :: forall a b. [Key a b] -> ShowS
show :: Key a b -> String
$cshow :: forall a b. Key a b -> String
showsPrec :: Int -> Key a b -> ShowS
$cshowsPrec :: forall a b. Int -> Key a b -> ShowS
Show,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
/= :: 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
Eq)

-- | Unsafely convert the value type @b@.
instance Functor (Key a) where
  fmap :: (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 :: 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 :: 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
=: :: 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 :: 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

-- | Prepend a 'Key' to 'Keys'.
--
-- @since 1.0.0.0
(-:) :: Key a b -> Keys a -> Keys a
-: :: 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 (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
showList :: [AVertex] -> ShowS
$cshowList :: [AVertex] -> ShowS
show :: AVertex -> String
$cshow :: AVertex -> String
showsPrec :: Int -> AVertex -> ShowS
$cshowsPrec :: Int -> AVertex -> ShowS
Show,AVertex -> AVertex -> Bool
(AVertex -> AVertex -> Bool)
-> (AVertex -> AVertex -> Bool) -> Eq AVertex
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AVertex -> AVertex -> Bool
$c/= :: AVertex -> AVertex -> Bool
== :: AVertex -> AVertex -> Bool
$c== :: AVertex -> AVertex -> Bool
Eq)

-- | @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 HashMap Text 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
<$> (HashMap Text GValue
o HashMap Text GValue -> Text -> Parser (ElementID AVertex)
forall a. FromGraphSON a => HashMap Text GValue -> Text -> Parser a
.: Text
"id")
                 Parser (Text -> AVertex) -> Parser Text -> Parser AVertex
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (HashMap Text GValue
o HashMap Text GValue -> Text -> Parser Text
forall a. FromGraphSON a => HashMap Text GValue -> Text -> Parser a
.: Text
"label")
    GValueBody
_ -> Parser AVertex
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 (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
showList :: [AEdge] -> ShowS
$cshowList :: [AEdge] -> ShowS
show :: AEdge -> String
$cshow :: AEdge -> String
showsPrec :: Int -> AEdge -> ShowS
$cshowsPrec :: Int -> AEdge -> ShowS
Show,AEdge -> AEdge -> Bool
(AEdge -> AEdge -> Bool) -> (AEdge -> AEdge -> Bool) -> Eq AEdge
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AEdge -> AEdge -> Bool
$c/= :: AEdge -> AEdge -> Bool
== :: AEdge -> AEdge -> Bool
$c== :: AEdge -> AEdge -> Bool
Eq)

-- | @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 HashMap Text 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
<$> (HashMap Text GValue
o HashMap Text GValue -> Text -> Parser (ElementID AEdge)
forall a. FromGraphSON a => HashMap Text GValue -> Text -> Parser a
.: Text
"id")
                 Parser (Text -> AEdge) -> Parser Text -> Parser AEdge
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (HashMap Text GValue
o HashMap Text GValue -> Text -> Parser Text
forall a. FromGraphSON a => HashMap Text GValue -> Text -> Parser a
.: Text
"label")
    GValueBody
_ -> Parser AEdge
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
  { AProperty v -> Text
apKey :: Text,
    AProperty v -> v
apValue :: v
  }
  deriving (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
showList :: [AProperty v] -> ShowS
$cshowList :: forall v. Show v => [AProperty v] -> ShowS
show :: AProperty v -> String
$cshow :: forall v. Show v => AProperty v -> String
showsPrec :: Int -> AProperty v -> ShowS
$cshowsPrec :: forall v. Show v => Int -> AProperty v -> ShowS
Show,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
/= :: AProperty v -> AProperty v -> Bool
$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
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
min :: AProperty v -> AProperty v -> AProperty v
$cmin :: forall v. Ord v => AProperty v -> AProperty v -> AProperty v
max :: AProperty v -> AProperty v -> AProperty v
$cmax :: forall v. Ord v => AProperty v -> AProperty v -> AProperty v
>= :: 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
$c< :: forall v. Ord v => AProperty v -> AProperty v -> Bool
compare :: AProperty v -> AProperty v -> Ordering
$ccompare :: forall v. Ord v => AProperty v -> AProperty v -> Ordering
$cp1Ord :: forall v. Ord v => Eq (AProperty v)
Ord)

-- | 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 HashMap Text 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
<$> (HashMap Text GValue
o HashMap Text GValue -> Text -> Parser Text
forall a. FromGraphSON a => HashMap Text GValue -> Text -> Parser a
.: Text
"key") Parser (v -> AProperty v) -> Parser v -> Parser (AProperty v)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (HashMap Text GValue
o HashMap Text GValue -> Text -> Parser v
forall a. FromGraphSON a => HashMap Text GValue -> Text -> Parser a
.: Text
"value")
    GValueBody
_ -> Parser (AProperty v)
forall (f :: * -> *) a. Alternative f => f a
empty

instance Property AProperty where
  propertyKey :: AProperty v -> Text
propertyKey = AProperty v -> Text
forall v. AProperty v -> Text
apKey
  propertyValue :: 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 :: (a -> b) -> AProperty a -> AProperty b
fmap a -> b
f AProperty a
sp = AProperty a
sp { apValue :: b
apValue = a -> b
f (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ AProperty a -> a
forall v. AProperty v -> v
apValue AProperty a
sp }

instance Foldable AProperty where
  foldr :: (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 :: (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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\b
v -> AProperty a
sp { apValue :: b
apValue = b
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
  { AVertexProperty v -> ElementID (AVertexProperty v)
avpId :: ElementID (AVertexProperty v),
    -- ^ ID of this vertex property.
    AVertexProperty v -> Text
avpLabel :: Text,
    -- ^ Label and key of this vertex property.
    AVertexProperty v -> v
avpValue :: v
    -- ^ Value of this vertex property.
  }
  deriving (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
showList :: [AVertexProperty v] -> ShowS
$cshowList :: forall v. Show v => [AVertexProperty v] -> ShowS
show :: AVertexProperty v -> String
$cshow :: forall v. Show v => AVertexProperty v -> String
showsPrec :: Int -> AVertexProperty v -> ShowS
$cshowsPrec :: forall v. Show v => Int -> AVertexProperty v -> ShowS
Show,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
/= :: AVertexProperty v -> AVertexProperty v -> Bool
$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
Eq)

-- | 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 HashMap Text 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
<$> (HashMap Text GValue
o HashMap Text GValue
-> Text -> Parser (ElementID (AVertexProperty v))
forall a. FromGraphSON a => HashMap Text GValue -> Text -> Parser a
.: Text
"id")
                 Parser (Text -> v -> AVertexProperty v)
-> Parser Text -> Parser (v -> AVertexProperty v)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (HashMap Text GValue
o HashMap Text GValue -> Text -> Parser Text
forall a. FromGraphSON a => HashMap Text GValue -> Text -> Parser a
.: Text
"label")
                 Parser (v -> AVertexProperty v)
-> Parser v -> Parser (AVertexProperty v)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (HashMap Text GValue
o HashMap Text GValue -> Text -> Parser v
forall a. FromGraphSON a => HashMap Text GValue -> Text -> Parser a
.: Text
"value")
    GValueBody
_ -> Parser (AVertexProperty v)
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 :: AVertexProperty v -> Text
propertyKey = AVertexProperty v -> Text
forall v. AVertexProperty v -> Text
avpLabel
  propertyValue :: AVertexProperty v -> v
propertyValue = AVertexProperty v -> v
forall v. AVertexProperty v -> v
avpValue

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

instance Foldable AVertexProperty where
  foldr :: (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 :: (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 (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 :: b
avpValue = b
v, avpId :: ElementID (AVertexProperty b)
avpId = ElementID (AVertexProperty a) -> ElementID (AVertexProperty b)
forall a b. ElementID a -> ElementID b
unsafeCastElementID (ElementID (AVertexProperty a) -> ElementID (AVertexProperty b))
-> ElementID (AVertexProperty a) -> ElementID (AVertexProperty b)
forall a b. (a -> b) -> a -> b
$ AVertexProperty a -> ElementID (AVertexProperty a)
forall v. AVertexProperty v -> ElementID (AVertexProperty v)
avpId AVertexProperty a
vp }


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

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 HashMap Text GValue
o -> HashMap Text GValue -> Parser (Path a)
forall a. FromGraphSON a => HashMap Text GValue -> Parser (Path a)
parseObj HashMap Text GValue
o
      GValueBody
_ -> Parser (Path a)
forall (f :: * -> *) a. Alternative f => f a
empty
    where
      parseObj :: HashMap Text GValue -> Parser (Path a)
parseObj HashMap Text GValue
o = do
        [HashSet Text]
labels <- HashMap Text GValue
o HashMap Text GValue -> Text -> Parser [HashSet Text]
forall a. FromGraphSON a => HashMap Text GValue -> Text -> Parser a
.: Text
"labels"
        [a]
objects <- HashMap Text GValue
o HashMap Text GValue -> Text -> Parser [a]
forall a. FromGraphSON a => HashMap Text GValue -> Text -> Parser a
.: Text
"objects"
        let nlabels :: Int
nlabels = [HashSet Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [HashSet Text]
labels
            nobjects :: Int
nobjects = [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 (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 (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
  { PathEntry a -> HashSet (AsLabel a)
peLabels :: HashSet (AsLabel a),
    PathEntry a -> a
peObject :: a
  }
  deriving (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
showList :: [PathEntry a] -> ShowS
$cshowList :: forall a. Show a => [PathEntry a] -> ShowS
show :: PathEntry a -> String
$cshow :: forall a. Show a => PathEntry a -> String
showsPrec :: Int -> PathEntry a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> PathEntry a -> ShowS
Show,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
/= :: PathEntry a -> PathEntry a -> Bool
$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
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
min :: PathEntry a -> PathEntry a -> PathEntry a
$cmin :: forall a. Ord a => PathEntry a -> PathEntry a -> PathEntry a
max :: PathEntry a -> PathEntry a -> PathEntry a
$cmax :: forall a. Ord a => PathEntry a -> PathEntry a -> PathEntry a
>= :: 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
$c< :: forall a. Ord a => PathEntry a -> PathEntry a -> Bool
compare :: PathEntry a -> PathEntry a -> Ordering
$ccompare :: forall a. Ord a => PathEntry a -> PathEntry a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (PathEntry a)
Ord)

instance Functor PathEntry where
  fmap :: (a -> b) -> PathEntry a -> PathEntry b
fmap a -> b
f PathEntry a
pe = PathEntry :: forall a. HashSet (AsLabel a) -> a -> PathEntry a
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 (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 :: (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 :: (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 (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 :: forall a. HashSet (AsLabel a) -> a -> PathEntry a
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 :: 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 (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 (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 :: [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