-- | This program mangles a pseudo-LaTeX document into actual LaTeX.
-- There are three key changes to the input:
--
--   * \\input{foo} is replaced by the contents of the file foo (after
--     it, too, is mangled).  Note that this is relative to the
--     working directory, *not* relative to the file being parsed.
--
--   * Anything between \\begin{code} and \\end{code} is deleted.
--     Note that this is quite unlike normal literate documentation
--     (for which we use Haddock, not LaTeX).
--
--   * Some nonstandard pseudo-LaTeX commands are expanded into actual
--     LaTeX text.  In particular, \\darcsCommand{foo} is replaced by
--     LaTeX markup describing the command @foo@.
module Preproc ( preprocMain ) where
import qualified Ratified( readFile )
import System.FilePath ( (</>) )
import System.Environment ( getArgs )
import System.Exit ( exitWith, ExitCode(..) )
import Control.Monad ( when )
import Data.List ( stripPrefix )
import Text.Regex ( matchRegex, mkRegex )
import Darcs.Commands ( DarcsCommand(SuperCommand,
                        commandSubCommands, commandName,
                        commandExtraArgHelp, commandBasicOptions,
                        commandAdvancedOptions, commandHelp,
                        commandDescription),
                        extractCommands )
import Darcs.Arguments ( optionsLatex )
import Darcs.Commands.Help ( commandControlList, environmentHelp )
import English ( andClauses )
import Version ( version )

theCommands :: [DarcsCommand]
theCommands = extractCommands commandControlList

-- | The entry point for this program.  The path to the TeX master
-- file is supplied as the first argument.  Bootstrapping into
-- 'preproc' then happens by passing it a pseudo-document that
-- contains a single input (include) line.
preprocMain :: [String] -> IO ()
preprocMain args = do
  when (length args < 1) $ exitWith $ ExitFailure 1
  putStrLn "%% This file was automatically generated by preproc."
  c <- preproc ["\\input{"++head args++"}"]
  mapM_ putStrLn c

-- | Depending on whether pdflatex or htlatex is to be used, the LaTeX
-- output of this program must vary subtly.  This procedure returns
-- true iff the command-line arguments contain @--html@.
amHtml :: IO Bool
amHtml = do args <- getArgs
            return $ elem "--html" args

-- | Given a list of input lines in pseudo-LaTeX, return the same
-- document in LaTeX.  The pseudo-LaTeX lines are replaced, other
-- lines are used unmodified.
preproc :: [String] -> IO [String]
preproc [] = return []              -- Empty input, empty output.
preproc ("\\usepackage{html}":ss) = -- only use html package with latex2html
    do rest <- preproc ss
       ah <- amHtml
       return $ if ah
                then "\\usepackage{html}" : rest
                else "\\usepackage{hyperref}" : rest
preproc ("\\begin{code}":ss) = ignore ss
    where ignore :: [String] -> IO [String]
          ignore ("\\end{code}":ss') = preproc ss'
          ignore (_:ss') = ignore ss'
          ignore [] = return []
preproc ("\\begin{options}":ss) =
    do rest <- preproc ss
       ah <- amHtml
       return $ if ah
                then "\\begin{rawhtml}" : "<div class=\"cmd-opt-hdr\">" : rest
                else ("\\begin{Verbatim}[frame=lines,xleftmargin=1cm," ++
                            "xrightmargin=1cm]") : rest
preproc ("\\end{options}":ss) =
    do rest <- preproc ss
       ah <- amHtml
       return $ if ah
                then "</div>" : "\\end{rawhtml}" : rest
                else "\\end{Verbatim}" : rest
preproc ("\\darcsVersion":ss) = do
  rest <- preproc ss
  return $ version:rest
preproc (s:ss) = do
  rest <- preproc ss
  let rx = mkRegex "^\\\\(input|darcsCommand|darcsEnv)\\{(.+)\\}$"
  case matchRegex rx s of
    Just ["input", path] ->
        do cs <- Ratified.readFile $ "doc" </> "src" </> path -- not part of normal darcs operation
           this <- preproc $ lines cs
           return $ this ++ rest
    Just ["darcsCommand", command] ->
        return $ latexCommandHelp command : rest
    Just ["darcsEnv", variable] ->
        return $ envHelp variable : rest
    -- The base case for the whole preproc function.  Nothing to
    -- mangle, so this is an ordinary line of TeX, and we append it to
    -- the result unmodified.
    _ -> return $ s : rest

latexCommandHelp :: String -> String
latexCommandHelp command = section ++ "{darcs " ++ command ++ "}\n" ++
                      "\\label{" ++ command ++ "}\n" ++
                      gh ++ getOptions command ++ "\n" ++ gd
    where
      section = if ' ' `elem` command then "\\subsubsection" else "\\subsection"
      -- | Given a Darcs command name as a string, return that command's (multi-line) help string.
      gh :: String
      gh =  escapeLatexSpecials $ commandProperty commandHelp theCommands command
      -- | Given a Darcs command name as a string, return that command's (one-line) description string.
      gd :: String
      gd = commandProperty commandDescription theCommands command

getOptions :: String -> String
getOptions comm = getComOptions $ getC names theCommands
    where names = words comm

getC :: [String] -> [DarcsCommand] -> [DarcsCommand]
getC (name:ns) commands =
    case ns of
    [] -> [get name commands]
    _ -> case get name commands of
         c@SuperCommand { } ->
             c : getC ns (extractCommands $ commandSubCommands c)
         _ ->
             error $ "Not a supercommand: " ++ name
    where get n (c:cs) | commandName c == n = c
                       | otherwise = get n cs
          get n [] = error $ "No such command:  "++n
getC [] _ = error "no command specified"

getComOptions :: [DarcsCommand] -> String
getComOptions c =
    "\\par\\verb!Usage: darcs " ++ cmd ++ " [OPTION]... " ++
    args ++ "!\n\n" ++ "Options:\n\n" ++ optionsLatex opts1 ++
    (if null opts2 then "" else "\n\n" ++ "Advanced options:\n\n" ++ optionsLatex opts2)
    where cmd = unwords $ map commandName c
          args = unwords $ commandExtraArgHelp $ last c
          opts1 = commandBasicOptions $ last c
          opts2 = commandAdvancedOptions $ last c

commandProperty :: (DarcsCommand -> String) -> [DarcsCommand] -> String
                 -> String
commandProperty property commands name =
    property $ last c
    where names = words name
          c = getC names commands



envHelp :: String -> String
envHelp var = unlines $ render $ entry environmentHelp
    where render (ks, ds) =
              ("\\paragraph{" ++ escapeLatexSpecials (andClauses ks) ++ "}") :
              ("\\label{env:" ++ var ++ "}") :
              map escapeLatexSpecials ds
          entry [] = undefined
          entry (x:xs) | elem var $ fst x = x
                       | otherwise = entry xs

-- | LaTeX treats a number of characters or sequences specially.
-- Therefore when including ordinary help text in a LaTeX document, it
-- is necessary to escape these characters in the way LaTeX expects.
escapeLatexSpecials :: String -> String
-- Order is important
escapeLatexSpecials =
  bs2 . amp . percent . carrot . dollar . underscore . rbrace . lbrace . bs1
  where
    amp        = replace "&"  "\\&"
    bs1        = replace "\\" "\001"
    bs2        = replace "\001" "$\\backslash$"
    carrot     = replace "^"  "\\^{}"
    dollar     = replace "$"  "\\$"
    lbrace     = replace "{"  "\\{"
    percent    = replace "%"  "\\%"
    rbrace     = replace "}"  "\\}"
    underscore = replace "_"  "\\_"

    replace :: Eq a => [a] -> [a] -> [a] -> [a]
    replace _ _ [] = []
    replace find repl s =
        case stripPrefix find s of
            Just rest -> repl ++ replace find repl rest
            Nothing -> head s : replace find repl (tail s)