utils/mkUserGuidePart/Main.hs

   1
   2 module Main (main) where
   3
   4 import DynFlags
   5
   6 import Data.List
   7 import System.Environment
   8
   9 main :: IO ()
  10 main = do args <- getArgs
  11           case args of
  12               [] -> error "Need to give filename to generate as an argument"
  13               [f] ->
  14                   case f of
  15                       "docs/users_guide/users_guide.xml" ->
  16                           writeFile f userGuideMain
  17                       "docs/users_guide/what_glasgow_exts_does.gen.xml" ->
  18                           writeFile f whatGlasgowExtsDoes
  19                       _ ->
  20                           error ("Don't know what to do for " ++ show f)
  21               _ -> error "Bad args"
  22
  23 -- Hack: dblatex normalises the name of the main input file using
  24 -- os.path.realpath, which means that if we're in a linked build tree,
  25 -- it find the real source files rather than the symlinks in our link
  26 -- tree. This is fine for the static sources, but it means it can't
  27 -- find the generated sources.
  28 -- We therefore also generate the main input file, so that it really
  29 -- is in the link tree, and thus dblatex can find everything.
  30 userGuideMain :: String
  31 userGuideMain = unlines [
  32     "<?xml version=\"1.0\" encoding=\"iso-8859-1\"?>",
  33     "<!DOCTYPE book PUBLIC \"-//OASIS//DTD DocBook XML V4.2//EN\"",
  34     "   \"http://www.oasis-open.org/docbook/xml/4.2/docbookx.dtd\" [",
  35     "<!ENTITY % ug-ent SYSTEM \"ug-ent.xml\">",
  36     "%ug-ent;",
  37     "<!ENTITY ug-book SYSTEM \"ug-book.xml\">",
  38     "]>",
  39     "",
  40     "<book id=\"users-guide\">",
  41     "&ug-book;",
  42     "</book>"]
  43
  44 whatGlasgowExtsDoes :: String
  45 whatGlasgowExtsDoes = case maybeInitLast glasgowExtsFlags of
  46                       Just (xs, x) ->
  47                           let xs' = map mkInitLine xs
  48                               x' = mkLastLine x
  49                           in unlines (xs' ++ [x'])
  50                       Nothing ->
  51                           error "glasgowExtsFlags is empty?"
  52     where mkInitLine = mkLine ','
  53           mkLastLine = mkLine '.'
  54           mkLine c f = case stripPrefix "Opt_" (show f) of
  55                        Just ext -> "<option>-X" ++ ext ++ "</option>" ++ [c]
  56                        Nothing -> error ("Can't parse extension: " ++ show f)
  57
  58 maybeInitLast :: [a] -> Maybe ([a], a)
  59 maybeInitLast xs = case reverse xs of
  60                    (y : ys) -> Just (reverse ys, y)
  61                    _        -> Nothing
  62