{-# LANGUAGE TypeApplications #-} module SuperUserSpark.ParserSpec where import TestImport hiding (succeeds) import Data.Either (isLeft, isRight) import Data.List (intercalate) import Text.Parsec import SuperUserSpark.CoreTypes import SuperUserSpark.Language.Gen () import SuperUserSpark.Language.Types import SuperUserSpark.Parser.Gen import SuperUserSpark.Parser.Internal import SuperUserSpark.Parser.TestUtils import TestUtils spec :: Spec spec = parallel $ do instanceSpec blankspaceParserTests enclosingCharacterTests delimiterTests identifierParserTests commentParserTests pathParserTests declarationParserTests parserBlackBoxTests toplevelParserTests enclosingCharacterTests :: Spec enclosingCharacterTests = do describe "inBraces" $ do it "succeeds for cases where we enclose braces around a string without braces" $ do forAll (listOf1 arbitrary `suchThat` (\c -> c /= "{" && c /= "}")) (\word -> parseShouldSucceedAs (inBraces $ string word) ("{" ++ word ++ "}") word) describe "inQuotes" $ do it "succeeds for cases where we enclose quotes around a string without quotes" $ do forAll (listOf1 arbitrary `suchThat` (/= "\"")) $ \word -> parseShouldSucceedAs (inQuotes $ string word) ("\"" ++ word ++ "\"") word instanceSpec :: Spec instanceSpec = do eqSpec @Card genValidSpec @Card eqSpec @Declaration genValidSpec @Declaration eqSpec @CardNameReference genValidSpec @CardNameReference eqSpec @CardFileReference genValidSpec @CardFileReference eqSpec @CardReference genValidSpec @CardReference eqSpec @SparkFile genValidSpec @SparkFile blankspaceParserTests :: Spec blankspaceParserTests = do describe "eol" $ do let s = shouldSucceed eol it "succeeds for Linux line endings" $ do s "\n" it "succeeds for Windows line endings" $ do s "\r\n" it "succeeds for Mac line endings" $ do s "\r" let f = shouldFail eol it "fails for the empty string" $ do f "" it "fails for spaces" $ do forAll (listOf generateSpace) (\ss -> f ss) it "fails for tabs" $ do forAll (listOf generateTab) (\ss -> f ss) it "fails for linespace" $ do forAll generateLineSpace (\ls -> f ls) describe "linespace" $ do let s = shouldSucceed linespace it "succeeds for spaces" $ do forAll (listOf generateSpace) s it "succeeds for tabs" $ do forAll (listOf generateTab) s it "succeeds for mixtures of spaces and tabs" $ do forAll generateLineSpace s let f = shouldSucceed whitespace it "fails for line ending characters" $ do forAll (listOf $ oneof [generateCarriageReturn, generateLineFeed]) f it "fails for any non-linespace, even if there's linespace in it" $ forAll (listOf1 generateNormalCharacter) $ \ls -> forAll generateLineSpace $ \ls1 -> forAll generateLineSpace $ \ls2 -> shouldFail linespace (ls1 ++ ls ++ ls2) describe "whitespace" $ do let s = shouldSucceed whitespace it "succeeds for spaces" $ do forAll (listOf generateSpace) s it "succeeds for tabs" $ do forAll (listOf generateTab) s it "succeeds carriage returns" $ do forAll (listOf generateCarriageReturn) s it "succeeds line feeds" $ do forAll (listOf generateLineFeed) s it "succeeds for mixtures of spaces, tabs, carriage returns and line feeds" $ do forAll generateWhiteSpace s it "fails for any non-whitespace, even if there's whitespace in it" $ do forAll (listOf1 generateNormalCharacter) $ \ls -> forAll generateWhiteSpace $ \ws1 -> forAll generateWhiteSpace $ \ws2 -> shouldFail whitespace (ws1 ++ ls ++ ws2) describe "inLineSpace" $ do it "succeeds for cases where we append whitespace to the front and back of non-whitespace" $ do forAll generateLineSpace $ \ws1 -> forAll generateLineSpace $ \ws2 -> forAll (listOf1 generateNormalCharacter) $ \ls -> parseShouldSucceedAs (inLineSpace $ string ls) (ws1 ++ ls ++ ws2) ls describe "inWhiteSpace" $ do it "succeeds for cases where we append whitespace to the front and back of non-whitespace" $ do forAll generateWhiteSpace $ \ws1 -> forAll generateWhiteSpace $ \ws2 -> forAll (listOf1 generateNormalCharacter) $ \ls -> parseShouldSucceedAs (inWhiteSpace $ string ls) (ws1 ++ ls ++ ws2) ls delimiterTests :: Spec delimiterTests = do describe "delim" $ do it "succeeds on a semicolon" $ do shouldSucceed delim ";" it "succeeds on an eol" $ do once $ forAll (arbitrary `suchThat` succeeds eol) (shouldSucceed delim) identifierParserTests :: Spec identifierParserTests = do describe "plainIdentifier" $ do it "succeeds for generated plain identifiers" $ do forAll generatePlainIdentifier $ \(e, a) -> parseShouldSucceedAs plainIdentifier e a let pti = shouldSucceed plainIdentifier it "succeeds for these examples" $ do pti "bash" pti "card" pti ".bashrc" pti "xmonad.hs" it "fails for generated quoted identifiers" $ do forAll generateQuotedIdentifier $ \(e, _) -> shouldFail plainIdentifier e describe "quotedIdentifier" $ do it "succeeds for generated plain identifiers surrounded in quotes" $ do forAll generatePlainIdentifier $ \(e, a) -> parseShouldSucceedAs quotedIdentifier ("\"" ++ e ++ "\"") a it "succeeds for generated quoted identifiers" $ do forAll generateQuotedIdentifier $ \(e, a) -> parseShouldSucceedAs quotedIdentifier e a let pti i = parseShouldSucceedAs quotedIdentifier ("\"" ++ i ++ "\"") i it "succeeds for these examples" $ do pti "bashrc" pti "with spaces" it "fails for generated plain identifiers" $ do forAll generatePlainIdentifier $ \(e, _) -> shouldFail quotedIdentifier e it "fails for generated identifiers with just one quote" $ do forAll generatePlainIdentifier $ \(e, _) -> shouldFail quotedIdentifier ("\"" ++ e) .&&. shouldFail quotedIdentifier (e ++ "\"") describe "identifier" $ do it "succeeds for generated identifiers" $ do forAll generateIdentifier $ \(e, a) -> parseShouldSucceedAs identifier e a commentParserTests :: Spec commentParserTests = do describe "eatComments" $ do it "should succeed unchanged on anything without comments" $ do property $ \s -> (not $ succeedsAnywhere comment s) ==> parseShouldSucceedAs eatComments s s let (-=>) e a = parseShouldSucceedAs eatComments e a it "successfully removes comments in these strings" $ do "abc#def\nghi" -=> "abcghi" "abc# This is a bigger comment \r\nghi" -=> "abcghi" "abc[[def]]ghi" -=> "abcghi" "abc[[ This is a bigger comment ]]ghi" -=> "abcghi" "Heavy[[use]]of#comments\n." -=> "Heavyof." describe "notComment" $ do it "should succeed for any string that doesn't contain comments" $ do property $ \s -> (not $ succeedsAnywhere comment s) ==> parseShouldSucceedAs notComment s s describe "lineComment" $ do it "succeeds for generated line comments" $ do forAll generateLineComment $ \(e, a) -> parseShouldSucceedAs lineComment e a it "succeeds for these test cases" $ do parseShouldSucceedAs lineComment "#a\n" "a" parseShouldSucceedAs lineComment "# This is a comment\n" " This is a comment" parseShouldSucceedAs lineComment "## This is a comment with two comment signs.\n" "# This is a comment with two comment signs." parseShouldSucceedAs lineComment "# with other eol\r\n" " with other eol" describe "blockComment" $ do it "succeeds for generated block comments" $ do forAll generateBlockComment $ \(e, a) -> parseShouldSucceedAs blockComment e a it "succeeds of these test cases" $ do parseShouldSucceedAs blockComment "[[a]]" "a" parseShouldSucceedAs blockComment "[[ This is a block comment. ]]" " This is a block comment. " parseShouldSucceedAs blockComment "[[ [This is a [block] comment containing brackets.] ]]" " [This is a [block] comment containing brackets.] " describe "comment" $ do it "succeeds for generated line comments" $ do forAll generateLineComment $ \(e, a) -> parseShouldSucceedAs comment e a it "succeeds for generated block comments" $ do forAll generateBlockComment $ \(e, a) -> parseShouldSucceedAs comment e a pathParserTests :: Spec pathParserTests = do describe "filepath" $ do it "succeeds for generated filepaths" $ do forAll generateFilePath $ \(e, a) -> parseShouldSucceedAs filepath e a it "succeeds for this quoted filepath with a space in it" $ do parseShouldSucceedAs filepath "\"/home/user/with spaces\"" "/home/user/with spaces" let s = shouldSucceed filepath it "succeeds for this file without an extension" $ do s "withoutExtension" it "succeeds for this simple file" $ do s "test.txt" it "succeeds for this simple file with a long extension" $ do s "file.somelongextension" it "succeeds for this absolute filepath" $ do s "/home/user/test.txt" it "succeeds for this absolute filepath with a long extension" $ do s "/home/user/file.somelongextension" it "succeeds for this absolute filepath with multiple extensions" $ do s "/home/user/test.multiple.extensions" it "succeeds for this relative filepath with a double dot" $ do s "/home/user/../user/test.txt" let f = shouldFail filepath it "fails for just a slash" $ do f "/" it "fails for strings ending in a slash" $ do property $ \s_ -> f (s_ ++ "/") describe "directory" $ do it "succeeds for generated directories" $ do forAll generateDirectory $ \(e, a) -> parseShouldSucceedAs directory e a let s = shouldSucceed directory it "succeeds for the home directory" $ do s "~" it "succeeds for this relative directory" $ do s "directory" it "succeeds for this absolute directory" $ do s "/home/user" it "succeeds for these directories in the home directory" $ do s "~/.vim" s "~/Dropbox" s "~/.xmonad" let f = shouldFail directory it "fails for just a slash" $ do f "/" it "fails for strings ending in a slash" $ do property $ \s_ -> f (s_ ++ "/") declarationParserTests :: Spec declarationParserTests = do describe "cardName" $ do it "succeeds on every card name that we generate" $ do forAll generateCardName $ \(a, e) -> parseShouldSucceedAs cardNameP a e describe "card" $ do let pc = parseShouldSucceedAs card it "succeeds on this card with an empty name correctly" $ do pc "card \"\" {}" $ Card "" (Block []) it "succeeds on this compressed empty cards" $ forAll generateCardName $ \(a, e) -> parseShouldSucceedAs card ("card" ++ a ++ "{}") $ Card e (Block []) it "succeeds on empty cards with whitespace around the name" $ forAll generateCardName $ \(a, e) -> forAll (twice generateWhiteSpace) $ \(ws1, ws2) -> parseShouldSucceedAs card ("card" ++ ws1 ++ a ++ ws2 ++ "{}") $ Card e (Block []) it "succeeds on empty cards with whitespace between the brackets" $ forAll generateCardName $ \(a, e) -> forAll generateWhiteSpace $ \ws -> parseShouldSucceedAs card ("card" ++ a ++ "{" ++ ws ++ "}") $ Card e (Block []) it "fails on any card with an empty body" $ forAll generateCardName $ \(a, _) -> forAll generateWhiteSpace $ \ws -> shouldFail card ("card" ++ a ++ ws) it "succeeds on this complicated example" $ parseShouldSucceedAs card "card complicated {\n alternatives $(HOST) shared\n hello l-> goodbye\n into $(HOME)\n outof depot\n spark card othercard\n kind link\n {\n one c-> more\n source -> destination\n file\n }\n}" $ Card "complicated" $ Block [ Alternatives ["$(HOST)", "shared"] , Deploy "hello" "goodbye" (Just LinkDeployment) , IntoDir "$(HOME)" , OutofDir "depot" , SparkOff (CardName (CardNameReference "othercard")) , DeployKindOverride LinkDeployment , Block [ Deploy "one" "more" (Just CopyDeployment) , Deploy "source" "destination" Nothing , Deploy "file" "file" Nothing ] ] describe "declarations" $ do it "succeeds for generated declarations'" pending let s = parseShouldSucceedAs declarations it "succeeds for these cases" $ s "into dir;outof dir" [IntoDir "dir", OutofDir "dir"] describe "declaration" $ do it "succeeds for generated declarations" pending let s = parseShouldSucceedAs declaration it "succeeds for these cases" $ do s "into directory" (IntoDir "directory") s "outof \"other directory\"" (OutofDir "other directory") s "{}" (Block []) s "{{{};{};{}}}" (Block [Block [Block [], Block [], Block []]]) s "\"hi i'm a file\"c->iamthedestination" (Deploy "hi i'm a file" "iamthedestination" (Just CopyDeployment)) describe "block" $ do it "succeeds for empty blocks" $ parseShouldSucceedAs block "{}" (Block []) it "succeeds for a doubly nested empty block" $ parseShouldSucceedAs block "{{}}" (Block [Block []]) it "succeeds for a triply nested empty block" $ parseShouldSucceedAs block "{{{}}}" (Block [Block [Block []]]) let s = parseShouldSucceedAs block it "succeeds for these cases" $ do s "{into ~;bashrc -> .bashrc}" (Block [IntoDir "~", Deploy "bashrc" ".bashrc" Nothing]) s "{\n into \"~\"\n \"xmonad\" -> \".xmonad\"\n}" (Block [IntoDir "~", Deploy "xmonad" ".xmonad" Nothing]) describe "sparkOff" $ do it "succeeds for generated sparkOff declarations" pending let s f g = parseShouldSucceedAs sparkOff f (SparkOff $ CardName $ CardNameReference g) it "succeeds for these cases" $ do s "spark card name" "name" s "sparkcardname" "name" s "spark card \"name with spaces\"" "name with spaces" describe "intoDir" $ do it "succeeds for generated into declarations" $ forAll generateLineSpace $ \ls -> forAll generateDirectory $ \(d, da) -> parseShouldSucceedAs intoDir ("into" ++ ls ++ d) (IntoDir da) let s f g = parseShouldSucceedAs intoDir f (IntoDir g) it "succeeds for these cases" $ do s "into \"bash\"" "bash" s "into\t.xmonad" ".xmonad" s "into ~" "~" describe "outOfDir" $ do it "succeeds for generated outof declarations" $ forAll generateLineSpace $ \ls -> forAll generateDirectory $ \(d, da) -> parseShouldSucceedAs outOfDir ("outof" ++ ls ++ d) (OutofDir da) let s f g = parseShouldSucceedAs outOfDir f (OutofDir g) it "succeeds for these cases" $ do s "outof bash" "bash" s "outof\t.xmonad" ".xmonad" describe "alternatives" $ it "succeeds for generated alternatives declarations with single spaces" $ forAll (listOf1 generateDirectory) $ \ds -> let (des, das) = unzip ds in parseShouldSucceedAs alternatives ("alternatives" ++ " " ++ unwords des) (Alternatives das) describe "deployment" $ do it "succeeds for short deployments" pending it "succeeds for long deployments" pending describe "shortDeployment" $ do it "succeeds for any filepath with an identity deployment" $ property $ \f -> succeeds filepath f ==> parseShouldSucceedAs shortDeployment f (Deploy f f Nothing) it "succeeds for generated filepaths with an identity deployment" $ forAll generateFilePath $ \(f, g) -> parseShouldSucceedAs shortDeployment f (Deploy g g Nothing) it "succeeds for any directory with an identity deployment" $ property $ \f -> succeeds directory f ==> parseShouldSucceedAs shortDeployment f (Deploy f f Nothing) it "succeeds for generated directories with an identity deployment" $ forAll generateDirectory $ \(f, g) -> parseShouldSucceedAs shortDeployment f (Deploy g g Nothing) let s f = parseShouldSucceedAs shortDeployment f (Deploy f f Nothing) it "succeeds as-is for these cases" $ do s "file.txt" s "xmonad.hs" s "/home/user/.bashrc" describe "longDeployment" $ do it "succeeds for generated long deployments with quoted identifiers" $ forAll generateDeploymentKindSymbol $ \dks -> forAll generateLineSpace $ \ls1 -> forAll generateLineSpace $ \ls2 -> forAll generateQuotedIdentifier $ \(fp1, fp1a) -> forAll generateQuotedIdentifier $ \(fp2, fp2a) -> case parseWithoutSource deploymentKind dks of Left _ -> fail "There was a problem with parsing the deployment kind" Right dk -> parseShouldSucceedAs longDeployment (fp1 ++ ls1 ++ dks ++ ls2 ++ fp2) (Deploy fp1a fp2a dk) it "succeeds for single-space-separated long deployments with gerenated plain identifiers" $ pendingWith "This would go wrong with plain identifiers they can end with \'l\' or \'c\'. Make sure to document this behaviour and write another test with plain identifiers." let s f g h i = parseShouldSucceedAs longDeployment f (Deploy g h i) it "succeeds for these cases" $ do s "\"something with spaces\"c->/home/user/test.txt" "something with spaces" "/home/user/test.txt" (Just CopyDeployment) s "\"xmonad.hs\"l-> /home/user/.xmonad/xmonad.hs" "xmonad.hs" "/home/user/.xmonad/xmonad.hs" (Just LinkDeployment) s "bashrc\t->\t/home/user/.bashrc" "bashrc" "/home/user/.bashrc" Nothing describe "deploymentKind" $ do let (-=>) = parseShouldSucceedAs deploymentKind it "succeeds for the link deployment kind" $ "l->" -=> Just LinkDeployment it "succeeds for the copy deployment kind" $ "c->" -=> Just CopyDeployment it "succeeds for the default deployment kind" $ "->" -=> Nothing it "fails for anything else" $ property $ \s -> notElem s ["l->", "c->", "->"] ==> shouldFail deploymentKind s cardReferenceParserTests :: Spec cardReferenceParserTests = do describe "compilerCardReference" pend describe "deployerCardReference" pend describe "compiledCardReference" pend describe "cardReference" pend describe "cardNameReference" $ do pend let s f g = parseShouldSucceedAs cardNameReference f (CardNameReference g) it "succeeds for these cases" $ do s "card name" "name" s "cardname" "name" s "card \"name with spaces\"" "name with spaces" describe "cardFileReference" $ do pend let s = parseShouldSucceedAs cardFileReference it "succeeds for these cases" $ do s "file card.sus" (CardFileReference "card.sus" Nothing) s "file card.sus name" (CardFileReference "card.sus" $ Just $ CardNameReference "name") describe "unprefixedCardFileReference" pend parserBlackBoxTests :: Spec parserBlackBoxTests = do testRecoursesDir <- runIO $ resolveDir' "test_resources" describe "Correct succesful parse examples" $ do let dirs = map (testRecoursesDir ) [shouldParseDir, shouldCompileDir, shouldNotCompileDir] forFileInDirss dirs $ concerningContents $ \f contents -> it (toFilePath f) $ parseCardFile f contents `shouldSatisfy` isRight describe "Correct unsuccesfull parse examples" $ do let dirs = map (testRecoursesDir ) [shouldNotParseDir] forFileInDirss dirs $ concerningContents $ \f contents -> it (toFilePath f) $ parseCardFile f contents `shouldSatisfy` isLeft toplevelParserTests :: Spec toplevelParserTests = do describe "sparkFile" $ do it "Only ever produces valid SparkFile's" $ validIfSucceeds2 parseCardFile pend describe "resetPosition" pend