{-# 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" ]