-- | 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 ( preproc_main ) where
import qualified Ratified( readFile )
import System.FilePath ( (</>) )
import System.Environment ( getArgs )
import System.Exit ( exitWith, ExitCode(..) )
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 )

the_commands :: [DarcsCommand]
the_commands = 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.
preproc_main :: [String] -> IO ()
preproc_main args = do
  if length args < 1
     then exitWith $ ExitFailure 1
     else return ()
  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@.
am_html :: IO Bool
am_html = 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 <- am_html
       if ah then return $ "\\usepackage{html}" : rest
             else return $ "\\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 <- am_html
       if ah then return $ "\\begin{rawhtml}" : "<div class=\"cmd-opt-hdr\">" : rest
             else return $ ("\\begin{Verbatim}[frame=lines,xleftmargin=1cm," ++
                            "xrightmargin=1cm]") : rest
preproc ("\\end{options}":ss) =
    do rest <- preproc ss
       ah <- am_html
       if ah then return $ "</div>" : "\\end{rawhtml}" : rest
             else return $ "\\end{Verbatim}" : rest
preproc ("\\darcsVersion":ss) = do
  rest <- preproc ss
  return $ version:rest
preproc (s:ss) = do
  rest <- preproc ss
  let rx = mkRegex "^\\\\(input|darcs(Command|Env))\\{(.+)\\}$"
  case matchRegex rx s of
    Just ["input", _, path] ->
        do cs <- Ratified.readFile $ "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 ++ get_options command ++ 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 =  escape_latex_specials $ command_property commandHelp the_commands command
      -- | Given a Darcs command name as a string, return that command's (one-line) description string.
      gd :: String
      gd = command_property commandDescription the_commands command

get_options :: String -> String
get_options comm = get_com_options $ get_c names the_commands
    where names = words comm

get_c :: [String] -> [DarcsCommand] -> [DarcsCommand]
get_c (name:ns) commands =
    case ns of
    [] -> [get name commands]
    _ -> case get name commands of
         c@SuperCommand { } ->
             c:(get_c 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
get_c [] _ = error "no command specified"

get_com_options :: [DarcsCommand] -> String
get_com_options 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

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



envHelp :: String -> String
envHelp var = unlines $ render $ entry environmentHelp
    where render (ks, ds) =
              ("\\paragraph{" ++ escape_latex_specials (andClauses ks) ++ "}") :
              ("\\label{env:" ++ var ++ "}") :
              map escape_latex_specials 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.
escape_latex_specials :: String -> String
-- Order is important
escape_latex_specials =
  (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 =
        if take (length find) s == find
            then repl ++ (replace find repl (drop (length find) s))
            else [head s] ++ replace find repl (tail s)