{-# 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 -> 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
<$ :: forall a b. a -> Flag b -> Flag a
$c<$ :: forall a b. a -> Flag b -> Flag a
fmap :: forall a b. (a -> b) -> Flag a -> Flag b
$cfmap :: forall a b. (a -> b) -> Flag a -> Flag b
Functor)

flagConcat :: Monoid a => [Flag a] -> Flag a
flagConcat :: forall a. Monoid a => [Flag a] -> Flag a
flagConcat = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall a. Monoid a => Flag a -> Flag a -> Flag a
flagAppend (forall a. a -> Flag a
NoHelp 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
_) -> forall a. Flag a
Help
      (Flag a
_, Flag a
Help) -> forall a. Flag a
Help
      (Version String
s, Flag a
_) -> forall a. String -> Flag a
Version String
s
      (Flag a
_, Version String
s) -> forall a. String -> Flag a
Version String
s
      (NoHelp a
a, NoHelp a
b) -> forall a. a -> Flag a
NoHelp (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 = forall a. Monoid a => [Flag a] -> Flag a
flagConcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) a. Applicative f => a -> f a
pure) [Flag a]
flags

helpOption :: OptDescr (Flag a)
helpOption :: forall a. OptDescr (Flag a)
helpOption =
  forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [Char
'h'] [String
"help"] (forall a. a -> ArgDescr a
NoArg 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 =
  forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [Char
'v'] [String
"version"] (forall a. a -> ArgDescr a
NoArg (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 = forall a. String -> [OptDescr a] -> String
usageInfo String
header [OptDescr ()]
options
  where
    header :: String
    header :: String
header = [String] -> String
unwords forall a b. (a -> b) -> a -> b
$
      String
progName forall a. a -> [a] -> [a]
:
      String
"[OPTIONS]" forall a. a -> [a] -> [a]
:
      forall a. a -> Maybe a -> a
fromMaybe [] ([(Bool, String)] -> Maybe [String]
formatFields [(Bool, String)]
fields) forall a. [a] -> [a] -> [a]
++
      []

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

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