testsuite: Assert that testsuite ways are known
[ghc.git] / testsuite / tests / typecheck / should_compile / tc080.hs
1 --module Parse(Parse(..),whiteSpace,separatedBy) where
2 --import StdLib
3 module ShouldSucceed where
4
5 import Data.Char
6
7 class Parse a where
8 parseFile :: String -> [a]
9 parseLine :: String -> a
10 parseType :: String -> (a,String)
11 parse :: String -> (a,String)
12 forced :: a -> Bool
13
14 parseFile string | all forced x = x
15 where x = map parseLine (lines' string)
16 parseLine = pl.parse where pl (a,_) = a
17 parse = parseType.whiteSpace
18 forced x = True
19
20 instance Parse Int where
21 parseType str = pl (span' isDigit str)
22 where pl (l,r) = (strToInt l,r)
23 forced n | n>=0 = True
24
25 instance Parse Char where
26 parseType (ch:str) = (ch,str)
27 forced n = True
28
29 instance (Parse a) => Parse [a] where
30 parseType more = (map parseLine (separatedBy ',' (l++",")),out)
31 where (l,']':out) = span' (\x->x/=']') (tail more)
32 forced = all forced
33
34 separatedBy :: Char -> String -> [String]
35 separatedBy ch [] = []
36 separatedBy ch xs = twaddle ch (span' (\x->x/=ch) xs)
37 where twaddle ch (l,_:r) = l:separatedBy ch r
38
39 whiteSpace :: String -> String
40 whiteSpace = dropWhile isSpace
41
42 span' :: (a->Bool) -> [a] -> ([a],[a])
43 span' p [] = ([],[])
44 span' p (x:xs') | p x = fixLeak x (span' p xs') where fixLeak x (xs,ys) = (x:xs,ys)
45 span' _ xs = ([],xs)
46
47 lines' :: [Char] -> [[Char]]
48 lines' "" = []
49 lines' s = plumb (span' ((/=) '\n') s)
50 where plumb (l,s') = l:if null s' then [] else lines' (tail s')
51
52 strToInt :: String -> Int
53 strToInt x = strToInt' (length x-1) x
54 where strToInt' _ [] = 0
55 strToInt' x (a:l) = (charToInt a)*(10^x) + (strToInt' (x-1) l)
56
57 charToInt :: Char -> Int
58 charToInt x = (ord x - ord '0')