BinderSpec.hs

module Data.Greskell.BinderSpec (main,spec) where

import Control.Applicative ((<$>), (<*>))
import Control.Monad (forM_)
import Data.Aeson (toJSON)
import qualified Data.Aeson.KeyMap as KM
import qualified Data.Aeson.Key as Key
import Data.Text (unpack)
import Test.Hspec

import Data.Greskell.AsLabel (AsLabel)
import Data.Greskell.Greskell (toGremlin, unsafeGreskell, Greskell)
import Data.Greskell.Binder (Binder, newBind, runBinder, newAsLabel)

main :: IO ()
main = hspec spec

shouldBeVariable :: Greskell a -> IO ()
shouldBeVariable got_greskell =
  case unpack $ toGremlin got_greskell of
   [] -> expectationFailure "Expect a Gremlin variable, but got empty script."
   (h : rest) -> do
     h `shouldSatisfy` (`elem` variableHeads)
     forM_ rest (`shouldSatisfy` (`elem` variableRests))
  where
    variableHeads = '_' : (['a' .. 'z'] ++ ['A' .. 'Z'])
    variableRests = variableHeads ++ ['0' .. '9']

toKey :: Greskell a -> Key.Key
toKey = Key.fromText . toGremlin

spec :: Spec
spec = describe "Binder" $ do
  it "should keep bound values" $ do
    let b = do
          v1 <- newBind (100 :: Int)
          v2 <- newBind "hogehoge"
          return (v1, v2)
        ((got_v1, got_v2), got_bind) = runBinder b
    toGremlin got_v1 `shouldNotBe` toGremlin got_v2
    shouldBeVariable got_v1
    shouldBeVariable got_v2
    got_bind `shouldBe` KM.fromList [ (toKey got_v1, toJSON (100 :: Int)),
                                      (toKey got_v2, toJSON "hogehoge")
                                    ]
  it "should compose and produce new variables" $ do
    let b = newBind "foobar"
        ((got_v1, got_v2), got_bind) = runBinder $ ((,) <$> b <*> b)
    toGremlin got_v1 `shouldNotBe` toGremlin got_v2
    shouldBeVariable got_v1
    shouldBeVariable got_v2
    got_bind `shouldBe` KM.fromList [ (toKey got_v1, toJSON "foobar"),
                                      (toKey got_v2, toJSON "foobar")
                                    ]
  it "should also be able to produce AsLabels" $ do
    let newIntLabel :: Binder (AsLabel Int)
        newIntLabel = newAsLabel
        newVar = newBind "foobar"
        ((got_v1, got_l1, got_v2, got_l2), _) =
          runBinder $ ((,,,) <$> newVar <*> newIntLabel <*> newVar <*> newIntLabel)
    shouldBeVariable got_v1
    shouldBeVariable got_v2
    toGremlin got_v1 `shouldNotBe` toGremlin got_v2
    got_l1 `shouldNotBe` got_l2