{-# LANGUAGE ViewPatterns #-}
module Curry.Files.Unlit (isLiterate, unlit) where
import Control.Monad (when, unless, zipWithM)
import Data.Char (isSpace)
import Data.List (stripPrefix)
import Curry.Base.Monad (CYM, failMessageAt)
import Curry.Base.Position (Position (..), first)
import Curry.Files.Filenames (lcurryExt, takeExtension)
isLiterate :: FilePath -> Bool
isLiterate :: FilePath -> Bool
isLiterate = (FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
lcurryExt) (FilePath -> Bool) -> (FilePath -> FilePath) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
takeExtension
data Line
= ProgramStart !Int
| ProgramEnd !Int
| Program !Int String
| !Int String
| Blank !Int
unlit :: FilePath -> String -> CYM String
unlit :: FilePath -> FilePath -> CYM FilePath
unlit fn :: FilePath
fn cy :: FilePath
cy
| FilePath -> Bool
isLiterate FilePath
fn = do
let cyl :: [FilePath]
cyl = FilePath -> [FilePath]
lines FilePath
cy
[FilePath]
ls <- FilePath -> [Line] -> CYM [FilePath]
progLines FilePath
fn ([Line] -> CYM [FilePath])
-> WriterT [Message] (ExceptT [Message] Identity) [Line]
-> CYM [FilePath]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
FilePath
-> Int
-> Bool
-> [Line]
-> WriterT [Message] (ExceptT [Message] Identity) [Line]
normalize FilePath
fn ([FilePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
cyl) Bool
False ((Int -> FilePath -> Line) -> [Int] -> [FilePath] -> [Line]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> FilePath -> Line
classify [1 .. ] [FilePath]
cyl)
Bool
-> WriterT [Message] (ExceptT [Message] Identity) ()
-> WriterT [Message] (ExceptT [Message] Identity) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((FilePath -> Bool) -> [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
ls) (WriterT [Message] (ExceptT [Message] Identity) ()
-> WriterT [Message] (ExceptT [Message] Identity) ())
-> WriterT [Message] (ExceptT [Message] Identity) ()
-> WriterT [Message] (ExceptT [Message] Identity) ()
forall a b. (a -> b) -> a -> b
$ Position
-> FilePath -> WriterT [Message] (ExceptT [Message] Identity) ()
forall (m :: * -> *) a. Monad m => Position -> FilePath -> CYT m a
failMessageAt (FilePath -> Position
first FilePath
fn) "No code in literate script"
FilePath -> CYM FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath] -> FilePath
unlines [FilePath]
ls)
| Bool
otherwise = FilePath -> CYM FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
cy
classify :: Int -> String -> Line
classify :: Int -> FilePath -> Line
classify l :: Int
l s :: FilePath
s@('>' : _) = Int -> FilePath -> Line
Program Int
l FilePath
s
classify l :: Int
l s :: FilePath
s@(FilePath -> FilePath -> Maybe FilePath
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix "\\begin{code}" -> Just cs :: FilePath
cs)
| (Char -> Bool) -> FilePath -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace FilePath
cs = Int -> Line
ProgramStart Int
l
| Bool
otherwise = Int -> FilePath -> Line
Comment Int
l FilePath
s
classify l :: Int
l s :: FilePath
s@(FilePath -> FilePath -> Maybe FilePath
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix "\\end{code}" -> Just cs :: FilePath
cs)
| (Char -> Bool) -> FilePath -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace FilePath
cs = Int -> Line
ProgramEnd Int
l
| Bool
otherwise = Int -> FilePath -> Line
Comment Int
l FilePath
s
classify l :: Int
l s :: FilePath
s
| (Char -> Bool) -> FilePath -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace FilePath
s = Int -> Line
Blank Int
l
| Bool
otherwise = Int -> FilePath -> Line
Comment Int
l FilePath
s
normalize :: FilePath -> Int -> Bool -> [Line] -> CYM [Line]
normalize :: FilePath
-> Int
-> Bool
-> [Line]
-> WriterT [Message] (ExceptT [Message] Identity) [Line]
normalize _ _ False [] = [Line] -> WriterT [Message] (ExceptT [Message] Identity) [Line]
forall (m :: * -> *) a. Monad m => a -> m a
return []
normalize fn :: FilePath
fn n :: Int
n True [] = FilePath
-> Int -> WriterT [Message] (ExceptT [Message] Identity) [Line]
forall a. FilePath -> Int -> CYM a
reportMissingEnd FilePath
fn Int
n
normalize fn :: FilePath
fn n :: Int
n b :: Bool
b (ProgramStart l :: Int
l : rest :: [Line]
rest) = do
Bool
-> WriterT [Message] (ExceptT [Message] Identity) ()
-> WriterT [Message] (ExceptT [Message] Identity) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
b (WriterT [Message] (ExceptT [Message] Identity) ()
-> WriterT [Message] (ExceptT [Message] Identity) ())
-> WriterT [Message] (ExceptT [Message] Identity) ()
-> WriterT [Message] (ExceptT [Message] Identity) ()
forall a b. (a -> b) -> a -> b
$ FilePath
-> Int
-> FilePath
-> WriterT [Message] (ExceptT [Message] Identity) ()
forall a. FilePath -> Int -> FilePath -> CYM a
reportSpurious FilePath
fn Int
l "\\begin{code}"
[Line]
norm <- FilePath
-> Int
-> Bool
-> [Line]
-> WriterT [Message] (ExceptT [Message] Identity) [Line]
normalize FilePath
fn Int
n Bool
True [Line]
rest
[Line] -> WriterT [Message] (ExceptT [Message] Identity) [Line]
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Line
Blank Int
l Line -> [Line] -> [Line]
forall a. a -> [a] -> [a]
: [Line]
norm)
normalize fn :: FilePath
fn n :: Int
n b :: Bool
b (ProgramEnd l :: Int
l : rest :: [Line]
rest) = do
Bool
-> WriterT [Message] (ExceptT [Message] Identity) ()
-> WriterT [Message] (ExceptT [Message] Identity) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
b (WriterT [Message] (ExceptT [Message] Identity) ()
-> WriterT [Message] (ExceptT [Message] Identity) ())
-> WriterT [Message] (ExceptT [Message] Identity) ()
-> WriterT [Message] (ExceptT [Message] Identity) ()
forall a b. (a -> b) -> a -> b
$ FilePath
-> Int
-> FilePath
-> WriterT [Message] (ExceptT [Message] Identity) ()
forall a. FilePath -> Int -> FilePath -> CYM a
reportSpurious FilePath
fn Int
l "\\end{code}"
[Line]
norm <- FilePath
-> Int
-> Bool
-> [Line]
-> WriterT [Message] (ExceptT [Message] Identity) [Line]
normalize FilePath
fn Int
n Bool
False [Line]
rest
[Line] -> WriterT [Message] (ExceptT [Message] Identity) [Line]
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Line
Blank Int
l Line -> [Line] -> [Line]
forall a. a -> [a] -> [a]
: [Line]
norm)
normalize fn :: FilePath
fn n :: Int
n b :: Bool
b (Comment l :: Int
l s :: FilePath
s : rest :: [Line]
rest) = do
let cons :: Line
cons = if Bool
b then Int -> FilePath -> Line
Program Int
l FilePath
s else Int -> FilePath -> Line
Comment Int
l FilePath
s
[Line]
norm <- FilePath
-> Int
-> Bool
-> [Line]
-> WriterT [Message] (ExceptT [Message] Identity) [Line]
normalize FilePath
fn Int
n Bool
b [Line]
rest
[Line] -> WriterT [Message] (ExceptT [Message] Identity) [Line]
forall (m :: * -> *) a. Monad m => a -> m a
return (Line
cons Line -> [Line] -> [Line]
forall a. a -> [a] -> [a]
: [Line]
norm)
normalize fn :: FilePath
fn n :: Int
n b :: Bool
b (Program l :: Int
l s :: FilePath
s : rest :: [Line]
rest) = do
let cons :: Line
cons = if Bool
b then Int -> FilePath -> Line
Program Int
l FilePath
s else Int -> FilePath -> Line
Program Int
l (Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
drop 1 FilePath
s)
[Line]
norm <- FilePath
-> Int
-> Bool
-> [Line]
-> WriterT [Message] (ExceptT [Message] Identity) [Line]
normalize FilePath
fn Int
n Bool
b [Line]
rest
[Line] -> WriterT [Message] (ExceptT [Message] Identity) [Line]
forall (m :: * -> *) a. Monad m => a -> m a
return (Line
cons Line -> [Line] -> [Line]
forall a. a -> [a] -> [a]
: [Line]
norm)
normalize fn :: FilePath
fn n :: Int
n b :: Bool
b (Blank l :: Int
l : rest :: [Line]
rest) = do
let cons :: Line
cons = if Bool
b then Int -> FilePath -> Line
Program Int
l "" else Int -> Line
Blank Int
l
[Line]
norm <- FilePath
-> Int
-> Bool
-> [Line]
-> WriterT [Message] (ExceptT [Message] Identity) [Line]
normalize FilePath
fn Int
n Bool
b [Line]
rest
[Line] -> WriterT [Message] (ExceptT [Message] Identity) [Line]
forall (m :: * -> *) a. Monad m => a -> m a
return (Line
cons Line -> [Line] -> [Line]
forall a. a -> [a] -> [a]
: [Line]
norm)
progLines :: FilePath -> [Line] -> CYM [String]
progLines :: FilePath -> [Line] -> CYM [FilePath]
progLines fn :: FilePath
fn cs :: [Line]
cs = (Line -> Line -> CYM FilePath)
-> [Line] -> [Line] -> CYM [FilePath]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM Line -> Line -> CYM FilePath
checkAdjacency (Int -> Line
Blank 0 Line -> [Line] -> [Line]
forall a. a -> [a] -> [a]
: [Line]
cs) [Line]
cs where
checkAdjacency :: Line -> Line -> CYM FilePath
checkAdjacency (Program p :: Int
p _) (Comment _ _) = FilePath -> Int -> FilePath -> CYM FilePath
forall a. FilePath -> Int -> FilePath -> CYM a
reportBlank FilePath
fn Int
p "followed"
checkAdjacency (Comment _ _) (Program p :: Int
p _) = FilePath -> Int -> FilePath -> CYM FilePath
forall a. FilePath -> Int -> FilePath -> CYM a
reportBlank FilePath
fn Int
p "preceded"
checkAdjacency _ (Program _ s :: FilePath
s) = FilePath -> CYM FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
s
checkAdjacency _ _ = FilePath -> CYM FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return ""
reportBlank :: FilePath -> Int -> String -> CYM a
reportBlank :: FilePath -> Int -> FilePath -> CYM a
reportBlank f :: FilePath
f l :: Int
l cause :: FilePath
cause = Position -> FilePath -> CYM a
forall (m :: * -> *) a. Monad m => Position -> FilePath -> CYT m a
failMessageAt (FilePath -> Int -> Int -> Position
Position FilePath
f Int
l 1) FilePath
msg
where msg :: FilePath
msg = [FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ "When reading literate source: "
, "Program line is " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
cause FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ " by comment line."
]
reportMissingEnd :: FilePath -> Int -> CYM a
reportMissingEnd :: FilePath -> Int -> CYM a
reportMissingEnd f :: FilePath
f l :: Int
l = Position -> FilePath -> CYM a
forall (m :: * -> *) a. Monad m => Position -> FilePath -> CYT m a
failMessageAt (FilePath -> Int -> Int -> Position
Position FilePath
f (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) 1) FilePath
msg
where msg :: FilePath
msg = [FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ "When reading literate source: "
, "Missing '\\end{code}' at the end of file."
]
reportSpurious :: FilePath -> Int -> String -> CYM a
reportSpurious :: FilePath -> Int -> FilePath -> CYM a
reportSpurious f :: FilePath
f l :: Int
l cause :: FilePath
cause = Position -> FilePath -> CYM a
forall (m :: * -> *) a. Monad m => Position -> FilePath -> CYT m a
failMessageAt (FilePath -> Int -> Int -> Position
Position FilePath
f Int
l 1) FilePath
msg
where msg :: FilePath
msg = [FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ "When reading literate source: "
, "Spurious '" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
cause FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "'."
]