git @ Cat's Eye Technologies Falderal / 7d08f35
Attempted refactor; not done yet. --HG-- rename : Test/Falderal/Loader.hs => Test/Falderal/Common.hs catseye 10 years ago
3 changed file(s) with 113 addition(s) and 69 deletion(s). Raw diff Collapse all Expand all
0 module Test.Falderal.Common where
1
2 --
3 -- Test.Falderal.Common -- Common data and functions for Falderal
4 -- Copyright (c)2011 Cat's Eye Technologies. All rights reserved.
5 --
6 -- Redistribution and use in source and binary forms, with or without
7 -- modification, are permitted provided that the following conditions
8 -- are met:
9 --
10 -- 1. Redistributions of source code must retain the above copyright
11 -- notices, this list of conditions and the following disclaimer.
12 -- 2. Redistributions in binary form must reproduce the above copyright
13 -- notices, this list of conditions, and the following disclaimer in
14 -- the documentation and/or other materials provided with the
15 -- distribution.
16 -- 3. Neither the names of the copyright holders nor the names of their
17 -- contributors may be used to endorse or promote products derived
18 -- from this software without specific prior written permission.
19 --
20 -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
21 -- ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
22 -- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
23 -- FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
24 -- COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
25 -- INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
26 -- BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
27 -- LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
28 -- CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
29 -- LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
30 -- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
31 -- POSSIBILITY OF SUCH DAMAGE.
32 --
33
34 --
35 -- Definitions for the structure of a test suite in Falderal format.
36 --
37
38 --
39 -- Before processing...
40 --
41
42 data Line = TestInput String
43 | ExpectedResult String
44 | ExpectedError String
45 | LiteralText String
46 | QuotedCode String
47 | SectionHeading String
48 | Placeholder
49 deriving (Show, Eq, Ord)
50
51 --
52 -- ...and after.
53 --
54
55 data Expectation = Output String
56 | Exception String
57 deriving (Show, Eq, Ord)
58
59 data Block = Section String
60 | Test String String Expectation
61 deriving (Show, Eq, Ord)
62
63 --
64 -- Common functions.
65 --
66
67 -- TODO: How many of these can be replaced by standard Haskell functions?
68
69 discoverRepeatedCharacter [] =
70 Nothing
71 discoverRepeatedCharacter (first:rest) =
72 confirmRepeatedCharacter first rest
73
74 confirmRepeatedCharacter char [] =
75 Just char
76 confirmRepeatedCharacter char (next:rest)
77 | char == next = confirmRepeatedCharacter char rest
78 | otherwise = Nothing
79
80 --
81 -- This could use Char.isSpace
82 --
83
84 allWhitespace [] = True
85 allWhitespace (' ':rest) = allWhitespace rest
86 allWhitespace ('\n':rest) = allWhitespace rest
87 allWhitespace ('\t':rest) = allWhitespace rest
88 allWhitespace (_:rest) = False
89
90 stripLeading y [] = []
91 stripLeading y all@(x:xs)
92 | x == y = stripLeading y xs
93 | otherwise = all
94
95 stripTrailing y str = reverse (stripLeading y (reverse str))
96
97 --
98 -- A version of `lines` that always considers the input "" to
99 -- represent a single, blank line.
100 --
101
102 allLines x =
103 case (lines x) of
104 [] -> [""]
105 other -> other
106
107 prefixEachLine prefix text =
108 foldl (++) "" (map (\x -> prefix ++ x ++ "\n") (allLines text))
109
110 formatLines formatter lines = foldl (++) "" (map (formatter) lines)
3535
3636 import System
3737
38 --
39 -- Definitions for the structure of a test suite in Falderal format.
40 --
41
42 data Line = TestInput String
43 | ExpectedResult String
44 | ExpectedError String
45 | LiteralText String
46 | QuotedCode String
47 | SectionHeading String
48 | Placeholder
49 deriving (Show, Eq, Ord)
50
51 -- TODO: move these datatypes to a common module?
52
53 data Expectation = Output String
54 | Exception String
55 deriving (Show, Eq, Ord)
56
57 data Block = Section String
58 | Test String String Expectation
59 deriving (Show, Eq, Ord)
38 import Test.Falderal.Common
6039
6140 --
6241 -- File loading functions.
10786 (last:findSectionHeadings lines line)
10887 findSectionHeadings (line:lines) last =
10988 (last:findSectionHeadings lines line)
110
111 discoverRepeatedCharacter [] =
112 Nothing
113 discoverRepeatedCharacter (first:rest) =
114 confirmRepeatedCharacter first rest
115
116 confirmRepeatedCharacter char [] =
117 Just char
118 confirmRepeatedCharacter char (next:rest)
119 | char == next = confirmRepeatedCharacter char rest
120 | otherwise = Nothing
12189
12290 --
12391 -- Coalesce neigbouring lines. For each line, if it is classified the
181149 where numberedDesc = "(#" ++ (show n) ++ ") " ++ (stripLeading '\n' desc)
182150 reDescribeBlocks' (block:rest) desc n =
183151 block:(reDescribeBlocks' rest "" 2)
184
185 --
186 -- This could use Char.isSpace
187 --
188
189 -- TODO: move these to a common utility module?
190 -- TODO: can these be replaced by standard Haskell functions?
191
192 allWhitespace [] = True
193 allWhitespace (' ':rest) = allWhitespace rest
194 allWhitespace ('\n':rest) = allWhitespace rest
195 allWhitespace ('\t':rest) = allWhitespace rest
196 allWhitespace (_:rest) = False
197
198 stripLeading y [] = []
199 stripLeading y all@(x:xs)
200 | x == y = stripLeading y xs
201 | otherwise = all
202
203 stripTrailing y str = reverse (stripLeading y (reverse str))
204
205 --
206 -- A version of `lines` that always considers the input "" to
207 -- represent a single, blank line.
208 --
209
210 allLines x =
211 case (lines x) of
212 [] -> [""]
213 other -> other
214
215 prefixEachLine prefix text =
216 foldl (++) "" (map (\x -> prefix ++ x ++ "\n") (allLines text))
217
218 formatLines formatter lines = foldl (++) "" (map (formatter) lines)
3434 import System
3535 import qualified Control.Exception as Exc
3636
37 import Test.Falderal.Loader
37 import Test.Falderal.Common
3838
3939 --
4040 -- Definitions.