{-# LANGUAGE FlexibleInstances, OverloadedStrings #-}
-- |
-- Module: NetSpider.Pangraph
-- Description: Conversion between NetSpider and Pangraph
-- Maintainer: Toshio Ito <debug.ito@gmail.com>
--
-- Conversion of NetSpider data model into Pangraph data model. This
-- module allows you to export a snapshot graph ('SnapshotNode's and
-- 'SnapshotLink's) to 'P.Pangraph'.
module NetSpider.Pangraph
( -- * Converters
makePangraph,
makePangraphIO,
makeVertex,
makeEdge,
-- * Types
Atom,
ToAtom(..),
ToAttributes(..),
-- * Utility
timestampAttributes,
writePangraph,
attributesFromGraphML,
-- * Re-exports
Attribute,
Key,
Value
) where
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.Foldable (Foldable)
import Data.Greskell.PMap (PMap, pMapToList)
import Data.Text (pack)
import Data.Text.Encoding (encodeUtf8)
import Data.Time.LocalTime (TimeZone(..))
import qualified NetSpider.GraphML.Writer as NGraphML
import NetSpider.Snapshot
( SnapshotNode, SnapshotLink,
nodeId, nodeAttributes, nodeTimestamp, isOnBoundary,
sourceNode, destinationNode, linkAttributes, linkTimestamp, isDirected
)
import NetSpider.Timestamp (Timestamp(..), showEpochTime)
import Pangraph (Attribute, Key, Value)
import qualified Pangraph as P
import qualified Pangraph.GraphML.Writer as GraphML
import System.IO.Error (userError, ioError)
import NetSpider.Pangraph.Atom (Atom, ToAtom(..))
-- | Make Pangraph 'Attribute's from 'Timestamp'.
--
-- >>> import NetSpider.Timestamp (fromS)
-- >>> timestampAttributes $ fromS "2018-10-11T11:23:05"
-- [("@timestamp","1539256985000")]
-- >>> timestampAttributes $ fromS "2018-09-23T08:48:52+09:00"
-- [("@timestamp","1537660132000"),("@tz_offset_min","540"),("@tz_summer_only","False"),("@tz_name","")]
-- >>> timestampAttributes $ fromS "2018-12-30T22:00:12.109-04:00"
-- [("@timestamp","1546221612109"),("@tz_offset_min","-240"),("@tz_summer_only","False"),("@tz_name","")]
timestampAttributes :: Timestamp -> [Attribute]
timestampAttributes ts = epoch : tz_attrs
where
epoch = ("@timestamp", encodeUtf8 $ showEpochTime ts)
tz_attrs = case timeZone ts of
Nothing -> []
Just tz -> [ ("@tz_offset_min", toAtom $ timeZoneMinutes tz),
("@tz_summer_only", toAtom $ timeZoneSummerOnly tz),
("@tz_name", encodeUtf8 $ pack $ timeZoneName tz)
]
maybeList :: Maybe [a] -> [a]
maybeList Nothing = []
maybeList (Just l) = l
-- | Make Pangraph 'P.Vertex' from 'SnapshotNode'.
--
-- Node attributes (@na@) is converted to attributes of
-- 'P.Vertex'. 'nodeTimestamp' is converted by 'timestampAttributes',
-- if present. 'isOnBoundary' is stored as \"\@is_on_boundary\"
-- attribute, if present. respectively.
makeVertex :: (ToAtom n, ToAttributes na) => SnapshotNode n na -> P.Vertex
makeVertex sn = P.makeVertex vid attrs
where
vid = toAtom $ nodeId sn
attrs = (maybeList $ fmap timestampAttributes $ nodeTimestamp sn)
++ [("@is_on_boundary", toAtom $ isOnBoundary sn)]
++ (maybeList $ fmap toAttributes $ nodeAttributes sn)
-- | Make Pangraph 'P.Edge' from 'SnapshotLink'.
--
-- Link attributes (@la@) is converted to attributes of
-- 'P.Edge'. 'linkTimestamp' is converted by
-- 'timestampAttributes'. 'isDirected' is stored as \"\@is_directed\"
-- attribute..
makeEdge :: (ToAtom n, ToAttributes la) => SnapshotLink n la -> P.Edge
makeEdge sl = P.makeEdge (src, dest) attrs
where
src = toAtom $ sourceNode sl
dest = toAtom $ destinationNode sl
attrs = (timestampAttributes $ linkTimestamp sl)
++ [("@is_directed", toAtom $ isDirected sl)]
++ (toAttributes $ linkAttributes sl)
-- | Make a 'P.Pangraph'.
makePangraph :: (ToAtom n, ToAttributes na, ToAttributes la)
=> [SnapshotNode n na] -> [SnapshotLink n la] -> Maybe P.Pangraph
makePangraph ns ls = P.makePangraph (map makeVertex ns) (map makeEdge ls)
-- | Data types that can be converted into a list of Pangraph
-- 'Attribute's.
class ToAttributes a where
toAttributes :: a -> [Attribute]
-- | No attribute.
instance ToAttributes () where
toAttributes () = []
-- | Make 'Attribute' from key-value pairs.
instance (ToAtom k, ToAtom v) => ToAttributes [(k,v)] where
toAttributes = map (\(k, v) -> (toAtom k, toAtom v))
-- | @since 0.2.0.0
instance (Foldable c, ToAtom v) => ToAttributes (PMap c v) where
toAttributes = toAttributes . pMapToList
-- | 'Nothing' is mapped to empty attributes.
instance ToAttributes a => ToAttributes (Maybe a) where
toAttributes Nothing = []
toAttributes (Just a) = toAttributes a
-- | Like 'makePangraph', but result of 'Nothing' is converted to an
-- IO exception.
makePangraphIO :: (ToAtom n, ToAttributes na, ToAttributes la)
=> [SnapshotNode n na] -> [SnapshotLink n la] -> IO P.Pangraph
makePangraphIO ns ls = case makePangraph ns ls of
Just p -> return p
Nothing -> ioError $ userError ("Malformed graph")
-- | Write 'P.Pangraph' to the given file in GraphML format.
writePangraph :: P.Pangraph -> FilePath -> IO ()
writePangraph p file = BS.writeFile file $ GraphML.write p
-- | Make Pangraph attributes from GraphML's attributes.
--
-- @since 0.1.1.0
attributesFromGraphML :: NGraphML.ToAttributes a => a -> [Attribute]
attributesFromGraphML = toAttributes . NGraphML.toAttributes