module GraqlQuerySpec ( spec ) where import Control.Exception (Exception, displayException) import Data.Either (isLeft) import Data.Map (member) import Data.Text (pack) import Env import Grakn import Test.Hspec aKnowledgeBaseContainingTypesAndInstances :: IO Client aKnowledgeBaseContainingTypesAndInstances = do client <- givenAKnowledgeBase envDefine "person sub entity, has name; name sub attribute, datatype string;" envInsert "$alice isa person, has name \"Alice\";" return client givenAKnowledgeBase :: IO Client givenAKnowledgeBase = Client defaultUrl <$> envKeyspace x :: Var x = var $ pack "x" spec :: Spec spec = before aKnowledgeBaseContainingTypesAndInstances $ describe "As a Grakn Developer, I should be able to interact with a Grakn knowledge base using Graql queries" $ do it "Valid Define Query" $ \client -> do response <- execute client "define $x label dog sub entity;" typeIsInTheKB "dog" response `hasVar` x it "Redundant Define Query" $ \client -> do response <- execute client "define $x label person sub entity;" response `hasVar` x it "Valid Insert Query" $ \client -> do response <- execute client "insert $bob isa person, has name \"Bob\";" instanceIsInTheKB "name" "Bob" response `hasAnswers` 1 it "Invalid Insert Query" $ \client -> do response <- execute client "insert $dunstan isa dog, has name \"Dunstan\";" isAnError response it "Get Query With Empty Response" $ \client -> do response <- execute client "match $x isa person, has name \"Precy\"; get;" response `hasAnswers` 0 it "Get Query With Non-Empty Response" $ \client -> do response <- execute client "match $x isa person, has name \"Alice\"; get;" response `hasAnswers` 1 it "Aggregate Ask Query With False Response" $ \client -> do response <- execute client "match $x has name \"Precy\"; aggregate ask;" response `is` AskResult False it "Aggregate Ask Query With True Response" $ \client -> do response <- execute client "match $x has name \"Alice\"; aggregate ask;" response `is` AskResult True it "Aggregate Query" $ \client -> do response <- execute client "match $x isa person; aggregate count;" response `is` CountResult 1 it "Compute Query" $ \client -> do response <- execute client "compute count in person;" response `is` CountResult 1 it "Successful Undefine Query" $ \client -> do envDefine "dog sub entity;" response <- execute client "undefine dog sub entity;" response `is` DeleteResult it "Unsuccessful Undefine Query" $ \client -> do response <- execute client "undefine person sub entity;" isAnError response it "Delete Query for non Existent Concept" $ \client -> do response <- execute client "match $x has name \"Precy\"; delete $x;" response `is` DeleteResult it "Inference on by default" $ \client -> do envDefine "weird-rule sub rule when { $person has name \"Alice\"; } then { $person has name \"A\"; };" response <- execute client "match $x has name \"A\"; get;" response `hasAnswers` 1 it "Inference can be disabled" $ \client -> do envDefine "weird-rule sub rule when { $person has name \"Alice\"; } then { $person has name \"A\"; };" response <- execute_ Options {infer = False} client "match $x has name \"A\"; get;" response `hasAnswers` 0 is :: (Exception e, Show a, Eq a) => Either e a -> a -> Expectation response `is` expected = case response of Right answer -> answer `shouldBe` expected Left err -> expectationFailure (displayException err) isAnError :: Either t a -> Expectation isAnError response = isLeft response `shouldBe` True typeIsInTheKB :: String -> Expectation typeIsInTheKB label = do isIn <- envCheckType label isIn `shouldBe` True instanceIsInTheKB :: String -> String -> Expectation instanceIsInTheKB res val = do isIn <- envCheckInstance res val isIn `shouldBe` True hasAnswers :: Exception e => Either e Result -> Int -> Expectation response `hasAnswers` n = case response of Right (AnswersResult answers) -> length answers `shouldBe` n Left err -> expectationFailure (displayException err) x -> expectationFailure (show x) hasVar :: Exception e => Either e Result -> Var -> Expectation response `hasVar` var = case response of Right (AnswerResult answer) -> member var answer `shouldBe` True Left err -> expectationFailure (displayException err) x -> expectationFailure (show x)