git @ Cat's Eye Technologies Falderal / 6f9cc6f
Improve Haskell directive pragma parsing somewhat. catseye 10 years ago
4 changed file(s) with 32 addition(s) and 13 deletion(s). Raw diff Collapse all Expand all
5858 deriving (Show, Eq, Ord)
5959
6060 data Block = Section String
61 | HaskellDirective String -- XXX should be more structured
61 | HaskellDirective String String -- module name, function name
6262 | Test String String Expectation
6363 deriving (Show, Eq, Ord)
6464
4545 ""
4646
4747 format _ blocks =
48 prelude ++ (formatBlocks blocks) ++ postlude
48 (prelude blocks) ++ (formatBlocks blocks) ++ postlude
49
50 gatherImports ((HaskellDirective moduleName functionName):rest) =
51 "import " ++ moduleName ++ "\n" ++ gatherImports rest
52 gatherImports (_:rest) =
53 gatherImports rest
54 gatherImports [] =
55 ""
4956
5057 --
5158 -- XXX this hard-codes some stuff, just to see things running
5461 -- list somehow.
5562 --
5663
57 prelude = "module GeneratedFalderalTests where\n\
58 \\n\
59 \import Test.Falderal.Loader\n\
60 \import Test.Falderal.Runner\n\
61 \import Test.Falderal.Demo\n\
62 \\n\
63 \testModule = runTests [] (everySecond) [\n"
64 prelude blocks =
65 "module GeneratedFalderalTests where\n\
66 \\n\
67 \import Test.Falderal.Common\n\
68 \import Test.Falderal.Runner\n\
69 \import Test.Falderal.Demo\n" ++ (gatherImports blocks) ++ "\
70 \\n\
71 \testModule = runTests [] (everySecond) [\n"
6472
65 postlude = " (Section \"DONE\")\n\
66 \ ]\n"
73 postlude =
74 " (Section \"DONE\")\n\
75 \ ]\n"
164164 case stripPrefix "Tests for " text of
165165 Just rest ->
166166 case stripPrefix "Haskell function " rest of
167 Just specifier -> HaskellDirective specifier
167 Just specifier ->
168 let
169 (moduleName, functionName) = parseSpecifier specifier
170 in
171 HaskellDirective moduleName functionName
168172 Nothing -> error "bad pragma"
169173 Nothing ->
170174 error "bad pragma"
175
176 parseSpecifier specifier =
177 let
178 (m, f) = break (\y -> y == ':') specifier
179 in
180 (m, stripLeading ':' f)
8181 -- select a new testFun from the funMap
8282 testFun' <- return $ selectTestFun funMap sectionText
8383 runTests funMap testFun' rest
84 runTests funMap testFun ((HaskellDirective _):rest) = do
84 runTests funMap testFun ((HaskellDirective _ _):rest) = do
8585 -- XXX ignored for now
8686 runTests funMap testFun rest
8787 runTests funMap testFun ((Test literalText inputText expected):rest) = do