module Ribosome.App.Options where

import Options.Applicative (
  CommandFields,
  Mod,
  Parser,
  ReadM,
  argument,
  command,
  customExecParser,
  fullDesc,
  header,
  help,
  helper,
  hsubparser,
  info,
  long,
  metavar,
  option,
  prefs,
  progDesc,
  readerError,
  short,
  showHelpOnEmpty,
  showHelpOnError,
  str,
  switch,
  )
import Options.Applicative.Types (readerAsk)
import Path (Abs, Dir, Path)
import Path.IO (getCurrentDir)
import Prelude hiding (Mod)

import Ribosome.App.Data (
  Author,
  Branch,
  CachixKey,
  CachixName,
  FlakeUrl,
  GithubOrg,
  GithubRepo,
  Maintainer,
  PrintDir (PrintDir),
  ProjectNames (..),
  SkipCachix (SkipCachix),
  )
import qualified Ribosome.App.ProjectNames as ProjectNames
import Ribosome.Host.Optparse (dirPathOption)

data ProjectOptions =
  ProjectOptions {
    ProjectOptions -> Maybe ProjectNames
names :: Maybe ProjectNames,
    ProjectOptions -> Maybe (Path Abs Dir)
directory :: Maybe (Path Abs Dir),
    ProjectOptions -> Maybe Branch
branch :: Maybe Branch,
    ProjectOptions -> Maybe GithubOrg
githubOrg :: Maybe GithubOrg,
    ProjectOptions -> Maybe GithubRepo
githubRepo :: Maybe GithubRepo,
    ProjectOptions -> SkipCachix
skipCachix :: SkipCachix,
    ProjectOptions -> Maybe CachixName
cachixName :: Maybe CachixName,
    ProjectOptions -> Maybe CachixKey
cachixKey :: Maybe CachixKey
  }
  deriving stock (ProjectOptions -> ProjectOptions -> Bool
(ProjectOptions -> ProjectOptions -> Bool)
-> (ProjectOptions -> ProjectOptions -> Bool) -> Eq ProjectOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProjectOptions -> ProjectOptions -> Bool
$c/= :: ProjectOptions -> ProjectOptions -> Bool
== :: ProjectOptions -> ProjectOptions -> Bool
$c== :: ProjectOptions -> ProjectOptions -> Bool
Eq, Int -> ProjectOptions -> ShowS
[ProjectOptions] -> ShowS
ProjectOptions -> String
(Int -> ProjectOptions -> ShowS)
-> (ProjectOptions -> String)
-> ([ProjectOptions] -> ShowS)
-> Show ProjectOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProjectOptions] -> ShowS
$cshowList :: [ProjectOptions] -> ShowS
show :: ProjectOptions -> String
$cshow :: ProjectOptions -> String
showsPrec :: Int -> ProjectOptions -> ShowS
$cshowsPrec :: Int -> ProjectOptions -> ShowS
Show, (forall x. ProjectOptions -> Rep ProjectOptions x)
-> (forall x. Rep ProjectOptions x -> ProjectOptions)
-> Generic ProjectOptions
forall x. Rep ProjectOptions x -> ProjectOptions
forall x. ProjectOptions -> Rep ProjectOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ProjectOptions x -> ProjectOptions
$cfrom :: forall x. ProjectOptions -> Rep ProjectOptions x
Generic)
  deriving anyclass (ProjectOptions
ProjectOptions -> Default ProjectOptions
forall a. a -> Default a
def :: ProjectOptions
$cdef :: ProjectOptions
Default)

data NewOptions =
  NewOptions {
    NewOptions -> ProjectOptions
project :: ProjectOptions,
    NewOptions -> Maybe FlakeUrl
flakeUrl :: Maybe FlakeUrl,
    NewOptions -> PrintDir
printDir :: PrintDir,
    NewOptions -> Maybe Author
author :: Maybe Author,
    NewOptions -> Maybe Maintainer
maintainer :: Maybe Maintainer
  }
  deriving stock (NewOptions -> NewOptions -> Bool
(NewOptions -> NewOptions -> Bool)
-> (NewOptions -> NewOptions -> Bool) -> Eq NewOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NewOptions -> NewOptions -> Bool
$c/= :: NewOptions -> NewOptions -> Bool
== :: NewOptions -> NewOptions -> Bool
$c== :: NewOptions -> NewOptions -> Bool
Eq, Int -> NewOptions -> ShowS
[NewOptions] -> ShowS
NewOptions -> String
(Int -> NewOptions -> ShowS)
-> (NewOptions -> String)
-> ([NewOptions] -> ShowS)
-> Show NewOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NewOptions] -> ShowS
$cshowList :: [NewOptions] -> ShowS
show :: NewOptions -> String
$cshow :: NewOptions -> String
showsPrec :: Int -> NewOptions -> ShowS
$cshowsPrec :: Int -> NewOptions -> ShowS
Show, (forall x. NewOptions -> Rep NewOptions x)
-> (forall x. Rep NewOptions x -> NewOptions) -> Generic NewOptions
forall x. Rep NewOptions x -> NewOptions
forall x. NewOptions -> Rep NewOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NewOptions x -> NewOptions
$cfrom :: forall x. NewOptions -> Rep NewOptions x
Generic)
  deriving anyclass (NewOptions
NewOptions -> Default NewOptions
forall a. a -> Default a
def :: NewOptions
$cdef :: NewOptions
Default)

data Command =
  New NewOptions
  |
  Boot ProjectOptions
  deriving stock (Command -> Command -> Bool
(Command -> Command -> Bool)
-> (Command -> Command -> Bool) -> Eq Command
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Command -> Command -> Bool
$c/= :: Command -> Command -> Bool
== :: Command -> Command -> Bool
$c== :: Command -> Command -> Bool
Eq, Int -> Command -> ShowS
[Command] -> ShowS
Command -> String
(Int -> Command -> ShowS)
-> (Command -> String) -> ([Command] -> ShowS) -> Show Command
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Command] -> ShowS
$cshowList :: [Command] -> ShowS
show :: Command -> String
$cshow :: Command -> String
showsPrec :: Int -> Command -> ShowS
$cshowsPrec :: Int -> Command -> ShowS
Show)

data GlobalOptions =
  GlobalOptions {
    GlobalOptions -> Maybe Bool
quiet :: Maybe Bool,
    GlobalOptions -> Maybe Bool
force :: Maybe Bool
  }
  deriving stock (GlobalOptions -> GlobalOptions -> Bool
(GlobalOptions -> GlobalOptions -> Bool)
-> (GlobalOptions -> GlobalOptions -> Bool) -> Eq GlobalOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GlobalOptions -> GlobalOptions -> Bool
$c/= :: GlobalOptions -> GlobalOptions -> Bool
== :: GlobalOptions -> GlobalOptions -> Bool
$c== :: GlobalOptions -> GlobalOptions -> Bool
Eq, Int -> GlobalOptions -> ShowS
[GlobalOptions] -> ShowS
GlobalOptions -> String
(Int -> GlobalOptions -> ShowS)
-> (GlobalOptions -> String)
-> ([GlobalOptions] -> ShowS)
-> Show GlobalOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GlobalOptions] -> ShowS
$cshowList :: [GlobalOptions] -> ShowS
show :: GlobalOptions -> String
$cshow :: GlobalOptions -> String
showsPrec :: Int -> GlobalOptions -> ShowS
$cshowsPrec :: Int -> GlobalOptions -> ShowS
Show, (forall x. GlobalOptions -> Rep GlobalOptions x)
-> (forall x. Rep GlobalOptions x -> GlobalOptions)
-> Generic GlobalOptions
forall x. Rep GlobalOptions x -> GlobalOptions
forall x. GlobalOptions -> Rep GlobalOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GlobalOptions x -> GlobalOptions
$cfrom :: forall x. GlobalOptions -> Rep GlobalOptions x
Generic)
  deriving anyclass (GlobalOptions
GlobalOptions -> Default GlobalOptions
forall a. a -> Default a
def :: GlobalOptions
$cdef :: GlobalOptions
Default)

data Options =
  Options {
    Options -> GlobalOptions
global :: GlobalOptions,
    Options -> Command
cmd :: Command
  }
  deriving stock (Options -> Options -> Bool
(Options -> Options -> Bool)
-> (Options -> Options -> Bool) -> Eq Options
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Options -> Options -> Bool
$c/= :: Options -> Options -> Bool
== :: Options -> Options -> Bool
$c== :: Options -> Options -> Bool
Eq, Int -> Options -> ShowS
[Options] -> ShowS
Options -> String
(Int -> Options -> ShowS)
-> (Options -> String) -> ([Options] -> ShowS) -> Show Options
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Options] -> ShowS
$cshowList :: [Options] -> ShowS
show :: Options -> String
$cshow :: Options -> String
showsPrec :: Int -> Options -> ShowS
$cshowsPrec :: Int -> Options -> ShowS
Show)

projectNamesOption ::
  ReadM ProjectNames
projectNamesOption :: ReadM ProjectNames
projectNamesOption = do
  String
raw <- ReadM String
readerAsk
  (String -> ReadM ProjectNames)
-> (ProjectNames -> ReadM ProjectNames)
-> Either String ProjectNames
-> ReadM ProjectNames
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> ReadM ProjectNames
forall a. String -> ReadM a
readerError ProjectNames -> ReadM ProjectNames
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Either String ProjectNames
forall err. IsString err => String -> Either err ProjectNames
ProjectNames.parse String
raw)

directoryParser ::
  Path Abs Dir ->
  Parser (Maybe (Path Abs Dir))
directoryParser :: Path Abs Dir -> Parser (Maybe (Path Abs Dir))
directoryParser Path Abs Dir
cwd =
  Parser (Path Abs Dir) -> Parser (Maybe (Path Abs Dir))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ReadM (Path Abs Dir)
-> Mod OptionFields (Path Abs Dir) -> Parser (Path Abs Dir)
forall a. ReadM a -> Mod OptionFields a -> Parser a
option (Path Abs Dir -> ReadM (Path Abs Dir)
dirPathOption Path Abs Dir
cwd) (String -> Mod OptionFields (Path Abs Dir)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"directory" Mod OptionFields (Path Abs Dir)
-> Mod OptionFields (Path Abs Dir)
-> Mod OptionFields (Path Abs Dir)
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields (Path Abs Dir)
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'd' Mod OptionFields (Path Abs Dir)
-> Mod OptionFields (Path Abs Dir)
-> Mod OptionFields (Path Abs Dir)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Path Abs Dir)
forall (f :: * -> *) a. String -> Mod f a
help String
dirHelp))
  where
    dirHelp :: String
dirHelp =
      String
"The directory for the new project. Defaults to the project name as subdir of the current dir"

projectParser ::
  Path Abs Dir ->
  Parser ProjectOptions
projectParser :: Path Abs Dir -> Parser ProjectOptions
projectParser Path Abs Dir
cwd =
  Maybe ProjectNames
-> Maybe (Path Abs Dir)
-> Maybe Branch
-> Maybe GithubOrg
-> Maybe GithubRepo
-> SkipCachix
-> Maybe CachixName
-> Maybe CachixKey
-> ProjectOptions
ProjectOptions
  (Maybe ProjectNames
 -> Maybe (Path Abs Dir)
 -> Maybe Branch
 -> Maybe GithubOrg
 -> Maybe GithubRepo
 -> SkipCachix
 -> Maybe CachixName
 -> Maybe CachixKey
 -> ProjectOptions)
-> Parser (Maybe ProjectNames)
-> Parser
     (Maybe (Path Abs Dir)
      -> Maybe Branch
      -> Maybe GithubOrg
      -> Maybe GithubRepo
      -> SkipCachix
      -> Maybe CachixName
      -> Maybe CachixKey
      -> ProjectOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  Parser ProjectNames -> Parser (Maybe ProjectNames)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ReadM ProjectNames
-> Mod ArgumentFields ProjectNames -> Parser ProjectNames
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument ReadM ProjectNames
projectNamesOption (String -> Mod ArgumentFields ProjectNames
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"NAME" Mod ArgumentFields ProjectNames
-> Mod ArgumentFields ProjectNames
-> Mod ArgumentFields ProjectNames
forall a. Semigroup a => a -> a -> a
<> String -> Mod ArgumentFields ProjectNames
forall (f :: * -> *) a. String -> Mod f a
help String
"Name of the project"))
  Parser
  (Maybe (Path Abs Dir)
   -> Maybe Branch
   -> Maybe GithubOrg
   -> Maybe GithubRepo
   -> SkipCachix
   -> Maybe CachixName
   -> Maybe CachixKey
   -> ProjectOptions)
-> Parser (Maybe (Path Abs Dir))
-> Parser
     (Maybe Branch
      -> Maybe GithubOrg
      -> Maybe GithubRepo
      -> SkipCachix
      -> Maybe CachixName
      -> Maybe CachixKey
      -> ProjectOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
  Path Abs Dir -> Parser (Maybe (Path Abs Dir))
directoryParser Path Abs Dir
cwd
  Parser
  (Maybe Branch
   -> Maybe GithubOrg
   -> Maybe GithubRepo
   -> SkipCachix
   -> Maybe CachixName
   -> Maybe CachixKey
   -> ProjectOptions)
-> Parser (Maybe Branch)
-> Parser
     (Maybe GithubOrg
      -> Maybe GithubRepo
      -> SkipCachix
      -> Maybe CachixName
      -> Maybe CachixKey
      -> ProjectOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
  Parser Branch -> Parser (Maybe Branch)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ReadM Branch -> Mod OptionFields Branch -> Parser Branch
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Branch
forall s. IsString s => ReadM s
str (String -> Mod OptionFields Branch
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"branch" Mod OptionFields Branch
-> Mod OptionFields Branch -> Mod OptionFields Branch
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields Branch
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'b' Mod OptionFields Branch
-> Mod OptionFields Branch -> Mod OptionFields Branch
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Branch
forall (f :: * -> *) a. String -> Mod f a
help String
branchHelp))
  Parser
  (Maybe GithubOrg
   -> Maybe GithubRepo
   -> SkipCachix
   -> Maybe CachixName
   -> Maybe CachixKey
   -> ProjectOptions)
-> Parser (Maybe GithubOrg)
-> Parser
     (Maybe GithubRepo
      -> SkipCachix
      -> Maybe CachixName
      -> Maybe CachixKey
      -> ProjectOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
  Parser GithubOrg -> Parser (Maybe GithubOrg)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ReadM GithubOrg -> Mod OptionFields GithubOrg -> Parser GithubOrg
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM GithubOrg
forall s. IsString s => ReadM s
str (String -> Mod OptionFields GithubOrg
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"github-org" Mod OptionFields GithubOrg
-> Mod OptionFields GithubOrg -> Mod OptionFields GithubOrg
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields GithubOrg
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'o' Mod OptionFields GithubOrg
-> Mod OptionFields GithubOrg -> Mod OptionFields GithubOrg
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields GithubOrg
forall (f :: * -> *) a. String -> Mod f a
help String
orgHelp))
  Parser
  (Maybe GithubRepo
   -> SkipCachix
   -> Maybe CachixName
   -> Maybe CachixKey
   -> ProjectOptions)
-> Parser (Maybe GithubRepo)
-> Parser
     (SkipCachix
      -> Maybe CachixName -> Maybe CachixKey -> ProjectOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
  Parser GithubRepo -> Parser (Maybe GithubRepo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ReadM GithubRepo
-> Mod OptionFields GithubRepo -> Parser GithubRepo
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM GithubRepo
forall s. IsString s => ReadM s
str (String -> Mod OptionFields GithubRepo
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"github-repo" Mod OptionFields GithubRepo
-> Mod OptionFields GithubRepo -> Mod OptionFields GithubRepo
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields GithubRepo
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'r' Mod OptionFields GithubRepo
-> Mod OptionFields GithubRepo -> Mod OptionFields GithubRepo
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields GithubRepo
forall (f :: * -> *) a. String -> Mod f a
help String
repoHelp))
  Parser
  (SkipCachix
   -> Maybe CachixName -> Maybe CachixKey -> ProjectOptions)
-> Parser SkipCachix
-> Parser (Maybe CachixName -> Maybe CachixKey -> ProjectOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
  (Bool -> SkipCachix
SkipCachix (Bool -> SkipCachix) -> Parser Bool -> Parser SkipCachix
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod FlagFields Bool -> Parser Bool
switch (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"skip-cachix" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"Don't ask for cachix credentials"))
  Parser (Maybe CachixName -> Maybe CachixKey -> ProjectOptions)
-> Parser (Maybe CachixName)
-> Parser (Maybe CachixKey -> ProjectOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
  Parser CachixName -> Parser (Maybe CachixName)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ReadM CachixName
-> Mod OptionFields CachixName -> Parser CachixName
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM CachixName
forall s. IsString s => ReadM s
str (String -> Mod OptionFields CachixName
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"cachix" Mod OptionFields CachixName
-> Mod OptionFields CachixName -> Mod OptionFields CachixName
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields CachixName
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'c' Mod OptionFields CachixName
-> Mod OptionFields CachixName -> Mod OptionFields CachixName
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields CachixName
forall (f :: * -> *) a. String -> Mod f a
help String
cachixHelp))
  Parser (Maybe CachixKey -> ProjectOptions)
-> Parser (Maybe CachixKey) -> Parser ProjectOptions
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
  Parser CachixKey -> Parser (Maybe CachixKey)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ReadM CachixKey -> Mod OptionFields CachixKey -> Parser CachixKey
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM CachixKey
forall s. IsString s => ReadM s
str (String -> Mod OptionFields CachixKey
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"cachix-key" Mod OptionFields CachixKey
-> Mod OptionFields CachixKey -> Mod OptionFields CachixKey
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields CachixKey
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'k' Mod OptionFields CachixKey
-> Mod OptionFields CachixKey -> Mod OptionFields CachixKey
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields CachixKey
forall (f :: * -> *) a. String -> Mod f a
help String
cachixKeyHelp))
  where
    orgHelp :: String
orgHelp =
      String
"Name of the Github org, for generating vim boot files that download binaries built by Actions"
    repoHelp :: String
repoHelp =
      String
"Name of the Github repo, in case it differs from the project name"
    branchHelp :: String
branchHelp =
      String
"Main branch for creating binaries via Github Actions, defaults to 'master'"
    cachixHelp :: String
cachixHelp =
      String
"Name of the cachix cache to push to from Github Actions, and pull from in the Neovim boot file"
    cachixKeyHelp :: String
cachixKeyHelp =
      String
"The public key for the cachix cache, found at https://app.cachix.org/cache/<name>"

newParser ::
  Path Abs Dir ->
  Parser NewOptions
newParser :: Path Abs Dir -> Parser NewOptions
newParser Path Abs Dir
cwd =
  ProjectOptions
-> Maybe FlakeUrl
-> PrintDir
-> Maybe Author
-> Maybe Maintainer
-> NewOptions
NewOptions
  (ProjectOptions
 -> Maybe FlakeUrl
 -> PrintDir
 -> Maybe Author
 -> Maybe Maintainer
 -> NewOptions)
-> Parser ProjectOptions
-> Parser
     (Maybe FlakeUrl
      -> PrintDir -> Maybe Author -> Maybe Maintainer -> NewOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  Path Abs Dir -> Parser ProjectOptions
projectParser Path Abs Dir
cwd
  Parser
  (Maybe FlakeUrl
   -> PrintDir -> Maybe Author -> Maybe Maintainer -> NewOptions)
-> Parser (Maybe FlakeUrl)
-> Parser
     (PrintDir -> Maybe Author -> Maybe Maintainer -> NewOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
  Parser FlakeUrl -> Parser (Maybe FlakeUrl)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ReadM FlakeUrl -> Mod OptionFields FlakeUrl -> Parser FlakeUrl
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM FlakeUrl
forall s. IsString s => ReadM s
str (String -> Mod OptionFields FlakeUrl
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"flake-url" Mod OptionFields FlakeUrl
-> Mod OptionFields FlakeUrl -> Mod OptionFields FlakeUrl
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields FlakeUrl
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'f' Mod OptionFields FlakeUrl
-> Mod OptionFields FlakeUrl -> Mod OptionFields FlakeUrl
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields FlakeUrl
forall (f :: * -> *) a. String -> Mod f a
help String
"Custom URL for the Ribosome flake"))
  Parser (PrintDir -> Maybe Author -> Maybe Maintainer -> NewOptions)
-> Parser PrintDir
-> Parser (Maybe Author -> Maybe Maintainer -> NewOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
  (Bool -> PrintDir
PrintDir (Bool -> PrintDir) -> Parser Bool -> Parser PrintDir
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod FlagFields Bool -> Parser Bool
switch (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"print-dir" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'p' Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"Write the generated directory to stdout"))
  Parser (Maybe Author -> Maybe Maintainer -> NewOptions)
-> Parser (Maybe Author) -> Parser (Maybe Maintainer -> NewOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
  Parser Author -> Parser (Maybe Author)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ReadM Author -> Mod OptionFields Author -> Parser Author
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Author
forall s. IsString s => ReadM s
str (String -> Mod OptionFields Author
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"author" Mod OptionFields Author
-> Mod OptionFields Author -> Mod OptionFields Author
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields Author
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'a' Mod OptionFields Author
-> Mod OptionFields Author -> Mod OptionFields Author
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Author
forall (f :: * -> *) a. String -> Mod f a
help String
"Author for the Cabal file"))
  Parser (Maybe Maintainer -> NewOptions)
-> Parser (Maybe Maintainer) -> Parser NewOptions
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
  Parser Maintainer -> Parser (Maybe Maintainer)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ReadM Maintainer
-> Mod OptionFields Maintainer -> Parser Maintainer
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Maintainer
forall s. IsString s => ReadM s
str (String -> Mod OptionFields Maintainer
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"maintainer" Mod OptionFields Maintainer
-> Mod OptionFields Maintainer -> Mod OptionFields Maintainer
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields Maintainer
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'm' Mod OptionFields Maintainer
-> Mod OptionFields Maintainer -> Mod OptionFields Maintainer
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Maintainer
forall (f :: * -> *) a. String -> Mod f a
help String
"Maintainer for the Cabal file"))

newCommand ::
  Path Abs Dir ->
  Mod CommandFields Command
newCommand :: Path Abs Dir -> Mod CommandFields Command
newCommand Path Abs Dir
cwd =
  String -> ParserInfo Command -> Mod CommandFields Command
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"new" (NewOptions -> Command
New (NewOptions -> Command)
-> ParserInfo NewOptions -> ParserInfo Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser NewOptions -> InfoMod NewOptions -> ParserInfo NewOptions
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Path Abs Dir -> Parser NewOptions
newParser Path Abs Dir
cwd) (String -> InfoMod NewOptions
forall a. String -> InfoMod a
progDesc String
"Generate a new project for a Neovim plugin"))

bootCommand ::
  Path Abs Dir ->
  Mod CommandFields Command
bootCommand :: Path Abs Dir -> Mod CommandFields Command
bootCommand Path Abs Dir
cwd =
  String -> ParserInfo Command -> Mod CommandFields Command
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"boot" (ProjectOptions -> Command
Boot (ProjectOptions -> Command)
-> ParserInfo ProjectOptions -> ParserInfo Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ProjectOptions
-> InfoMod ProjectOptions -> ParserInfo ProjectOptions
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Path Abs Dir -> Parser ProjectOptions
projectParser Path Abs Dir
cwd) (String -> InfoMod ProjectOptions
forall a. String -> InfoMod a
progDesc String
"Generate the Neovim boot file"))

globalParser :: Parser GlobalOptions
globalParser :: Parser GlobalOptions
globalParser = do
  Maybe Bool
quiet <- Parser Bool -> Parser (Maybe Bool)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Mod FlagFields Bool -> Parser Bool
switch (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"quiet" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'q' Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"Suppress informational messages"))
  Maybe Bool
force <- Parser Bool -> Parser (Maybe Bool)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Mod FlagFields Bool -> Parser Bool
switch (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"force" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'f' Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"Overwrite existing files"))
  pure (GlobalOptions :: Maybe Bool -> Maybe Bool -> GlobalOptions
GlobalOptions {Maybe Bool
force :: Maybe Bool
quiet :: Maybe Bool
$sel:force:GlobalOptions :: Maybe Bool
$sel:quiet:GlobalOptions :: Maybe Bool
..})

appParser ::
  Path Abs Dir ->
  Parser Options
appParser :: Path Abs Dir -> Parser Options
appParser Path Abs Dir
cwd =
  GlobalOptions -> Command -> Options
Options (GlobalOptions -> Command -> Options)
-> Parser GlobalOptions -> Parser (Command -> Options)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser GlobalOptions
globalParser Parser (Command -> Options) -> Parser Command -> Parser Options
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod CommandFields Command -> Parser Command
forall a. Mod CommandFields a -> Parser a
hsubparser ([Mod CommandFields Command] -> Mod CommandFields Command
forall a. Monoid a => [a] -> a
mconcat [Path Abs Dir -> Mod CommandFields Command
newCommand Path Abs Dir
cwd, Path Abs Dir -> Mod CommandFields Command
bootCommand Path Abs Dir
cwd])

parseCli ::
  IO Options
parseCli :: IO Options
parseCli = do
  Path Abs Dir
cwd <- IO (Path Abs Dir)
forall (m :: * -> *). MonadIO m => m (Path Abs Dir)
getCurrentDir
  ParserPrefs -> ParserInfo Options -> IO Options
forall a. ParserPrefs -> ParserInfo a -> IO a
customExecParser ParserPrefs
parserPrefs (Parser Options -> InfoMod Options -> ParserInfo Options
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Path Abs Dir -> Parser Options
appParser Path Abs Dir
cwd Parser Options -> Parser (Options -> Options) -> Parser Options
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (Options -> Options)
forall a. Parser (a -> a)
helper) InfoMod Options
forall {a}. InfoMod a
desc)
  where
    parserPrefs :: ParserPrefs
parserPrefs =
      PrefsMod -> ParserPrefs
prefs (PrefsMod
showHelpOnEmpty PrefsMod -> PrefsMod -> PrefsMod
forall a. Semigroup a => a -> a -> a
<> PrefsMod
showHelpOnError)
    desc :: InfoMod a
desc =
      InfoMod a
forall {a}. InfoMod a
fullDesc InfoMod a -> InfoMod a -> InfoMod a
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod a
forall a. String -> InfoMod a
header String
"Tools for maintaining Ribosome plugins"