{-# LANGUAGE DeriveGeneric #-}
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
type SnapshotGraph n na la = ([SnapshotNode n na], [SnapshotLink n la])
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
}
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)
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)
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 }
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
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
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
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)
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
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)
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)
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 }
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
}
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
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