module Distribution.Simple.PreProcess.Unlit (unlit,plain) where
import Prelude ()
import Distribution.Compat.Prelude
import Distribution.Utils.Generic (safeTail, safeLast, safeInit)
import Data.List (mapAccumL)
data Classified = BirdTrack String | Blank String | Ordinary String
| Line !Int String | CPP String
| BeginCode | EndCode
| Error String | String
plain :: String -> String -> String
plain :: String -> String -> String
plain String
_ String
hs = String
hs
classify :: String -> Classified
classify :: String -> Classified
classify (Char
'>':String
s) = String -> Classified
BirdTrack String
s
classify (Char
'#':String
s) = case String -> [String]
tokens String
s of
(String
line:file :: String
file@(Char
'"':Char
_:String
_):[String]
_) | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit String
line
Bool -> Bool -> Bool
&& forall a. [a] -> Maybe a
safeLast String
file forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Char
'"'
-> Int -> String -> Classified
Line (forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"panic! read @Int " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
line) forall a b. (a -> b) -> a -> b
$ forall a. Read a => String -> Maybe a
readMaybe String
line) (forall a. [a] -> [a]
safeTail (forall a. [a] -> [a]
safeInit String
file))
[String]
_ -> String -> Classified
CPP String
s
where tokens :: String -> [String]
tokens = forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr forall a b. (a -> b) -> a -> b
$ \String
str -> case ReadS String
lex String
str of
(t :: String
t@(Char
_:String
_), String
str'):[(String, String)]
_ -> forall a. a -> Maybe a
Just (String
t, String
str')
[(String, String)]
_ -> forall a. Maybe a
Nothing
classify (Char
'\\':String
s)
| String
"begin{code}" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
s = Classified
BeginCode
| String
"end{code}" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
s = Classified
EndCode
classify String
s | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace String
s = String -> Classified
Blank String
s
classify String
s = String -> Classified
Ordinary String
s
unclassify :: Bool -> Classified -> String
unclassify :: Bool -> Classified -> String
unclassify Bool
_ (BirdTrack String
s) = Char
' 'forall a. a -> [a] -> [a]
:String
s
unclassify Bool
_ (Blank String
s) = String
s
unclassify Bool
_ (Ordinary String
s) = String
s
unclassify Bool
_ (Line Int
n String
file) = String
"# " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
file
unclassify Bool
_ (CPP String
s) = Char
'#'forall a. a -> [a] -> [a]
:String
s
unclassify Bool
True (Comment String
"") = String
" --"
unclassify Bool
True (Comment String
s) = String
" -- " forall a. [a] -> [a] -> [a]
++ String
s
unclassify Bool
False (Comment String
"") = String
"--"
unclassify Bool
False (Comment String
s) = String
"-- " forall a. [a] -> [a] -> [a]
++ String
s
unclassify Bool
_ Classified
_ = forall a. a
internalError
unlit :: FilePath -> String -> Either String String
unlit :: String -> String -> Either String String
unlit String
file String
input =
let (Bool
usesBirdTracks, [Classified]
classified) = [String] -> (Bool, [Classified])
classifyAndCheckForBirdTracks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
inlines
forall a b. (a -> b) -> a -> b
$ String
input
in forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Classified -> String
unclassify Bool
usesBirdTracks))
forall a b. b -> Either a b
Right
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Classified] -> Either [Classified] String
checkErrors
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Classified] -> [Classified]
reclassify
forall a b. (a -> b) -> a -> b
$ [Classified]
classified
where
classifyAndCheckForBirdTracks :: [String] -> (Bool, [Classified])
classifyAndCheckForBirdTracks =
forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL Bool
False forall a b. (a -> b) -> a -> b
$ \Bool
seenBirdTrack String
line ->
let classification :: Classified
classification = String -> Classified
classify String
line
in (Bool
seenBirdTrack Bool -> Bool -> Bool
|| Classified -> Bool
isBirdTrack Classified
classification, Classified
classification)
isBirdTrack :: Classified -> Bool
isBirdTrack (BirdTrack String
_) = Bool
True
isBirdTrack Classified
_ = Bool
False
checkErrors :: [Classified] -> Either [Classified] String
checkErrors [Classified]
ls = case [ String
e | Error String
e <- [Classified]
ls ] of
[] -> forall a b. a -> Either a b
Left [Classified]
ls
(String
message:[String]
_) -> forall a b. b -> Either a b
Right (String
f forall a. [a] -> [a] -> [a]
++ String
":" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ String
message)
where (String
f, Int
n) = String -> Int -> [Classified] -> (String, Int)
errorPos String
file Int
1 [Classified]
ls
errorPos :: String -> Int -> [Classified] -> (String, Int)
errorPos String
f Int
n [] = (String
f, Int
n)
errorPos String
f Int
n (Error String
_:[Classified]
_) = (String
f, Int
n)
errorPos String
_ Int
_ (Line Int
n' String
f':[Classified]
ls) = String -> Int -> [Classified] -> (String, Int)
errorPos String
f' Int
n' [Classified]
ls
errorPos String
f Int
n (Classified
_ :[Classified]
ls) = String -> Int -> [Classified] -> (String, Int)
errorPos String
f (Int
nforall a. Num a => a -> a -> a
+Int
1) [Classified]
ls
reclassify :: [Classified] -> [Classified]
reclassify :: [Classified] -> [Classified]
reclassify = [Classified] -> [Classified]
blank
where
latex :: [Classified] -> [Classified]
latex [] = []
latex (Classified
EndCode :[Classified]
ls) = String -> Classified
Blank String
"" forall a. a -> [a] -> [a]
: [Classified] -> [Classified]
comment [Classified]
ls
latex (Classified
BeginCode :[Classified]
_ ) = [String -> Classified
Error String
"\\begin{code} in code section"]
latex (BirdTrack String
l:[Classified]
ls) = String -> Classified
Ordinary (Char
'>'forall a. a -> [a] -> [a]
:String
l) forall a. a -> [a] -> [a]
: [Classified] -> [Classified]
latex [Classified]
ls
latex ( Classified
l:[Classified]
ls) = Classified
l forall a. a -> [a] -> [a]
: [Classified] -> [Classified]
latex [Classified]
ls
blank :: [Classified] -> [Classified]
blank [] = []
blank (Classified
EndCode :[Classified]
_ ) = [String -> Classified
Error String
"\\end{code} without \\begin{code}"]
blank (Classified
BeginCode :[Classified]
ls) = String -> Classified
Blank String
"" forall a. a -> [a] -> [a]
: [Classified] -> [Classified]
latex [Classified]
ls
blank (BirdTrack String
l:[Classified]
ls) = String -> Classified
BirdTrack String
l forall a. a -> [a] -> [a]
: [Classified] -> [Classified]
bird [Classified]
ls
blank (Ordinary String
l:[Classified]
ls) = String -> Classified
Comment String
l forall a. a -> [a] -> [a]
: [Classified] -> [Classified]
comment [Classified]
ls
blank ( Classified
l:[Classified]
ls) = Classified
l forall a. a -> [a] -> [a]
: [Classified] -> [Classified]
blank [Classified]
ls
bird :: [Classified] -> [Classified]
bird [] = []
bird (Classified
EndCode :[Classified]
_ ) = [String -> Classified
Error String
"\\end{code} without \\begin{code}"]
bird (Classified
BeginCode :[Classified]
ls) = String -> Classified
Blank String
"" forall a. a -> [a] -> [a]
: [Classified] -> [Classified]
latex [Classified]
ls
bird (Blank String
l :[Classified]
ls) = String -> Classified
Blank String
l forall a. a -> [a] -> [a]
: [Classified] -> [Classified]
blank [Classified]
ls
bird (Ordinary String
_:[Classified]
_ ) = [String -> Classified
Error String
"program line before comment line"]
bird ( Classified
l:[Classified]
ls) = Classified
l forall a. a -> [a] -> [a]
: [Classified] -> [Classified]
bird [Classified]
ls
comment :: [Classified] -> [Classified]
comment [] = []
comment (Classified
EndCode :[Classified]
_ ) = [String -> Classified
Error String
"\\end{code} without \\begin{code}"]
comment (Classified
BeginCode :[Classified]
ls) = String -> Classified
Blank String
"" forall a. a -> [a] -> [a]
: [Classified] -> [Classified]
latex [Classified]
ls
comment (CPP String
l :[Classified]
ls) = String -> Classified
CPP String
l forall a. a -> [a] -> [a]
: [Classified] -> [Classified]
comment [Classified]
ls
comment (BirdTrack String
_:[Classified]
_ ) = [String -> Classified
Error String
"comment line before program line"]
comment (Blank String
l:ls :: [Classified]
ls@(Ordinary String
_:[Classified]
_)) = String -> Classified
Comment String
l forall a. a -> [a] -> [a]
: [Classified] -> [Classified]
comment [Classified]
ls
comment (Blank String
l:[Classified]
ls) = String -> Classified
Blank String
l forall a. a -> [a] -> [a]
: [Classified] -> [Classified]
blank [Classified]
ls
comment (Line Int
n String
f :[Classified]
ls) = Int -> String -> Classified
Line Int
n String
f forall a. a -> [a] -> [a]
: [Classified] -> [Classified]
comment [Classified]
ls
comment (Ordinary String
l:[Classified]
ls) = String -> Classified
Comment String
l forall a. a -> [a] -> [a]
: [Classified] -> [Classified]
comment [Classified]
ls
comment (Comment String
_: [Classified]
_) = forall a. a
internalError
comment (Error String
_: [Classified]
_) = forall a. a
internalError
inlines :: String -> [String]
inlines :: String -> [String]
inlines String
xs = String -> (String -> String) -> [String]
lines' String
xs 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 [] forall a. a -> [a] -> [a]
: String -> (String -> String) -> [String]
lines' String
s forall a. a -> a
id
lines' (Char
'\^M':String
s) String -> String
acc = String -> String
acc [] forall a. a -> [a] -> [a]
: String -> (String -> String) -> [String]
lines' String
s forall a. a -> a
id
lines' (Char
'\n':String
s) String -> String
acc = String -> String
acc [] forall a. a -> [a] -> [a]
: String -> (String -> String) -> [String]
lines' String
s forall a. a -> a
id
lines' (Char
c:String
s) String -> String
acc = String -> (String -> String) -> [String]
lines' String
s (String -> String
acc forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
cforall a. a -> [a] -> [a]
:))
internalError :: a
internalError :: forall a. a
internalError = forall a. HasCallStack => String -> a
error String
"unlit: internal error"