-- |
-- Module: NetSpider.Snapshot
-- Description: Types about snapshot graph
-- Maintainer: Toshio Ito <debug.ito@gmail.com>
--
-- A snapshot graph is a graph constructed from the NetSpider
-- database. It reprensents a graph at specific time.
module NetSpider.Snapshot
       ( -- * SnapshotGraph
         SnapshotGraph,
         graphTimestamp,
         -- * SnapshotNode
         SnapshotNode,
         nodeId,
         isOnBoundary,
         nodeTimestamp,
         nodeAttributes,
         -- * SnapshotLink
         SnapshotLink,
         sourceNode,
         destinationNode,
         linkNodeTuple,
         linkNodePair,
         isDirected,
         linkTimestamp,
         linkAttributes
       ) where

import Data.Maybe (catMaybes)

import NetSpider.Snapshot.Internal
  ( SnapshotGraph,
    SnapshotNode(..),
    SnapshotLink(..),
    linkNodeTuple,
    linkNodePair
  )
import NetSpider.Timestamp (Timestamp)

-- | Get the timestamp of the graph. It's the latest timestamp of the
-- nodes and links.
--
-- @since 0.4.3.0
graphTimestamp :: SnapshotGraph n na la -> Maybe Timestamp
graphTimestamp :: SnapshotGraph n na la -> Maybe Timestamp
graphTimestamp ([SnapshotNode n na]
nodes, [SnapshotLink n la]
links) = [Timestamp] -> Maybe Timestamp
forall a. Ord a => [a] -> Maybe a
maximum' ([Timestamp]
node_times [Timestamp] -> [Timestamp] -> [Timestamp]
forall a. [a] -> [a] -> [a]
++ [Timestamp]
link_times)
  where
    maximum' :: [a] -> Maybe a
maximum' [] = Maybe a
forall a. Maybe a
Nothing
    maximum' [a]
ts = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [a]
ts
    node_times :: [Timestamp]
node_times = [Maybe Timestamp] -> [Timestamp]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Timestamp] -> [Timestamp])
-> [Maybe Timestamp] -> [Timestamp]
forall a b. (a -> b) -> a -> b
$ (SnapshotNode n na -> Maybe Timestamp)
-> [SnapshotNode n na] -> [Maybe Timestamp]
forall a b. (a -> b) -> [a] -> [b]
map SnapshotNode n na -> Maybe Timestamp
forall n na. SnapshotNode n na -> Maybe Timestamp
nodeTimestamp [SnapshotNode n na]
nodes
    link_times :: [Timestamp]
link_times = (SnapshotLink n la -> Timestamp)
-> [SnapshotLink n la] -> [Timestamp]
forall a b. (a -> b) -> [a] -> [b]
map SnapshotLink n la -> Timestamp
forall n la. SnapshotLink n la -> Timestamp
linkTimestamp [SnapshotLink n la]
links

nodeId :: SnapshotNode n na -> n
nodeId :: SnapshotNode n na -> n
nodeId = SnapshotNode n na -> n
forall n na. SnapshotNode n na -> n
_nodeId

-- | This property is 'True' if the node is on the boundary of the
-- query. This means that nodes adjacent to this node may not be
-- included in the query result.
isOnBoundary :: SnapshotNode n na -> Bool
isOnBoundary :: SnapshotNode n na -> Bool
isOnBoundary = SnapshotNode n na -> Bool
forall n na. SnapshotNode n na -> Bool
_isOnBoundary

-- | If the node is not observed yet or 'isOnBoundary' is 'True', its
-- timestamp is 'Nothing'.
nodeTimestamp :: SnapshotNode n na -> Maybe Timestamp
nodeTimestamp :: SnapshotNode n na -> Maybe Timestamp
nodeTimestamp = SnapshotNode n na -> Maybe Timestamp
forall n na. SnapshotNode n na -> Maybe Timestamp
_nodeTimestamp

-- | If the node is not observed yet or 'isOnBoundary' is 'True', its
-- node attributes is 'Nothing'.
nodeAttributes :: SnapshotNode n na -> Maybe na
nodeAttributes :: SnapshotNode n na -> Maybe na
nodeAttributes = SnapshotNode n na -> Maybe na
forall n na. SnapshotNode n na -> Maybe na
_nodeAttributes

sourceNode :: SnapshotLink n la -> n
sourceNode :: SnapshotLink n la -> n
sourceNode = SnapshotLink n la -> n
forall n la. SnapshotLink n la -> n
_sourceNode

destinationNode :: SnapshotLink n la -> n
destinationNode :: SnapshotLink n la -> n
destinationNode = SnapshotLink n la -> n
forall n la. SnapshotLink n la -> n
_destinationNode

isDirected :: SnapshotLink n la -> Bool
isDirected :: SnapshotLink n la -> Bool
isDirected = SnapshotLink n la -> Bool
forall n la. SnapshotLink n la -> Bool
_isDirected

linkTimestamp :: SnapshotLink n la -> Timestamp
linkTimestamp :: SnapshotLink n la -> Timestamp
linkTimestamp = SnapshotLink n la -> Timestamp
forall n la. SnapshotLink n la -> Timestamp
_linkTimestamp

linkAttributes :: SnapshotLink n la -> la
linkAttributes :: SnapshotLink n la -> la
linkAttributes = SnapshotLink n la -> la
forall n la. SnapshotLink n la -> la
_linkAttributes