net-spider-pangraph (empty) → 0.1.0.0
raw patch · 10 files changed
+421/−0 lines, 10 filesdep +basedep +bytestringdep +doctestsetup-changed
Dependencies added: base, bytestring, doctest, doctest-discover, greskell, hspec, net-spider, net-spider-pangraph, pangraph, text, time
Files
- ChangeLog.md +5/−0
- LICENSE +30/−0
- README.md +9/−0
- Setup.hs +2/−0
- net-spider-pangraph.cabal +67/−0
- src/NetSpider/Pangraph.hs +140/−0
- src/NetSpider/Pangraph/Atom.hs +90/−0
- test/DocTest.hs +1/−0
- test/NetSpider/PangraphSpec.hs +76/−0
- test/Spec.hs +1/−0
+ ChangeLog.md view
@@ -0,0 +1,5 @@+# Revision history for net-spider-pangraph++## 0.1.0.0 -- 2019-05-03++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2018, Toshio Ito++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Toshio Ito nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,9 @@+# net-spider-pangraph++Conversion between [net-spider](https://hackage.haskell.org/package/net-spider) and [pangraph](https://hackage.haskell.org/package/pangraph).++net-spider is a middleware for storing time-varying graphs to a graph database. Using this package and pangraph, you can export snapshot graphs to GraphML files, [Data.Graph](https://hackage.haskell.org/package/containers/docs/Data-Graph.html) data model, etc.++## Author++Toshio Ito <debug.ito@gmail.com>
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ net-spider-pangraph.cabal view
@@ -0,0 +1,67 @@+name: net-spider-pangraph+version: 0.1.0.0+author: Toshio Ito <debug.ito@gmail.com>+maintainer: Toshio Ito <debug.ito@gmail.com>+license: BSD3+license-file: LICENSE+synopsis: Conversion between net-spider and pangraph+description: Conversion between <https://hackage.haskell.org/package/net-spider net-spider> and <https://hackage.haskell.org/package/pangraph pangraph>. See README.md for detail.+category: Database+cabal-version: >= 1.10+build-type: Simple+extra-source-files: README.md, ChangeLog.md+homepage: https://github.com/debug-ito/net-spider+bug-reports: https://github.com/debug-ito/net-spider/issues++library+ default-language: Haskell2010+ hs-source-dirs: src+ ghc-options: -Wall -fno-warn-unused-imports+ -- default-extensions: + other-extensions: FlexibleInstances, OverloadedStrings+ exposed-modules: NetSpider.Pangraph,+ NetSpider.Pangraph.Atom+ -- other-modules: + build-depends: base >=4.11.1.0 && <4.13,+ net-spider >=0.3.0.0 && <0.4,+ bytestring >=0.10.8.2 && <0.11,+ text >=1.2.3.1 && <1.3,+ pangraph >=0.2.1 && <0.3,+ time >=1.8.0.2 && <1.9,+ greskell >=0.2.3.0 && <0.3++-- executable net-spider-pangraph+-- default-language: Haskell2010+-- hs-source-dirs: app+-- main-is: Main.hs+-- ghc-options: -Wall -fno-warn-unused-imports+-- -- other-modules: +-- -- default-extensions: +-- -- other-extensions: +-- build-depends: base++test-suite spec+ type: exitcode-stdio-1.0+ default-language: Haskell2010+ hs-source-dirs: test+ ghc-options: -Wall -fno-warn-unused-imports "-with-rtsopts=-M512m"+ main-is: Spec.hs+ -- default-extensions: + -- other-extensions: + other-modules: NetSpider.PangraphSpec+ build-depends: base, net-spider-pangraph, text, pangraph, net-spider,+ hspec >=2.4.4++test-suite doctest+ type: exitcode-stdio-1.0+ default-language: Haskell2010+ hs-source-dirs: test+ ghc-options: -Wall -fno-warn-unused-imports "-with-rtsopts=-M512m"+ main-is: DocTest.hs+ build-depends: base,+ doctest >=0.13 && <0.17,+ doctest-discover >=0.1.0.7 && <0.3++source-repository head+ type: git+ location: https://github.com/debug-ito/net-spider.git
+ src/NetSpider/Pangraph.hs view
@@ -0,0 +1,140 @@+{-# 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'. Then you can export it to a+-- GraphML file so that external tools can handle it.+module NetSpider.Pangraph+ ( -- * Converters+ makePangraph,+ makePangraphIO,+ makeVertex,+ makeEdge,+ -- * Types+ Atom,+ ToAtom(..),+ ToAttributes(..),+ -- * Utility+ timestampAttributes,+ writePangraph,+ -- * Re-exports+ Attribute,+ Key,+ Value+ ) where++import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import Data.Greskell.Graph (PropertyMap(allProperties), Property(..))+import Data.Text (pack)+import Data.Text.Encoding (encodeUtf8)+import Data.Time.LocalTime (TimeZone(..))+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))++instance (PropertyMap m, Property p, ToAtom v) => ToAttributes (m p v) where+ toAttributes = toAttributes . map toPair . allProperties+ where+ toPair p = (propertyKey p, propertyValue p)++-- | '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
+ src/NetSpider/Pangraph/Atom.hs view
@@ -0,0 +1,90 @@+{-# LANGUAGE FlexibleInstances #-}+-- |+-- Module: NetSpider.Pangraph.Atom+-- Description: Atom type for Pangraph attributes+-- Maintainer: Toshio Ito <debug.ito@gmail.com>+--+-- +module NetSpider.Pangraph.Atom+ ( -- * Types+ Atom,+ ToAtom(..),+ -- * Utility+ showAtom+ ) where++import Data.ByteString (ByteString)+import qualified Data.ByteString.Lazy as BSL+import Data.Int (Int8, Int16, Int32, Int64)+import Data.Text (Text)+import Data.Text.Encoding (encodeUtf8)+import qualified Data.Text.Lazy as TL+import Data.Word (Word, Word8, Word16, Word32)++-- | 'Atom' is the type for Node ID and attributes in Pangraph data+-- model.+type Atom = ByteString++-- | Conversion to 'Atom'.+--+-- String-like types are just converted without quoting. Number types+-- are converted using 'show'.+class ToAtom a where+ toAtom :: a -> Atom++instance ToAtom ByteString where+ toAtom = id++instance ToAtom BSL.ByteString where+ toAtom = BSL.toStrict++instance ToAtom Text where+ toAtom = encodeUtf8++instance ToAtom TL.Text where+ toAtom = toAtom . TL.toStrict++instance ToAtom String where+ toAtom = toAtom . TL.pack++showAtom :: Show a => a -> Atom+showAtom = toAtom . show++instance ToAtom Int where+ toAtom = showAtom++instance ToAtom Int8 where+ toAtom = showAtom++instance ToAtom Int16 where+ toAtom = showAtom++instance ToAtom Int32 where+ toAtom = showAtom++instance ToAtom Int64 where+ toAtom = showAtom++instance ToAtom Word where+ toAtom = showAtom++instance ToAtom Word8 where+ toAtom = showAtom++instance ToAtom Word16 where+ toAtom = showAtom++instance ToAtom Word32 where+ toAtom = showAtom++instance ToAtom Integer where+ toAtom = showAtom++instance ToAtom Float where+ toAtom = showAtom++instance ToAtom Double where+ toAtom = showAtom++instance ToAtom Bool where+ toAtom = showAtom
+ test/DocTest.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF doctest-discover #-}
+ test/NetSpider/PangraphSpec.hs view
@@ -0,0 +1,76 @@+{-# LANGUAGE OverloadedStrings #-}+module NetSpider.PangraphSpec (main, spec) where++import Data.List (sort)+import Data.Text (Text)+import NetSpider.Snapshot.Internal (SnapshotNode(..), SnapshotLink(..))+import NetSpider.Timestamp (fromS)+import qualified Pangraph as P+import Test.Hspec++import NetSpider.Pangraph (makeVertex, ToAttributes(..), makeEdge)+import NetSpider.Pangraph.Atom (ToAtom(..))++data SampleAttr = SampleAttr Text Int+ deriving (Show,Eq,Ord)++instance ToAttributes SampleAttr where+ toAttributes (SampleAttr t i) = [ ("text", toAtom t),+ ("int", toAtom i)+ ]++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+ describe "makeVertex" $ do+ specify "text ID, empty attriubutes" $ do+ let sn :: SnapshotNode Text ()+ sn = SnapshotNode { _nodeId = "node ID",+ _isOnBoundary = False,+ _nodeTimestamp = Just $ fromS "2018-03-22T09:00:00+09:00",+ _nodeAttributes = Just ()+ }+ got = makeVertex sn+ P.vertexID got `shouldBe` "node ID"+ (sort $ P.vertexAttributes got)+ `shouldBe` [ ("@is_on_boundary", "False"),+ ("@timestamp", "1521676800000"),+ ("@tz_name", ""),+ ("@tz_offset_min", "540"),+ ("@tz_summer_only", "False")+ ]+ specify "int ID, list attributes" $ do+ let attrs :: [(Text, Text)]+ attrs = [("foo", "bar"), ("quux", "100")]+ sn :: SnapshotNode Int [(Text, Text)]+ sn = SnapshotNode { _nodeId = 119,+ _isOnBoundary = True,+ _nodeTimestamp = Nothing,+ _nodeAttributes = Just attrs+ }+ got = makeVertex sn+ P.vertexID got `shouldBe` "119"+ (sort $ P.vertexAttributes got)+ `shouldBe` [ ("@is_on_boundary", "True"),+ ("foo", "bar"),+ ("quux", "100")+ ]+ describe "makeEdge" $ do+ specify "text ID, SampleAttr" $ do+ let sl :: SnapshotLink Text SampleAttr+ sl = SnapshotLink { _sourceNode = "src",+ _destinationNode = "dst",+ _isDirected = True,+ _linkTimestamp = fromS "2018-07-18T22:34:01",+ _linkAttributes = SampleAttr "hoge" 256+ }+ got = makeEdge sl+ P.edgeEndpoints got `shouldBe` ("src", "dst")+ (sort $ P.edgeAttributes got)+ `shouldBe` [ ("@is_directed", "True"),+ ("@timestamp", "1531953241000"),+ ("int", "256"),+ ("text", "hoge")+ ]
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}