    {-# LANGUAGE DeriveFunctor #-}
    {-# LANGUAGE ViewPatterns #-}

    module WithCli.Flag where

    import           Prelude ()
    import           Prelude.Compat

    import           Data.List
    import           Data.Maybe
    import           System.Console.GetOpt

    data Flag a
      = Help
      | Version String
      | NoHelp a
      deriving ((forall a b. (a -> b) -> Flag a -> Flag b)
    -> (forall a b. a -> Flag b -> Flag a) -> Functor Flag
    forall a b. a -> Flag b -> Flag a
    forall a b. (a -> b) -> Flag a -> Flag b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    $cfmap :: forall a b. (a -> b) -> Flag a -> Flag b
    fmap :: forall a b. (a -> b) -> Flag a -> Flag b
    $c<$ :: forall a b. a -> Flag b -> Flag a
    <$ :: forall a b. a -> Flag b -> Flag a
    Functor)

    flagConcat :: Monoid a => [Flag a] -> Flag a
    flagConcat :: forall a. Monoid a => [Flag a] -> Flag a
    flagConcat = (Flag a -> Flag a -> Flag a) -> Flag a -> [Flag a] -> Flag a
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' Flag a -> Flag a -> Flag a
    forall a. Monoid a => Flag a -> Flag a -> Flag a
    flagAppend (a -> Flag a
    forall a. a -> Flag a
    NoHelp a
    forall a. Monoid a => a
    mempty)
      where
        flagAppend :: Monoid a => Flag a -> Flag a -> Flag a
        flagAppend :: forall a. Monoid a => Flag a -> Flag a -> Flag a
    flagAppend Flag a
    a Flag a
    b = case (Flag a
    a, Flag a
    b) of
          (Flag a
    Help, Flag a
    _) -> Flag a
    forall a. Flag a
    Help
          (Flag a
    _, Flag a
    Help) -> Flag a
    forall a. Flag a
    Help
          (Version String
    s, Flag a
    _) -> String -> Flag a
    forall a. String -> Flag a
    Version String
    s
          (Flag a
    _, Version String
    s) -> String -> Flag a
    forall a. String -> Flag a
    Version String
    s
          (NoHelp a
    a, NoHelp a
    b) -> a -> Flag a
    forall a. a -> Flag a
    NoHelp (a -> a -> a
    forall a. Monoid a => a -> a -> a
    mappend a
    a a
    b)

    foldFlags :: [Flag a] -> Flag [a]
    foldFlags :: forall a. [Flag a] -> Flag [a]
    foldFlags [Flag a]
    flags = [Flag [a]] -> Flag [a]
    forall a. Monoid a => [Flag a] -> Flag a
    flagConcat ([Flag [a]] -> Flag [a]) -> [Flag [a]] -> Flag [a]
    forall a b. (a -> b) -> a -> b
    $ (Flag a -> Flag [a]) -> [Flag a] -> [Flag [a]]
    forall a b. (a -> b) -> [a] -> [b]
    map ((a -> [a]) -> Flag a -> Flag [a]
    forall a b. (a -> b) -> Flag a -> Flag b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> [a]
    forall a. a -> [a]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure) [Flag a]
    flags

    helpOption :: OptDescr (Flag a)
    helpOption :: forall a. OptDescr (Flag a)
    helpOption =
      String
    -> [String] -> ArgDescr (Flag a) -> String -> OptDescr (Flag a)
    forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
    Option [Char
    'h'] [String
    "help"] (Flag a -> ArgDescr (Flag a)
    forall a. a -> ArgDescr a
    NoArg Flag a
    forall a. Flag a
    Help) String
    "show help and exit"

    versionOption :: String -> OptDescr (Flag a)
    versionOption :: forall a. String -> OptDescr (Flag a)
    versionOption String
    version =
      String
    -> [String] -> ArgDescr (Flag a) -> String -> OptDescr (Flag a)
    forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
    Option [Char
    'v'] [String
    "version"] (Flag a -> ArgDescr (Flag a)
    forall a. a -> ArgDescr a
    NoArg (String -> Flag a
    forall a. String -> Flag a
    Version String
    version)) String
    "show version and exit"

    usage :: String -> [(Bool, String)] -> [OptDescr ()] -> String
    usage :: String -> [(Bool, String)] -> [OptDescr ()] -> String
    usage String
    progName [(Bool, String)]
    fields [OptDescr ()]
    options = String -> [OptDescr ()] -> String
    forall a. String -> [OptDescr a] -> String
    usageInfo String
    header [OptDescr ()]
    options
      where
        header :: String
        header :: String
    header = [String] -> String
    unwords ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $
          String
    progName String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :
          String
    "[OPTIONS]" String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :
          [String] -> Maybe [String] -> [String]
    forall a. a -> Maybe a -> a
    fromMaybe [] ([(Bool, String)] -> Maybe [String]
    formatFields [(Bool, String)]
    fields) [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++
          []

        formatFields :: [(Bool, String)] -> Maybe [String]
        formatFields :: [(Bool, String)] -> Maybe [String]
    formatFields [] = Maybe [String]
    forall a. Maybe a
    Nothing
        formatFields [(Bool, String)]
    fields = [String] -> Maybe [String]
    forall a. a -> Maybe a
    Just ([String] -> Maybe [String]) -> [String] -> Maybe [String]
    forall a b. (a -> b) -> a -> b
    $
          let (((Bool, String) -> String) -> [(Bool, String)] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (Bool, String) -> String
    forall a b. (a, b) -> b
    snd -> [String]
    nonOptional, ((Bool, String) -> String) -> [(Bool, String)] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (Bool, String) -> String
    forall a b. (a, b) -> b
    snd -> [String]
    optional) =
                ((Bool, String) -> Bool)
    -> [(Bool, String)] -> ([(Bool, String)], [(Bool, String)])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    span (Bool -> Bool
    not (Bool -> Bool)
    -> ((Bool, String) -> Bool) -> (Bool, String) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Bool, String) -> Bool
    forall a b. (a, b) -> a
    fst) [(Bool, String)]
    fields
          in [String]
    nonOptional [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [[String] -> String
    formatOptional [String]
    optional]

        formatOptional :: [String] -> String
        formatOptional :: [String] -> String
    formatOptional [] = String
    ""
        formatOptional [String
    a] = String
    "[" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    a String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "]"
        formatOptional (String
    a : [String]
    r) = String
    "[" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    a String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [String] -> String
    formatOptional [String]
    r String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "]"