{-# 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 = (== lcurryExt) . takeExtension
data Line
= ProgramStart !Int
| ProgramEnd !Int
| Program !Int String
| Comment !Int String
| Blank !Int
unlit :: FilePath -> String -> CYM String
unlit fn cy
| isLiterate fn = do
let cyl = lines cy
ls <- progLines fn =<<
normalize fn (length cyl) False (zipWith classify [1 .. ] cyl)
when (all null ls) $ failMessageAt (pos2Span $ first fn) "No code in literate script"
return (unlines ls)
| otherwise = return cy
classify :: Int -> String -> Line
classify l s@('>' : _) = Program l s
classify l s@(stripPrefix "\\begin{code}" -> Just cs)
| all isSpace cs = ProgramStart l
| otherwise = Comment l s
classify l s@(stripPrefix "\\end{code}" -> Just cs)
| all isSpace cs = ProgramEnd l
| otherwise = Comment l s
classify l s
| all isSpace s = Blank l
| otherwise = Comment l s
normalize :: FilePath -> Int -> Bool -> [Line] -> CYM [Line]
normalize _ _ False [] = return []
normalize fn n True [] = reportMissingEnd fn n
normalize fn n b (ProgramStart l : rest) = do
when b $ reportSpurious fn l "\\begin{code}"
norm <- normalize fn n True rest
return (Blank l : norm)
normalize fn n b (ProgramEnd l : rest) = do
unless b $ reportSpurious fn l "\\end{code}"
norm <- normalize fn n False rest
return (Blank l : norm)
normalize fn n b (Comment l s : rest) = do
let cons = if b then Program l s else Comment l s
norm <- normalize fn n b rest
return (cons : norm)
normalize fn n b (Program l s : rest) = do
let cons = if b then Program l s else Program l (drop 1 s)
norm <- normalize fn n b rest
return (cons : norm)
normalize fn n b (Blank l : rest) = do
let cons = if b then Program l "" else Blank l
norm <- normalize fn n b rest
return (cons : norm)
progLines :: FilePath -> [Line] -> CYM [String]
progLines fn cs = zipWithM checkAdjacency (Blank 0 : cs) cs where
checkAdjacency (Program p _) (Comment _ _) = reportBlank fn p "followed"
checkAdjacency (Comment _ _) (Program p _) = reportBlank fn p "preceded"
checkAdjacency _ (Program _ s) = return s
checkAdjacency _ _ = return ""
reportBlank :: FilePath -> Int -> String -> CYM a
reportBlank f l cause = failMessageAt (pos2Span $ Position f l 1) msg
where msg = concat [ "When reading literate source: "
, "Program line is " ++ cause ++ " by comment line."
]
reportMissingEnd :: FilePath -> Int -> CYM a
reportMissingEnd f l = failMessageAt (pos2Span $ Position f (l+1) 1) msg
where msg = concat [ "When reading literate source: "
, "Missing '\\end{code}' at the end of file."
]
reportSpurious :: FilePath -> Int -> String -> CYM a
reportSpurious f l cause = failMessageAt (pos2Span $ Position f l 1) msg
where msg = concat [ "When reading literate source: "
, "Spurious '" ++ cause ++ "'."
]