{-# LANGUAGE DeriveGeneric #-}
-- |
-- Module: NetSpider.Snapshot.Internal
-- Description: Implementation of Snapshot graph types
-- Maintainer: Toshio Ito <debug.ito@gmail.com>
--
-- __this module is internal. End-users should not use this.__
--
-- Implementation of Snapshot graph types. This module is for internal
-- and testing purposes only.
--
-- @since 0.3.0.0
module NetSpider.Snapshot.Internal
       ( SnapshotGraph,
         SnapshotLink(..),
         linkNodeTuple,
         linkNodePair,
         SnapshotNode(..)
       ) where

import Control.Applicative (many, (*>))
import Data.Aeson (ToJSON(..), FromJSON(..))
import qualified Data.Aeson as Aeson
import Data.Bifunctor (Bifunctor(..))
import Data.Char (isUpper, toLower)
import GHC.Generics (Generic)
import NetSpider.Pair (Pair(..))
import NetSpider.Timestamp (Timestamp)
import qualified Text.Regex.Applicative as RE

-- | The snapshot graph, which is a collection nodes and links.
--
-- @since 0.3.1.0
type SnapshotGraph n na la = ([SnapshotNode n na], [SnapshotLink n la])

-- | A link in the snapshot graph.
--
-- 'SnapshotLink' is summary of one or more link observations by
-- different subject nodes. Basically the latest of these observations
-- is used to make 'SnapshotLink'.
--
-- - type @n@: node ID.
-- - type @la@: link attributes.
data SnapshotLink n la =
  SnapshotLink
  { SnapshotLink n la -> n
_sourceNode :: n,
    SnapshotLink n la -> n
_destinationNode :: n,
    SnapshotLink n la -> Bool
_isDirected :: Bool,
    SnapshotLink n la -> Timestamp
_linkTimestamp :: Timestamp,
    SnapshotLink n la -> la
_linkAttributes :: la
    
    -- Maybe it's a good idea to include 'observationLogs', which can
    -- contain warnings or other logs about making this SnapshotLink.
  }
  deriving (Int -> SnapshotLink n la -> ShowS
[SnapshotLink n la] -> ShowS
SnapshotLink n la -> String
(Int -> SnapshotLink n la -> ShowS)
-> (SnapshotLink n la -> String)
-> ([SnapshotLink n la] -> ShowS)
-> Show (SnapshotLink n la)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall n la. (Show n, Show la) => Int -> SnapshotLink n la -> ShowS
forall n la. (Show n, Show la) => [SnapshotLink n la] -> ShowS
forall n la. (Show n, Show la) => SnapshotLink n la -> String
showList :: [SnapshotLink n la] -> ShowS
$cshowList :: forall n la. (Show n, Show la) => [SnapshotLink n la] -> ShowS
show :: SnapshotLink n la -> String
$cshow :: forall n la. (Show n, Show la) => SnapshotLink n la -> String
showsPrec :: Int -> SnapshotLink n la -> ShowS
$cshowsPrec :: forall n la. (Show n, Show la) => Int -> SnapshotLink n la -> ShowS
Show,SnapshotLink n la -> SnapshotLink n la -> Bool
(SnapshotLink n la -> SnapshotLink n la -> Bool)
-> (SnapshotLink n la -> SnapshotLink n la -> Bool)
-> Eq (SnapshotLink n la)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall n la.
(Eq n, Eq la) =>
SnapshotLink n la -> SnapshotLink n la -> Bool
/= :: SnapshotLink n la -> SnapshotLink n la -> Bool
$c/= :: forall n la.
(Eq n, Eq la) =>
SnapshotLink n la -> SnapshotLink n la -> Bool
== :: SnapshotLink n la -> SnapshotLink n la -> Bool
$c== :: forall n la.
(Eq n, Eq la) =>
SnapshotLink n la -> SnapshotLink n la -> Bool
Eq,(forall x. SnapshotLink n la -> Rep (SnapshotLink n la) x)
-> (forall x. Rep (SnapshotLink n la) x -> SnapshotLink n la)
-> Generic (SnapshotLink n la)
forall x. Rep (SnapshotLink n la) x -> SnapshotLink n la
forall x. SnapshotLink n la -> Rep (SnapshotLink n la) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall n la x. Rep (SnapshotLink n la) x -> SnapshotLink n la
forall n la x. SnapshotLink n la -> Rep (SnapshotLink n la) x
$cto :: forall n la x. Rep (SnapshotLink n la) x -> SnapshotLink n la
$cfrom :: forall n la x. SnapshotLink n la -> Rep (SnapshotLink n la) x
Generic)

-- | Comparison by node-tuple (source node, destination node).
instance (Ord n, Eq la) => Ord (SnapshotLink n la) where
  compare :: SnapshotLink n la -> SnapshotLink n la -> Ordering
compare SnapshotLink n la
l SnapshotLink n la
r = (n, n) -> (n, n) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (SnapshotLink n la -> (n, n)
forall n la. SnapshotLink n la -> (n, n)
linkNodeTuple SnapshotLink n la
l) (SnapshotLink n la -> (n, n)
forall n la. SnapshotLink n la -> (n, n)
linkNodeTuple SnapshotLink n la
r)

-- | @since 0.3.0.0
instance Functor (SnapshotLink n) where
  fmap :: (a -> b) -> SnapshotLink n a -> SnapshotLink n b
fmap a -> b
f SnapshotLink n a
l = SnapshotLink n a
l { _linkAttributes :: b
_linkAttributes = a -> b
f (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ SnapshotLink n a -> a
forall n la. SnapshotLink n la -> la
_linkAttributes SnapshotLink n a
l }

-- | @since 0.3.0.0
instance Bifunctor SnapshotLink where
  bimap :: (a -> b) -> (c -> d) -> SnapshotLink a c -> SnapshotLink b d
bimap a -> b
fn c -> d
fla SnapshotLink a c
l = SnapshotLink a c
l { _linkAttributes :: d
_linkAttributes = c -> d
fla (c -> d) -> c -> d
forall a b. (a -> b) -> a -> b
$ SnapshotLink a c -> c
forall n la. SnapshotLink n la -> la
_linkAttributes SnapshotLink a c
l,
                       _sourceNode :: b
_sourceNode = a -> b
fn (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ SnapshotLink a c -> a
forall n la. SnapshotLink n la -> n
_sourceNode SnapshotLink a c
l,
                       _destinationNode :: b
_destinationNode = a -> b
fn (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ SnapshotLink a c -> a
forall n la. SnapshotLink n la -> n
_destinationNode SnapshotLink a c
l
                     }

aesonOpt :: Aeson.Options
aesonOpt :: Options
aesonOpt = Options
Aeson.defaultOptions
           { fieldLabelModifier :: ShowS
Aeson.fieldLabelModifier = ShowS
modifier
           }
  where
    modifier :: ShowS
modifier = RE Char String -> ShowS
forall s. RE s [s] -> [s] -> [s]
RE.replace RE Char String
reSnake ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RE Char String -> ShowS
forall s. RE s [s] -> [s] -> [s]
RE.replace RE Char String
reAttr ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RE Char String -> ShowS
forall s. RE s [s] -> [s] -> [s]
RE.replace RE Char String
reDest ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RE Char String -> ShowS
forall s. RE s [s] -> [s] -> [s]
RE.replace RE Char String
reTime
    reDest :: RE Char String
reDest = ShowS -> RE Char String -> RE Char String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> ShowS
forall a b. a -> b -> a
const String
"dest") (RE Char String -> RE Char String)
-> RE Char String -> RE Char String
forall a b. (a -> b) -> a -> b
$ String -> RE Char String
forall a. Eq a => [a] -> RE a [a]
RE.string String
"destination"
    reAttr :: RE Char String
reAttr = ShowS -> RE Char String -> RE Char String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> ShowS
forall a b. a -> b -> a
const String
"Attrs") (RE Char String -> RE Char String)
-> RE Char String -> RE Char String
forall a b. (a -> b) -> a -> b
$ String -> RE Char String
forall a. Eq a => [a] -> RE a [a]
RE.string String
"Attributes"
    reTime :: RE Char String
reTime = ShowS -> RE Char String -> RE Char String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> ShowS
forall a b. a -> b -> a
const String
"timestamp") (RE Char Char -> RE Char String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many RE Char Char
forall s. RE s s
RE.anySym RE Char String -> RE Char String -> RE Char String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> RE Char String
forall a. Eq a => [a] -> RE a [a]
RE.string String
"Timestamp")
    reSnake :: RE Char String
reSnake = (Char -> Maybe String) -> RE Char String
forall s a. (s -> Maybe a) -> RE s a
RE.msym ((Char -> Maybe String) -> RE Char String)
-> (Char -> Maybe String) -> RE Char String
forall a b. (a -> b) -> a -> b
$ \Char
c ->
      if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_'
      then String -> Maybe String
forall a. a -> Maybe a
Just String
""
      else if Char -> Bool
isUpper Char
c
           then String -> Maybe String
forall a. a -> Maybe a
Just [Char
'_', Char -> Char
toLower Char
c]
           else Maybe String
forall a. Maybe a
Nothing

-- | @since 0.4.1.0
instance (FromJSON n, FromJSON la) => FromJSON (SnapshotLink n la) where
  parseJSON :: Value -> Parser (SnapshotLink n la)
parseJSON = Options -> Value -> Parser (SnapshotLink n la)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Aeson.genericParseJSON Options
aesonOpt

-- | @since 0.4.1.0
instance (ToJSON n, ToJSON la) => ToJSON (SnapshotLink n la) where
  toJSON :: SnapshotLink n la -> Value
toJSON = Options -> SnapshotLink n la -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Aeson.genericToJSON Options
aesonOpt
  toEncoding :: SnapshotLink n la -> Encoding
toEncoding = Options -> SnapshotLink n la -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
Aeson.genericToEncoding Options
aesonOpt
  

-- | Node-tuple (source node, destination node) of the link.
linkNodeTuple :: SnapshotLink n la -> (n, n)
linkNodeTuple :: SnapshotLink n la -> (n, n)
linkNodeTuple SnapshotLink n la
link = (SnapshotLink n la -> n
forall n la. SnapshotLink n la -> n
_sourceNode SnapshotLink n la
link, SnapshotLink n la -> n
forall n la. SnapshotLink n la -> n
_destinationNode SnapshotLink n la
link)

-- | Like 'linkNodeTuple', but this returns a 'Pair'.
linkNodePair :: SnapshotLink n la -> Pair n
linkNodePair :: SnapshotLink n la -> Pair n
linkNodePair = (n, n) -> Pair n
forall a. (a, a) -> Pair a
Pair ((n, n) -> Pair n)
-> (SnapshotLink n la -> (n, n)) -> SnapshotLink n la -> Pair n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SnapshotLink n la -> (n, n)
forall n la. SnapshotLink n la -> (n, n)
linkNodeTuple

-- | A node in the snapshot graph.
data SnapshotNode n na =
  SnapshotNode
  { SnapshotNode n na -> n
_nodeId :: n,
    SnapshotNode n na -> Bool
_isOnBoundary :: Bool,
    SnapshotNode n na -> Maybe Timestamp
_nodeTimestamp :: Maybe Timestamp,
    SnapshotNode n na -> Maybe na
_nodeAttributes :: Maybe na
  }
  deriving (Int -> SnapshotNode n na -> ShowS
[SnapshotNode n na] -> ShowS
SnapshotNode n na -> String
(Int -> SnapshotNode n na -> ShowS)
-> (SnapshotNode n na -> String)
-> ([SnapshotNode n na] -> ShowS)
-> Show (SnapshotNode n na)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall n na. (Show n, Show na) => Int -> SnapshotNode n na -> ShowS
forall n na. (Show n, Show na) => [SnapshotNode n na] -> ShowS
forall n na. (Show n, Show na) => SnapshotNode n na -> String
showList :: [SnapshotNode n na] -> ShowS
$cshowList :: forall n na. (Show n, Show na) => [SnapshotNode n na] -> ShowS
show :: SnapshotNode n na -> String
$cshow :: forall n na. (Show n, Show na) => SnapshotNode n na -> String
showsPrec :: Int -> SnapshotNode n na -> ShowS
$cshowsPrec :: forall n na. (Show n, Show na) => Int -> SnapshotNode n na -> ShowS
Show,SnapshotNode n na -> SnapshotNode n na -> Bool
(SnapshotNode n na -> SnapshotNode n na -> Bool)
-> (SnapshotNode n na -> SnapshotNode n na -> Bool)
-> Eq (SnapshotNode n na)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall n na.
(Eq n, Eq na) =>
SnapshotNode n na -> SnapshotNode n na -> Bool
/= :: SnapshotNode n na -> SnapshotNode n na -> Bool
$c/= :: forall n na.
(Eq n, Eq na) =>
SnapshotNode n na -> SnapshotNode n na -> Bool
== :: SnapshotNode n na -> SnapshotNode n na -> Bool
$c== :: forall n na.
(Eq n, Eq na) =>
SnapshotNode n na -> SnapshotNode n na -> Bool
Eq,(forall x. SnapshotNode n na -> Rep (SnapshotNode n na) x)
-> (forall x. Rep (SnapshotNode n na) x -> SnapshotNode n na)
-> Generic (SnapshotNode n na)
forall x. Rep (SnapshotNode n na) x -> SnapshotNode n na
forall x. SnapshotNode n na -> Rep (SnapshotNode n na) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall n na x. Rep (SnapshotNode n na) x -> SnapshotNode n na
forall n na x. SnapshotNode n na -> Rep (SnapshotNode n na) x
$cto :: forall n na x. Rep (SnapshotNode n na) x -> SnapshotNode n na
$cfrom :: forall n na x. SnapshotNode n na -> Rep (SnapshotNode n na) x
Generic)

-- | Comparison by node ID.
instance (Ord n, Eq na) => Ord (SnapshotNode n na) where
  compare :: SnapshotNode n na -> SnapshotNode n na -> Ordering
compare SnapshotNode n na
l SnapshotNode n na
r = n -> n -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (SnapshotNode n na -> n
forall n na. SnapshotNode n na -> n
_nodeId SnapshotNode n na
l) (SnapshotNode n na -> n
forall n na. SnapshotNode n na -> n
_nodeId SnapshotNode n na
r)

-- | @since 0.3.0.0
instance Functor (SnapshotNode n) where
  fmap :: (a -> b) -> SnapshotNode n a -> SnapshotNode n b
fmap a -> b
f SnapshotNode n a
n = SnapshotNode n a
n { _nodeAttributes :: Maybe b
_nodeAttributes = (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (Maybe a -> Maybe b) -> Maybe a -> Maybe b
forall a b. (a -> b) -> a -> b
$ SnapshotNode n a -> Maybe a
forall n na. SnapshotNode n na -> Maybe na
_nodeAttributes SnapshotNode n a
n }

-- | @since 0.3.0.0
instance Bifunctor SnapshotNode where
  bimap :: (a -> b) -> (c -> d) -> SnapshotNode a c -> SnapshotNode b d
bimap a -> b
fn c -> d
fna SnapshotNode a c
n = SnapshotNode a c
n { _nodeAttributes :: Maybe d
_nodeAttributes = (c -> d) -> Maybe c -> Maybe d
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> d
fna (Maybe c -> Maybe d) -> Maybe c -> Maybe d
forall a b. (a -> b) -> a -> b
$ SnapshotNode a c -> Maybe c
forall n na. SnapshotNode n na -> Maybe na
_nodeAttributes SnapshotNode a c
n,
                       _nodeId :: b
_nodeId = a -> b
fn (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ SnapshotNode a c -> a
forall n na. SnapshotNode n na -> n
_nodeId SnapshotNode a c
n
                     }

-- | @since 0.4.1.0
instance (FromJSON n, FromJSON na) => FromJSON (SnapshotNode n na) where
  parseJSON :: Value -> Parser (SnapshotNode n na)
parseJSON = Options -> Value -> Parser (SnapshotNode n na)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Aeson.genericParseJSON Options
aesonOpt

-- | @since 0.4.1.0
instance (ToJSON n, ToJSON na) => ToJSON (SnapshotNode n na) where
  toJSON :: SnapshotNode n na -> Value
toJSON = Options -> SnapshotNode n na -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Aeson.genericToJSON Options
aesonOpt
  toEncoding :: SnapshotNode n na -> Encoding
toEncoding = Options -> SnapshotNode n na -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
Aeson.genericToEncoding Options
aesonOpt