{-# LANGUAGE TypeFamilies, OverloadedStrings, FlexibleInstances, GeneralizedNewtypeDeriving, DeriveTraversable, GADTs, DeriveGeneric #-}
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
module Data.Greskell.Graph
(
Element(..),
ElementData(..),
ElementID(..),
unsafeCastElementID,
Vertex,
Edge,
Property(..),
T,
tId,
tKey,
tLabel,
tValue,
Cardinality,
cList,
cSet,
cSingle,
Key(..),
key,
unsafeCastKey,
KeyValue(..),
(=:),
Keys(..),
singletonKeys,
(-:),
Path(..),
PathEntry(..),
pathToPMap,
makePathEntry,
AVertex(..),
AEdge(..),
AVertexProperty(..),
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)
newtype ElementID e =
ElementID
{ ElementID e -> GValue
unElementID :: GValue
}
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, 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
hash :: ElementID e -> Int
$chash :: forall e. ElementID e -> Int
hashWithSalt :: Int -> ElementID e -> Int
$chashWithSalt :: forall e. Int -> ElementID e -> Int
$cp1Hashable :: forall e. Eq (ElementID e)
Hashable)
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
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
class ElementData e where
elementId :: e -> ElementID e
elementLabel :: e -> Text
class ElementData e => Element e where
type ElementProperty e :: * -> *
type ElementPropertyContainer e :: * -> *
class (Element v) => Vertex v
class (Element e) => Edge e
class Property p where
propertyKey :: p v -> Text
propertyValue :: p v -> v
data T a b
instance GraphSONTyped (T a b) where
gsonTypeFor :: T a b -> Text
gsonTypeFor T a b
_ = Text
"g:T"
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"
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"
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"
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"
data Cardinality
cList :: Greskell Cardinality
cList :: Greskell Cardinality
cList = Text -> Greskell Cardinality
forall a. Text -> Greskell a
unsafeGreskellLazy Text
"list"
cSet :: Greskell Cardinality
cSet :: Greskell Cardinality
cSet = Text -> Greskell Cardinality
forall a. Text -> Greskell a
unsafeGreskellLazy Text
"set"
cSingle :: Greskell Cardinality
cSingle :: Greskell Cardinality
cSingle = Text -> Greskell Cardinality
forall a. Text -> Greskell a
unsafeGreskellLazy Text
"single"
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)
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
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
instance PMapKey (Key a b) where
type PMapValue (Key a b) = b
keyText :: Key a b -> Text
keyText (Key Text
t) = Text
t
key :: Text -> Key a b
key :: Text -> Key a b
key = Text -> Key a b
forall a b. Text -> Key a b
Key
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
data KeyValue a where
KeyValue :: Key a b -> Greskell b -> KeyValue a
KeyNoValue :: Key a b -> KeyValue a
(=:) :: 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
data Keys a where
KeysNil :: Keys a
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
(<>)
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
(-:) :: 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 -:
data AVertex =
AVertex
{ AVertex -> ElementID AVertex
avId :: ElementID AVertex,
AVertex -> Text
avLabel :: Text
}
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)
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 (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 (f :: * -> *) a. Alternative f => f a
empty
data AEdge =
AEdge
{ AEdge -> ElementID AEdge
aeId :: ElementID AEdge,
AEdge -> Text
aeLabel :: Text
}
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)
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 (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 (f :: * -> *) a. Alternative f => f a
empty
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)
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
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 (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 (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
data AVertexProperty v =
AVertexProperty
{ AVertexProperty v -> ElementID (AVertexProperty v)
avpId :: ElementID (AVertexProperty v),
AVertexProperty v -> Text
avpLabel :: Text,
AVertexProperty v -> v
avpValue :: v
}
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)
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 (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 (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 (f :: * -> *) a. Alternative f => f a
empty
instance GraphSONTyped (AVertexProperty v) where
gsonTypeFor :: AVertexProperty v -> Text
gsonTypeFor AVertexProperty v
_ = Text
"g:VertexProperty"
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
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
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 }
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"
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 (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 (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
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
}
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
makePathEntry :: [AsLabel a]
-> a
-> 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