content: -- From nhc13/src/comiler13/Unlit.hs
  module Unlit(unlit,readHaskellFile,optUnlit,isLiterateFile) where
  
  -- Part of the following code is from "Report on the Programming Language Haskell",
  -- version 1.2, appendix C.
  
  import Char
  
  readHaskellFile path = fmap (optUnlit path) (readFile path)
  
  optUnlit path =
    if isLiterateFile path
    then unlit path
    else id
  
  isLiterateFile path = last4 path == ".lhs"
    where last4 = reverse . take 4 . reverse
  
  --------------------------------------------------------------------------------
  
  data Classified = Program String | Blank | Comment String | Include Int String | Pre String
  
  classify :: [String] -> [Classified]
  classify []                = []
  classify (('\\':x):xs) | x == "begin{code}" = Blank : allProg xs
     where allProg [] = []  -- Should give an error message, but I have no good position information.
           allProg (('\\':x):xs) |  x == "end{code}" = Blank : classify xs
  	 allProg (x:xs) = Program x:allProg xs
  classify (('>':x):xs)      = Program (' ':x) : classify xs
  classify (('#':x):xs)      = (case words x of
                                  (line:file:_) | all isDigit line -> Include (read line) file
                                  _                                -> Pre x
                               ) : classify xs
  classify (x:xs) | all isSpace x = Blank:classify xs
  classify (x:xs)                 = Comment x:classify xs
  
  -- Old version: put literate comment lines in one-line comments
  old_unclassify = unlines . map unclassify1
  
  unclassify1 :: Classified -> String
  unclassify1 (Program s) = s
  unclassify1 (Pre s)     = '#':s
  unclassify1 (Include i f) = '#':' ':show i ++ ' ':f
  unclassify1 Blank       = ""
  unclassify1 (Comment s) = "-- "++s
  
  -- New version: put literate comment blocks in nested comments
  -- (Drawback: these can potentially interfere with other comments)
  new_unclassify = unclassify0
    where
      unclassify0 (Comment s:xs) = "{-+\t"++s++"\n"++unc xs -- -}
      unclassify0 xs = un xs
  
      -- Normal state, inside code block
      un [] = []
      un (Blank:Comment s:xs) = "{-+\n"++s++"\n"++unc xs -- -}
      un (x:xs) = unclassify1 x++"\n"++un xs
  
      -- Comment state, inside a literate comment
      unc [] = "-}\n"
      unc (Comment s:xs) = s++"\n"++unc xs
      unc (Blank:xs) = unb xs
  
      -- Blank line state, inside a literate comment, after a blank line
      unb [] = "-}\n"
      unb (Blank:xs) = "\n"++unb xs
      unb xs@(Comment _:_) = "\n"++unc xs
      unb xs = "-}\n"++un xs
  
  unlit :: String -> String -> String
  unlit file =
    new_unclassify . adjecent file (0::Int) Blank . classify . lines
  
  adjecent :: String -> Int -> Classified -> [Classified] -> [Classified]
  adjecent file 0 _             (x              :xs) = x : adjecent file 1 x xs -- force evaluation of line number
  adjecent file n y@(Program _) (x@(Comment _)  :xs) = error (message file n "program" "comment")
  adjecent file n y@(Program _) (x@(Include i f):xs) = x: adjecent f    i     y xs
  adjecent file n y@(Program _) (x@(Pre _)      :xs) = x: adjecent file (n+1) y xs
  adjecent file n y@(Comment _) (x@(Program _)  :xs) = error (message file n "comment" "program")
  adjecent file n y@(Comment _) (x@(Include i f):xs) = x: adjecent f    i     y xs
  adjecent file n y@(Comment _) (x@(Pre _)      :xs) = x: adjecent file (n+1) y xs
  adjecent file n y@Blank       (x@(Include i f):xs) = x: adjecent f    i     y xs
  adjecent file n y@Blank       (x@(Pre _)      :xs) = x: adjecent file (n+1) y xs
  adjecent file n _             (x@next         :xs) = x: adjecent file (n+1) x xs
  adjecent file n _             []                    = []
  
  message "\"\"" n p c = "Line "++show n++": "++p++ " line before "++c++" line.\n"
  message []     n p c = "Line "++show n++": "++p++ " line before "++c++" line.\n"
  message file   n p c = "In file " ++ file ++ " at line "++show n++": "++p++ " line before "++c++" line.\n"
  