greskell-0.2.0.0: test/ServerTest.hs

{-# LANGUAGE OverloadedStrings, TypeFamilies #-}
module Main (main,spec) where

import Control.Category ((<<<))
import Control.Exception.Safe (bracket)
import qualified Data.Aeson as Aeson
import Data.Either (isRight)
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HM
import Data.List (sortBy)
import Data.Monoid (mempty, (<>))
import Data.Scientific (Scientific)
import Data.Text (unpack, Text)
import qualified Data.Vector as V
import qualified Network.Greskell.WebSocket.Client as WS
import System.Environment (lookupEnv)
import Test.Hspec

import Data.Greskell.AsIterator
  ( AsIterator(IteratorItem)
  )
import Data.Greskell.GMap (GMapEntry, unGMapEntry)
import Data.Greskell.Gremlin
  ( oIncr, oDecr, cCompare, Order,
    Predicate(..), pLt, pAnd, pGte, pNot, pEq, pTest
  )
import Data.Greskell.Greskell
  ( toGremlin, Greskell, toGreskell, ToGreskell(..),
    true, false, list, value, single, number, gvalueInt,
    unsafeMethodCall, unsafeGreskell
  )
import Data.Greskell.Graph
  ( AVertex(..), AEdge(..), AProperty(..), AVertexProperty(..),
    PropertyMapSingle,
    T, tId, tLabel, tKey, tValue, cList, (=:),
    fromProperties, allProperties
  )
import Data.Greskell.GraphSON
  ( FromGraphSON, nonTypedGValue, GValue,
    parseEither
  )
import Data.Greskell.GTraversal
  ( Walk, GTraversal, SideEffect,
    source, sV', sE', gV', sAddV', gAddE', gTo, gHasValue,
    ($.), gOrder, gBy1,
    Transform, unsafeWalk, unsafeGTraversal,
    gProperties, gProperty, gPropertyV, liftWalk
  )

main :: IO ()
main = hspec spec

spec :: Spec
spec = withEnv $ do
  spec_basics
  spec_comparator
  spec_predicate
  spec_T
  spec_P
  spec_graph


spec_basics :: SpecWith (String,Int)
spec_basics = do
  describe "Num" $ do
    let checkInt :: Greskell Int -> Int -> SpecWith (String,Int)
        checkInt = checkOne
    checkInt 100 100
    checkInt (20 + 30) (20 + 30)
    checkInt (10 - 3 * 6) (10 - 3 * 6)
    checkInt (-99) (-99)
    checkInt (abs (-53)) (abs (-53))
    checkInt (signum 0) (signum 0)
    checkInt (signum 99) (signum 99)
    checkInt (signum (-12)) (signum (-12))
  describe "Fractional" $ do
    let checkFrac :: Greskell Scientific -> Scientific -> SpecWith (String,Int)
        checkFrac = checkOne
    checkFrac (20.5) (20.5)
    checkFrac (20.123) (20.123)
    checkFrac (32.25 / 2.5) (32.25 / 2.5)
    checkFrac (19.2 * recip 12.5) (19.2 * recip 12.5)
  describe "Monoid" $ do
    let checkT :: Greskell Text -> Text -> SpecWith (String,Int)
        checkT = checkOne
    checkT mempty mempty
    checkT ("hello, " <> "world!") ("hello, " <> "world!")
    checkT ("!\"#$%&'()=~\\|><+*;:@{}[]/?_\r\n\t  ") ("!\"#$%&'()=~\\|><+*;:@{}[]/?_\r\n\t  ")
  describe "Bool" $ do
    let checkB :: Greskell Bool -> Bool -> SpecWith (String,Int)
        checkB = checkOne
    checkB true True
    checkB false False
  describe "list" $ do
    let checkL :: Greskell [Int] -> [Int] -> SpecWith (String,Int)
        checkL = checkRaw
    checkL (list []) []
    checkL (list [20,30,20,10]) [20,30,20,10]
  describe "number" $ do
    let checkN :: Greskell Scientific -> Scientific -> SpecWith (String,Int)
        checkN = checkOne
    checkN (number 3.1415) (3.1415)
    checkN (number 2.31e12) (2.31e12)
    checkN (number (-434.23e-19)) (-434.23e-19)
  describe "nested map" $ do
    let check :: Greskell (HashMap Int (HashMap Text Int)) -> [(Int, (HashMap Text Int))] -> SpecWith (String,Int)
        check = checkRawMapped unGMapEntry
    check (unsafeGreskell "[:]") []
    check (unsafeGreskell "[100: [\"foo\": 55], 200: [:], 300: [\"bar\": 60, \"buzz\": 65]]")
      [ (100, HM.fromList [("foo", 55)]),
        (200, mempty),
        (300, HM.fromList [("bar", 60), ("buzz", 65)])
      ]
  describe "array in map" $ do
    let check :: Greskell (HashMap Text [Int]) -> [(Text, [Int])] -> SpecWith (String,Int)
        check = checkRawMapped unGMapEntry
    check (unsafeGreskell "[:]") []
    check (unsafeGreskell "[\"foo\": [], \"bar\": [1,2,3]]")
      [ ("foo", []),
        ("bar", [1,2,3])
      ]

checkRawMapped :: (AsIterator a, b ~ IteratorItem a, FromGraphSON b, Eq c, Show c)
               => (b -> c)
               -> Greskell a
               -> [c]
               -> SpecWith (String, Int)
checkRawMapped mapResult input expected = specify label $ withClient $ \client -> do
  got <- WS.slurpResults =<< WS.submit client input Nothing
  fmap mapResult got `shouldBe` V.fromList expected
  where
    label = unpack $ toGremlin input

checkRaw :: (AsIterator a, b ~ IteratorItem a, FromGraphSON b, Eq b, Show b)
         => Greskell a
         -> [b]
         -> SpecWith (String, Int)
checkRaw = checkRawMapped id

checkOne :: (AsIterator a, b ~ IteratorItem a, FromGraphSON b, Eq b, Show b)
         => Greskell a -> b -> SpecWith (String, Int)
checkOne input expected = checkRaw input [expected]

requireEnv :: String -> IO String
requireEnv env_key = maybe bail return =<< lookupEnv env_key
  where
    bail = expectationFailure msg >> return ""
      where
        msg = "Set environment variable "++ env_key ++ " for Server test. "

withEnv :: SpecWith (String, Int) -> Spec
withEnv = before $ do
  hostname <- requireEnv "GRESKELL_TEST_HOST"
  port <- fmap read $ requireEnv "GRESKELL_TEST_PORT"
  return (hostname, port)

withClient :: (WS.Client -> IO ()) -> (String, Int) -> IO ()
withClient act (host, port) = bracket (WS.connect host port) WS.close act

spec_comparator :: SpecWith (String,Int)
spec_comparator = do
  let oIncr' :: Greskell (Order Int)
      oIncr' = oIncr
      oDecr' :: Greskell (Order Int)
      oDecr' = oDecr
  checkOne (cCompare oIncr' 20 20) 0
  checkOne (cCompare oIncr' 10 20) (-1)
  checkOne (cCompare oIncr' 20 10) 1
  checkOne (cCompare oDecr' 20 20) 0
  checkOne (cCompare oDecr' 10 20) 1
  checkOne (cCompare oDecr' 20 10) (-1)

spec_predicate :: SpecWith (String,Int)
spec_predicate = do
  checkOne (pTest (pLt 20 `pAnd` pGte 10) (5 :: Greskell Int)) False
  checkOne (pTest (pLt 20 `pAnd` pGte 10) (10 :: Greskell Int)) True
  checkOne (pTest (pLt 20 `pAnd` pGte 10) (15 :: Greskell Int)) True
  checkOne (pTest (pLt 20 `pAnd` pGte 10) (20 :: Greskell Int)) False

iterateTraversal :: GTraversal c s e -> Greskell ()
iterateTraversal gt = unsafeMethodCall (toGreskell gt) "iterate" []

spec_T :: SpecWith (String,Int)
spec_T = describe "T enum" $ do
  specFor' "tId" (gMapT tId) parseEither [(Right 10 :: Either String Int)]
  specFor "tLabel" (gMapT tLabel) ["VLABEL"]
  specFor "tKey" (gMapT tKey <<< gProperties ["vprop"]) ["vprop"]
  specFor' "tValue" (gMapT tValue <<< gProperties ["vprop"]) parseEither [(Right 400 :: Either String Int)]
  where
    gMapT :: Greskell (T a b) -> Walk Transform a b
    gMapT t = unsafeWalk "map" ["{ " <> toGremlin (unsafeMethodCall t "apply" ["it.get()"]) <> " }"]
    prefixedTraversal :: Walk Transform AVertex a -> GTraversal Transform () a
    prefixedTraversal mapper = unsafeGTraversal (prelude <> body)
      where
        prelude = 
          ( "graph = org.apache.tinkerpop.gremlin.tinkergraph.structure.TinkerGraph.open(); "
            <> "g = graph.traversal(); "
            <> "graph.addVertex(id, 10, label, \"VLABEL\"); "
            <> ( toGremlin $ iterateTraversal
                 $ gPropertyV Nothing "vprop" (gvalueInt $ (400 :: Int))
                   ["a" =: ("A" :: Greskell Text), "b" =: ("B" :: Greskell Text)]
                 $. liftWalk $ sV' [] $ source "g"
               ) <> "; "
          )
        body = toGremlin $ mapper $. sV' [] $ source "g"
    specFor' :: (FromGraphSON a, Eq b, Show b) => String -> Walk Transform AVertex a -> (a -> b) -> [b] -> SpecWith (String,Int)
    specFor' desc mapper convResult expected = specify desc $ withClient $ \client -> do
      got <- WS.slurpResults =<< WS.submit client (prefixedTraversal mapper) Nothing
      (fmap convResult got) `shouldBe` V.fromList expected
    specFor :: (FromGraphSON a, Eq a, Show a) => String -> Walk Transform AVertex a -> [a] -> SpecWith (String,Int)
    specFor desc mapper expected = specFor' desc mapper id expected

spec_P :: SpecWith (String,Int)
spec_P = describe "P class" $ specify "pNot, pEq, pTest" $ withClient $ \client -> do
  let p = pNot $ pEq $ number 10
      test v = WS.slurpResults =<< WS.submit client (pTest p $ v) Nothing
  test (number 10) `shouldReturn` V.fromList [False]
  test (number 15) `shouldReturn` V.fromList [True]

-- | This test is supported TinkerPop 3.1.0 and above, because it uses
-- 'gAddE'' function.
spec_graph :: SpecWith (String,Int)
spec_graph = do
  specify "AProperty (edge properties)" $ withClient $ \client -> do
    let trav = gProperties [] $. sE' [] $ source "g"
        prop t = AProperty "condition" $ Right (t :: Text)
        expected = map prop [ ">=0.11.2.1",
                              ">=1.2.2.1",
                              ">=1.2.3"
                            ]
    got <- WS.slurpResults =<< WS.submit client (withPrelude trav) Nothing
    (map (fmap parseEither) $ V.toList got) `shouldMatchList` expected
  specify "AProperty (vertex property meta-properties)" $ withClient $ \client -> do
    let trav = gProperties [] $. gProperties [] $. sV' [] $ source "g"
        prop t = AProperty "date" $ Right (t :: Text)
        expected = map prop [ "2018-04-08",
                              "2018-05-10",
                              "2017-09-20",
                              "2017-12-27",
                              "2017-12-23"
                            ]
    got <- WS.slurpResults =<< WS.submit client (withPrelude trav) Nothing
    (map (fmap parseEither) $ V.toList got) `shouldMatchList` expected
  specify "AEdge" $ withClient $ \client -> do
    let trav = sE' [] $ source "g"
        expE :: Int -> Int -> Text -> (Text,Text,Text,Either String Int, Either String Int, PropertyMapSingle AProperty (Either String Text))
        expE outv inv cond = ("depends_on", "package", "package", Right outv, Right inv, props)
          where
            props = fromProperties [AProperty "condition" $ Right cond]
        getE e = ( aeLabel e, aeInVLabel e, aeOutVLabel e,
                   parseEither $ aeOutV e, parseEither $ aeInV e,
                   fmap parseEither $ aeProperties e
                 )
        expected = [ expE 1 2 ">=0.11.2.1",
                     expE 1 3 ">=1.2.2.1",
                     expE 2 3 ">=1.2.3"
                   ]
    got <- WS.slurpResults =<< WS.submit client (withPrelude trav) Nothing
    (map getE $ V.toList got) `shouldMatchList` expected
  let getVP vp = (avpLabel vp, parseEither $ avpValue vp, fmap parseEither $ avpProperties vp)
  specify "AVertexProperty" $ withClient $ \client -> do
    let trav = gProperties [] $. sV' [] $ source "g"
        expName :: Text -> (Text,Either String Text, PropertyMapSingle AProperty (Either String Text))
        expName val = ("name", Right val, mempty)
        expVer :: Text -> Text -> (Text,Either String Text, PropertyMapSingle AProperty (Either String Text))
        expVer val date = ("version", Right val, fromProperties [AProperty "date" $ Right date])
        expected = [ expName "greskell",
                     expName "aeson",
                     expName "text",
                     expVer "0.1.1.0" "2018-04-08",
                     expVer "1.3.1.1" "2018-05-10",
                     expVer "1.2.2.0" "2017-09-20",
                     expVer "1.2.3.0" "2017-12-27",
                     expVer "1.2.2.0" "2017-12-23"
                   ]
    got <- WS.slurpResults =<< WS.submit client (withPrelude trav) Nothing
    (map getVP $ V.toList got) `shouldMatchList` expected
  specify "AVertex" $ withClient $ \client -> do
    let trav = sV' [] $ source "g"
        getV v = ( parseEither $ avId v,
                   avLabel v,
                   sort' $ map getVP $ allProperties $ avProperties v
                 )
        sort' = sortBy $ \(k1, v1, _) (k2, v2, _) -> compare (show k1,show v1) (show k2,show v2)
        expV :: Int -> Text -> [(Text, Text)] -> (Either String Int,Text,[(Text,Either String Text,PropertyMapSingle AProperty (Either String Text))])
        expV vid name ver_dates = (Right vid, "package", ("name", Right name, mempty) : map toVP ver_dates)
        toVP (ver, date) = ("version", Right ver, fromProperties [AProperty "date" $ Right date])
        expected = [ expV 1 "greskell" [("0.1.1.0", "2018-04-08")],
                     expV 2 "aeson" [("1.2.2.0", "2017-09-20"), ("1.3.1.1", "2018-05-10")],
                     expV 3 "text" [("1.2.2.0", "2017-12-23"), ("1.2.3.0", "2017-12-27")]
                   ]
    got <- WS.slurpResults =<< WS.submit client (withPrelude trav) Nothing
    (map getV $ V.toList got) `shouldMatchList` expected
  where
    withPrelude :: (ToGreskell a) => a -> Greskell (GreskellReturn a)
    withPrelude orig = unsafeGreskell (toGremlin prelude <> toGremlin orig)
    prelude :: Greskell ()
    prelude = unsafeGreskell $ mconcat $ map (<> "; ")
              ( [ "graph = org.apache.tinkerpop.gremlin.tinkergraph.structure.TinkerGraph.open()",
                  "g = graph.traversal()",
                  "graph.addVertex(id, 1, label, 'package')",
                  "graph.addVertex(id, 2, label, 'package')",
                  "graph.addVertex(id, 3, label, 'package')",
                  finalize $ setName 1 "greskell",
                  finalize $ setName 2 "aeson",
                  finalize $ setName 3 "text",
                  finalize $ dependsOn 1 2 ">=0.11.2.1",
                  finalize $ dependsOn 1 3 ">=1.2.2.1",
                  finalize $ dependsOn 2 3 ">=1.2.3"
                ]
                ++ addVersion 1 "0.1.1.0" "2018-04-08"
                ++ addVersion 2 "1.3.1.1" "2018-05-10"
                ++ addVersion 2 "1.2.2.0" "2017-09-20"
                ++ addVersion 3 "1.2.3.0" "2017-12-27"
                ++ addVersion 3 "1.2.2.0" "2017-12-23"
              )
    finalize :: GTraversal c s e -> Text
    finalize gt = toGremlin $ iterateTraversal gt
    num :: Integer -> Greskell GValue
    num = gvalueInt
    setName :: Integer -> Greskell Text -> GTraversal SideEffect () AVertex
    setName vid name = gProperty "name" name $. liftWalk $ sV' [num vid] $ source "g"
    dependsOn :: Integer -> Integer -> Greskell Text -> GTraversal SideEffect () AEdge
    dependsOn from_id to_id version_cond =
      gProperty "condition" version_cond
      $. (gAddE' "depends_on" $ gTo (gV' [num to_id]))
      $. liftWalk $ sV' [num from_id] $ source "g"
    addVersion :: Integer -> Greskell Text -> Greskell Text -> [Text]
    addVersion vid ver date =
      [ finalize $ gPropertyV (Just cList) "version" ver ["date" =: date] $. liftWalk $ sV' [num vid] $ source "g"
      ]