{-# LANGUAGE OverloadedStrings, DeriveGeneric, TypeSynonymInstances, FlexibleInstances #-}
module NetSpider.GraphML.Writer
(
writeGraphML,
writeGraphMLWith,
WriteOption,
defWriteOption,
woptDefaultDirected,
NodeID,
ToNodeID(..),
nodeIDByShow,
AttributeKey,
AttributeValue(..),
ToAttributes(..),
valueFromAeson,
attributesFromAeson
) where
import Data.Foldable (foldl')
import Data.Greskell.Graph (Property(..))
import Data.Hashable (Hashable(..))
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HM
import Data.Int (Int8, Int16, Int32, Int64)
import Data.Maybe (catMaybes)
import Data.Monoid ((<>), Monoid(..), mconcat)
import Data.Semigroup (Semigroup(..))
import Data.Text (Text, pack, unpack)
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as TLB
import Data.Time (TimeZone(..))
import Data.Word (Word8, Word16, Word32, Word64)
import GHC.Generics (Generic)
import NetSpider.GraphML.Attribute
( AttributeKey,
AttributeValue(..),
ToAttributes(..),
valueFromAeson,
attributesFromAeson
)
import NetSpider.Snapshot
( SnapshotNode, nodeId, nodeTimestamp, isOnBoundary, nodeAttributes,
SnapshotLink, sourceNode, destinationNode, linkTimestamp, isDirected, linkAttributes,
SnapshotGraph
)
import NetSpider.Timestamp
( Timestamp(epochTime, timeZone),
showTimestamp
)
type NodeID = Text
class ToNodeID a where
toNodeID :: a -> NodeID
nodeIDByShow :: Show a => a -> NodeID
nodeIDByShow :: a -> NodeID
nodeIDByShow = String -> NodeID
pack (String -> NodeID) -> (a -> String) -> a -> NodeID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show
instance ToNodeID Text where
toNodeID :: NodeID -> NodeID
toNodeID = NodeID -> NodeID
forall a. a -> a
id
instance ToNodeID TL.Text where
toNodeID :: Text -> NodeID
toNodeID = Text -> NodeID
TL.toStrict
instance ToNodeID String where
toNodeID :: String -> NodeID
toNodeID = String -> NodeID
pack
instance ToNodeID Int where
toNodeID :: Int -> NodeID
toNodeID = Int -> NodeID
forall a. Show a => a -> NodeID
nodeIDByShow
instance ToNodeID Int8 where
toNodeID :: Int8 -> NodeID
toNodeID = Int8 -> NodeID
forall a. Show a => a -> NodeID
nodeIDByShow
instance ToNodeID Int16 where
toNodeID :: Int16 -> NodeID
toNodeID = Int16 -> NodeID
forall a. Show a => a -> NodeID
nodeIDByShow
instance ToNodeID Int32 where
toNodeID :: Int32 -> NodeID
toNodeID = Int32 -> NodeID
forall a. Show a => a -> NodeID
nodeIDByShow
instance ToNodeID Int64 where
toNodeID :: Int64 -> NodeID
toNodeID = Int64 -> NodeID
forall a. Show a => a -> NodeID
nodeIDByShow
instance ToNodeID Word where
toNodeID :: Word -> NodeID
toNodeID = Word -> NodeID
forall a. Show a => a -> NodeID
nodeIDByShow
instance ToNodeID Word8 where
toNodeID :: Word8 -> NodeID
toNodeID = Word8 -> NodeID
forall a. Show a => a -> NodeID
nodeIDByShow
instance ToNodeID Word16 where
toNodeID :: Word16 -> NodeID
toNodeID = Word16 -> NodeID
forall a. Show a => a -> NodeID
nodeIDByShow
instance ToNodeID Word32 where
toNodeID :: Word32 -> NodeID
toNodeID = Word32 -> NodeID
forall a. Show a => a -> NodeID
nodeIDByShow
instance ToNodeID Integer where
toNodeID :: Integer -> NodeID
toNodeID = Integer -> NodeID
forall a. Show a => a -> NodeID
nodeIDByShow
instance ToNodeID Float where
toNodeID :: Float -> NodeID
toNodeID = Float -> NodeID
forall a. Show a => a -> NodeID
nodeIDByShow
instance ToNodeID Double where
toNodeID :: Double -> NodeID
toNodeID = Double -> NodeID
forall a. Show a => a -> NodeID
nodeIDByShow
instance ToNodeID Bool where
toNodeID :: Bool -> NodeID
toNodeID Bool
True = NodeID
"true"
toNodeID Bool
False = NodeID
"false"
sbuild :: Show a => a -> TLB.Builder
sbuild :: a -> Builder
sbuild = String -> Builder
TLB.fromString (String -> Builder) -> (a -> String) -> a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show
showAttributeValue :: AttributeValue -> TLB.Builder
showAttributeValue :: AttributeValue -> Builder
showAttributeValue AttributeValue
v =
case AttributeValue
v of
AttrBoolean Bool
False -> Builder
"false"
AttrBoolean Bool
True -> Builder
"true"
AttrInt Int
i -> Int -> Builder
forall a. Show a => a -> Builder
sbuild Int
i
AttrLong Integer
i -> Integer -> Builder
forall a. Show a => a -> Builder
sbuild Integer
i
AttrFloat Float
f -> Float -> Builder
forall a. Show a => a -> Builder
sbuild Float
f
AttrDouble Double
d -> Double -> Builder
forall a. Show a => a -> Builder
sbuild Double
d
AttrString NodeID
t -> NodeID -> Builder
encodeXML NodeID
t
data AttributeType = ATBoolean
| ATInt
| ATLong
| ATFloat
| ATDouble
| ATString
deriving (Int -> AttributeType -> ShowS
[AttributeType] -> ShowS
AttributeType -> String
(Int -> AttributeType -> ShowS)
-> (AttributeType -> String)
-> ([AttributeType] -> ShowS)
-> Show AttributeType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AttributeType] -> ShowS
$cshowList :: [AttributeType] -> ShowS
show :: AttributeType -> String
$cshow :: AttributeType -> String
showsPrec :: Int -> AttributeType -> ShowS
$cshowsPrec :: Int -> AttributeType -> ShowS
Show,AttributeType -> AttributeType -> Bool
(AttributeType -> AttributeType -> Bool)
-> (AttributeType -> AttributeType -> Bool) -> Eq AttributeType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttributeType -> AttributeType -> Bool
$c/= :: AttributeType -> AttributeType -> Bool
== :: AttributeType -> AttributeType -> Bool
$c== :: AttributeType -> AttributeType -> Bool
Eq,Eq AttributeType
Eq AttributeType
-> (AttributeType -> AttributeType -> Ordering)
-> (AttributeType -> AttributeType -> Bool)
-> (AttributeType -> AttributeType -> Bool)
-> (AttributeType -> AttributeType -> Bool)
-> (AttributeType -> AttributeType -> Bool)
-> (AttributeType -> AttributeType -> AttributeType)
-> (AttributeType -> AttributeType -> AttributeType)
-> Ord AttributeType
AttributeType -> AttributeType -> Bool
AttributeType -> AttributeType -> Ordering
AttributeType -> AttributeType -> AttributeType
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
min :: AttributeType -> AttributeType -> AttributeType
$cmin :: AttributeType -> AttributeType -> AttributeType
max :: AttributeType -> AttributeType -> AttributeType
$cmax :: AttributeType -> AttributeType -> AttributeType
>= :: AttributeType -> AttributeType -> Bool
$c>= :: AttributeType -> AttributeType -> Bool
> :: AttributeType -> AttributeType -> Bool
$c> :: AttributeType -> AttributeType -> Bool
<= :: AttributeType -> AttributeType -> Bool
$c<= :: AttributeType -> AttributeType -> Bool
< :: AttributeType -> AttributeType -> Bool
$c< :: AttributeType -> AttributeType -> Bool
compare :: AttributeType -> AttributeType -> Ordering
$ccompare :: AttributeType -> AttributeType -> Ordering
$cp1Ord :: Eq AttributeType
Ord,(forall x. AttributeType -> Rep AttributeType x)
-> (forall x. Rep AttributeType x -> AttributeType)
-> Generic AttributeType
forall x. Rep AttributeType x -> AttributeType
forall x. AttributeType -> Rep AttributeType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AttributeType x -> AttributeType
$cfrom :: forall x. AttributeType -> Rep AttributeType x
Generic)
instance Hashable AttributeType
valueType :: AttributeValue -> AttributeType
valueType :: AttributeValue -> AttributeType
valueType AttributeValue
v =
case AttributeValue
v of
AttrBoolean Bool
_ -> AttributeType
ATBoolean
AttrInt Int
_ -> AttributeType
ATInt
AttrLong Integer
_ -> AttributeType
ATLong
AttrFloat Float
_ -> AttributeType
ATFloat
AttrDouble Double
_ -> AttributeType
ATDouble
AttrString NodeID
_ -> AttributeType
ATString
showAttributeType :: AttributeType -> TLB.Builder
showAttributeType :: AttributeType -> Builder
showAttributeType AttributeType
t =
case AttributeType
t of
AttributeType
ATBoolean -> Builder
"boolean"
AttributeType
ATInt -> Builder
"int"
AttributeType
ATLong -> Builder
"long"
AttributeType
ATFloat -> Builder
"float"
AttributeType
ATDouble -> Builder
"double"
AttributeType
ATString -> Builder
"string"
data AttributeDomain = DomainGraph
| DomainNode
| DomainEdge
| DomainAll
deriving (Int -> AttributeDomain -> ShowS
[AttributeDomain] -> ShowS
AttributeDomain -> String
(Int -> AttributeDomain -> ShowS)
-> (AttributeDomain -> String)
-> ([AttributeDomain] -> ShowS)
-> Show AttributeDomain
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AttributeDomain] -> ShowS
$cshowList :: [AttributeDomain] -> ShowS
show :: AttributeDomain -> String
$cshow :: AttributeDomain -> String
showsPrec :: Int -> AttributeDomain -> ShowS
$cshowsPrec :: Int -> AttributeDomain -> ShowS
Show,AttributeDomain -> AttributeDomain -> Bool
(AttributeDomain -> AttributeDomain -> Bool)
-> (AttributeDomain -> AttributeDomain -> Bool)
-> Eq AttributeDomain
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttributeDomain -> AttributeDomain -> Bool
$c/= :: AttributeDomain -> AttributeDomain -> Bool
== :: AttributeDomain -> AttributeDomain -> Bool
$c== :: AttributeDomain -> AttributeDomain -> Bool
Eq,Eq AttributeDomain
Eq AttributeDomain
-> (AttributeDomain -> AttributeDomain -> Ordering)
-> (AttributeDomain -> AttributeDomain -> Bool)
-> (AttributeDomain -> AttributeDomain -> Bool)
-> (AttributeDomain -> AttributeDomain -> Bool)
-> (AttributeDomain -> AttributeDomain -> Bool)
-> (AttributeDomain -> AttributeDomain -> AttributeDomain)
-> (AttributeDomain -> AttributeDomain -> AttributeDomain)
-> Ord AttributeDomain
AttributeDomain -> AttributeDomain -> Bool
AttributeDomain -> AttributeDomain -> Ordering
AttributeDomain -> AttributeDomain -> AttributeDomain
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
min :: AttributeDomain -> AttributeDomain -> AttributeDomain
$cmin :: AttributeDomain -> AttributeDomain -> AttributeDomain
max :: AttributeDomain -> AttributeDomain -> AttributeDomain
$cmax :: AttributeDomain -> AttributeDomain -> AttributeDomain
>= :: AttributeDomain -> AttributeDomain -> Bool
$c>= :: AttributeDomain -> AttributeDomain -> Bool
> :: AttributeDomain -> AttributeDomain -> Bool
$c> :: AttributeDomain -> AttributeDomain -> Bool
<= :: AttributeDomain -> AttributeDomain -> Bool
$c<= :: AttributeDomain -> AttributeDomain -> Bool
< :: AttributeDomain -> AttributeDomain -> Bool
$c< :: AttributeDomain -> AttributeDomain -> Bool
compare :: AttributeDomain -> AttributeDomain -> Ordering
$ccompare :: AttributeDomain -> AttributeDomain -> Ordering
$cp1Ord :: Eq AttributeDomain
Ord,(forall x. AttributeDomain -> Rep AttributeDomain x)
-> (forall x. Rep AttributeDomain x -> AttributeDomain)
-> Generic AttributeDomain
forall x. Rep AttributeDomain x -> AttributeDomain
forall x. AttributeDomain -> Rep AttributeDomain x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AttributeDomain x -> AttributeDomain
$cfrom :: forall x. AttributeDomain -> Rep AttributeDomain x
Generic)
instance Hashable AttributeDomain
showDomain :: AttributeDomain -> TLB.Builder
showDomain :: AttributeDomain -> Builder
showDomain AttributeDomain
d =
case AttributeDomain
d of
AttributeDomain
DomainGraph -> Builder
"graph"
AttributeDomain
DomainNode -> Builder
"node"
AttributeDomain
DomainEdge -> Builder
"edge"
AttributeDomain
DomainAll -> Builder
"all"
data KeyMeta =
KeyMeta
{ KeyMeta -> NodeID
kmName :: AttributeKey,
KeyMeta -> AttributeType
kmType :: AttributeType,
KeyMeta -> AttributeDomain
kmDomain :: AttributeDomain
}
deriving (Int -> KeyMeta -> ShowS
[KeyMeta] -> ShowS
KeyMeta -> String
(Int -> KeyMeta -> ShowS)
-> (KeyMeta -> String) -> ([KeyMeta] -> ShowS) -> Show KeyMeta
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KeyMeta] -> ShowS
$cshowList :: [KeyMeta] -> ShowS
show :: KeyMeta -> String
$cshow :: KeyMeta -> String
showsPrec :: Int -> KeyMeta -> ShowS
$cshowsPrec :: Int -> KeyMeta -> ShowS
Show,KeyMeta -> KeyMeta -> Bool
(KeyMeta -> KeyMeta -> Bool)
-> (KeyMeta -> KeyMeta -> Bool) -> Eq KeyMeta
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KeyMeta -> KeyMeta -> Bool
$c/= :: KeyMeta -> KeyMeta -> Bool
== :: KeyMeta -> KeyMeta -> Bool
$c== :: KeyMeta -> KeyMeta -> Bool
Eq,Eq KeyMeta
Eq KeyMeta
-> (KeyMeta -> KeyMeta -> Ordering)
-> (KeyMeta -> KeyMeta -> Bool)
-> (KeyMeta -> KeyMeta -> Bool)
-> (KeyMeta -> KeyMeta -> Bool)
-> (KeyMeta -> KeyMeta -> Bool)
-> (KeyMeta -> KeyMeta -> KeyMeta)
-> (KeyMeta -> KeyMeta -> KeyMeta)
-> Ord KeyMeta
KeyMeta -> KeyMeta -> Bool
KeyMeta -> KeyMeta -> Ordering
KeyMeta -> KeyMeta -> KeyMeta
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
min :: KeyMeta -> KeyMeta -> KeyMeta
$cmin :: KeyMeta -> KeyMeta -> KeyMeta
max :: KeyMeta -> KeyMeta -> KeyMeta
$cmax :: KeyMeta -> KeyMeta -> KeyMeta
>= :: KeyMeta -> KeyMeta -> Bool
$c>= :: KeyMeta -> KeyMeta -> Bool
> :: KeyMeta -> KeyMeta -> Bool
$c> :: KeyMeta -> KeyMeta -> Bool
<= :: KeyMeta -> KeyMeta -> Bool
$c<= :: KeyMeta -> KeyMeta -> Bool
< :: KeyMeta -> KeyMeta -> Bool
$c< :: KeyMeta -> KeyMeta -> Bool
compare :: KeyMeta -> KeyMeta -> Ordering
$ccompare :: KeyMeta -> KeyMeta -> Ordering
$cp1Ord :: Eq KeyMeta
Ord,(forall x. KeyMeta -> Rep KeyMeta x)
-> (forall x. Rep KeyMeta x -> KeyMeta) -> Generic KeyMeta
forall x. Rep KeyMeta x -> KeyMeta
forall x. KeyMeta -> Rep KeyMeta x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep KeyMeta x -> KeyMeta
$cfrom :: forall x. KeyMeta -> Rep KeyMeta x
Generic)
instance Hashable KeyMeta
makeMetaValue :: AttributeDomain -> AttributeKey -> AttributeValue -> (KeyMeta, AttributeValue)
makeMetaValue :: AttributeDomain
-> NodeID -> AttributeValue -> (KeyMeta, AttributeValue)
makeMetaValue AttributeDomain
d NodeID
k AttributeValue
v = (KeyMeta
meta, AttributeValue
v)
where
meta :: KeyMeta
meta = KeyMeta :: NodeID -> AttributeType -> AttributeDomain -> KeyMeta
KeyMeta { kmName :: NodeID
kmName = NodeID
k,
kmType :: AttributeType
kmType = AttributeValue -> AttributeType
valueType AttributeValue
v,
kmDomain :: AttributeDomain
kmDomain = AttributeDomain
d
}
data KeyStore =
KeyStore
{ KeyStore -> [KeyMeta]
ksMetas :: [KeyMeta],
KeyStore -> HashMap KeyMeta Int
ksIndexFor :: HashMap KeyMeta Int
}
deriving (Int -> KeyStore -> ShowS
[KeyStore] -> ShowS
KeyStore -> String
(Int -> KeyStore -> ShowS)
-> (KeyStore -> String) -> ([KeyStore] -> ShowS) -> Show KeyStore
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KeyStore] -> ShowS
$cshowList :: [KeyStore] -> ShowS
show :: KeyStore -> String
$cshow :: KeyStore -> String
showsPrec :: Int -> KeyStore -> ShowS
$cshowsPrec :: Int -> KeyStore -> ShowS
Show,KeyStore -> KeyStore -> Bool
(KeyStore -> KeyStore -> Bool)
-> (KeyStore -> KeyStore -> Bool) -> Eq KeyStore
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KeyStore -> KeyStore -> Bool
$c/= :: KeyStore -> KeyStore -> Bool
== :: KeyStore -> KeyStore -> Bool
$c== :: KeyStore -> KeyStore -> Bool
Eq,Eq KeyStore
Eq KeyStore
-> (KeyStore -> KeyStore -> Ordering)
-> (KeyStore -> KeyStore -> Bool)
-> (KeyStore -> KeyStore -> Bool)
-> (KeyStore -> KeyStore -> Bool)
-> (KeyStore -> KeyStore -> Bool)
-> (KeyStore -> KeyStore -> KeyStore)
-> (KeyStore -> KeyStore -> KeyStore)
-> Ord KeyStore
KeyStore -> KeyStore -> Bool
KeyStore -> KeyStore -> Ordering
KeyStore -> KeyStore -> KeyStore
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
min :: KeyStore -> KeyStore -> KeyStore
$cmin :: KeyStore -> KeyStore -> KeyStore
max :: KeyStore -> KeyStore -> KeyStore
$cmax :: KeyStore -> KeyStore -> KeyStore
>= :: KeyStore -> KeyStore -> Bool
$c>= :: KeyStore -> KeyStore -> Bool
> :: KeyStore -> KeyStore -> Bool
$c> :: KeyStore -> KeyStore -> Bool
<= :: KeyStore -> KeyStore -> Bool
$c<= :: KeyStore -> KeyStore -> Bool
< :: KeyStore -> KeyStore -> Bool
$c< :: KeyStore -> KeyStore -> Bool
compare :: KeyStore -> KeyStore -> Ordering
$ccompare :: KeyStore -> KeyStore -> Ordering
$cp1Ord :: Eq KeyStore
Ord)
emptyKeyStore :: KeyStore
emptyKeyStore :: KeyStore
emptyKeyStore = KeyStore :: [KeyMeta] -> HashMap KeyMeta Int -> KeyStore
KeyStore { ksMetas :: [KeyMeta]
ksMetas = [],
ksIndexFor :: HashMap KeyMeta Int
ksIndexFor = HashMap KeyMeta Int
forall k v. HashMap k v
HM.empty
}
addKey :: KeyMeta -> KeyStore -> KeyStore
addKey :: KeyMeta -> KeyStore -> KeyStore
addKey KeyMeta
new_meta KeyStore
ks = KeyStore :: [KeyMeta] -> HashMap KeyMeta Int -> KeyStore
KeyStore { ksMetas :: [KeyMeta]
ksMetas = if KeyMeta -> HashMap KeyMeta Int -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
HM.member KeyMeta
new_meta (HashMap KeyMeta Int -> Bool) -> HashMap KeyMeta Int -> Bool
forall a b. (a -> b) -> a -> b
$ KeyStore -> HashMap KeyMeta Int
ksIndexFor KeyStore
ks
then KeyStore -> [KeyMeta]
ksMetas KeyStore
ks
else KeyMeta
new_meta KeyMeta -> [KeyMeta] -> [KeyMeta]
forall a. a -> [a] -> [a]
: KeyStore -> [KeyMeta]
ksMetas KeyStore
ks,
ksIndexFor :: HashMap KeyMeta Int
ksIndexFor = (Int -> Int -> Int)
-> KeyMeta -> Int -> HashMap KeyMeta Int -> HashMap KeyMeta Int
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
HM.insertWith (\Int
_ Int
old -> Int
old) KeyMeta
new_meta ([KeyMeta] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([KeyMeta] -> Int) -> [KeyMeta] -> Int
forall a b. (a -> b) -> a -> b
$ KeyStore -> [KeyMeta]
ksMetas KeyStore
ks) (HashMap KeyMeta Int -> HashMap KeyMeta Int)
-> HashMap KeyMeta Int -> HashMap KeyMeta Int
forall a b. (a -> b) -> a -> b
$ KeyStore -> HashMap KeyMeta Int
ksIndexFor KeyStore
ks
}
keyIndex :: KeyStore -> KeyMeta -> Maybe Int
keyIndex :: KeyStore -> KeyMeta -> Maybe Int
keyIndex KeyStore
ks KeyMeta
km = KeyMeta -> HashMap KeyMeta Int -> Maybe Int
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup KeyMeta
km (HashMap KeyMeta Int -> Maybe Int)
-> HashMap KeyMeta Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ KeyStore -> HashMap KeyMeta Int
ksIndexFor KeyStore
ks
showAllKeys :: TLB.Builder -> KeyStore -> TLB.Builder
showAllKeys :: Builder -> KeyStore -> Builder
showAllKeys Builder
prefix KeyStore
ks = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ (Builder -> Builder) -> [Builder] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (Builder
prefix Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>) ([Builder] -> [Builder]) -> [Builder] -> [Builder]
forall a b. (a -> b) -> a -> b
$ [Maybe Builder] -> [Builder]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Builder] -> [Builder]) -> [Maybe Builder] -> [Builder]
forall a b. (a -> b) -> a -> b
$ (KeyMeta -> Maybe Builder) -> [KeyMeta] -> [Maybe Builder]
forall a b. (a -> b) -> [a] -> [b]
map (KeyStore -> KeyMeta -> Maybe Builder
showKeyMeta KeyStore
ks) ([KeyMeta] -> [Maybe Builder]) -> [KeyMeta] -> [Maybe Builder]
forall a b. (a -> b) -> a -> b
$ [KeyMeta] -> [KeyMeta]
forall a. [a] -> [a]
reverse ([KeyMeta] -> [KeyMeta]) -> [KeyMeta] -> [KeyMeta]
forall a b. (a -> b) -> a -> b
$ KeyStore -> [KeyMeta]
ksMetas KeyStore
ks
showKeyMeta :: KeyStore -> KeyMeta -> Maybe TLB.Builder
showKeyMeta :: KeyStore -> KeyMeta -> Maybe Builder
showKeyMeta KeyStore
ks KeyMeta
km = (Int -> Builder) -> Maybe Int -> Maybe Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int
i -> Int -> KeyMeta -> Builder
showKeyMetaWithIndex Int
i KeyMeta
km) (Maybe Int -> Maybe Builder) -> Maybe Int -> Maybe Builder
forall a b. (a -> b) -> a -> b
$ KeyStore -> KeyMeta -> Maybe Int
keyIndex KeyStore
ks KeyMeta
km
showAttributeID :: Int -> TLB.Builder
showAttributeID :: Int -> Builder
showAttributeID Int
index = Builder
"d" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
forall a. Show a => a -> Builder
sbuild Int
index
showKeyMetaWithIndex :: Int -> KeyMeta -> TLB.Builder
showKeyMetaWithIndex :: Int -> KeyMeta -> Builder
showKeyMetaWithIndex Int
index KeyMeta
km = Builder
"<key id=\"" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
id_str Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\" for=\"" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
domain_str
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\" attr.name=\"" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
name_str Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\" attr.type=\"" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
type_str Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\"/>\n"
where
id_str :: Builder
id_str = Int -> Builder
showAttributeID Int
index
domain_str :: Builder
domain_str = AttributeDomain -> Builder
showDomain (AttributeDomain -> Builder) -> AttributeDomain -> Builder
forall a b. (a -> b) -> a -> b
$ KeyMeta -> AttributeDomain
kmDomain KeyMeta
km
name_str :: Builder
name_str = NodeID -> Builder
encodeXML (NodeID -> Builder) -> NodeID -> Builder
forall a b. (a -> b) -> a -> b
$ KeyMeta -> NodeID
kmName KeyMeta
km
type_str :: Builder
type_str = AttributeType -> Builder
showAttributeType (AttributeType -> Builder) -> AttributeType -> Builder
forall a b. (a -> b) -> a -> b
$ KeyMeta -> AttributeType
kmType KeyMeta
km
nodeMetaKeys :: ToAttributes na => SnapshotNode n na -> [KeyMeta]
nodeMetaKeys :: SnapshotNode n na -> [KeyMeta]
nodeMetaKeys SnapshotNode n na
n = ((KeyMeta, AttributeValue) -> KeyMeta)
-> [(KeyMeta, AttributeValue)] -> [KeyMeta]
forall a b. (a -> b) -> [a] -> [b]
map (KeyMeta, AttributeValue) -> KeyMeta
forall a b. (a, b) -> a
fst ([(KeyMeta, AttributeValue)] -> [KeyMeta])
-> [(KeyMeta, AttributeValue)] -> [KeyMeta]
forall a b. (a -> b) -> a -> b
$ SnapshotNode n na -> [(KeyMeta, AttributeValue)]
forall na n.
ToAttributes na =>
SnapshotNode n na -> [(KeyMeta, AttributeValue)]
nodeMetaValues SnapshotNode n na
n
nodeMetaValues :: ToAttributes na => SnapshotNode n na -> [(KeyMeta, AttributeValue)]
nodeMetaValues :: SnapshotNode n na -> [(KeyMeta, AttributeValue)]
nodeMetaValues SnapshotNode n na
n = ((NodeID, AttributeValue) -> (KeyMeta, AttributeValue))
-> [(NodeID, AttributeValue)] -> [(KeyMeta, AttributeValue)]
forall a b. (a -> b) -> [a] -> [b]
map (NodeID, AttributeValue) -> (KeyMeta, AttributeValue)
convert ([(NodeID, AttributeValue)] -> [(KeyMeta, AttributeValue)])
-> [(NodeID, AttributeValue)] -> [(KeyMeta, AttributeValue)]
forall a b. (a -> b) -> a -> b
$ [(NodeID, AttributeValue)]
base [(NodeID, AttributeValue)]
-> [(NodeID, AttributeValue)] -> [(NodeID, AttributeValue)]
forall a. Semigroup a => a -> a -> a
<> [(NodeID, AttributeValue)]
attrs
where
timestamp :: [(NodeID, AttributeValue)]
timestamp = case SnapshotNode n na -> Maybe Timestamp
forall n na. SnapshotNode n na -> Maybe Timestamp
nodeTimestamp SnapshotNode n na
n of
Maybe Timestamp
Nothing -> []
Just Timestamp
t -> Timestamp -> [(NodeID, AttributeValue)]
forall a. ToAttributes a => a -> [(NodeID, AttributeValue)]
toAttributes Timestamp
t
base :: [(NodeID, AttributeValue)]
base = [(NodeID, AttributeValue)]
timestamp [(NodeID, AttributeValue)]
-> [(NodeID, AttributeValue)] -> [(NodeID, AttributeValue)]
forall a. Semigroup a => a -> a -> a
<> [(NodeID
"@is_on_boundary", Bool -> AttributeValue
AttrBoolean (Bool -> AttributeValue) -> Bool -> AttributeValue
forall a b. (a -> b) -> a -> b
$ SnapshotNode n na -> Bool
forall n na. SnapshotNode n na -> Bool
isOnBoundary SnapshotNode n na
n)]
attrs :: [(NodeID, AttributeValue)]
attrs = Maybe na -> [(NodeID, AttributeValue)]
forall a. ToAttributes a => a -> [(NodeID, AttributeValue)]
toAttributes (Maybe na -> [(NodeID, AttributeValue)])
-> Maybe na -> [(NodeID, AttributeValue)]
forall a b. (a -> b) -> a -> b
$ SnapshotNode n na -> Maybe na
forall n na. SnapshotNode n na -> Maybe na
nodeAttributes SnapshotNode n na
n
convert :: (NodeID, AttributeValue) -> (KeyMeta, AttributeValue)
convert (NodeID
k, AttributeValue
v) = AttributeDomain
-> NodeID -> AttributeValue -> (KeyMeta, AttributeValue)
makeMetaValue AttributeDomain
DomainNode NodeID
k AttributeValue
v
linkMetaKeys :: ToAttributes la => SnapshotLink n la -> [KeyMeta]
linkMetaKeys :: SnapshotLink n la -> [KeyMeta]
linkMetaKeys SnapshotLink n la
l = ((KeyMeta, AttributeValue) -> KeyMeta)
-> [(KeyMeta, AttributeValue)] -> [KeyMeta]
forall a b. (a -> b) -> [a] -> [b]
map (KeyMeta, AttributeValue) -> KeyMeta
forall a b. (a, b) -> a
fst ([(KeyMeta, AttributeValue)] -> [KeyMeta])
-> [(KeyMeta, AttributeValue)] -> [KeyMeta]
forall a b. (a -> b) -> a -> b
$ SnapshotLink n la -> [(KeyMeta, AttributeValue)]
forall la n.
ToAttributes la =>
SnapshotLink n la -> [(KeyMeta, AttributeValue)]
linkMetaValues SnapshotLink n la
l
linkMetaValues :: ToAttributes la => SnapshotLink n la -> [(KeyMeta, AttributeValue)]
linkMetaValues :: SnapshotLink n la -> [(KeyMeta, AttributeValue)]
linkMetaValues SnapshotLink n la
l = ((NodeID, AttributeValue) -> (KeyMeta, AttributeValue))
-> [(NodeID, AttributeValue)] -> [(KeyMeta, AttributeValue)]
forall a b. (a -> b) -> [a] -> [b]
map (NodeID, AttributeValue) -> (KeyMeta, AttributeValue)
convert ([(NodeID, AttributeValue)] -> [(KeyMeta, AttributeValue)])
-> [(NodeID, AttributeValue)] -> [(KeyMeta, AttributeValue)]
forall a b. (a -> b) -> a -> b
$ [(NodeID, AttributeValue)]
base [(NodeID, AttributeValue)]
-> [(NodeID, AttributeValue)] -> [(NodeID, AttributeValue)]
forall a. Semigroup a => a -> a -> a
<> [(NodeID, AttributeValue)]
attrs
where
base :: [(NodeID, AttributeValue)]
base = Timestamp -> [(NodeID, AttributeValue)]
forall a. ToAttributes a => a -> [(NodeID, AttributeValue)]
toAttributes (Timestamp -> [(NodeID, AttributeValue)])
-> Timestamp -> [(NodeID, AttributeValue)]
forall a b. (a -> b) -> a -> b
$ SnapshotLink n la -> Timestamp
forall n la. SnapshotLink n la -> Timestamp
linkTimestamp SnapshotLink n la
l
attrs :: [(NodeID, AttributeValue)]
attrs = la -> [(NodeID, AttributeValue)]
forall a. ToAttributes a => a -> [(NodeID, AttributeValue)]
toAttributes (la -> [(NodeID, AttributeValue)])
-> la -> [(NodeID, AttributeValue)]
forall a b. (a -> b) -> a -> b
$ SnapshotLink n la -> la
forall n la. SnapshotLink n la -> la
linkAttributes SnapshotLink n la
l
convert :: (NodeID, AttributeValue) -> (KeyMeta, AttributeValue)
convert (NodeID
k, AttributeValue
v) = AttributeDomain
-> NodeID -> AttributeValue -> (KeyMeta, AttributeValue)
makeMetaValue AttributeDomain
DomainEdge NodeID
k AttributeValue
v
showAttribute :: KeyStore -> KeyMeta -> AttributeValue -> TLB.Builder
showAttribute :: KeyStore -> KeyMeta -> AttributeValue -> Builder
showAttribute KeyStore
ks KeyMeta
km AttributeValue
val =
case KeyStore -> KeyMeta -> Maybe Int
keyIndex KeyStore
ks KeyMeta
km of
Maybe Int
Nothing -> Builder
""
Just Int
index -> Builder
"<data key=\"" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
key_id_str Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\">" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
val_str Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"</data>\n"
where
key_id_str :: Builder
key_id_str = Int -> Builder
showAttributeID Int
index
val_str :: Builder
val_str = AttributeValue -> Builder
showAttributeValue AttributeValue
val
data WriteOption =
WriteOption
{ WriteOption -> Bool
woptDefaultDirected :: Bool
}
deriving (Int -> WriteOption -> ShowS
[WriteOption] -> ShowS
WriteOption -> String
(Int -> WriteOption -> ShowS)
-> (WriteOption -> String)
-> ([WriteOption] -> ShowS)
-> Show WriteOption
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WriteOption] -> ShowS
$cshowList :: [WriteOption] -> ShowS
show :: WriteOption -> String
$cshow :: WriteOption -> String
showsPrec :: Int -> WriteOption -> ShowS
$cshowsPrec :: Int -> WriteOption -> ShowS
Show,WriteOption -> WriteOption -> Bool
(WriteOption -> WriteOption -> Bool)
-> (WriteOption -> WriteOption -> Bool) -> Eq WriteOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WriteOption -> WriteOption -> Bool
$c/= :: WriteOption -> WriteOption -> Bool
== :: WriteOption -> WriteOption -> Bool
$c== :: WriteOption -> WriteOption -> Bool
Eq,Eq WriteOption
Eq WriteOption
-> (WriteOption -> WriteOption -> Ordering)
-> (WriteOption -> WriteOption -> Bool)
-> (WriteOption -> WriteOption -> Bool)
-> (WriteOption -> WriteOption -> Bool)
-> (WriteOption -> WriteOption -> Bool)
-> (WriteOption -> WriteOption -> WriteOption)
-> (WriteOption -> WriteOption -> WriteOption)
-> Ord WriteOption
WriteOption -> WriteOption -> Bool
WriteOption -> WriteOption -> Ordering
WriteOption -> WriteOption -> WriteOption
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
min :: WriteOption -> WriteOption -> WriteOption
$cmin :: WriteOption -> WriteOption -> WriteOption
max :: WriteOption -> WriteOption -> WriteOption
$cmax :: WriteOption -> WriteOption -> WriteOption
>= :: WriteOption -> WriteOption -> Bool
$c>= :: WriteOption -> WriteOption -> Bool
> :: WriteOption -> WriteOption -> Bool
$c> :: WriteOption -> WriteOption -> Bool
<= :: WriteOption -> WriteOption -> Bool
$c<= :: WriteOption -> WriteOption -> Bool
< :: WriteOption -> WriteOption -> Bool
$c< :: WriteOption -> WriteOption -> Bool
compare :: WriteOption -> WriteOption -> Ordering
$ccompare :: WriteOption -> WriteOption -> Ordering
$cp1Ord :: Eq WriteOption
Ord)
defWriteOption :: WriteOption
defWriteOption :: WriteOption
defWriteOption =
WriteOption :: Bool -> WriteOption
WriteOption
{ woptDefaultDirected :: Bool
woptDefaultDirected = Bool
True
}
writeGraphML :: (ToNodeID n, ToAttributes na, ToAttributes la)
=> SnapshotGraph n na la
-> TL.Text
writeGraphML :: SnapshotGraph n na la -> Text
writeGraphML = WriteOption -> SnapshotGraph n na la -> Text
forall n na la.
(ToNodeID n, ToAttributes na, ToAttributes la) =>
WriteOption -> SnapshotGraph n na la -> Text
writeGraphMLWith WriteOption
defWriteOption
writeGraphMLWith :: (ToNodeID n, ToAttributes na, ToAttributes la)
=> WriteOption
-> SnapshotGraph n na la
-> TL.Text
writeGraphMLWith :: WriteOption -> SnapshotGraph n na la -> Text
writeGraphMLWith WriteOption
wopt ([SnapshotNode n na]
input_nodes, [SnapshotLink n la]
input_links) =
Builder -> Text
TLB.toLazyText ( Builder
xml_header
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
graphml_header
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
keys
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
graph_header
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
nodes
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
edges
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
graph_footer
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
graphml_footer
)
where
xml_header :: Builder
xml_header = Builder
"<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n"
graphml_header :: Builder
graphml_header = Builder
"<graphml xmlns=\"http://graphml.graphdrawing.org/xmlns\"\n"
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" xmlns:xsi=\"http://www.w3.org/2001/XMLSchema-instance\"\n"
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" xsi:schemaLocation=\"http://graphml.graphdrawing.org/xmlns http://graphml.graphdrawing.org/xmlns/1.0/graphml.xsd\">\n"
graphml_footer :: Builder
graphml_footer = Builder
"</graphml>\n"
keys :: Builder
keys = Builder -> KeyStore -> Builder
showAllKeys Builder
"" KeyStore
key_store
key_metas :: [KeyMeta]
key_metas = [[KeyMeta]] -> [KeyMeta]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[KeyMeta]] -> [KeyMeta]) -> [[KeyMeta]] -> [KeyMeta]
forall a b. (a -> b) -> a -> b
$ (SnapshotNode n na -> [KeyMeta])
-> [SnapshotNode n na] -> [[KeyMeta]]
forall a b. (a -> b) -> [a] -> [b]
map SnapshotNode n na -> [KeyMeta]
forall na n. ToAttributes na => SnapshotNode n na -> [KeyMeta]
nodeMetaKeys [SnapshotNode n na]
input_nodes [[KeyMeta]] -> [[KeyMeta]] -> [[KeyMeta]]
forall a. Semigroup a => a -> a -> a
<> (SnapshotLink n la -> [KeyMeta])
-> [SnapshotLink n la] -> [[KeyMeta]]
forall a b. (a -> b) -> [a] -> [b]
map SnapshotLink n la -> [KeyMeta]
forall la n. ToAttributes la => SnapshotLink n la -> [KeyMeta]
linkMetaKeys [SnapshotLink n la]
input_links
key_store :: KeyStore
key_store = (KeyStore -> KeyMeta -> KeyStore)
-> KeyStore -> [KeyMeta] -> KeyStore
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\KeyStore
acc KeyMeta
m -> KeyMeta -> KeyStore -> KeyStore
addKey KeyMeta
m KeyStore
acc) KeyStore
emptyKeyStore [KeyMeta]
key_metas
edgedefault_str :: Builder
edgedefault_str = if WriteOption -> Bool
woptDefaultDirected WriteOption
wopt
then Builder
"directed"
else Builder
"undirected"
graph_header :: Builder
graph_header = Builder
"<graph edgedefault=\"" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
edgedefault_str Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\">\n"
graph_footer :: Builder
graph_footer = Builder
"</graph>\n"
nodes :: Builder
nodes = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ (SnapshotNode n na -> Builder) -> [SnapshotNode n na] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map SnapshotNode n na -> Builder
forall n na.
(ToNodeID n, ToAttributes na) =>
SnapshotNode n na -> Builder
writeNode [SnapshotNode n na]
input_nodes
edges :: Builder
edges = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ (SnapshotLink n la -> Builder) -> [SnapshotLink n la] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map SnapshotLink n la -> Builder
forall n la.
(ToNodeID n, ToAttributes la) =>
SnapshotLink n la -> Builder
writeLink [SnapshotLink n la]
input_links
showAttribute' :: (KeyMeta, AttributeValue) -> Builder
showAttribute' (KeyMeta
k,AttributeValue
v) = (Builder
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ) (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ KeyStore -> KeyMeta -> AttributeValue -> Builder
showAttribute KeyStore
key_store KeyMeta
k AttributeValue
v
writeNode :: SnapshotNode n na -> Builder
writeNode SnapshotNode n na
n = Builder
" <node id=\"" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (n -> Builder
forall n. ToNodeID n => n -> Builder
encodeNodeID (n -> Builder) -> n -> Builder
forall a b. (a -> b) -> a -> b
$ SnapshotNode n na -> n
forall n na. SnapshotNode n na -> n
nodeId SnapshotNode n na
n) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\">\n"
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ([Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ ((KeyMeta, AttributeValue) -> Builder)
-> [(KeyMeta, AttributeValue)] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (KeyMeta, AttributeValue) -> Builder
showAttribute' ([(KeyMeta, AttributeValue)] -> [Builder])
-> [(KeyMeta, AttributeValue)] -> [Builder]
forall a b. (a -> b) -> a -> b
$ SnapshotNode n na -> [(KeyMeta, AttributeValue)]
forall na n.
ToAttributes na =>
SnapshotNode n na -> [(KeyMeta, AttributeValue)]
nodeMetaValues SnapshotNode n na
n)
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" </node>\n"
writeLink :: SnapshotLink n la -> Builder
writeLink SnapshotLink n la
l = Builder
" <edge source=\"" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (n -> Builder
forall n. ToNodeID n => n -> Builder
encodeNodeID (n -> Builder) -> n -> Builder
forall a b. (a -> b) -> a -> b
$ SnapshotLink n la -> n
forall n la. SnapshotLink n la -> n
sourceNode SnapshotLink n la
l)
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\" target=\"" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (n -> Builder
forall n. ToNodeID n => n -> Builder
encodeNodeID (n -> Builder) -> n -> Builder
forall a b. (a -> b) -> a -> b
$ SnapshotLink n la -> n
forall n la. SnapshotLink n la -> n
destinationNode SnapshotLink n la
l)
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\" directed=\"" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> SnapshotLink n la -> Builder
forall p n la. IsString p => SnapshotLink n la -> p
showDirected SnapshotLink n la
l Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\">\n"
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ([Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ ((KeyMeta, AttributeValue) -> Builder)
-> [(KeyMeta, AttributeValue)] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (KeyMeta, AttributeValue) -> Builder
showAttribute' ([(KeyMeta, AttributeValue)] -> [Builder])
-> [(KeyMeta, AttributeValue)] -> [Builder]
forall a b. (a -> b) -> a -> b
$ SnapshotLink n la -> [(KeyMeta, AttributeValue)]
forall la n.
ToAttributes la =>
SnapshotLink n la -> [(KeyMeta, AttributeValue)]
linkMetaValues SnapshotLink n la
l)
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" </edge>\n"
showDirected :: SnapshotLink n la -> p
showDirected SnapshotLink n la
l = if SnapshotLink n la -> Bool
forall n la. SnapshotLink n la -> Bool
isDirected SnapshotLink n la
l
then p
"true"
else p
"false"
encodeNodeID :: ToNodeID n => n -> TLB.Builder
encodeNodeID :: n -> Builder
encodeNodeID = NodeID -> Builder
encodeXML (NodeID -> Builder) -> (n -> NodeID) -> n -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> NodeID
forall a. ToNodeID a => a -> NodeID
toNodeID
encodeXML :: Text -> TLB.Builder
encodeXML :: NodeID -> Builder
encodeXML = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder)
-> (NodeID -> [Builder]) -> NodeID -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Builder) -> String -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Builder
escape (String -> [Builder]) -> (NodeID -> String) -> NodeID -> [Builder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeID -> String
unpack
where
escape :: Char -> Builder
escape Char
c =
case Char
c of
Char
'<' -> Builder
"<"
Char
'>' -> Builder
">"
Char
'&' -> Builder
"&"
Char
'"' -> Builder
"""
Char
'\'' -> Builder
"'"
Char
'\n' -> Builder
"
"
Char
'\r' -> Builder
"
"
Char
_ -> Char -> Builder
TLB.singleton Char
c