diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -16,3 +16,5 @@ If you would like to have your name on this list, just send a pull request. - [NorfairKing](https://github.com/NorfairKing/sus-depot) +- [plietar](https://github.com/plietar/dotfiles) +- [mkirsche](https://github.com/mkirsche/sus-depot) diff --git a/super-user-spark.cabal b/super-user-spark.cabal --- a/super-user-spark.cabal +++ b/super-user-spark.cabal @@ -1,5 +1,5 @@ name: super-user-spark -version: 0.2.0.1 +version: 0.2.0.2 license: MIT license-file: LICENSE description: Configure your dotfile deployment with a DSL. @@ -54,6 +54,8 @@ type: exitcode-stdio-1.0 main-is: TestMain.hs hs-source-dirs: src, test + other-modules: Parser.Test + , Compiler.Test build-depends: base >= 4.6 && < 4.9 , HTF >= 0.13 && < 0.14 , HUnit >= 1.2 && < 1.3 diff --git a/test/Compiler/Test.hs b/test/Compiler/Test.hs new file mode 100644 --- /dev/null +++ b/test/Compiler/Test.hs @@ -0,0 +1,39 @@ +{-# OPTIONS_GHC -F -pgmF htfpp #-} +module Compiler.Test (htf_thisModulesTests) where + +import Test.Framework +import Test.HUnit (Assertion) + +import Compiler +import Types + +{- +compilerTest :: [Declaration] -> [Deployment] -> Assertion +compilerTest dc dp = assertEqual dp $ compile dc + +test_compiler_empty = compilerTest [] [] + +test_compiler_single_deploy = compilerTest [Deploy "bashrc" ".bashrc" LinkDeployment] [Link "bashrc" ".bashrc"] +--test_compiler_single_spark = compilerTest +test_compiler_single_into = compilerTest [IntoDir "~/.xmonad"] [] +test_compiler_single_outof = compilerTest [OutofDir "bash"] [] + +test_compiler_into = compilerTest + [IntoDir "~" + ,Deploy "bashrc" ".bashrc" LinkDeployment + ,IntoDir "~/.xmonad" + ,Deploy "xmonad.hs" "xmonad.hs" LinkDeployment] + [Link "bashrc" "~/.bashrc", Link "xmonad.hs" "~/.xmonad/xmonad.hs"] + +test_compiler_outof = compilerTest + [OutofDir "bash" + ,Deploy "bashrc" "~/.bashrc" LinkDeployment] + [Link "bash/bashrc" "~/.bashrc"] + +test_compiler_both = compilerTest + [IntoDir "~/.xmonad" + ,OutofDir "xmonad" + ,Deploy "xmonad.hs" "xmonad.hs" LinkDeployment] + [Link "xmonad/xmonad.hs" "~/.xmonad/xmonad.hs"] +-} + diff --git a/test/Parser/Test.hs b/test/Parser/Test.hs new file mode 100644 --- /dev/null +++ b/test/Parser/Test.hs @@ -0,0 +1,388 @@ +{-# OPTIONS_GHC -F -pgmF htfpp #-} +module Parser.Test (htf_thisModulesTests) where + +import Control.Applicative +import Test.Framework +import Test.HUnit (Assertion) +import Text.ParserCombinators.Parsec + +import Parser +import Types + + +testFileName = "parser testinput" + +--[ Parser helper functions ]--- + +parserTest :: (Show a, Eq a) => Parser a -> a -> String -> Assertion +parserTest p result str = assertEqual (Right result) parseResult + where parseResult = parse p testFileName str + +parserTests :: (Show a, Eq a) => Parser a -> [(a, [String])] -> Assertion +parserTests p tests = sequence_ $ map (\(result, strs) -> sequence_ $ map (\s -> assertEqual (Right result) (parseResult s)) strs) tests + where parseResult = parse p testFileName + +parseItself :: Parser String -> String -> Assertion +parseItself p str = parserTest p str str + +parseSuccess :: Parser String -> String -> Assertion +parseSuccess p str = (assertRight $ parse (p <* eof) testFileName str) >> return () + +parseFail :: Parser String -> String -> Assertion +parseFail p str = (assertLeft $ parse (p <* eof) testFileName str) >> return () + +parseItselfs :: Parser String -> [String] -> Assertion +parseItselfs p strs = sequence_ $ map (parseItself p) strs + +parseSuccesses :: Parser String -> [String] -> Assertion +parseSuccesses p strs = sequence_ $ map (parseSuccess p) strs + +parseFails :: Parser String -> [String] -> Assertion +parseFails p strs = sequence_ $ map (parseFail p) strs + + + + +--[ Language ]-- + +test_card_empty = parserTests card $ + [ + (Card "" testFileName (Block []), [ + "card \"\" {}" + ] + ) + , (Card "hi" testFileName (Block []), [ + "card hi {}" + , "card \"hi\" {}" + , "card \nhi\n{}" + ] + ) + , (Card "something spaced" testFileName (Block []), [ + "card \"something spaced\" {}" + , " card \"something spaced\" {\n}" + , " \t \n card \n\r \"something spaced\" \t\n{\n\r}" + ] + ) + ] + +test_card_complicated = parserTests card $ + [ + (myCard, + [ + "card testcard {\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}" + ] + ) + ] + where + myCard = Card "testcard" testFileName $ 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 + ] + ] + + +test_Block = parserTests block $ + [ + (Block [IntoDir "~", Deploy "bashrc" ".bashrc" Nothing], + [ + "{into ~;bashrc -> .bashrc}" + , "{into ~ ; \tbashrc -> .bashrc;}" + , "{ into ~\n\tbashrc -> .bashrc}" + , "{\n\tinto \"~\"\nbashrc -> .bashrc}" + , "{\n into ~\n bashrc -> .bashrc\n}" + , "{\n into \"~\"\n \"bashrc\" -> \".bashrc\"\n}" + ] + ) + ] + +test_sparkOff = parserTests sparkOff $ + [ + (SparkOff (CardName $ CardNameReference "name"), + [ + "spark card name" + , "sparkcard \"name\"" + , "spark\tcard\tname" + , "spark \tcard\t \tname" + ] + ) + ] + +test_cardNameReference = parserTests cardNameReference $ + [ + (CardNameReference "name", + [ + "card name" + , "card \"name\"" + , "card\tname" + , "card\t \tname" + ] + ) + ] + +test_cardFileReference = parserTests cardFileReference $ + [ + (CardFileReference "card.sus" Nothing, + [ + "file card.sus" + , "file \"card.sus\"" + , "file\tcard.sus" + , "file \t card.sus" + ] + ) + , (CardFileReference "card.sus" (Just $ CardNameReference "name"), + [ + "file card.sus name" + , "file \"card.sus\" \"name\"" + , "file\tcard.sus\tname" + , "file \t card.sus \t name" + ] + ) + ] + +test_intoDir = parserTests intoDir $ + [ + (IntoDir "~", [ + "into ~" + , "into \t ~" + , "into\t \t ~" + , "into \"~\"" + ] + ) + , (IntoDir "~/.xmonad", [ + "into ~/.xmonad" + , "into \"~/.xmonad\"" + , "into ~/.xmonad/" + ] + ) + ] + +test_outofDir = parserTests outOfDir $ + [ + (OutofDir "bash", [ + "outof bash" + , "outof \t bash" + , "outof \"bash\"" + , "outof bash" + ] + ) + , (OutofDir "xmonad", [ + "outof xmonad" + , "outof \t\t\txmonad" + , "outof \"xmonad\"" + , "outof \txmonad" + ] + ) + ] + +test_deployment = parserTests deployment $ + [ + (Deploy "bashrc" "/home/user/.bashrc" Nothing, [ + "bashrc -> /home/user/.bashrc" + , "bashrc \t-> /home/user/.bashrc" + , "bashrc ->\"/home/user/.bashrc\"" + , "\"bashrc\"-> /home/user/.bashrc" + , "\"bashrc\" -> \"/home/user/.bashrc\"" + , "\"bashrc\"->\"/home/user/.bashrc\"" + ] + ) + , (Deploy "xmonad.hs" "/home/user/.xmonad/xmonad.hs" (Just LinkDeployment), [ + "xmonad.hs l-> /home/user/.xmonad/xmonad.hs" + , "\"xmonad.hs\"l-> /home/user/.xmonad/xmonad.hs" + ] + ) + , (Deploy "something with spaces" "/home/user/test.txt" (Just CopyDeployment), [ + "\"something with spaces\"c->/home/user/test.txt" + , "\"something with spaces\"\tc->/home/user/test.txt" + ] + ) + , (Deploy "file.txt" "file.txt" Nothing, [ + "file.txt" + , "\"file.txt\"" + ] + ) + ] + +test_deploymentKind_link = parserTest deploymentKind (Just LinkDeployment) "l->" +test_deploymentKind_copy = parserTest deploymentKind (Just CopyDeployment) "c->" +test_deploymentKind_default = parserTest deploymentKind Nothing "->" + +test_directory = parseItselfs directory $ + [ + "~" + , "~/.vim" + , "~/Dropbox" + + , "/home/user" + , "/home/user/.xmonad" + ] + +test_filepath = parseItselfs filepath $ + [ + "withoutExtension" + , "test.txt" + , "file.somelongextension" + + , "/home/user/test.txt" + , "/home/user/test.multiple.extensions" + + , "/home/user/../user/test.txt" + ] + +test_filepath_quoted = parserTest filepath "/home/user/long/path/with spaces" "\"/home/user/long/path/with spaces\"" + +test_lineComment = parseSuccesses lineComment $ + [ + "#hello\n", "#hello\n\r" + , "# This is a very long\tline comment\t with whitespaces \n" + ] + +test_blockComment = parseSuccesses blockComment $ + [ + "[[ hellokidoki ]]" + , "[[ This is a very long block comment\n with \n\r whitespace\n ]]" + ] + + +--[ Identifiers ]-- + +test_plainIdentifier_success = parseItselfs plainIdentifier $ + [ + "test" + , "thing" + , "sus-depot" + , "super_user_spark" + , "super.user.spark" + , "a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z" + ] + +test_plainIdentifier_fail = parseFails plainIdentifier $ + [ + "\"identifier\"" + , "\"", "\n", "\r", ";", " ", "\t", "{", "}" + , "sus depot" + ] + +test_quotedIdentifier_success = parseSuccesses quotedIdentifier $ + [ + "\"a\"", "\"abc\"", "\"abcdefghijklmnopqrstuvwxyz\"" + , "\" \"", "\"\t\"", "\";\"", "\"{\"", "\"}\"" + , "\"sus depot\"", "\"sus\tdepot\"" + ] + +test_quotedIdentifier_fail = parseFails quotedIdentifier $ + [ + "\"" + , "\n", "\r", ";", " ", "\t", "{", "}" + , "\"\n\"", "\"\r\"", " ", "\t", "{", "}" + , "\"a", "\"abc" + , "a\"", "abc\"" + ] + + + +--[ Delimiters ]-- + +test_inBraces_letter = parserTest (inBraces plainIdentifier) "a" "{a}" +test_inBraces_word = parserTest (inBraces plainIdentifier) "abc" "{abc}" + +test_inQuotes_letter = parserTest (inQuotes plainIdentifier) "a" "\"a\"" +test_inQuotes_word = parserTest (inQuotes plainIdentifier) "abc" "\"abc\"" + + +test_delim = parseItselfs delim $ + [ + ";" + , "\n" + , "\r" + , "\n\r" + , "\r\n" + , "\n\r \t \n\t \n" + ] + + +--[ Whitespace ]-- + +test_inLineSpace = parserTests (inLineSpace plainIdentifier) $ + [ + ("a", [ + "a" + , " a \t " + , " a " + , "\ta\t" + ] + ) + , ("abc", [ + "abc" + , " abc " + , "abc" + , "abc\t\t\t\t" + ] + ) + ] + +test_inWhiteSpace = parserTests (inWhiteSpace plainIdentifier) $ + [ + ("a", [ + "a" + , " \n\r a \t " + , " a\n " + , "\ta\r\t" + ] + ) + , ("abc", [ + "abc" + , " abc " + , "abc\t\t\t\t" + ] + ) + ] + +test_linespace = parseItselfs linespace $ + [ + "" + , " " + , "\t" + , " \t" + , "\t " + , "\t \t\t\t \t\t \t" + ] + +test_whitespace = parseItselfs whitespace $ + [ + "" + , " " + , "\t" + , "\n" + , "\r" + , " \t" + , "\n\r" + , " \t\n\r" + , " \t \n \r\n\t\t\t \n\n\r\n" + ] + +test_eol = parseItselfs eol $ + [ + "\n\r" + , "\r\n" + , "\n" + , "\r" + ] + +test_eol_fail = parseFails eol $ + [ + "" + , " " + , "\t" + , "\t " + , " \t" + ] +