JanusBench.hs

{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE PartialTypeSignatures #-}

{-# OPTIONS_GHC -Wall                        #-}
{-# OPTIONS_GHC -Wno-missing-signatures      #-}
{-# OPTIONS_GHC -Wno-partial-type-signatures #-}

{-

Setup and start Gremlin server:

    wget https://github.com/JanusGraph/janusgraph/releases/download/v0.1.1/janusgraph-0.1.1-hadoop2.zip

    unzip janusgraph-0.1.1-hadoop2.zip
    cd janusgraph-0.1.1-hadoop2

    mkdir -p test/conf/gremlin-server
    mkdir -p test/db
    cp conf/gremlin-server/janusgraph-berkeleyje-server.properties test/conf/gremlin-server/
    cp conf/gremlin-server/gremlin-server.yaml test/conf/gremlin-server/

    sed -i "s|  graph: conf/gremlin-server/janusgraph-cassandra-es-server.properties}|  graph: test/conf/gremlin-server/janusgraph-berkeleyje-server.properties}|g" test/conf/gremlin-server/gremlin-server.yaml

    sed -i "s|storage.directory=db/berkeley|storage.directory=test/db|g" test/conf/gremlin-server/janusgraph-berkeleyje-server.properties

    bin/gremlin-server.sh test/conf/gremlin-server/gremlin-server.yaml

Install https://hackage.haskell.org/package/gremlin-haskell

Compile and run this file:

  ghc -O2 --make ImportBench.hs -o ImportBench
  ./ImportBench

-}

import Control.Lens (element, _Right, (^?))
import Control.Monad
import Data.Aeson ((.=))
import Data.Aeson.Lens
import qualified Data.HashMap.Strict as HashMap
import Data.Int
import Data.IORef
import Data.Monoid
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.IO as Text
import Data.Time (diffUTCTime, getCurrentTime)

import Database.TinkerPop

timeIO :: Text -> IO a -> IO ()
timeIO name a = do
    start <- getCurrentTime
    void a
    stop  <- getCurrentTime
    let n = 20 - Text.length name
    Text.putStr $ name <> ": " <> Text.replicate n " "
    print $ diffUTCTime stop start

myRun :: _ -> _ -> (_ -> IO a) -> IO a
myRun s i k = do
    r <- newIORef undefined
    run s i (k >=> writeIORef r)
    readIORef r

addEntity :: _ -> Text -> Text -> Int64 -> Int64 -> _
addEntity conn uuid name created lastMod = submit conn
    "graph.addVertex(label, 'Entity', 'uuid', u, 'name', n, 'createdAt', c, 'lastModified', l)" $
    Just $ HashMap.fromList
      [ ("u" .= uuid)
      , ("n" .= name)
      , ("c" .= created)
      , ("l" .= lastMod)
      ]

addImport :: _ -> Text -> Text -> Int64 -> Int64 -> Int64 -> _
addImport conn uuid name created impTime lastMod = submit conn
    "graph.addVertex(label, 'Import', 'uuid', u, 'name', n, 'createdAt', c, 'importTime', i, 'lastModified', l)" $
    Just $ HashMap.fromList
      [ ("u" .= uuid)
      , ("n" .= name)
      , ("c" .= created)
      , ("i" .= impTime)
      , ("l" .= lastMod)
      ]

addScorecard :: _ -> Text -> Text -> Text -> Int64 -> Int64 -> Int64 -> Int64 -> _
addScorecard conn uuid name ty start end created lastMod = submit conn
    "graph.addVertex(label, 'Import', 'uuid', u, 'name', n, 'type', t, 'startDate', s, 'endDate', e, 'createdAt', c, 'lastModified', l)" $
    Just $ HashMap.fromList
      [ ("u" .= uuid)
      , ("n" .= name)
      , ("t" .= ty)
      , ("s" .= start)
      , ("e" .= end)
      , ("c" .= created)
      , ("l" .= lastMod)
      ]

addManager :: _ -> Text -> Text -> Text -> Text -> Text -> Text -> Text -> Int64 -> Bool -> Bool -> Bool -> _
addManager conn uuid name idn idt gender race designation for vot disabled imposed = submit conn
    "graph.addVertex(label, 'Person', 'uuid', u, 'name', n, 'idNumber', idn, 'idType', idt, 'gender', g, 'race', r, 'designation', d, 'foreign', f, 'votingRights', v, 'disabled', dis, 'imposed', i)" $
    Just $ HashMap.fromList
      [ ("u"   .= uuid)
      , ("n"   .= name)
      , ("idn" .= idn)
      , ("idt" .= idt)
      , ("g"   .= gender)
      , ("r"   .= race)
      , ("d"   .= designation)
      , ("f"   .= for)
      , ("v"   .= vot)
      , ("dis" .= disabled)
      , ("i"   .= imposed)
      ]

addRel :: _ -> Text -> Integer -> Integer -> _
addRel conn label from to = submit conn ("g.V(from).next().addEdge('" <> label <> "', g.V(to).next())") $
    Just $ HashMap.fromList ["from" .= from, "to" .= to]

destroyDB :: IO ()
destroyDB = run "localhost" 8182 $ \conn ->
    void $ submit conn "g.V().drop()" Nothing

getId = (^? Control.Lens._Right . element 0 . key "id" . Data.Aeson.Lens._Integer)

importManagement :: Int -> IO Integer
importManagement n = myRun "localhost" 8182 $ \conn -> do
    Just sid <- getId <$> addScorecard conn "asdf987asdf987asdf981" "Test scorecard" "fsc" 1262304000 1265155200 1494945157 1494945157
    Just iid <- getId <$> addImport    conn "asdf987asdf987asdf982" "Import A" 1494945157 1494945157 1494945157
    Just eid <- getId <$> addEntity    conn "asdf987asdf987asdf983" "Entity A" 1494945157 1494945157

    void $ addRel conn "ScorecardFor"  sid eid
    void $ addRel conn "RelatedImport" sid iid

    sequence_
      [ do Just man <- getId <$> addManager conn
             ("aasdf987asdf987as" <> i')
             ("Name " <> i')
             i'
             "employeenumber"
             "female"
             "coloured"
             "executivedirector"
             12
             False
             False
             False
           void $ addRel conn "Imported" iid man
           void $ addRel conn "Employs" eid man
          | i <- [1..n], let i' = Text.pack (show i)
      ]

    return sid
  where
      -- Using qualified names so that it doesn't look like a whole

main :: IO ()
main = run "localhost" 8182 $ \conn -> do
    destroyDB

    let n = 10
    sid <- timeIO ("management " <> Text.pack (show n)) $ importManagement n

    putStrLn "\n### Find entity:"
    (print =<<) $ submit conn "g.V(sid).out('ScorecardFor').values('name')" $ Just $
      HashMap.fromList [("sid" .= sid)]

    putStrLn "\n### Find import:"
    (print =<<) $ submit conn "g.V(sid).out('RelatedImport').values('name')" $ Just $
      HashMap.fromList [("sid" .= sid)]

--     putStrLn "\n### Find persons:"
--     (print =<<) $ submit conn "g.V(sid).out('RelatedImport').out('Imported').values('name')" $ Just $
--       HashMap.fromList [("sid" .= sid)]

    -- putStrLn "\n### All nodes:"
    -- submit conn "g.V().values()" Nothing >>= print
    -- submit conn "g.V().valueMap()" Nothing >>= print