|
| 1 | +------------------------------------------------------------------------------ |
| 2 | +-- | |
| 3 | +-- Module : LibOA |
| 4 | +-- Description : supplementary functions for optparse-applicative |
| 5 | +-- Copyright : Copyright (c) 2019-2020 Travis Cardwell |
| 6 | +-- License : MIT |
| 7 | +-- |
| 8 | +-- This is a collection of functions that I often use with |
| 9 | +-- @optparse-applicative@. I do not feel that it is worth maintaining yet |
| 10 | +-- another helper package on Hackage, so I just copy the code to different |
| 11 | +-- projects as required. If the library grows to a substantial size or others |
| 12 | +-- with to use it, I will reconsider. |
| 13 | +-- |
| 14 | +-- Revision: 2020-01-02 |
| 15 | +------------------------------------------------------------------------------ |
| 16 | + |
| 17 | +{-# LANGUAGE CPP #-} |
| 18 | + |
| 19 | +module LibOA |
| 20 | + ( -- * Options |
| 21 | + -- $Options |
| 22 | + helper |
| 23 | + , versioner |
| 24 | + -- * Utilities |
| 25 | + , commands |
| 26 | + -- * Help |
| 27 | + , (<||>) |
| 28 | + , section |
| 29 | + , table |
| 30 | + , vspace |
| 31 | + ) where |
| 32 | + |
| 33 | +-- https://hackage.haskell.org/package/ansi-wl-pprint |
| 34 | +import qualified Text.PrettyPrint.ANSI.Leijen as Doc |
| 35 | +import Text.PrettyPrint.ANSI.Leijen (Doc) |
| 36 | + |
| 37 | +-- https://hackage.haskell.org/package/base |
| 38 | +import qualified Data.List as List |
| 39 | +#if !MIN_VERSION_base (4,11,0) |
| 40 | +import Data.Monoid ((<>)) |
| 41 | +#endif |
| 42 | + |
| 43 | +-- https://hackage.haskell.org/package/optparse-applicative |
| 44 | +import qualified Options.Applicative as OA |
| 45 | +import qualified Options.Applicative.Common as OAC |
| 46 | +import qualified Options.Applicative.Types as OAT |
| 47 | + |
| 48 | +------------------------------------------------------------------------------ |
| 49 | +-- $Options |
| 50 | +-- |
| 51 | +-- Option descriptions are not capitalized. |
| 52 | + |
| 53 | +-- | A hidden @-h@ / @--help@ option that always fails, showing the help |
| 54 | +-- |
| 55 | +-- This is the same as 'OA.helper' except that it has a different help |
| 56 | +-- message. |
| 57 | +helper :: OA.Parser (a -> a) |
| 58 | +helper = OA.abortOption OA.ShowHelpText $ mconcat |
| 59 | + [ OA.short 'h' |
| 60 | + , OA.long "help" |
| 61 | + , OA.help "show help and exit" |
| 62 | + , OA.hidden |
| 63 | + ] |
| 64 | + |
| 65 | +-- | A hidden @--version@ option that always fails, showing the version |
| 66 | +versioner |
| 67 | + :: String -- ^ version string |
| 68 | + -> OA.Parser (a -> a) |
| 69 | +versioner verStr = OA.infoOption verStr $ mconcat |
| 70 | + [ OA.long "version" |
| 71 | + , OA.help "show version and exit" |
| 72 | + , OA.hidden |
| 73 | + ] |
| 74 | + |
| 75 | +------------------------------------------------------------------------------ |
| 76 | +-- $Utilities |
| 77 | + |
| 78 | +-- | Get a list of commands for a parser |
| 79 | +commands :: OA.Parser a -> [String] |
| 80 | +commands = |
| 81 | + let go _ opt = case OAT.optMain opt of |
| 82 | + OAT.CmdReader _ cmds _ -> reverse cmds |
| 83 | + _ -> [] |
| 84 | + in concat . OAC.mapParser go |
| 85 | + |
| 86 | +------------------------------------------------------------------------------ |
| 87 | +-- $Help |
| 88 | + |
| 89 | +-- | Insert a blank line between two documents |
| 90 | +(<||>) :: Doc -> Doc -> Doc |
| 91 | +d1 <||> d2 = d1 <> Doc.line <> Doc.line <> d2 |
| 92 | + |
| 93 | +-- | Create a section with a title and indented body |
| 94 | +section :: String -> Doc -> Doc |
| 95 | +section title = (Doc.text title Doc.<$$>) . Doc.indent 2 |
| 96 | + |
| 97 | +-- | Create a two-column table |
| 98 | +table :: [(String, String)] -> Doc |
| 99 | +table rows = |
| 100 | + let width = 1 + maximum (map (length . fst) rows) |
| 101 | + in Doc.vcat |
| 102 | + [ Doc.fillBreak width (Doc.text l) Doc.<+> Doc.text r |
| 103 | + | (l, r) <- rows |
| 104 | + ] |
| 105 | + |
| 106 | +-- | Vertically space documents with blank lines between them |
| 107 | +vspace :: [Doc] -> Doc |
| 108 | +vspace = mconcat . List.intersperse (Doc.line <> Doc.line) |
0 commit comments