{-# 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.Span (pos2Span)
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
$ Span
-> FilePath -> WriterT [Message] (ExceptT [Message] Identity) ()
forall (m :: * -> *) a. Monad m => Span -> FilePath -> CYT m a
failMessageAt (Position -> Span
pos2Span (Position -> Span) -> Position -> Span
forall a b. (a -> b) -> a -> b
$ 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 = Span -> FilePath -> CYM a
forall (m :: * -> *) a. Monad m => Span -> FilePath -> CYT m a
failMessageAt (Position -> Span
pos2Span (Position -> Span) -> Position -> Span
forall a b. (a -> b) -> a -> b
$ 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 = Span -> FilePath -> CYM a
forall (m :: * -> *) a. Monad m => Span -> FilePath -> CYT m a
failMessageAt (Position -> Span
pos2Span (Position -> Span) -> Position -> Span
forall a b. (a -> b) -> a -> b
$ 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 = Span -> FilePath -> CYM a
forall (m :: * -> *) a. Monad m => Span -> FilePath -> CYT m a
failMessageAt (Position -> Span
pos2Span (Position -> Span) -> Position -> Span
forall a b. (a -> b) -> a -> b
$ 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]
++ "'."
]