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