snm-0.0.1: bin/snm.hs

-- Generate simple and nice looking manuals

import Manual

import System.Environment
import System.Console.GetOpt

import Data.Maybe

import Data.List

import System.FilePath

import Control.Monad

import Data.Map (Map)
import qualified Data.Map as M

import Data.Maybe

import System.IO

-- Flags determine how we should behave
data ManFlag =
     Dump
   | OutputFile (Maybe String)
   | OutputType {out_type :: OutputType}
   | Help
   deriving Eq


-- Match only output types
only_types :: ManFlag -> Bool
only_types (OutputType _) = True
only_types _ = False

-- Match only output flag
only_output :: ManFlag -> Bool
only_output (OutputFile _) = True
only_output _ = False

-- Get the output file
output_dir :: FilePath -> ManFlag -> FilePath
output_dir defaul flg =
   case flg of
      OutputFile ms -> fromMaybe defaul ms
      _             -> error "Bug in snm.hs::output_dir!\nContact John Morrice at spoon@killersmurf.com"

-- The order of the arguments
order :: ArgOrder ManFlag 
order = Permute

-- The options we use
options :: [OptDescr ManFlag]
options =
   [dump, output_file, help, text_out, xhtml_out]

-- The user is requesting help
help :: OptDescr ManFlag
help =
   Option "h" ["help"] (NoArg Help) "Print usage information"

-- The user requests output in xhtml
xhtml_out :: OptDescr ManFlag
xhtml_out =
   Option "x" ["xhtml", "html"] (NoArg $ OutputType XHtml) "Output in xhtml format." 

-- The user requests output in text
text_out :: OptDescr ManFlag
text_out =
   Option "t" ["text", "txt"] (NoArg $ OutputType Text) "Text output."

-- The user requests ouput dumped to stdout
dump :: OptDescr ManFlag
dump = 
   Option "d" ["dump"] (NoArg Dump) "Print output to stdout."

-- The user requests output dumped to file
output_file :: OptDescr ManFlag
output_file =
   Option "o" ["output"] (OptArg OutputFile "A file name") "Write output to a file.  Multiple outputs ignored, printing warning to stderr."

-- Print usage information
usage :: IO ()
usage = do
   nm <- getProgName
   putStrLn $ usageInfo 
      (unlines [nm ++ ": The Simple Nice-Looking Manual Generator"
              ,"\nusage: "
              ,"   " ++ nm ++ " documentation_source_directory options*"
              ,"\nWhere options* stands for zero or more of the options below."
              ,"\nNote:"
              ,"   Only one output format is permitted per invocation."
              ,"   If -d or --dump is used, snm will not write a file unless -o or --output is also used."
              ,"   There can be no whitespace between -o and its argument, nor can there be whitespace between --output= and its argument"
              ,"   If no arguments are given to -o, then the file written will have the same filename as the documentation source directory, with an appropriate extension added."
              ,"   " ++ nm ++ " will always add an appropriate extension to output files." 
              ,"   By default, snm will emit xhtml, and act as if the user had specified -o without an argument."])
      options


-- "Make it so" - Jean Luc Picard. 
main :: IO ()
main = do
   -- get the args
   as <- getArgs
   -- get the options
   let (unclean_flags, non, err) = getOpt order options as
       -- clean the flags
       flags = nub unclean_flags
       user_output = msum $ map (flip M.lookup formats) $ map out_type $ filter only_types flags

       output = fromMaybe (xhtml_format) user_output
   -- terminate if there were errors
   if null err
      then do
         case non of
            (input:[]) -> do
               man <- load_manual input 
               -- did the user tell us what to do?
               if null flags
                  then
                     uncurry (undirected input man) output
                  else
                     if elem Help flags
                        then usage
                        else 
                           uncurry (directed input man flags input) output
            _ -> usage
      else 
         usage
      where
     
      -- The user has specified what to do
      directed input man flags defaul format ext = do
         let outs = filter only_output flags
             dump = elem Dump flags 
         -- dump the text if dump is present
         when dump $ putStrLn $ format man
         mout <- case outs of
                    (out:[]) -> return $ Just out
                    (out:n:_) -> do
                       hPutStrLn stderr 
                                 ("Warning: multiple outputs ignored.")
                       return (Just out)
                    _        -> if dump then return Nothing else return $ Just $ OutputFile Nothing
         maybe (return ()) 
               (\out ->
                  write_manual format ext man $ output_dir defaul out)
               mout

      -- The default behaviour
      undirected input man format ext =
         write_manual format ext man (dropExtensions $ takeFileName input)