{-# LANGUAGE ViewPatterns #-}
{- |
    Module      :  $Header$
    Description :  Handling of literate Curry files
    Copyright   :  (c) 2009         Holger Siegel
                       2012  - 2014 Björn Peemöller
    License     :  BSD-3-clause

    Maintainer  :  bjp@informatik.uni-kiel.de
    Stability   :  experimental
    Portability :  portable

    Since version 0.7 of the language report, Curry accepts literate
    source programs. In a literate source, all program lines must begin
    with a greater sign in the first column. All other lines are assumed
    to be documentation. In order to avoid some common errors with
    literate programs, Curry requires at least one program line to be
    present in the file. In addition, every block of program code must be
    preceded by a blank line and followed by a blank line.

    It is also possible to use "\begin{code}" and "\end{code}"
    to mark code segments. Both styles can be used in mixed fashion.
-}

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)

-- |Check whether a 'FilePath' represents a literate Curry module
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 type representing different kind of lines in a literate source
data Line
  = ProgramStart !Int        -- ^ \begin{code}
  | ProgramEnd   !Int        -- ^ \end{code}
  | Program      !Int String -- ^ program line with a line number and content
  | Comment      !Int String -- ^ comment line
  | Blank        !Int        -- ^ blank line

-- |Process a curry program into error messages (if any) and the
-- corresponding non-literate program.
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

-- |Classification of a single program line
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

-- |Check that ProgramStart and ProgramEnd match and desugar them.
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)

-- |Check that each program line is not adjacent to a comment line.
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 ""

-- |Compute an appropiate error message
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]
++ "'."
                     ]