{-# LANGUAGE OverloadedStrings, DeriveGeneric #-}
module NetSpider.Found
(
FoundNode(..),
FoundLink(..),
LinkState(..),
linkStateToText,
linkStateFromText,
sortByTime,
allTargetNodes
) where
import qualified Control.Monad.Fail as Fail
import Data.Aeson (FromJSON(..), ToJSON(..))
import qualified Data.Aeson as Aeson
import Data.Bifunctor (Bifunctor(..))
import Data.Char (isUpper, toLower)
import Data.Greskell (FromGraphSON(..))
import Data.List (sortOn, reverse)
import Data.Text (Text, unpack)
import GHC.Generics (Generic)
import qualified Text.Regex.Applicative as RE
import NetSpider.Timestamp (Timestamp)
data LinkState =
LinkUnused
| LinkToTarget
| LinkToSubject
| LinkBidirectional
deriving (Show,Eq,Ord,Bounded,Enum)
linkStateToText :: LinkState -> Text
linkStateToText ls = case ls of
LinkUnused -> "unused"
LinkToTarget -> "to_target"
LinkToSubject -> "to_subject"
LinkBidirectional -> "bidirectional"
linkStateFromText :: Text -> Maybe LinkState
linkStateFromText t = case t of
"unused" -> Just LinkUnused
"to_target" -> Just LinkToTarget
"to_subject" -> Just LinkToSubject
"bidirectional" -> Just LinkBidirectional
_ -> Nothing
linkStateFromTextF :: Fail.MonadFail m => Text -> m LinkState
linkStateFromTextF t =
case linkStateFromText t of
Just ls -> return ls
Nothing -> Fail.fail ("Unrecognized LinkState: " ++ unpack t)
instance FromGraphSON LinkState where
parseGraphSON gv = linkStateFromTextF =<< parseGraphSON gv
instance FromJSON LinkState where
parseJSON v = linkStateFromTextF =<< parseJSON v
instance ToJSON LinkState where
toJSON = toJSON . linkStateToText
aesonOpt :: Aeson.Options
aesonOpt = Aeson.defaultOptions
{ Aeson.fieldLabelModifier = modifier
}
where
modifier = RE.replace reSnake . RE.replace reAttr
reAttr = fmap (const "Attrs") $ RE.string "Attributes"
reSnake = RE.msym $ \c -> if isUpper c then Just ['_', toLower c] else Nothing
data FoundLink n la =
FoundLink
{ targetNode :: n,
linkState :: LinkState,
linkAttributes :: la
}
deriving (Show,Eq,Ord,Generic)
instance Functor (FoundLink n) where
fmap f l = l { linkAttributes = f $ linkAttributes l }
instance Bifunctor FoundLink where
bimap fn fla l = l { targetNode = fn $ targetNode l,
linkAttributes = fla $ linkAttributes l
}
instance (FromJSON n, FromJSON la) => FromJSON (FoundLink n la) where
parseJSON = Aeson.genericParseJSON aesonOpt
instance (ToJSON n, ToJSON la) => ToJSON (FoundLink n la) where
toJSON = Aeson.genericToJSON aesonOpt
toEncoding = Aeson.genericToEncoding aesonOpt
data FoundNode n na la =
FoundNode
{ subjectNode :: n,
foundAt :: Timestamp,
neighborLinks :: [FoundLink n la],
nodeAttributes :: na
}
deriving (Show,Eq,Ord,Generic)
instance Functor (FoundNode n na) where
fmap f n = n { neighborLinks = (fmap . fmap) f $ neighborLinks n }
instance Bifunctor (FoundNode n) where
bimap fna fla n = n { neighborLinks = (fmap . fmap) fla $ neighborLinks n,
nodeAttributes = fna $ nodeAttributes n
}
instance (FromJSON n, FromJSON na, FromJSON la) => FromJSON (FoundNode n na la) where
parseJSON = Aeson.genericParseJSON aesonOpt
instance (ToJSON n, ToJSON na, ToJSON la) => ToJSON (FoundNode n na la) where
toJSON = Aeson.genericToJSON aesonOpt
toEncoding = Aeson.genericToEncoding aesonOpt
sortByTime :: [FoundNode n na la] -> [FoundNode n na la]
sortByTime fns = reverse $ sortOn foundAt fns
allTargetNodes :: FoundNode n na la -> [n]
allTargetNodes = map targetNode . neighborLinks