{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase    #-}
module Distribution.Client.ManpageFlags
( ManpageFlags (..)
, defaultManpageFlags
, manpageOptions,
) where

import Distribution.Client.Compat.Prelude

import Distribution.Simple.Command (OptionField (..), ShowOrParseArgs (..), option)
import Distribution.Simple.Setup   (Flag (..), toFlag, trueArg, optionVerbosity)
import Distribution.Verbosity      (normal)

data ManpageFlags = ManpageFlags
  { ManpageFlags -> Flag Verbosity
manpageVerbosity :: Flag Verbosity
  , ManpageFlags -> Flag Bool
manpageRaw       :: Flag Bool
  } deriving (ManpageFlags -> ManpageFlags -> Bool
(ManpageFlags -> ManpageFlags -> Bool)
-> (ManpageFlags -> ManpageFlags -> Bool) -> Eq ManpageFlags
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ManpageFlags -> ManpageFlags -> Bool
$c/= :: ManpageFlags -> ManpageFlags -> Bool
== :: ManpageFlags -> ManpageFlags -> Bool
$c== :: ManpageFlags -> ManpageFlags -> Bool
Eq, Int -> ManpageFlags -> ShowS
[ManpageFlags] -> ShowS
ManpageFlags -> String
(Int -> ManpageFlags -> ShowS)
-> (ManpageFlags -> String)
-> ([ManpageFlags] -> ShowS)
-> Show ManpageFlags
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ManpageFlags] -> ShowS
$cshowList :: [ManpageFlags] -> ShowS
show :: ManpageFlags -> String
$cshow :: ManpageFlags -> String
showsPrec :: Int -> ManpageFlags -> ShowS
$cshowsPrec :: Int -> ManpageFlags -> ShowS
Show, (forall x. ManpageFlags -> Rep ManpageFlags x)
-> (forall x. Rep ManpageFlags x -> ManpageFlags)
-> Generic ManpageFlags
forall x. Rep ManpageFlags x -> ManpageFlags
forall x. ManpageFlags -> Rep ManpageFlags x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ManpageFlags x -> ManpageFlags
$cfrom :: forall x. ManpageFlags -> Rep ManpageFlags x
Generic)

instance Monoid ManpageFlags  where
  mempty :: ManpageFlags
mempty = ManpageFlags
forall a. (Generic a, GMonoid (Rep a)) => a
gmempty
  mappend :: ManpageFlags -> ManpageFlags -> ManpageFlags
mappend = ManpageFlags -> ManpageFlags -> ManpageFlags
forall a. Semigroup a => a -> a -> a
(<>)

instance Semigroup ManpageFlags where
  <> :: ManpageFlags -> ManpageFlags -> ManpageFlags
(<>) = ManpageFlags -> ManpageFlags -> ManpageFlags
forall a. (Generic a, GSemigroup (Rep a)) => a -> a -> a
gmappend

defaultManpageFlags :: ManpageFlags
defaultManpageFlags :: ManpageFlags
defaultManpageFlags = ManpageFlags :: Flag Verbosity -> Flag Bool -> ManpageFlags
ManpageFlags
    { manpageVerbosity :: Flag Verbosity
manpageVerbosity = Verbosity -> Flag Verbosity
forall a. a -> Flag a
toFlag Verbosity
normal
    , manpageRaw :: Flag Bool
manpageRaw       = Bool -> Flag Bool
forall a. a -> Flag a
toFlag Bool
False
    }

manpageOptions :: ShowOrParseArgs -> [OptionField ManpageFlags]
manpageOptions :: ShowOrParseArgs -> [OptionField ManpageFlags]
manpageOptions ShowOrParseArgs
_ =
    [ (ManpageFlags -> Flag Verbosity)
-> (Flag Verbosity -> ManpageFlags -> ManpageFlags)
-> OptionField ManpageFlags
forall flags.
(flags -> Flag Verbosity)
-> (Flag Verbosity -> flags -> flags) -> OptionField flags
optionVerbosity ManpageFlags -> Flag Verbosity
manpageVerbosity (\Flag Verbosity
v ManpageFlags
flags -> ManpageFlags
flags { manpageVerbosity :: Flag Verbosity
manpageVerbosity = Flag Verbosity
v })
    , String
-> LFlags
-> String
-> (ManpageFlags -> Flag Bool)
-> (Flag Bool -> ManpageFlags -> ManpageFlags)
-> MkOptDescr
     (ManpageFlags -> Flag Bool)
     (Flag Bool -> ManpageFlags -> ManpageFlags)
     ManpageFlags
-> OptionField ManpageFlags
forall get set a.
String
-> LFlags
-> String
-> get
-> set
-> MkOptDescr get set a
-> OptionField a
option String
"" [String
"raw"]
      String
"Output raw troff content"
      ManpageFlags -> Flag Bool
manpageRaw (\Flag Bool
v ManpageFlags
flags -> ManpageFlags
flags { manpageRaw :: Flag Bool
manpageRaw = Flag Bool
v })
      MkOptDescr
  (ManpageFlags -> Flag Bool)
  (Flag Bool -> ManpageFlags -> ManpageFlags)
  ManpageFlags
forall a. MkOptDescr (a -> Flag Bool) (Flag Bool -> a -> a) a
trueArg
    ]