{-# LANGUAGE OverloadedStrings, DeriveGeneric, TypeSynonymInstances, FlexibleInstances #-}
-- |
-- Module: NetSpider.GraphML.Writer
-- Description: Serialize a Snapshot graph into GraphML format.
-- Maintainer: Toshio Ito <debug.ito@gmail.com>
--
-- This module defines tools to serialize a 'SnapshotGraph' into
-- [GraphML](http://graphml.graphdrawing.org/primer/graphml-primer.html)
-- format.
--
-- @since 0.3.1.0
module NetSpider.GraphML.Writer
  ( -- * Functions
    writeGraphML,
    writeGraphMLWith,
    -- * Options
    WriteOption,
    defWriteOption,
    -- ** accessors for WriteOption
    woptDefaultDirected,
    -- * NodeID
    NodeID,
    ToNodeID(..),
    nodeIDByShow,
    -- * Attributes (re-exports)
    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
  )

-- | Node ID in GraphML.
type NodeID = Text

-- | Type that can be converted to 'NodeID'.
class ToNodeID a where
  toNodeID :: a -> NodeID

-- | Make a 'NodeID' by calling 'show'.
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

-- | Type specifier of 'AttributeValue'
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"

-- | Domain (`for` field of the key) of attribute.
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"

-- | Meta data for a key.
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
                   }

-- | Storage of key metadata.
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

-- | Options to write GraphML. Use 'defWriteOption' to get the default
-- values.
data WriteOption =
  WriteOption
  { WriteOption -> Bool
woptDefaultDirected :: Bool
    -- ^ If 'True', set GraphML's @edgedefault@ attribute to
    -- @directed@. If 'False', set it to @undirected@. Note that
    -- regardless of this option, each @edge@ element specifies
    -- @directed@ attribute explicitly.
    --
    -- Default: 'True'
  }
  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
  }

-- | 'writeGraphMLWith' the default options.
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

-- | Show the 'SnapshotGraph' into GraphML format. 'WriteOption'
-- controls the conversion.
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
"&lt;"
        Char
'>' -> Builder
"&gt;"
        Char
'&' -> Builder
"&amp;"
        Char
'"' -> Builder
"&quot;"
        Char
'\'' -> Builder
"&apos;"
        Char
'\n' -> Builder
"&#x0a;"
        Char
'\r' -> Builder
"&#x0d;"
        Char
_ -> Char -> Builder
TLB.singleton Char
c