1-- | Part of this code is from "Report on the Programming Language Haskell", 2-- version 1.2, appendix C. 3module Language.Preprocessor.Unlit (unlit) where 4 5import Data.Char 6import Data.List (isPrefixOf) 7 8data Classified = Program String | Blank | Comment 9 | Include Int String | Pre String 10 11classify :: [String] -> [Classified] 12classify [] = [] 13classify (('\\':x):xs) | x == "begin{code}" = Blank : allProg xs 14 where allProg [] = [] -- Should give an error message, 15 -- but I have no good position information. 16 allProg (('\\':x):xs) | "end{code}"`isPrefixOf`x = Blank : classify xs 17 allProg (x:xs) = Program x:allProg xs 18classify (('>':x):xs) = Program (' ':x) : classify xs 19classify (('#':x):xs) = (case words x of 20 (line:rest) | all isDigit line 21 -> Include (read line) (unwords rest) 22 _ -> Pre x 23 ) : classify xs 24--classify (x:xs) | "{-# LINE" `isPrefixOf` x = Program x: classify xs 25classify (x:xs) | all isSpace x = Blank:classify xs 26classify (x:xs) = Comment:classify xs 27 28unclassify :: Classified -> String 29unclassify (Program s) = s 30unclassify (Pre s) = '#':s 31unclassify (Include i f) = '#':' ':show i ++ ' ':f 32unclassify Blank = "" 33unclassify Comment = "" 34 35-- | 'unlit' takes a filename (for error reports), and transforms the 36-- given string, to eliminate the literate comments from the program text. 37unlit :: FilePath -> String -> String 38unlit file lhs = (unlines 39 . map unclassify 40 . adjacent file (0::Int) Blank 41 . classify) (inlines lhs) 42 43adjacent :: FilePath -> Int -> Classified -> [Classified] -> [Classified] 44adjacent file 0 _ (x :xs) = x : adjacent file 1 x xs -- force evaluation of line number 45adjacent file n y@(Program _) (x@Comment :xs) = error (message file n "program" "comment") 46adjacent file n y@(Program _) (x@(Include i f):xs) = x: adjacent f i y xs 47adjacent file n y@(Program _) (x@(Pre _) :xs) = x: adjacent file (n+1) y xs 48adjacent file n y@Comment (x@(Program _) :xs) = error (message file n "comment" "program") 49adjacent file n y@Comment (x@(Include i f):xs) = x: adjacent f i y xs 50adjacent file n y@Comment (x@(Pre _) :xs) = x: adjacent file (n+1) y xs 51adjacent file n y@Blank (x@(Include i f):xs) = x: adjacent f i y xs 52adjacent file n y@Blank (x@(Pre _) :xs) = x: adjacent file (n+1) y xs 53adjacent file n _ (x@next :xs) = x: adjacent file (n+1) x xs 54adjacent file n _ [] = [] 55 56message :: String -> Int -> String -> String -> String 57message "\"\"" n p c = "Line "++show n++": "++p++ " line before "++c++" line.\n" 58message [] n p c = "Line "++show n++": "++p++ " line before "++c++" line.\n" 59message file n p c = "In file " ++ file ++ " at line "++show n++": "++p++ " line before "++c++" line.\n" 60 61 62-- Re-implementation of 'lines', for better efficiency (but decreased laziness). 63-- Also, importantly, accepts non-standard DOS and Mac line ending characters. 64inlines :: String -> [String] 65inlines s = lines' s id 66 where 67 lines' [] acc = [acc []] 68 lines' ('\^M':'\n':s) acc = acc [] : lines' s id -- DOS 69 lines' ('\^M':s) acc = acc [] : lines' s id -- MacOS 70 lines' ('\n':s) acc = acc [] : lines' s id -- Unix 71 lines' (c:s) acc = lines' s (acc . (c:)) 72 73