{-# LANGUAGE OverloadedStrings, DeriveGeneric #-}
module NetSpider.RPL.DIO
(
FoundNodeDIO,
SnapshotGraphDIO,
DIONode(..),
DIOLink(..),
dioLinkState,
MergedDIOLink(..),
Rank,
TrickleInterval,
NeighborType(..),
neighborTypeToText,
neighborTypeFromText,
dioDefQuery,
dioUnifierConf
) where
import Control.Applicative ((<$>), (<*>), empty)
import Data.Aeson (ToJSON(..), FromJSON(..))
import qualified Data.Aeson as Aeson
import Data.Bifunctor (bimap)
import Data.Greskell
( Property, GValue,
Binder, Walk, SideEffect, Element, Parser,
Key, pMapToFail, lookupAs, lookupAs', keyText,
FromGraphSON(..)
)
import Data.Greskell.Extra (writeKeyValues, (<=:>), (<=?>))
import Data.Monoid ((<>))
import Data.Text (Text, unpack)
import Data.Word (Word32)
import GHC.Generics (Generic)
import NetSpider.Found (FoundNode, LinkState(..))
import NetSpider.Graph (NodeAttributes(..), LinkAttributes(..), VFoundNode, EFinds)
import qualified NetSpider.GraphML.Writer as GraphML
import qualified NetSpider.Query as Query
import NetSpider.Snapshot (SnapshotGraph)
import NetSpider.Unify (UnifyStdConfig, lsLinkAttributes, latestLinkSample)
import qualified NetSpider.Unify as Unify
import NetSpider.RPL.FindingID (FindingID)
import NetSpider.RPL.JSONUtil (optSnake)
type FoundNodeDIO = FoundNode FindingID DIONode DIOLink
type SnapshotGraphDIO = SnapshotGraph FindingID DIONode MergedDIOLink
type Rank = Word
type TrickleInterval = Word
data DIONode =
DIONode
{ DIONode -> Rank
rank :: Rank,
DIONode -> Rank
dioInterval :: TrickleInterval
}
deriving (Int -> DIONode -> ShowS
[DIONode] -> ShowS
DIONode -> String
(Int -> DIONode -> ShowS)
-> (DIONode -> String) -> ([DIONode] -> ShowS) -> Show DIONode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DIONode] -> ShowS
$cshowList :: [DIONode] -> ShowS
show :: DIONode -> String
$cshow :: DIONode -> String
showsPrec :: Int -> DIONode -> ShowS
$cshowsPrec :: Int -> DIONode -> ShowS
Show,DIONode -> DIONode -> Bool
(DIONode -> DIONode -> Bool)
-> (DIONode -> DIONode -> Bool) -> Eq DIONode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DIONode -> DIONode -> Bool
$c/= :: DIONode -> DIONode -> Bool
== :: DIONode -> DIONode -> Bool
$c== :: DIONode -> DIONode -> Bool
Eq,Eq DIONode
Eq DIONode
-> (DIONode -> DIONode -> Ordering)
-> (DIONode -> DIONode -> Bool)
-> (DIONode -> DIONode -> Bool)
-> (DIONode -> DIONode -> Bool)
-> (DIONode -> DIONode -> Bool)
-> (DIONode -> DIONode -> DIONode)
-> (DIONode -> DIONode -> DIONode)
-> Ord DIONode
DIONode -> DIONode -> Bool
DIONode -> DIONode -> Ordering
DIONode -> DIONode -> DIONode
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 :: DIONode -> DIONode -> DIONode
$cmin :: DIONode -> DIONode -> DIONode
max :: DIONode -> DIONode -> DIONode
$cmax :: DIONode -> DIONode -> DIONode
>= :: DIONode -> DIONode -> Bool
$c>= :: DIONode -> DIONode -> Bool
> :: DIONode -> DIONode -> Bool
$c> :: DIONode -> DIONode -> Bool
<= :: DIONode -> DIONode -> Bool
$c<= :: DIONode -> DIONode -> Bool
< :: DIONode -> DIONode -> Bool
$c< :: DIONode -> DIONode -> Bool
compare :: DIONode -> DIONode -> Ordering
$ccompare :: DIONode -> DIONode -> Ordering
$cp1Ord :: Eq DIONode
Ord,(forall x. DIONode -> Rep DIONode x)
-> (forall x. Rep DIONode x -> DIONode) -> Generic DIONode
forall x. Rep DIONode x -> DIONode
forall x. DIONode -> Rep DIONode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DIONode x -> DIONode
$cfrom :: forall x. DIONode -> Rep DIONode x
Generic)
keyRank :: Key VFoundNode Rank
keyRank :: Key VFoundNode Rank
keyRank = Key VFoundNode Rank
"rank"
keyDioInterval :: Key VFoundNode TrickleInterval
keyDioInterval :: Key VFoundNode Rank
keyDioInterval = Key VFoundNode Rank
"dio_interval"
instance NodeAttributes DIONode where
writeNodeAttributes :: DIONode -> Binder (Walk SideEffect VFoundNode VFoundNode)
writeNodeAttributes DIONode
ln = ([KeyValue VFoundNode] -> Walk SideEffect VFoundNode VFoundNode)
-> Binder [KeyValue VFoundNode]
-> Binder (Walk SideEffect VFoundNode VFoundNode)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [KeyValue VFoundNode] -> Walk SideEffect VFoundNode VFoundNode
forall e. Element e => [KeyValue e] -> Walk SideEffect e e
writeKeyValues (Binder [KeyValue VFoundNode]
-> Binder (Walk SideEffect VFoundNode VFoundNode))
-> Binder [KeyValue VFoundNode]
-> Binder (Walk SideEffect VFoundNode VFoundNode)
forall a b. (a -> b) -> a -> b
$ [Binder (KeyValue VFoundNode)] -> Binder [KeyValue VFoundNode]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Binder (KeyValue VFoundNode)]
pairs
where
pairs :: [Binder (KeyValue VFoundNode)]
pairs = [ Key VFoundNode Rank
keyRank Key VFoundNode Rank -> Rank -> Binder (KeyValue VFoundNode)
forall b a. ToJSON b => Key a b -> b -> Binder (KeyValue a)
<=:> DIONode -> Rank
rank DIONode
ln,
Key VFoundNode Rank
keyDioInterval Key VFoundNode Rank -> Rank -> Binder (KeyValue VFoundNode)
forall b a. ToJSON b => Key a b -> b -> Binder (KeyValue a)
<=:> DIONode -> Rank
dioInterval DIONode
ln
]
parseNodeAttributes :: PMap Multi GValue -> Parser DIONode
parseNodeAttributes PMap Multi GValue
ps = Either PMapLookupException DIONode -> Parser DIONode
forall (m :: * -> *) a.
MonadFail m =>
Either PMapLookupException a -> m a
pMapToFail (Either PMapLookupException DIONode -> Parser DIONode)
-> Either PMapLookupException DIONode -> Parser DIONode
forall a b. (a -> b) -> a -> b
$ Rank -> Rank -> DIONode
DIONode
(Rank -> Rank -> DIONode)
-> Either PMapLookupException Rank
-> Either PMapLookupException (Rank -> DIONode)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key VFoundNode Rank
-> PMap Multi GValue -> Either PMapLookupException Rank
forall k (c :: * -> *) a.
(PMapKey k, NonEmptyLike c, PMapValue k ~ a, FromGraphSON a) =>
k -> PMap c GValue -> Either PMapLookupException a
lookupAs Key VFoundNode Rank
keyRank PMap Multi GValue
ps
Either PMapLookupException (Rank -> DIONode)
-> Either PMapLookupException Rank
-> Either PMapLookupException DIONode
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Key VFoundNode Rank
-> PMap Multi GValue -> Either PMapLookupException Rank
forall k (c :: * -> *) a.
(PMapKey k, NonEmptyLike c, PMapValue k ~ a, FromGraphSON a) =>
k -> PMap c GValue -> Either PMapLookupException a
lookupAs Key VFoundNode Rank
keyDioInterval PMap Multi GValue
ps
instance GraphML.ToAttributes DIONode where
toAttributes :: DIONode -> [(AttributeKey, AttributeValue)]
toAttributes DIONode
ln = [ (Key VFoundNode Rank -> AttributeKey
forall k. PMapKey k => k -> AttributeKey
keyText Key VFoundNode Rank
keyRank, Int -> AttributeValue
GraphML.AttrInt (Int -> AttributeValue) -> Int -> AttributeValue
forall a b. (a -> b) -> a -> b
$ Rank -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Rank -> Int) -> Rank -> Int
forall a b. (a -> b) -> a -> b
$ DIONode -> Rank
rank DIONode
ln),
(Key VFoundNode Rank -> AttributeKey
forall k. PMapKey k => k -> AttributeKey
keyText Key VFoundNode Rank
keyDioInterval, Int -> AttributeValue
GraphML.AttrInt (Int -> AttributeValue) -> Int -> AttributeValue
forall a b. (a -> b) -> a -> b
$ Rank -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Rank -> Int) -> Rank -> Int
forall a b. (a -> b) -> a -> b
$ DIONode -> Rank
dioInterval DIONode
ln)
]
instance FromJSON DIONode where
parseJSON :: Value -> Parser DIONode
parseJSON = Options -> Value -> Parser DIONode
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Aeson.genericParseJSON Options
optSnake
instance ToJSON DIONode where
toJSON :: DIONode -> Value
toJSON = Options -> DIONode -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Aeson.genericToJSON Options
optSnake
toEncoding :: DIONode -> Encoding
toEncoding = Options -> DIONode -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
Aeson.genericToEncoding Options
optSnake
data NeighborType = PreferredParent
| ParentCandidate
| OtherNeighbor
deriving (Int -> NeighborType -> ShowS
[NeighborType] -> ShowS
NeighborType -> String
(Int -> NeighborType -> ShowS)
-> (NeighborType -> String)
-> ([NeighborType] -> ShowS)
-> Show NeighborType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NeighborType] -> ShowS
$cshowList :: [NeighborType] -> ShowS
show :: NeighborType -> String
$cshow :: NeighborType -> String
showsPrec :: Int -> NeighborType -> ShowS
$cshowsPrec :: Int -> NeighborType -> ShowS
Show,NeighborType -> NeighborType -> Bool
(NeighborType -> NeighborType -> Bool)
-> (NeighborType -> NeighborType -> Bool) -> Eq NeighborType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NeighborType -> NeighborType -> Bool
$c/= :: NeighborType -> NeighborType -> Bool
== :: NeighborType -> NeighborType -> Bool
$c== :: NeighborType -> NeighborType -> Bool
Eq,Eq NeighborType
Eq NeighborType
-> (NeighborType -> NeighborType -> Ordering)
-> (NeighborType -> NeighborType -> Bool)
-> (NeighborType -> NeighborType -> Bool)
-> (NeighborType -> NeighborType -> Bool)
-> (NeighborType -> NeighborType -> Bool)
-> (NeighborType -> NeighborType -> NeighborType)
-> (NeighborType -> NeighborType -> NeighborType)
-> Ord NeighborType
NeighborType -> NeighborType -> Bool
NeighborType -> NeighborType -> Ordering
NeighborType -> NeighborType -> NeighborType
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 :: NeighborType -> NeighborType -> NeighborType
$cmin :: NeighborType -> NeighborType -> NeighborType
max :: NeighborType -> NeighborType -> NeighborType
$cmax :: NeighborType -> NeighborType -> NeighborType
>= :: NeighborType -> NeighborType -> Bool
$c>= :: NeighborType -> NeighborType -> Bool
> :: NeighborType -> NeighborType -> Bool
$c> :: NeighborType -> NeighborType -> Bool
<= :: NeighborType -> NeighborType -> Bool
$c<= :: NeighborType -> NeighborType -> Bool
< :: NeighborType -> NeighborType -> Bool
$c< :: NeighborType -> NeighborType -> Bool
compare :: NeighborType -> NeighborType -> Ordering
$ccompare :: NeighborType -> NeighborType -> Ordering
$cp1Ord :: Eq NeighborType
Ord,Int -> NeighborType
NeighborType -> Int
NeighborType -> [NeighborType]
NeighborType -> NeighborType
NeighborType -> NeighborType -> [NeighborType]
NeighborType -> NeighborType -> NeighborType -> [NeighborType]
(NeighborType -> NeighborType)
-> (NeighborType -> NeighborType)
-> (Int -> NeighborType)
-> (NeighborType -> Int)
-> (NeighborType -> [NeighborType])
-> (NeighborType -> NeighborType -> [NeighborType])
-> (NeighborType -> NeighborType -> [NeighborType])
-> (NeighborType -> NeighborType -> NeighborType -> [NeighborType])
-> Enum NeighborType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: NeighborType -> NeighborType -> NeighborType -> [NeighborType]
$cenumFromThenTo :: NeighborType -> NeighborType -> NeighborType -> [NeighborType]
enumFromTo :: NeighborType -> NeighborType -> [NeighborType]
$cenumFromTo :: NeighborType -> NeighborType -> [NeighborType]
enumFromThen :: NeighborType -> NeighborType -> [NeighborType]
$cenumFromThen :: NeighborType -> NeighborType -> [NeighborType]
enumFrom :: NeighborType -> [NeighborType]
$cenumFrom :: NeighborType -> [NeighborType]
fromEnum :: NeighborType -> Int
$cfromEnum :: NeighborType -> Int
toEnum :: Int -> NeighborType
$ctoEnum :: Int -> NeighborType
pred :: NeighborType -> NeighborType
$cpred :: NeighborType -> NeighborType
succ :: NeighborType -> NeighborType
$csucc :: NeighborType -> NeighborType
Enum,NeighborType
NeighborType -> NeighborType -> Bounded NeighborType
forall a. a -> a -> Bounded a
maxBound :: NeighborType
$cmaxBound :: NeighborType
minBound :: NeighborType
$cminBound :: NeighborType
Bounded,(forall x. NeighborType -> Rep NeighborType x)
-> (forall x. Rep NeighborType x -> NeighborType)
-> Generic NeighborType
forall x. Rep NeighborType x -> NeighborType
forall x. NeighborType -> Rep NeighborType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NeighborType x -> NeighborType
$cfrom :: forall x. NeighborType -> Rep NeighborType x
Generic)
neighborTypeToText :: NeighborType -> Text
neighborTypeToText :: NeighborType -> AttributeKey
neighborTypeToText NeighborType
nt = case NeighborType
nt of
NeighborType
PreferredParent -> AttributeKey
"preferred_parent"
NeighborType
ParentCandidate -> AttributeKey
"parent_candidate"
NeighborType
OtherNeighbor -> AttributeKey
"other_neighbor"
neighborTypeFromText :: Text -> Maybe NeighborType
neighborTypeFromText :: AttributeKey -> Maybe NeighborType
neighborTypeFromText AttributeKey
t = case AttributeKey
t of
AttributeKey
"preferred_parent" -> NeighborType -> Maybe NeighborType
forall (m :: * -> *) a. Monad m => a -> m a
return NeighborType
PreferredParent
AttributeKey
"parent_candidate" -> NeighborType -> Maybe NeighborType
forall (m :: * -> *) a. Monad m => a -> m a
return NeighborType
ParentCandidate
AttributeKey
"other_neighbor" -> NeighborType -> Maybe NeighborType
forall (m :: * -> *) a. Monad m => a -> m a
return NeighborType
OtherNeighbor
AttributeKey
_ -> Maybe NeighborType
forall a. Maybe a
Nothing
adaptWalk :: (Element e1, Element e2) => Walk SideEffect e1 e1 -> Walk SideEffect e2 e2
adaptWalk :: Walk SideEffect e1 e1 -> Walk SideEffect e2 e2
adaptWalk = (e1 -> e2)
-> (e1 -> e2) -> Walk SideEffect e1 e1 -> Walk SideEffect e2 e2
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap e1 -> e2
forall a. HasCallStack => a
undefined e1 -> e2
forall a. HasCallStack => a
undefined
keyNeighborType :: Key EFinds NeighborType
keyNeighborType :: Key EFinds NeighborType
keyNeighborType = Key EFinds NeighborType
"neighbor_type"
instance FromGraphSON NeighborType where
parseGraphSON :: GValue -> Parser NeighborType
parseGraphSON GValue
gv = AttributeKey -> Parser NeighborType
forall (m :: * -> *). MonadFail m => AttributeKey -> m NeighborType
fromT (AttributeKey -> Parser NeighborType)
-> Parser AttributeKey -> Parser NeighborType
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< GValue -> Parser AttributeKey
forall a. FromGraphSON a => GValue -> Parser a
parseGraphSON GValue
gv
where
fromT :: AttributeKey -> m NeighborType
fromT AttributeKey
t = m NeighborType
-> (NeighborType -> m NeighborType)
-> Maybe NeighborType
-> m NeighborType
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> m NeighborType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Unknown neighbor type: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> AttributeKey -> String
unpack AttributeKey
t)) NeighborType -> m NeighborType
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe NeighborType -> m NeighborType)
-> Maybe NeighborType -> m NeighborType
forall a b. (a -> b) -> a -> b
$ AttributeKey -> Maybe NeighborType
neighborTypeFromText AttributeKey
t
instance ToJSON NeighborType where
toJSON :: NeighborType -> Value
toJSON NeighborType
n = AttributeKey -> Value
forall a. ToJSON a => a -> Value
toJSON (AttributeKey -> Value) -> AttributeKey -> Value
forall a b. (a -> b) -> a -> b
$ NeighborType -> AttributeKey
neighborTypeToText NeighborType
n
instance FromJSON NeighborType where
parseJSON :: Value -> Parser NeighborType
parseJSON (Aeson.String AttributeKey
t) = Parser NeighborType
-> (NeighborType -> Parser NeighborType)
-> Maybe NeighborType
-> Parser NeighborType
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Parser NeighborType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err_msg) NeighborType -> Parser NeighborType
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe NeighborType -> Parser NeighborType)
-> Maybe NeighborType -> Parser NeighborType
forall a b. (a -> b) -> a -> b
$ AttributeKey -> Maybe NeighborType
neighborTypeFromText AttributeKey
t
where
err_msg :: String
err_msg = String
"Invalid string for NeighborType: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> AttributeKey -> String
forall a. Show a => a -> String
show AttributeKey
t
parseJSON Value
_ = Parser NeighborType
forall (f :: * -> *) a. Alternative f => f a
empty
instance LinkAttributes NeighborType where
writeLinkAttributes :: NeighborType -> Binder (Walk SideEffect EFinds EFinds)
writeLinkAttributes NeighborType
nt = ([KeyValue EFinds] -> Walk SideEffect EFinds EFinds)
-> Binder [KeyValue EFinds]
-> Binder (Walk SideEffect EFinds EFinds)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [KeyValue EFinds] -> Walk SideEffect EFinds EFinds
forall e. Element e => [KeyValue e] -> Walk SideEffect e e
writeKeyValues (Binder [KeyValue EFinds]
-> Binder (Walk SideEffect EFinds EFinds))
-> Binder [KeyValue EFinds]
-> Binder (Walk SideEffect EFinds EFinds)
forall a b. (a -> b) -> a -> b
$ [Binder (KeyValue EFinds)] -> Binder [KeyValue EFinds]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Key EFinds NeighborType
keyNeighborType Key EFinds NeighborType -> NeighborType -> Binder (KeyValue EFinds)
forall b a. ToJSON b => Key a b -> b -> Binder (KeyValue a)
<=:> NeighborType
nt]
parseLinkAttributes :: PMap Single GValue -> Parser NeighborType
parseLinkAttributes PMap Single GValue
ps = Either PMapLookupException NeighborType -> Parser NeighborType
forall (m :: * -> *) a.
MonadFail m =>
Either PMapLookupException a -> m a
pMapToFail (Either PMapLookupException NeighborType -> Parser NeighborType)
-> Either PMapLookupException NeighborType -> Parser NeighborType
forall a b. (a -> b) -> a -> b
$ Key EFinds NeighborType
-> PMap Single GValue -> Either PMapLookupException NeighborType
forall k (c :: * -> *) a.
(PMapKey k, NonEmptyLike c, PMapValue k ~ a, FromGraphSON a) =>
k -> PMap c GValue -> Either PMapLookupException a
lookupAs Key EFinds NeighborType
keyNeighborType PMap Single GValue
ps
data DIOLink =
DIOLink
{ DIOLink -> NeighborType
neighborType :: NeighborType,
DIOLink -> Rank
neighborRank :: Rank,
DIOLink -> Maybe Rank
metric :: Maybe Rank
}
deriving (Int -> DIOLink -> ShowS
[DIOLink] -> ShowS
DIOLink -> String
(Int -> DIOLink -> ShowS)
-> (DIOLink -> String) -> ([DIOLink] -> ShowS) -> Show DIOLink
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DIOLink] -> ShowS
$cshowList :: [DIOLink] -> ShowS
show :: DIOLink -> String
$cshow :: DIOLink -> String
showsPrec :: Int -> DIOLink -> ShowS
$cshowsPrec :: Int -> DIOLink -> ShowS
Show,DIOLink -> DIOLink -> Bool
(DIOLink -> DIOLink -> Bool)
-> (DIOLink -> DIOLink -> Bool) -> Eq DIOLink
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DIOLink -> DIOLink -> Bool
$c/= :: DIOLink -> DIOLink -> Bool
== :: DIOLink -> DIOLink -> Bool
$c== :: DIOLink -> DIOLink -> Bool
Eq,Eq DIOLink
Eq DIOLink
-> (DIOLink -> DIOLink -> Ordering)
-> (DIOLink -> DIOLink -> Bool)
-> (DIOLink -> DIOLink -> Bool)
-> (DIOLink -> DIOLink -> Bool)
-> (DIOLink -> DIOLink -> Bool)
-> (DIOLink -> DIOLink -> DIOLink)
-> (DIOLink -> DIOLink -> DIOLink)
-> Ord DIOLink
DIOLink -> DIOLink -> Bool
DIOLink -> DIOLink -> Ordering
DIOLink -> DIOLink -> DIOLink
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 :: DIOLink -> DIOLink -> DIOLink
$cmin :: DIOLink -> DIOLink -> DIOLink
max :: DIOLink -> DIOLink -> DIOLink
$cmax :: DIOLink -> DIOLink -> DIOLink
>= :: DIOLink -> DIOLink -> Bool
$c>= :: DIOLink -> DIOLink -> Bool
> :: DIOLink -> DIOLink -> Bool
$c> :: DIOLink -> DIOLink -> Bool
<= :: DIOLink -> DIOLink -> Bool
$c<= :: DIOLink -> DIOLink -> Bool
< :: DIOLink -> DIOLink -> Bool
$c< :: DIOLink -> DIOLink -> Bool
compare :: DIOLink -> DIOLink -> Ordering
$ccompare :: DIOLink -> DIOLink -> Ordering
$cp1Ord :: Eq DIOLink
Ord,(forall x. DIOLink -> Rep DIOLink x)
-> (forall x. Rep DIOLink x -> DIOLink) -> Generic DIOLink
forall x. Rep DIOLink x -> DIOLink
forall x. DIOLink -> Rep DIOLink x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DIOLink x -> DIOLink
$cfrom :: forall x. DIOLink -> Rep DIOLink x
Generic)
keyNeighborRank :: Key EFinds Rank
keyNeighborRank :: Key EFinds Rank
keyNeighborRank = Key EFinds Rank
"neighbor_rank"
keyMetric :: Key EFinds (Maybe Rank)
keyMetric :: Key EFinds (Maybe Rank)
keyMetric = Key EFinds (Maybe Rank)
"metric"
instance LinkAttributes DIOLink where
writeLinkAttributes :: DIOLink -> Binder (Walk SideEffect EFinds EFinds)
writeLinkAttributes DIOLink
ll = do
Walk SideEffect EFinds EFinds
nt_steps <- NeighborType -> Binder (Walk SideEffect EFinds EFinds)
forall ps.
LinkAttributes ps =>
ps -> Binder (Walk SideEffect EFinds EFinds)
writeLinkAttributes (NeighborType -> Binder (Walk SideEffect EFinds EFinds))
-> NeighborType -> Binder (Walk SideEffect EFinds EFinds)
forall a b. (a -> b) -> a -> b
$ DIOLink -> NeighborType
neighborType DIOLink
ll
Walk SideEffect EFinds EFinds
other <- ([KeyValue EFinds] -> Walk SideEffect EFinds EFinds)
-> Binder [KeyValue EFinds]
-> Binder (Walk SideEffect EFinds EFinds)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [KeyValue EFinds] -> Walk SideEffect EFinds EFinds
forall e. Element e => [KeyValue e] -> Walk SideEffect e e
writeKeyValues (Binder [KeyValue EFinds]
-> Binder (Walk SideEffect EFinds EFinds))
-> Binder [KeyValue EFinds]
-> Binder (Walk SideEffect EFinds EFinds)
forall a b. (a -> b) -> a -> b
$ [Binder (KeyValue EFinds)] -> Binder [KeyValue EFinds]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Binder (KeyValue EFinds)]
pairs
Walk SideEffect EFinds EFinds
-> Binder (Walk SideEffect EFinds EFinds)
forall (m :: * -> *) a. Monad m => a -> m a
return (Walk SideEffect EFinds EFinds -> Walk SideEffect EFinds EFinds
forall e1 e2.
(Element e1, Element e2) =>
Walk SideEffect e1 e1 -> Walk SideEffect e2 e2
adaptWalk Walk SideEffect EFinds EFinds
nt_steps Walk SideEffect EFinds EFinds
-> Walk SideEffect EFinds EFinds -> Walk SideEffect EFinds EFinds
forall a. Semigroup a => a -> a -> a
<> Walk SideEffect EFinds EFinds
other)
where
pairs :: [Binder (KeyValue EFinds)]
pairs = [ Key EFinds Rank
keyNeighborRank Key EFinds Rank -> Rank -> Binder (KeyValue EFinds)
forall b a. ToJSON b => Key a b -> b -> Binder (KeyValue a)
<=:> DIOLink -> Rank
neighborRank DIOLink
ll,
Key EFinds (Maybe Rank)
keyMetric Key EFinds (Maybe Rank) -> Maybe Rank -> Binder (KeyValue EFinds)
forall b a.
ToJSON b =>
Key a (Maybe b) -> Maybe b -> Binder (KeyValue a)
<=?> DIOLink -> Maybe Rank
metric DIOLink
ll
]
parseLinkAttributes :: PMap Single GValue -> Parser DIOLink
parseLinkAttributes PMap Single GValue
ps =
NeighborType -> Rank -> Maybe Rank -> DIOLink
DIOLink
(NeighborType -> Rank -> Maybe Rank -> DIOLink)
-> Parser NeighborType -> Parser (Rank -> Maybe Rank -> DIOLink)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PMap Single GValue -> Parser NeighborType
forall ps. LinkAttributes ps => PMap Single GValue -> Parser ps
parseLinkAttributes PMap Single GValue
ps
Parser (Rank -> Maybe Rank -> DIOLink)
-> Parser Rank -> Parser (Maybe Rank -> DIOLink)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Either PMapLookupException Rank -> Parser Rank
forall (m :: * -> *) a.
MonadFail m =>
Either PMapLookupException a -> m a
pMapToFail (Either PMapLookupException Rank -> Parser Rank)
-> Either PMapLookupException Rank -> Parser Rank
forall a b. (a -> b) -> a -> b
$ Key EFinds Rank
-> PMap Single GValue -> Either PMapLookupException Rank
forall k (c :: * -> *) a.
(PMapKey k, NonEmptyLike c, PMapValue k ~ a, FromGraphSON a) =>
k -> PMap c GValue -> Either PMapLookupException a
lookupAs Key EFinds Rank
keyNeighborRank PMap Single GValue
ps)
Parser (Maybe Rank -> DIOLink)
-> Parser (Maybe Rank) -> Parser DIOLink
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Either PMapLookupException (Maybe Rank) -> Parser (Maybe Rank)
forall (m :: * -> *) a.
MonadFail m =>
Either PMapLookupException a -> m a
pMapToFail (Either PMapLookupException (Maybe Rank) -> Parser (Maybe Rank))
-> Either PMapLookupException (Maybe Rank) -> Parser (Maybe Rank)
forall a b. (a -> b) -> a -> b
$ Key EFinds (Maybe Rank)
-> PMap Single GValue -> Either PMapLookupException (Maybe Rank)
forall k (c :: * -> *) a.
(PMapKey k, NonEmptyLike c, PMapValue k ~ Maybe a,
FromGraphSON a) =>
k -> PMap c GValue -> Either PMapLookupException (Maybe a)
lookupAs' Key EFinds (Maybe Rank)
keyMetric PMap Single GValue
ps)
dioLinkState :: DIOLink -> LinkState
dioLinkState :: DIOLink -> LinkState
dioLinkState DIOLink
l =
case DIOLink -> NeighborType
neighborType DIOLink
l of
NeighborType
PreferredParent -> LinkState
LinkToTarget
NeighborType
_ -> LinkState
LinkUnused
instance GraphML.ToAttributes DIOLink where
toAttributes :: DIOLink -> [(AttributeKey, AttributeValue)]
toAttributes DIOLink
ll = [ (Key EFinds NeighborType -> AttributeKey
forall k. PMapKey k => k -> AttributeKey
keyText Key EFinds NeighborType
keyNeighborType, AttributeKey -> AttributeValue
GraphML.AttrString (AttributeKey -> AttributeValue) -> AttributeKey -> AttributeValue
forall a b. (a -> b) -> a -> b
$ NeighborType -> AttributeKey
neighborTypeToText (NeighborType -> AttributeKey) -> NeighborType -> AttributeKey
forall a b. (a -> b) -> a -> b
$ DIOLink -> NeighborType
neighborType DIOLink
ll),
(Key EFinds Rank -> AttributeKey
forall k. PMapKey k => k -> AttributeKey
keyText Key EFinds Rank
keyNeighborRank, Int -> AttributeValue
GraphML.AttrInt (Int -> AttributeValue) -> Int -> AttributeValue
forall a b. (a -> b) -> a -> b
$ Rank -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Rank -> Int) -> Rank -> Int
forall a b. (a -> b) -> a -> b
$ DIOLink -> Rank
neighborRank DIOLink
ll)
]
[(AttributeKey, AttributeValue)]
-> [(AttributeKey, AttributeValue)]
-> [(AttributeKey, AttributeValue)]
forall a. [a] -> [a] -> [a]
++ [(AttributeKey, AttributeValue)]
at_metric
where
at_metric :: [(AttributeKey, AttributeValue)]
at_metric =
case DIOLink -> Maybe Rank
metric DIOLink
ll of
Maybe Rank
Nothing -> []
Just Rank
m -> [(Key EFinds (Maybe Rank) -> AttributeKey
forall k. PMapKey k => k -> AttributeKey
keyText Key EFinds (Maybe Rank)
keyMetric, Int -> AttributeValue
GraphML.AttrInt (Int -> AttributeValue) -> Int -> AttributeValue
forall a b. (a -> b) -> a -> b
$ Rank -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Rank
m)]
instance FromJSON DIOLink where
parseJSON :: Value -> Parser DIOLink
parseJSON = Options -> Value -> Parser DIOLink
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Aeson.genericParseJSON Options
optSnake
instance ToJSON DIOLink where
toJSON :: DIOLink -> Value
toJSON = Options -> DIOLink -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Aeson.genericToJSON Options
optSnake
toEncoding :: DIOLink -> Encoding
toEncoding = Options -> DIOLink -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
Aeson.genericToEncoding Options
optSnake
data MergedDIOLink =
MergedDIOLink
{ MergedDIOLink -> DIOLink
fromSource :: DIOLink,
MergedDIOLink -> Maybe DIOLink
fromDest :: Maybe DIOLink
}
deriving (Int -> MergedDIOLink -> ShowS
[MergedDIOLink] -> ShowS
MergedDIOLink -> String
(Int -> MergedDIOLink -> ShowS)
-> (MergedDIOLink -> String)
-> ([MergedDIOLink] -> ShowS)
-> Show MergedDIOLink
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MergedDIOLink] -> ShowS
$cshowList :: [MergedDIOLink] -> ShowS
show :: MergedDIOLink -> String
$cshow :: MergedDIOLink -> String
showsPrec :: Int -> MergedDIOLink -> ShowS
$cshowsPrec :: Int -> MergedDIOLink -> ShowS
Show,MergedDIOLink -> MergedDIOLink -> Bool
(MergedDIOLink -> MergedDIOLink -> Bool)
-> (MergedDIOLink -> MergedDIOLink -> Bool) -> Eq MergedDIOLink
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MergedDIOLink -> MergedDIOLink -> Bool
$c/= :: MergedDIOLink -> MergedDIOLink -> Bool
== :: MergedDIOLink -> MergedDIOLink -> Bool
$c== :: MergedDIOLink -> MergedDIOLink -> Bool
Eq,Eq MergedDIOLink
Eq MergedDIOLink
-> (MergedDIOLink -> MergedDIOLink -> Ordering)
-> (MergedDIOLink -> MergedDIOLink -> Bool)
-> (MergedDIOLink -> MergedDIOLink -> Bool)
-> (MergedDIOLink -> MergedDIOLink -> Bool)
-> (MergedDIOLink -> MergedDIOLink -> Bool)
-> (MergedDIOLink -> MergedDIOLink -> MergedDIOLink)
-> (MergedDIOLink -> MergedDIOLink -> MergedDIOLink)
-> Ord MergedDIOLink
MergedDIOLink -> MergedDIOLink -> Bool
MergedDIOLink -> MergedDIOLink -> Ordering
MergedDIOLink -> MergedDIOLink -> MergedDIOLink
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 :: MergedDIOLink -> MergedDIOLink -> MergedDIOLink
$cmin :: MergedDIOLink -> MergedDIOLink -> MergedDIOLink
max :: MergedDIOLink -> MergedDIOLink -> MergedDIOLink
$cmax :: MergedDIOLink -> MergedDIOLink -> MergedDIOLink
>= :: MergedDIOLink -> MergedDIOLink -> Bool
$c>= :: MergedDIOLink -> MergedDIOLink -> Bool
> :: MergedDIOLink -> MergedDIOLink -> Bool
$c> :: MergedDIOLink -> MergedDIOLink -> Bool
<= :: MergedDIOLink -> MergedDIOLink -> Bool
$c<= :: MergedDIOLink -> MergedDIOLink -> Bool
< :: MergedDIOLink -> MergedDIOLink -> Bool
$c< :: MergedDIOLink -> MergedDIOLink -> Bool
compare :: MergedDIOLink -> MergedDIOLink -> Ordering
$ccompare :: MergedDIOLink -> MergedDIOLink -> Ordering
$cp1Ord :: Eq MergedDIOLink
Ord,(forall x. MergedDIOLink -> Rep MergedDIOLink x)
-> (forall x. Rep MergedDIOLink x -> MergedDIOLink)
-> Generic MergedDIOLink
forall x. Rep MergedDIOLink x -> MergedDIOLink
forall x. MergedDIOLink -> Rep MergedDIOLink x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MergedDIOLink x -> MergedDIOLink
$cfrom :: forall x. MergedDIOLink -> Rep MergedDIOLink x
Generic)
withKeyPrefix :: Monoid k
=> k
-> [(k, v)]
-> [(k, v)]
withKeyPrefix :: k -> [(k, v)] -> [(k, v)]
withKeyPrefix k
prefix = ((k, v) -> (k, v)) -> [(k, v)] -> [(k, v)]
forall a b. (a -> b) -> [a] -> [b]
map (k, v) -> (k, v)
forall b. (k, b) -> (k, b)
prependPrefix
where
prependPrefix :: (k, b) -> (k, b)
prependPrefix (k
k, b
v) = (k
prefix k -> k -> k
forall a. Semigroup a => a -> a -> a
<> k
k, b
v)
dioDefQuery :: [FindingID]
-> Query.Query FindingID DIONode DIOLink MergedDIOLink
dioDefQuery :: [FindingID] -> Query FindingID DIONode DIOLink MergedDIOLink
dioDefQuery [FindingID]
start =
([FindingID] -> Query FindingID DIONode Any Any
forall n na fla. (Eq n, Show n) => [n] -> Query n na fla fla
Query.defQuery [FindingID]
start)
{ startsFrom :: [FindingID]
Query.startsFrom = [FindingID]
start,
unifyLinkSamples :: LinkSampleUnifier FindingID DIONode DIOLink MergedDIOLink
Query.unifyLinkSamples = UnifyStdConfig FindingID DIONode DIOLink MergedDIOLink ()
-> LinkSampleUnifier FindingID DIONode DIOLink MergedDIOLink
forall n lsid na fla sla.
(Eq n, Show n, Ord lsid) =>
UnifyStdConfig n na fla sla lsid -> LinkSampleUnifier n na fla sla
Unify.unifyStd UnifyStdConfig FindingID DIONode DIOLink MergedDIOLink ()
dioUnifierConf
}
dioUnifierConf :: UnifyStdConfig FindingID DIONode DIOLink MergedDIOLink ()
dioUnifierConf :: UnifyStdConfig FindingID DIONode DIOLink MergedDIOLink ()
dioUnifierConf = UnifyStdConfig :: forall n na fla sla lsid.
(LinkSample n fla -> lsid)
-> ([LinkSample n fla]
-> [LinkSample n fla] -> Maybe (LinkSample n sla))
-> (SnapshotNode n na -> LinkSample n sla -> Bool)
-> UnifyStdConfig n na fla sla lsid
Unify.UnifyStdConfig
{ makeLinkSubId :: LinkSample FindingID DIOLink -> ()
Unify.makeLinkSubId = () -> LinkSample FindingID DIOLink -> ()
forall a b. a -> b -> a
const (),
mergeSamples :: [LinkSample FindingID DIOLink]
-> [LinkSample FindingID DIOLink]
-> Maybe (LinkSample FindingID MergedDIOLink)
Unify.mergeSamples = [LinkSample FindingID DIOLink]
-> [LinkSample FindingID DIOLink]
-> Maybe (LinkSample FindingID MergedDIOLink)
forall n.
[LinkSample n DIOLink]
-> [LinkSample n DIOLink] -> Maybe (LinkSample n MergedDIOLink)
merger,
negatesLinkSample :: SnapshotNode FindingID DIONode
-> LinkSample FindingID MergedDIOLink -> Bool
Unify.negatesLinkSample = \SnapshotNode FindingID DIONode
_ LinkSample FindingID MergedDIOLink
_ -> Bool
False
}
where
merger :: [LinkSample n DIOLink]
-> [LinkSample n DIOLink] -> Maybe (LinkSample n MergedDIOLink)
merger [LinkSample n DIOLink]
llinks [LinkSample n DIOLink]
rlinks =
case ([LinkSample n DIOLink] -> Maybe (LinkSample n DIOLink)
forall n la. [LinkSample n la] -> Maybe (LinkSample n la)
latestLinkSample [LinkSample n DIOLink]
llinks, [LinkSample n DIOLink] -> Maybe (LinkSample n DIOLink)
forall n la. [LinkSample n la] -> Maybe (LinkSample n la)
latestLinkSample [LinkSample n DIOLink]
rlinks) of
(Maybe (LinkSample n DIOLink)
Nothing, Maybe (LinkSample n DIOLink)
Nothing) -> Maybe (LinkSample n MergedDIOLink)
forall a. Maybe a
Nothing
(Just LinkSample n DIOLink
ll, Maybe (LinkSample n DIOLink)
Nothing) -> LinkSample n MergedDIOLink -> Maybe (LinkSample n MergedDIOLink)
forall a. a -> Maybe a
Just (LinkSample n MergedDIOLink -> Maybe (LinkSample n MergedDIOLink))
-> LinkSample n MergedDIOLink -> Maybe (LinkSample n MergedDIOLink)
forall a b. (a -> b) -> a -> b
$ LinkSample n DIOLink
-> Maybe (LinkSample n DIOLink) -> LinkSample n MergedDIOLink
forall n.
LinkSample n DIOLink
-> Maybe (LinkSample n DIOLink) -> LinkSample n MergedDIOLink
doMerge LinkSample n DIOLink
ll Maybe (LinkSample n DIOLink)
forall a. Maybe a
Nothing
(Maybe (LinkSample n DIOLink)
Nothing, Just LinkSample n DIOLink
rl) -> LinkSample n MergedDIOLink -> Maybe (LinkSample n MergedDIOLink)
forall a. a -> Maybe a
Just (LinkSample n MergedDIOLink -> Maybe (LinkSample n MergedDIOLink))
-> LinkSample n MergedDIOLink -> Maybe (LinkSample n MergedDIOLink)
forall a b. (a -> b) -> a -> b
$ LinkSample n DIOLink
-> Maybe (LinkSample n DIOLink) -> LinkSample n MergedDIOLink
forall n.
LinkSample n DIOLink
-> Maybe (LinkSample n DIOLink) -> LinkSample n MergedDIOLink
doMerge LinkSample n DIOLink
rl Maybe (LinkSample n DIOLink)
forall a. Maybe a
Nothing
(Just LinkSample n DIOLink
ll, Just LinkSample n DIOLink
rl) -> LinkSample n MergedDIOLink -> Maybe (LinkSample n MergedDIOLink)
forall a. a -> Maybe a
Just (LinkSample n MergedDIOLink -> Maybe (LinkSample n MergedDIOLink))
-> LinkSample n MergedDIOLink -> Maybe (LinkSample n MergedDIOLink)
forall a b. (a -> b) -> a -> b
$ LinkSample n DIOLink
-> Maybe (LinkSample n DIOLink) -> LinkSample n MergedDIOLink
forall n.
LinkSample n DIOLink
-> Maybe (LinkSample n DIOLink) -> LinkSample n MergedDIOLink
doMerge LinkSample n DIOLink
ll (Maybe (LinkSample n DIOLink) -> LinkSample n MergedDIOLink)
-> Maybe (LinkSample n DIOLink) -> LinkSample n MergedDIOLink
forall a b. (a -> b) -> a -> b
$ LinkSample n DIOLink -> Maybe (LinkSample n DIOLink)
forall a. a -> Maybe a
Just LinkSample n DIOLink
rl
doMerge :: LinkSample n DIOLink
-> Maybe (LinkSample n DIOLink) -> LinkSample n MergedDIOLink
doMerge LinkSample n DIOLink
main_link Maybe (LinkSample n DIOLink)
msub_link =
case Maybe (LinkSample n DIOLink)
msub_link of
Maybe (LinkSample n DIOLink)
Nothing -> LinkSample n DIOLink
main_link
{ lsLinkAttributes :: MergedDIOLink
lsLinkAttributes = DIOLink -> Maybe DIOLink -> MergedDIOLink
MergedDIOLink DIOLink
main_ll Maybe DIOLink
forall a. Maybe a
Nothing }
Just LinkSample n DIOLink
sub_link ->
if DIOLink -> NeighborType
neighborType DIOLink
main_ll NeighborType -> NeighborType -> Bool
forall a. Ord a => a -> a -> Bool
<= DIOLink -> NeighborType
neighborType DIOLink
sub_ll
then LinkSample n DIOLink
main_link { lsLinkAttributes :: MergedDIOLink
lsLinkAttributes = DIOLink -> Maybe DIOLink -> MergedDIOLink
MergedDIOLink DIOLink
main_ll (Maybe DIOLink -> MergedDIOLink) -> Maybe DIOLink -> MergedDIOLink
forall a b. (a -> b) -> a -> b
$ DIOLink -> Maybe DIOLink
forall a. a -> Maybe a
Just DIOLink
sub_ll }
else LinkSample n DIOLink
sub_link { lsLinkAttributes :: MergedDIOLink
lsLinkAttributes = DIOLink -> Maybe DIOLink -> MergedDIOLink
MergedDIOLink DIOLink
sub_ll (Maybe DIOLink -> MergedDIOLink) -> Maybe DIOLink -> MergedDIOLink
forall a b. (a -> b) -> a -> b
$ DIOLink -> Maybe DIOLink
forall a. a -> Maybe a
Just DIOLink
main_ll }
where
sub_ll :: DIOLink
sub_ll = LinkSample n DIOLink -> DIOLink
forall n la. LinkSample n la -> la
lsLinkAttributes LinkSample n DIOLink
sub_link
where
main_ll :: DIOLink
main_ll = LinkSample n DIOLink -> DIOLink
forall n la. LinkSample n la -> la
lsLinkAttributes LinkSample n DIOLink
main_link
instance GraphML.ToAttributes MergedDIOLink where
toAttributes :: MergedDIOLink -> [(AttributeKey, AttributeValue)]
toAttributes MergedDIOLink
ml =
(AttributeKey
-> [(AttributeKey, AttributeValue)]
-> [(AttributeKey, AttributeValue)]
forall k v. Monoid k => k -> [(k, v)] -> [(k, v)]
withKeyPrefix AttributeKey
"source_" ([(AttributeKey, AttributeValue)]
-> [(AttributeKey, AttributeValue)])
-> [(AttributeKey, AttributeValue)]
-> [(AttributeKey, AttributeValue)]
forall a b. (a -> b) -> a -> b
$ DIOLink -> [(AttributeKey, AttributeValue)]
forall a. ToAttributes a => a -> [(AttributeKey, AttributeValue)]
GraphML.toAttributes (DIOLink -> [(AttributeKey, AttributeValue)])
-> DIOLink -> [(AttributeKey, AttributeValue)]
forall a b. (a -> b) -> a -> b
$ MergedDIOLink -> DIOLink
fromSource MergedDIOLink
ml)
[(AttributeKey, AttributeValue)]
-> [(AttributeKey, AttributeValue)]
-> [(AttributeKey, AttributeValue)]
forall a. [a] -> [a] -> [a]
++
( case MergedDIOLink -> Maybe DIOLink
fromDest MergedDIOLink
ml of
Maybe DIOLink
Nothing -> []
Just DIOLink
dl -> AttributeKey
-> [(AttributeKey, AttributeValue)]
-> [(AttributeKey, AttributeValue)]
forall k v. Monoid k => k -> [(k, v)] -> [(k, v)]
withKeyPrefix AttributeKey
"dest_" ([(AttributeKey, AttributeValue)]
-> [(AttributeKey, AttributeValue)])
-> [(AttributeKey, AttributeValue)]
-> [(AttributeKey, AttributeValue)]
forall a b. (a -> b) -> a -> b
$ DIOLink -> [(AttributeKey, AttributeValue)]
forall a. ToAttributes a => a -> [(AttributeKey, AttributeValue)]
GraphML.toAttributes DIOLink
dl
)
instance FromJSON MergedDIOLink where
parseJSON :: Value -> Parser MergedDIOLink
parseJSON = Options -> Value -> Parser MergedDIOLink
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Aeson.genericParseJSON Options
optSnake
instance ToJSON MergedDIOLink where
toJSON :: MergedDIOLink -> Value
toJSON = Options -> MergedDIOLink -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Aeson.genericToJSON Options
optSnake
toEncoding :: MergedDIOLink -> Encoding
toEncoding = Options -> MergedDIOLink -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
Aeson.genericToEncoding Options
optSnake