    -- | Part of this code is from "Report on the Programming Language Haskell",
    --   version 1.2, appendix C.
    module Language.Preprocessor.Unlit (unlit) where

    import Data.Char
    import Data.List (isPrefixOf)

    data Classified = Program String | Blank | Comment
                    | Include Int String | Pre String

    classify :: [String] -> [Classified]
    classify :: [[Char]] -> [Classified]
    classify []                = []
    classify ((Char
    '\\':[Char]
    x):[[Char]]
    xs) | [Char]
    x [Char] -> [Char] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [Char]
    "begin{code}" = Classified
    Blank Classified -> [Classified] -> [Classified]
    forall a. a -> [a] -> [a]
    : [[Char]] -> [Classified]
    allProg [[Char]]
    xs
       where allProg :: [[Char]] -> [Classified]
    allProg [] = []  -- Should give an error message,
                              -- but I have no good position information.
             allProg ((Char
    '\\':[Char]
    x):[[Char]]
    xs) |  [Char]
    "end{code}"[Char] -> [Char] -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf`[Char]
    x = Classified
    Blank Classified -> [Classified] -> [Classified]
    forall a. a -> [a] -> [a]
    : [[Char]] -> [Classified]
    classify [[Char]]
    xs
             allProg ([Char]
    x:[[Char]]
    xs) = [Char] -> Classified
    Program [Char]
    xClassified -> [Classified] -> [Classified]
    forall a. a -> [a] -> [a]
    :[[Char]] -> [Classified]
    allProg [[Char]]
    xs
    classify ((Char
    '>':[Char]
    x):[[Char]]
    xs)      = [Char] -> Classified
    Program (Char
    ' 'Char -> [Char] -> [Char]
    forall a. a -> [a] -> [a]
    :[Char]
    x) Classified -> [Classified] -> [Classified]
    forall a. a -> [a] -> [a]
    : [[Char]] -> [Classified]
    classify [[Char]]
    xs
    classify ((Char
    '#':[Char]
    x):[[Char]]
    xs)      = (case [Char] -> [[Char]]
    words [Char]
    x of
                                    ([Char]
    line:[[Char]]
    rest) | (Char -> Bool) -> [Char] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Char -> Bool
    isDigit [Char]
    line
                                       -> Int -> [Char] -> Classified
    Include ([Char] -> Int
    forall a. Read a => [Char] -> a
    read [Char]
    line) ([[Char]] -> [Char]
    unwords [[Char]]
    rest)
                                    [[Char]]
    _  -> [Char] -> Classified
    Pre [Char]
    x
                                 ) Classified -> [Classified] -> [Classified]
    forall a. a -> [a] -> [a]
    : [[Char]] -> [Classified]
    classify [[Char]]
    xs
    --classify (x:xs) | "{-# LINE" `isPrefixOf` x = Program x: classify xs
    classify ([Char]
    x:[[Char]]
    xs) | (Char -> Bool) -> [Char] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Char -> Bool
    isSpace [Char]
    x = Classified
    BlankClassified -> [Classified] -> [Classified]
    forall a. a -> [a] -> [a]
    :[[Char]] -> [Classified]
    classify [[Char]]
    xs
    classify ([Char]
    x:[[Char]]
    xs)                 = Classified
    CommentClassified -> [Classified] -> [Classified]
    forall a. a -> [a] -> [a]
    :[[Char]] -> [Classified]
    classify [[Char]]
    xs

    unclassify :: Classified -> String
    unclassify :: Classified -> [Char]
    unclassify (Program [Char]
    s) = [Char]
    s
    unclassify (Pre [Char]
    s)     = Char
    '#'Char -> [Char] -> [Char]
    forall a. a -> [a] -> [a]
    :[Char]
    s
    unclassify (Include Int
    i [Char]
    f) = Char
    '#'Char -> [Char] -> [Char]
    forall a. a -> [a] -> [a]
    :Char
    ' 'Char -> [Char] -> [Char]
    forall a. a -> [a] -> [a]
    :Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    i [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Char
    ' 'Char -> [Char] -> [Char]
    forall a. a -> [a] -> [a]
    :[Char]
    f
    unclassify Classified
    Blank       = [Char]
    ""
    unclassify Classified
    Comment     = [Char]
    ""

    -- | 'unlit' takes a filename (for error reports), and transforms the
    --   given string, to eliminate the literate comments from the program text.
    unlit :: FilePath -> String -> String
    unlit :: [Char] -> [Char] -> [Char]
    unlit [Char]
    file [Char]
    lhs = ([[Char]] -> [Char]
    unlines
                     ([[Char]] -> [Char])
    -> ([[Char]] -> [[Char]]) -> [[Char]] -> [Char]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Classified -> [Char]) -> [Classified] -> [[Char]]
    forall a b. (a -> b) -> [a] -> [b]
    map Classified -> [Char]
    unclassify
                     ([Classified] -> [[Char]])
    -> ([[Char]] -> [Classified]) -> [[Char]] -> [[Char]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> Int -> Classified -> [Classified] -> [Classified]
    adjacent [Char]
    file (Int
    0::Int) Classified
    Blank
                     ([Classified] -> [Classified])
    -> ([[Char]] -> [Classified]) -> [[Char]] -> [Classified]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [[Char]] -> [Classified]
    classify) ([Char] -> [[Char]]
    inlines [Char]
    lhs)

    adjacent :: FilePath -> Int -> Classified -> [Classified] -> [Classified]
    adjacent :: [Char] -> Int -> Classified -> [Classified] -> [Classified]
    adjacent [Char]
    file Int
    0 Classified
    _             (Classified
    x              :[Classified]
    xs) = Classified
    x Classified -> [Classified] -> [Classified]
    forall a. a -> [a] -> [a]
    : [Char] -> Int -> Classified -> [Classified] -> [Classified]
    adjacent [Char]
    file Int
    1 Classified
    x [Classified]
    xs -- force evaluation of line number
    adjacent [Char]
    file Int
    n y :: Classified
    y@(Program [Char]
    _) (x :: Classified
    x@Classified
    Comment      :[Classified]
    xs) = [Char] -> [Classified]
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> Int -> [Char] -> [Char] -> [Char]
    message [Char]
    file Int
    n [Char]
    "program" [Char]
    "comment")
    adjacent [Char]
    file Int
    n y :: Classified
    y@(Program [Char]
    _) (x :: Classified
    x@(Include Int
    i [Char]
    f):[Classified]
    xs) = Classified
    xClassified -> [Classified] -> [Classified]
    forall a. a -> [a] -> [a]
    : [Char] -> Int -> Classified -> [Classified] -> [Classified]
    adjacent [Char]
    f    Int
    i     Classified
    y [Classified]
    xs
    adjacent [Char]
    file Int
    n y :: Classified
    y@(Program [Char]
    _) (x :: Classified
    x@(Pre [Char]
    _)      :[Classified]
    xs) = Classified
    xClassified -> [Classified] -> [Classified]
    forall a. a -> [a] -> [a]
    : [Char] -> Int -> Classified -> [Classified] -> [Classified]
    adjacent [Char]
    file (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1) Classified
    y [Classified]
    xs
    adjacent [Char]
    file Int
    n y :: Classified
    y@Classified
    Comment     (x :: Classified
    x@(Program [Char]
    _)  :[Classified]
    xs) = [Char] -> [Classified]
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> Int -> [Char] -> [Char] -> [Char]
    message [Char]
    file Int
    n [Char]
    "comment" [Char]
    "program")
    adjacent [Char]
    file Int
    n y :: Classified
    y@Classified
    Comment     (x :: Classified
    x@(Include Int
    i [Char]
    f):[Classified]
    xs) = Classified
    xClassified -> [Classified] -> [Classified]
    forall a. a -> [a] -> [a]
    : [Char] -> Int -> Classified -> [Classified] -> [Classified]
    adjacent [Char]
    f    Int
    i     Classified
    y [Classified]
    xs
    adjacent [Char]
    file Int
    n y :: Classified
    y@Classified
    Comment     (x :: Classified
    x@(Pre [Char]
    _)      :[Classified]
    xs) = Classified
    xClassified -> [Classified] -> [Classified]
    forall a. a -> [a] -> [a]
    : [Char] -> Int -> Classified -> [Classified] -> [Classified]
    adjacent [Char]
    file (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1) Classified
    y [Classified]
    xs
    adjacent [Char]
    file Int
    n y :: Classified
    y@Classified
    Blank       (x :: Classified
    x@(Include Int
    i [Char]
    f):[Classified]
    xs) = Classified
    xClassified -> [Classified] -> [Classified]
    forall a. a -> [a] -> [a]
    : [Char] -> Int -> Classified -> [Classified] -> [Classified]
    adjacent [Char]
    f    Int
    i     Classified
    y [Classified]
    xs
    adjacent [Char]
    file Int
    n y :: Classified
    y@Classified
    Blank       (x :: Classified
    x@(Pre [Char]
    _)      :[Classified]
    xs) = Classified
    xClassified -> [Classified] -> [Classified]
    forall a. a -> [a] -> [a]
    : [Char] -> Int -> Classified -> [Classified] -> [Classified]
    adjacent [Char]
    file (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1) Classified
    y [Classified]
    xs
    adjacent [Char]
    file Int
    n Classified
    _             (x :: Classified
    x@Classified
    next         :[Classified]
    xs) = Classified
    xClassified -> [Classified] -> [Classified]
    forall a. a -> [a] -> [a]
    : [Char] -> Int -> Classified -> [Classified] -> [Classified]
    adjacent [Char]
    file (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1) Classified
    x [Classified]
    xs
    adjacent [Char]
    file Int
    n Classified
    _             []                   = []

    message :: String -> Int -> String -> String -> String
    message :: [Char] -> Int -> [Char] -> [Char] -> [Char]
    message [Char]
    "\"\"" Int
    n [Char]
    p [Char]
    c = [Char]
    "Line "[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    n[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++[Char]
    ": "[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++[Char]
    p[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " line before "[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++[Char]
    c[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++[Char]
    " line.\n"
    message []     Int
    n [Char]
    p [Char]
    c = [Char]
    "Line "[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    n[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++[Char]
    ": "[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++[Char]
    p[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " line before "[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++[Char]
    c[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++[Char]
    " line.\n"
    message [Char]
    file   Int
    n [Char]
    p [Char]
    c = [Char]
    "In file " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    file [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " at line "[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    n[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++[Char]
    ": "[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++[Char]
    p[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " line before "[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++[Char]
    c[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++[Char]
    " line.\n"

    -- Re-implementation of 'lines', for better efficiency (but decreased laziness).
    -- Also, importantly, accepts non-standard DOS and Mac line ending characters.
    inlines :: String -> [String]
    inlines :: [Char] -> [[Char]]
    inlines [Char]
    s = [Char] -> ([Char] -> [Char]) -> [[Char]]
    lines' [Char]
    s [Char] -> [Char]
    forall a. a -> a
    id
      where
      lines' :: [Char] -> ([Char] -> [Char]) -> [[Char]]
    lines' []             [Char] -> [Char]
    acc = [[Char] -> [Char]
    acc []]
      lines' (Char
    '\^M':Char
    '\n':[Char]
    s) [Char] -> [Char]
    acc = [Char] -> [Char]
    acc [] [Char] -> [[Char]] -> [[Char]]
    forall a. a -> [a] -> [a]
    : [Char] -> ([Char] -> [Char]) -> [[Char]]
    lines' [Char]
    s [Char] -> [Char]
    forall a. a -> a
    id      -- DOS
      lines' (Char
    '\^M':[Char]
    s)      [Char] -> [Char]
    acc = [Char] -> [Char]
    acc [] [Char] -> [[Char]] -> [[Char]]
    forall a. a -> [a] -> [a]
    : [Char] -> ([Char] -> [Char]) -> [[Char]]
    lines' [Char]
    s [Char] -> [Char]
    forall a. a -> a
    id      -- MacOS
      lines' (Char
    '\n':[Char]
    s)       [Char] -> [Char]
    acc = [Char] -> [Char]
    acc [] [Char] -> [[Char]] -> [[Char]]
    forall a. a -> [a] -> [a]
    : [Char] -> ([Char] -> [Char]) -> [[Char]]
    lines' [Char]
    s [Char] -> [Char]
    forall a. a -> a
    id      -- Unix
      lines' (Char
    c:[Char]
    s)          [Char] -> [Char]
    acc = [Char] -> ([Char] -> [Char]) -> [[Char]]
    lines' [Char]
    s ([Char] -> [Char]
    acc ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char
    cChar -> [Char] -> [Char]
    forall a. a -> [a] -> [a]
    :))