{-# LANGUAGE OverloadedStrings, DeriveGeneric #-}
-- |
-- Module: NetSpider.RPL.DIO
-- Description: Node and link information based on DIO (DODAG Information Object)
-- Maintainer: Toshio Ito <debug.ito@gmail.com>
--
-- 
module NetSpider.RPL.DIO
  ( -- * Types
    FoundNodeDIO,
    SnapshotGraphDIO,
    DIONode(..),
    DIOLink(..),
    dioLinkState,
    MergedDIOLink(..),
    Rank,
    TrickleInterval,
    NeighborType(..),
    neighborTypeToText,
    neighborTypeFromText,
    -- * Query
    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)

-- | 'FoundNode' for a network described by DIOs.
type FoundNodeDIO = FoundNode FindingID DIONode DIOLink

-- | 'SnapshotGraph' for a network described by DIOs. This is what you
-- get by 'dioDefQuery'.
type SnapshotGraphDIO = SnapshotGraph FindingID DIONode MergedDIOLink

-- | RPL rank
type Rank = Word

-- | The interval of Trickle timer as decribed as number of doublings
-- of the minimum interval, i.e. log2(I / Imin).
--
-- @since 0.2.1.0
type TrickleInterval = Word

-- | Node attributes about DIO.
data DIONode =
  DIONode
  { DIONode -> Rank
rank :: Rank,
    -- ^ RPL rank
    DIONode -> Rank
dioInterval :: TrickleInterval
    -- ^ Current interval of Trickle timer for DIO transmission.
  }
  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)
                    ]

-- | @since 0.4.1.0
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

-- | @since 0.4.1.0
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

-- | Classification of RPL neighbors.
data NeighborType = PreferredParent
                    -- ^ The neighbor is the preferred parent.
                  | ParentCandidate
                    -- ^ The neighbor is not the preferred parent, but
                    -- is in the parent set.
                  | OtherNeighbor
                    -- ^ The neighbor is not in the parent set.
                  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

-- | Unsafely convert walk's type signature
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"

-- | @since 0.4.0.0
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

-- | Encode to a JSON string.
--
-- @since 0.4.0.0
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

-- | Decode from a JSON string.
--
-- @since 0.4.1.0
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

-- | Link attributes about DIO.
--
-- Basically this represents information of a neighbor learned from
-- the DIOs it has sent.
data DIOLink =
  DIOLink
  { DIOLink -> NeighborType
neighborType :: NeighborType,
    -- ^ Type of the neighbor at the other end of this link.
    DIOLink -> Rank
neighborRank :: Rank,
    -- ^ Observed rank of the neighbor.
    DIOLink -> Maybe Rank
metric :: Maybe Rank
    -- ^ Link metric of this link, calculated as step of Rank. Because
    -- Rank computation is up to the Objective Function, this field is
    -- optional.
  }
  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)

-- | 'LinkState' that should be set for given 'DIOLink'.
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)]

-- | @since 0.4.1.0
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

-- | @since 0.4.1.0
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

-- | Link attributes merging two 'DIOLink's from the two end nodes
-- of the link.
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)

-- | Default 'Query.Query' for DIO nodes.
dioDefQuery :: [FindingID] -- ^ 'Query.startsFrom' field.
         -> 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
  }

-- | 'UnifyStdConfig' for RPL DIO data. Used in 'defQuery'.
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
    )

-- | @since 0.4.1.0
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

-- | @since 0.4.1.0
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