diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,5 @@ +# Revision history for net-spider-pangraph + +## 0.1.0.0 -- 2019-05-03 + +* First version. Released on an unsuspecting world. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -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 diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/net-spider-pangraph.cabal b/net-spider-pangraph.cabal new file mode 100644 --- /dev/null +++ b/net-spider-pangraph.cabal @@ -0,0 +1,67 @@ +name: net-spider-pangraph +version: 0.1.0.0 +author: Toshio Ito +maintainer: Toshio Ito +license: BSD3 +license-file: LICENSE +synopsis: Conversion between net-spider and pangraph +description: Conversion between and . 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 diff --git a/src/NetSpider/Pangraph.hs b/src/NetSpider/Pangraph.hs new file mode 100644 --- /dev/null +++ b/src/NetSpider/Pangraph.hs @@ -0,0 +1,140 @@ +{-# LANGUAGE FlexibleInstances, OverloadedStrings #-} +-- | +-- Module: NetSpider.Pangraph +-- Description: Conversion between NetSpider and Pangraph +-- Maintainer: Toshio Ito +-- +-- 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 diff --git a/src/NetSpider/Pangraph/Atom.hs b/src/NetSpider/Pangraph/Atom.hs new file mode 100644 --- /dev/null +++ b/src/NetSpider/Pangraph/Atom.hs @@ -0,0 +1,90 @@ +{-# LANGUAGE FlexibleInstances #-} +-- | +-- Module: NetSpider.Pangraph.Atom +-- Description: Atom type for Pangraph attributes +-- Maintainer: Toshio Ito +-- +-- +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 diff --git a/test/DocTest.hs b/test/DocTest.hs new file mode 100644 --- /dev/null +++ b/test/DocTest.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF doctest-discover #-} diff --git a/test/NetSpider/PangraphSpec.hs b/test/NetSpider/PangraphSpec.hs new file mode 100644 --- /dev/null +++ b/test/NetSpider/PangraphSpec.hs @@ -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") + ] diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-}