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

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

-- | '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 :: String -> String -> String
unlit String
file String
lhs = ([String] -> String
unlines
                 ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Classified -> String) -> [Classified] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Classified -> String
unclassify
                 ([Classified] -> [String])
-> ([String] -> [Classified]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Int -> Classified -> [Classified] -> [Classified]
adjacent String
file (Int
0::Int) Classified
Blank
                 ([Classified] -> [Classified])
-> ([String] -> [Classified]) -> [String] -> [Classified]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [Classified]
classify) (String -> [String]
inlines String
lhs)

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

message :: String -> Int -> String -> String -> String
message :: String -> Int -> String -> String -> String
message String
"\"\"" Int
n String
p String
c = String
"Line "String -> String -> String
forall a. [a] -> [a] -> [a]
++Int -> String
forall a. Show a => a -> String
show Int
nString -> String -> String
forall a. [a] -> [a] -> [a]
++String
": "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
pString -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" line before "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
cString -> String -> String
forall a. [a] -> [a] -> [a]
++String
" line.\n"
message []     Int
n String
p String
c = String
"Line "String -> String -> String
forall a. [a] -> [a] -> [a]
++Int -> String
forall a. Show a => a -> String
show Int
nString -> String -> String
forall a. [a] -> [a] -> [a]
++String
": "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
pString -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" line before "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
cString -> String -> String
forall a. [a] -> [a] -> [a]
++String
" line.\n"
message String
file   Int
n String
p String
c = String
"In file " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" at line "String -> String -> String
forall a. [a] -> [a] -> [a]
++Int -> String
forall a. Show a => a -> String
show Int
nString -> String -> String
forall a. [a] -> [a] -> [a]
++String
": "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
pString -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" line before "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
cString -> String -> String
forall a. [a] -> [a] -> [a]
++String
" 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 :: String -> [String]
inlines String
s = String -> (String -> String) -> [String]
lines' String
s String -> String
forall a. a -> a
id
  where
  lines' :: String -> (String -> String) -> [String]
lines' []             String -> String
acc = [String -> String
acc []]
  lines' (Char
'\^M':Char
'\n':String
s) String -> String
acc = String -> String
acc [] String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> (String -> String) -> [String]
lines' String
s String -> String
forall a. a -> a
id      -- DOS
  lines' (Char
'\^M':String
s)      String -> String
acc = String -> String
acc [] String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> (String -> String) -> [String]
lines' String
s String -> String
forall a. a -> a
id      -- MacOS
  lines' (Char
'\n':String
s)       String -> String
acc = String -> String
acc [] String -> [String] -> [String]
forall a. a -> [a] -> [a]
: String -> (String -> String) -> [String]
lines' String
s String -> String
forall a. a -> a
id      -- Unix
  lines' (Char
c:String
s)          String -> String
acc = String -> (String -> String) -> [String]
lines' String
s (String -> String
acc (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:))