ghc/compiler/tests/typecheck/should_succeed/tc080.hs

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