src/preproc.hs

   1 import System.Environment ( getArgs )
   2 import System.Exit ( exitWith, ExitCode(..) )
   3 import Text.Regex ( matchRegex, mkRegex )
   4
   5 import Darcs.Commands
   6 import Darcs.Arguments
   7 import Darcs.Commands.Help ( command_control_list )
   8 import Darcs.FilePathUtils ( (///) )
   9 import Autoconf ( darcs_version )
  10
  11 the_commands :: [DarcsCommand]
  12 the_commands = extract_commands command_control_list
  13
  14 main :: IO ()
  15 main = do
  16   args <- getArgs
  17   if length args < 1
  18      then exitWith $ ExitFailure 1
  19      else return ()
  20   putStrLn "%% This file was automatically generated by preproc."
  21   c <- preproc ["\\input{"++head args++"}"]
  22   mapM_ putStrLn c
  23
  24 am_html :: IO Bool
  25 am_html = do args <- getArgs
  26              case args of
  27                [_,"--html"] -> return True
  28                _ -> return False
  29
  30 preproc :: [String] -> IO [String]
  31 preproc ("\\usepackage{html}":ss) = -- only use html package with latex2html
  32     do rest <- preproc ss
  33        ah <- am_html
  34        if ah then return $ "\\usepackage{html}" : rest
  35              else return $ "\\newcommand{\\htmladdnormallink}[2]{#1}" :
  36                   "\\newcommand{\\htmladdnormallinkfoot}[2]{#1\\footnotetext{\\tt #2}}"
  37                   : rest
  38 preproc ("\\begin{code}":ss) = ignore ss
  39 preproc ("\\begin{options}":ss) =
  40     do rest <- preproc ss
  41        ah <- am_html
  42        if ah then return $ "\\begin{rawhtml}" : "<div class=\"cmd-opt-hdr\">" : rest
  43              else return $ ("\\begin{Verbatim}[frame=lines,xleftmargin=1cm," ++
  44                             "xrightmargin=1cm]") : rest
  45 preproc ("\\end{options}":ss) =
  46     do rest <- preproc ss
  47        ah <- am_html
  48        if ah then return $ "</div>" : "\\end{rawhtml}" : rest
  49              else return $ "\\end{Verbatim}" : rest
  50 preproc (s:ss) = do
  51   rest <- preproc ss
  52   case matchRegex (mkRegex "^\\\\input\\{(.+)\\}$") s of
  53     Just (fn:_) -> do cs <- readFile $ "src" /// fn -- ratify readFile: not part of
  54                                         -- darcs executable
  55                       this <- preproc $ lines cs
  56                       return $ this ++ rest
  57     _ -> case matchRegex (mkRegex "^(.*)\\\\haskell\\{(.+)\\}(.*)$") s of
  58          Just (before:var:after:_) ->
  59              case breakLast '_' var of
  60              (cn,"help") -> return $ (before++gh cn++after):rest
  61              (cn,"description") -> return $ (before++gd cn++after):rest
  62              ("darcs","version") -> return $ (before++darcs_version++after):rest
  63              aack -> error $ show aack
  64          _ -> case matchRegex (mkRegex "^(.*)\\\\options\\{(.+)\\}(.*)$") s of
  65               Just (before:comm:after:_) ->
  66                   return $ (before++get_options comm++after):rest
  67               _ ->  case matchRegex (mkRegex "^(.*)\\\\example\\{(.+)\\}(.*)$") s of
  68                     Just (before:fn:after:_) -> do
  69                         filecont <- readFile fn -- ratify readFile: not part of
  70                                                 -- darcs executable
  71                         return $ (before++"\\begin{verbatim}"++
  72                                   filecont++"\\end{verbatim}"
  73                                   ++after):rest
  74                     _ -> return $ s : rest
  75   where breakLast chr str = (reverse $ tail l, reverse f)
  76             where (f, l) = break (==chr) $ reverse str
  77
  78 preproc [] = return []
  79
  80 get_options :: String -> String
  81 get_options comm = get_com_options $ get_c names the_commands
  82     where names = words comm
  83
  84 get_c :: [String] -> [DarcsCommand] -> [DarcsCommand]
  85 get_c (name:ns) commands =
  86     case ns of
  87     [] -> [get name commands]
  88     _ -> case get name commands of
  89          c@SuperCommand { } ->
  90              c:(get_c ns $ extract_commands $ command_sub_commands c)
  91          _ ->
  92              error $ "Not a supercommand: " ++ name
  93     where get n (c:cs) | command_name c == n = c
  94                        | otherwise = get n cs
  95           get n [] = error $ "No such command:  "++n
  96 get_c [] _ = error "no command specified"
  97
  98 get_com_options :: [DarcsCommand] -> String
  99 get_com_options c =
 100     "\\verb!Usage: darcs " ++ cmd ++ " [OPTION]... " ++
 101     args ++ "!\n\n" ++ "Options:\n\n" ++ options_latex opts1 ++
 102     (if null opts2 then "" else "\n\n" ++ "Advanced options:\n\n" ++ options_latex opts2)
 103     where cmd = unwords $ map command_name c
 104           args = unwords $ command_extra_arg_help $ last c
 105           opts1 = command_basic_options $ last c
 106           opts2 = command_advanced_options $ last c
 107
 108 ignore :: [String] -> IO [String]
 109 ignore ("\\end{code}":ss) = preproc ss
 110 ignore (_:ss) = ignore ss
 111 ignore [] = return []
 112
 113 command_property :: (DarcsCommand -> String) -> [DarcsCommand] -> String
 114                  -> String
 115 command_property property commands name =
 116     property $ last c
 117     where words_ :: String -> [String] -- "word" with '_' instead of spaces
 118           words_ s =
 119               case dropWhile (=='_') s of
 120                        "" -> []
 121                        s' -> w : words_ s''
 122                            where (w, s'') = break (=='_') s'
 123           names = words_ name
 124           c = get_c names commands
 125
 126 gh :: String -> String
 127 gh = command_property command_help the_commands
 128 gd :: String -> String
 129 gd = command_property command_description the_commands