-- | Part of this code is from "Report on the Programming Language Haskell",
--   version 1.2, appendix C.
{-# OPTIONS_GHC -Wwarn #-}
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]
:))