Main.hs 2.92 KB
Newer Older
1 2 3
module Main (main) where

import DynFlags
4 5 6 7 8
import Data.List (stripPrefix)
import Control.Monad (forM_)
import Types hiding (flag)
import Table
import Options
9

10 11 12 13 14
import System.IO

writeFileUtf8 :: FilePath -> String -> IO ()
writeFileUtf8 f txt = withFile f WriteMode (\ hdl -> hSetEncoding hdl utf8 >> hPutStr hdl txt)

15 16
-- | A ReStructuredText fragment
type ReST = String
17 18

main :: IO ()
19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34
main = do
  -- users guide
  writeRestFile (usersGuideFile "what_glasgow_exts_does.gen.rst")
    $ whatGlasgowExtsDoes
  forM_ groups $ \(Group name _ theFlags) ->
    let fname = usersGuideFile $ "flags-"++name++".gen.rst"
    in writeRestFile fname (flagsTable theFlags)

  -- man page
  writeRestFile (usersGuideFile "all-flags.gen.rst") (flagsList groups)

usersGuideFile :: FilePath -> FilePath
usersGuideFile fname = "docs/users_guide/"++fname

writeRestFile :: FilePath -> ReST -> IO ()
writeRestFile fname content =
35
  writeFileUtf8 fname $ unlines
36 37 38 39
    [ ".. This file is generated by utils/mkUserGuidePart"
    , ""
    , content
    ]
40

41
whatGlasgowExtsDoes :: String
42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96
whatGlasgowExtsDoes = unlines
    $ [ ".. hlist::", ""]
    ++ map ((" * "++) . parseExt) glasgowExtsFlags
  where
    parseExt f
      | Just ext <- stripPrefix "Opt_" (show f)
      = inlineCode $ "-X" ++ ext
      | otherwise
      = error ("Can't parse extension: " ++ show f)

-- | Generate a reference table of the given set of flags. This is used in
-- the users guide.
flagsTable :: [Flag] -> ReST
flagsTable theFlags =
    table [50, 100, 30, 50]
          ["Flag", "Description", "Static/Dynamic", "Reverse"]
          (map flagRow theFlags)
  where
    code ""  = ""
    code str = "``"++str++"``"
    flagRow flag =
        [ code (flagName flag)
        , flagDescription flag
        , type_
        , code (flagReverse flag)
        ]
      where
        type_ = case flagType flag of
                  StaticFlag          -> "static"
                  DynamicFlag         -> "dynamic"
                  DynamicSettableFlag -> "dynamic/``:set``"
                  ModeFlag            -> "mode"

-- | Place the given text in an ReST inline code element.
inlineCode :: String -> ReST
inlineCode s = "``" ++ s ++ "``"

heading :: Char -> String -> ReST
heading chr title = unlines
    [ title
    , replicate (length title) chr
    , ""
    ]

-- | Generate a listing of all the flags known to GHC.
-- Used in the man page.
flagsList :: [Group] -> ReST
flagsList grps = unlines $
    map doGroup grps ++ map flagDescriptions grps
  where
    doGroup grp = unlines
      [ grpTitle grp
      , "    " ++ unwords (map (inlineCode . flagName) (grpFlags grp))
      , ""
      ]
97

98 99 100 101 102 103 104 105 106 107
-- | Generate a definition list of the known flags.
-- Used in the man page.
flagDescriptions :: Group -> ReST
flagDescriptions (Group _ title fs) =
    unlines $ [ heading '~' title ] ++ map doFlag fs
  where
    doFlag flag =
      unlines $ [ inlineCode (flagName flag)
                , "    " ++ flagDescription flag
                ]