git @ Cat's Eye Technologies Falderal / 62494ed
Don't output "encoding:" pragmas in Markdown. catseye 13 years ago
4 changed file(s) with 45 addition(s) and 35 deletion(s). Raw diff Collapse all Expand all
+15
-11
Test/Falderal/Common.hs less more
4747 | LiteralText String
4848 | QuotedCode String
4949 | SectionHeading String
50 | Pragma String
50 | Pragma String (Maybe Directive)
5151 | Placeholder
5252 deriving (Show, Eq, Ord)
53
54 --
55 -- ...and in the middle of processing...
56 --
57
58 data Directive = TestsFor Functionality
59 | FunctionalityDefinition String Functionality
60 | Encoding String
61 deriving (Show, Eq, Ord)
62
63 data Functionality = HaskellTest String String -- module name, function name
64 | ShellTest String -- command
65 | NamedFunctionality String
66 deriving (Show, Eq, Ord)
5367
5468 --
5569 -- ...and after.
5872 data Expectation = Output String
5973 | Exception String
6074 deriving (Show, Eq, Ord)
61
62 data Functionality = HaskellTest String String -- module name, function name
63 | ShellTest String -- command
64 | NamedFunctionality String
65 deriving (Show, Eq, Ord)
66
67 data Directive = TestsFor Functionality
68 | FunctionalityDefinition String Functionality
69 | Encoding String
70 deriving (Show, Eq, Ord)
7175
7276 data Block = Section String
7377 | Test [Functionality] String String Expectation
+1
-1
Test/Falderal/Formatter/Identity.hs less more
4848 (prefixEachLine "" text)
4949 formatLine (QuotedCode text) =
5050 (prefixEachLine "> " text)
51 formatLine (Pragma text) =
51 formatLine (Pragma text _) =
5252 (prefixEachLine "->" text)
5353 formatLine (SectionHeading text) =
5454 text ++ "\n" ++ (take (length text) (repeat '-')) ++ "\n"
+3
-1
Test/Falderal/Formatter/Markdown.hs less more
4949 (prefixEachLine "" text)
5050 formatLine (QuotedCode text) =
5151 (prefixEachLine " " text)
52 formatLine (Pragma text) =
52 formatLine (Pragma text (Just (Encoding _))) =
53 ""
54 formatLine (Pragma text _) =
5355 (prefixEachLine " ->" text)
5456 formatLine (SectionHeading text) =
5557 text ++ "\n" ++ (take (length text) (repeat '-')) ++ "\n"
+26
-22
Test/Falderal/Loader.hs less more
6060 loadText text =
6161 let
6262 ls = transformLines $ lines text
63 fds = collectFunctionalityDefinitions ls
64 bs = convertLinesToBlocks ls [] fds
63 ls' = resolvePragmas ls
64 fds = collectFunctionalityDefinitions ls'
65 bs = convertLinesToBlocks ls' [] fds
6566 bs' = reDescribeBlocks bs
6667 in
67 (ls, bs)
68 (ls', bs)
6869
6970 transformLines ls =
7071 let
8384 | prefix == "= " = ExpectedResult suffix
8485 | prefix == "? " = ExpectedError suffix
8586 | prefix == "> " = QuotedCode suffix
86 | prefix == "->" = Pragma suffix
87 | prefix == "->" = Pragma suffix Nothing
8788 | otherwise = LiteralText line
8889 where
8990 prefix = take 2 line
119120 coalesceLines lines (LiteralText (last ++ "\n" ++ more))
120121 coalesceLines ((QuotedCode more):lines) (QuotedCode last) =
121122 coalesceLines lines (QuotedCode (last ++ "\n" ++ more))
122 coalesceLines ((Pragma more):lines) (Pragma last) =
123 coalesceLines lines (Pragma (last ++ "\n" ++ more))
123 coalesceLines ((Pragma more Nothing):lines) (Pragma last Nothing) =
124 coalesceLines lines (Pragma (last ++ "\n" ++ more) Nothing)
124125 coalesceLines (line:lines) (LiteralText last) =
125126 ((LiteralText (last ++ "\n")):coalesceLines lines line)
126127 coalesceLines (line:lines) last =
127128 (last:coalesceLines lines line)
129
130 resolvePragmas ((Pragma text Nothing):rest) =
131 ((Pragma text $ Just $ parsePragma text):resolvePragmas rest)
132 resolvePragmas (other:rest) = (other:resolvePragmas rest)
133 resolvePragmas [] = []
128134
129135 --
130136 -- Convert (coalesced) lines to blocks.
142148 ((Test fns "(undescribed output test)" testText (Exception expected)):(convertLinesToBlocks rest fns fnMap))
143149 convertLinesToBlocks ((SectionHeading text):rest) fn fnMap =
144150 ((Section text):(convertLinesToBlocks rest fn fnMap))
145 convertLinesToBlocks ((Pragma text):rest) fns fnMap =
146 case parsePragma text of
147 TestsFor (NamedFunctionality name) ->
148 case map (snd) $ filter (\(s,fn) -> s == name) fnMap of
149 [] -> error ("Can't find " ++ name ++ " in " ++ (show fnMap))
150 fns' -> convertLinesToBlocks rest fns' fnMap
151 TestsFor fn ->
152 convertLinesToBlocks rest [fn] fnMap
153 _ ->
154 convertLinesToBlocks rest fns fnMap
151 convertLinesToBlocks ((Pragma _ (Just (TestsFor (NamedFunctionality name)))):rest) fns fnMap =
152 case map (snd) $ filter (\(s,fn) -> s == name) fnMap of
153 [] -> error ("Can't find " ++ name ++ " in " ++ (show fnMap))
154 fns' -> convertLinesToBlocks rest fns' fnMap
155 convertLinesToBlocks ((Pragma _ (Just (TestsFor fn))):rest) fns fnMap =
156 convertLinesToBlocks rest [fn] fnMap
157 convertLinesToBlocks ((Pragma _ Nothing):rest) fns fnMap =
158 error $ "should have resolved all pragmas to directives by now"
159 convertLinesToBlocks ((Pragma _ _):rest) fns fnMap =
160 convertLinesToBlocks rest fns fnMap
155161 convertLinesToBlocks ((LiteralText _):(SectionHeading text):rest) fns fnMap =
156162 ((Section text):(convertLinesToBlocks rest fns fnMap))
157163
159165 convertLinesToBlocks rest fns fnMap
160166 convertLinesToBlocks [] _ _ = []
161167
162 collectFunctionalityDefinitions ((Pragma text):rest) =
163 case parsePragma text of
164 FunctionalityDefinition name functionality ->
165 ((name, functionality):collectFunctionalityDefinitions rest)
166 _ ->
167 collectFunctionalityDefinitions rest
168 collectFunctionalityDefinitions ((Pragma _ (Just (FunctionalityDefinition name functionality))):rest) =
169 ((name, functionality):collectFunctionalityDefinitions rest)
170 collectFunctionalityDefinitions ((Pragma _ Nothing):rest) =
171 error $ "should have resolved all pragmas to directives by now"
168172 collectFunctionalityDefinitions (_:rest) =
169173 collectFunctionalityDefinitions rest
170174 collectFunctionalityDefinitions [] =