{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE CPP #-}

module Hercules.CLI.Options where

import qualified Data.Attoparsec.Text as A
import qualified Data.Text as T
import Options.Applicative hiding (helper)
import qualified Options.Applicative as Optparse
#if MIN_VERSION_hercules_ci_optparse_applicative(0, 18, 0)
import Options.Applicative.Extra as Optparse hiding (helper)
#endif
import Protolude

-- | Custom execParser that provides help text when input is incomplete.
execParser :: ParserInfo a -> IO a
execParser :: forall a. ParserInfo a -> IO a
execParser = ParserPrefs -> ParserInfo a -> IO a
forall a. ParserPrefs -> ParserInfo a -> IO a
Optparse.customExecParser (PrefsMod -> ParserPrefs
Optparse.prefs PrefsMod
Optparse.showHelpOnEmpty)

-- | We omit --help from the help text and completion.
helper :: Parser (a -> a)
helper :: forall a. Parser (a -> a)
helper = Mod OptionFields (a -> a) -> Parser (a -> a)
forall a. Mod OptionFields (a -> a) -> Parser (a -> a)
helperWith (Char -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'h' Mod OptionFields (a -> a)
-> Mod OptionFields (a -> a) -> Mod OptionFields (a -> a)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"help" Mod OptionFields (a -> a)
-> Mod OptionFields (a -> a) -> Mod OptionFields (a -> a)
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields (a -> a)
forall (f :: * -> *) a. Mod f a
internal)

subparser :: Mod CommandFields a -> Parser a
subparser :: forall a. Mod CommandFields a -> Parser a
subparser = Mod CommandFields a -> Parser a
forall a. Mod CommandFields a -> Parser a
Optparse.subparser

mkCommand ::
  [Char] ->
  InfoMod a ->
  Parser a ->
  Mod CommandFields a
mkCommand :: forall a. String -> InfoMod a -> Parser a -> Mod CommandFields a
mkCommand String
name InfoMod a
infos Parser a
cmdParser =
  String -> ParserInfo a -> Mod CommandFields a
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
name (Parser a -> InfoMod a -> ParserInfo a
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser (a -> a)
forall a. Parser (a -> a)
helper Parser (a -> a) -> Parser a -> Parser a
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser a
cmdParser) InfoMod a
infos)

packSome :: A.Parser Char -> A.Parser Text
packSome :: Parser Char -> Parser Text
packSome = (String -> Text) -> Parser Text String -> Parser Text
forall a b. (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack (Parser Text String -> Parser Text)
-> (Parser Char -> Parser Text String)
-> Parser Char
-> Parser Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser Char -> Parser Text String
forall a. Parser Text a -> Parser Text [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some

attoparsecReader :: A.Parser a -> ReadM a
attoparsecReader :: forall a. Parser a -> ReadM a
attoparsecReader Parser a
p = (String -> Either String a) -> ReadM a
forall a. (String -> Either String a) -> ReadM a
eitherReader (Parser a -> Text -> Either String a
forall a. Parser a -> Text -> Either String a
A.parseOnly Parser a
p (Text -> Either String a)
-> (String -> Text) -> String -> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack)

scanArguments :: Text -> [Text] -> [Text]
scanArguments :: Text -> [Text] -> [Text]
scanArguments Text
opt (Text
opt' : Text
val : [Text]
opts) | Text
opt Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
opt' = Text
val Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text -> [Text] -> [Text]
scanArguments Text
opt [Text]
opts
scanArguments Text
opt (Text
_ : [Text]
opts) = Text -> [Text] -> [Text]
scanArguments Text
opt [Text]
opts
scanArguments Text
_ [Text]
_ = []

getCompletionWords :: IO [Text]
getCompletionWords :: IO [Text]
getCompletionWords = Text -> [Text] -> [Text]
scanArguments Text
"--bash-completion-word" ([Text] -> [Text]) -> ([String] -> [Text]) -> [String] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
forall a b. ConvertText a b => a -> b
toS ([String] -> [Text]) -> IO [String] -> IO [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [String]
getArgs

scanOption :: Text -> IO (Maybe Text)
scanOption :: Text -> IO (Maybe Text)
scanOption Text
opt = do
  [Text] -> Maybe Text
forall a. [a] -> Maybe a
lastMay ([Text] -> Maybe Text)
-> ([Text] -> [Text]) -> [Text] -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> [Text]
scanArguments Text
opt ([Text] -> Maybe Text) -> IO [Text] -> IO (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [Text]
getCompletionWords

flatCompleter :: IO [Text] -> Completer
flatCompleter :: IO [Text] -> Completer
flatCompleter IO [Text]
generate = (String -> IO [String]) -> Completer
mkCompleter \String
prefix -> do
  [Text]
items <- IO [Text]
generate
  [String] -> IO [String]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([String] -> IO [String]) -> [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$
    [Text]
items
      [Text] -> ([Text] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
T.isPrefixOf (String -> Text
forall a b. ConvertText a b => a -> b
toS String
prefix))
      [Text] -> ([Text] -> [String]) -> [String]
forall a b. a -> (a -> b) -> b
& (Text -> String) -> [Text] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Text -> String
forall a b. ConvertText a b => a -> b
toS