module Cloudy.Cli.Utils where

import Control.Applicative (optional)
import Options.Applicative (Parser, help, Mod)

-- | This lifts a option 'Parser' to a 'Parser' of 'Maybe', allowing you to
-- specify a default value.
--
-- Given a call like:
--
-- @
--   'maybeOpt' \"Which foobar to use\" \"bazqux\" 'strOption' ('short' \'f\' <> 'metavar' \"FOOBAR\") :: 'Parser' (Maybe 'Text')
-- @
--
-- this returns 'Nothing' if the user doesn't specify the @-f@ option, and
-- 'Just' if the user does.  It also shows that the default values is @\"bazqux\"@.
--
-- Using 'maybeOpt' is different than just using the 'value' 'Mod' in order to
-- set a default value, since 'maybeOpt' returns 'Nothing' if the option was
-- not given on the command line (but it still shows the default value in the
-- @--help@ output.
maybeOpt ::
  Show a =>
  String ->
  a ->
  (Mod f a -> Parser a) ->
  Mod f a ->
  Parser (Maybe a)
maybeOpt :: forall a (f :: * -> *).
Show a =>
String -> a -> (Mod f a -> Parser a) -> Mod f a -> Parser (Maybe a)
maybeOpt String
helpStr a
defaultVal Mod f a -> Parser a
p Mod f a
mods = Parser a -> Parser (Maybe a)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Mod f a -> Parser a
p (Mod f a -> Parser a) -> Mod f a -> Parser a
forall a b. (a -> b) -> a -> b
$ Mod f a
mods Mod f a -> Mod f a -> Mod f a
forall a. Semigroup a => a -> a -> a
<> String -> Mod f a
forall (f :: * -> *) a. String -> Mod f a
help String
helpWithDefaultStr)
  where
    helpWithDefaultStr :: String
helpWithDefaultStr = String
helpStr String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" (default: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
defaultVal String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
")"