{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TemplateHaskell #-}

-- | Copyright: (c) 2021-2022 berberman
-- SPDX-License-Identifier: MIT
-- Maintainer: berberman <berberman@yandex.com>
-- Stability: experimental
-- Portability: portable
--
-- CLI interface of nvfetcher
module NvFetcher.Options
  ( CLIOptions (..),
    Target (..),
    cliOptionsParser,
    getCLIOptions,
  )
where

import Options.Applicative.Simple
import qualified Paths_nvfetcher as Paths

data Target = Build | Clean
  deriving (Target -> Target -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Target -> Target -> Bool
$c/= :: Target -> Target -> Bool
== :: Target -> Target -> Bool
$c== :: Target -> Target -> Bool
Eq)

instance Show Target where
  show :: Target -> FilePath
show Target
Build = FilePath
"build"
  show Target
Clean = FilePath
"clean"

targetParser :: ReadM Target
targetParser :: ReadM Target
targetParser = forall a. (FilePath -> Maybe a) -> ReadM a
maybeReader forall a b. (a -> b) -> a -> b
$ \case
  FilePath
"build" -> forall a. a -> Maybe a
Just Target
Build
  FilePath
"clean" -> forall a. a -> Maybe a
Just Target
Clean
  FilePath
_ -> forall a. Maybe a
Nothing

-- | Options for nvfetcher CLI
data CLIOptions = CLIOptions
  { CLIOptions -> FilePath
optBuildDir :: FilePath,
    CLIOptions -> Bool
optCommit :: Bool,
    CLIOptions -> Maybe FilePath
optLogPath :: Maybe FilePath,
    CLIOptions -> Int
optThreads :: Int,
    CLIOptions -> Int
optRetry :: Int,
    CLIOptions -> Bool
optTiming :: Bool,
    CLIOptions -> Bool
optVerbose :: Bool,
    CLIOptions -> Maybe FilePath
optPkgNameFilter :: Maybe String,
    CLIOptions -> Maybe FilePath
optKeyfile :: Maybe FilePath,
    CLIOptions -> Target
optTarget :: Target
  }
  deriving (Int -> CLIOptions -> ShowS
[CLIOptions] -> ShowS
CLIOptions -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [CLIOptions] -> ShowS
$cshowList :: [CLIOptions] -> ShowS
show :: CLIOptions -> FilePath
$cshow :: CLIOptions -> FilePath
showsPrec :: Int -> CLIOptions -> ShowS
$cshowsPrec :: Int -> CLIOptions -> ShowS
Show)

cliOptionsParser :: Parser CLIOptions
cliOptionsParser :: Parser CLIOptions
cliOptionsParser =
  FilePath
-> Bool
-> Maybe FilePath
-> Int
-> Int
-> Bool
-> Bool
-> Maybe FilePath
-> Maybe FilePath
-> Target
-> CLIOptions
CLIOptions
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. IsString s => Mod OptionFields s -> Parser s
strOption
      ( forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"build-dir"
          forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'o'
          forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"DIR"
          forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Directory that nvfetcher puts artifacts to"
          forall a. Semigroup a => a -> a -> a
<> forall a (f :: * -> *). Show a => Mod f a
showDefault
          forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasValue f => a -> Mod f a
value FilePath
"_sources"
          forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer (FilePath -> Completer
bashCompleter FilePath
"directory")
      )
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch
      ( forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"commit-changes"
          forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"`git commit` build dir with version changes as commit message"
      )
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
      ( forall s. IsString s => Mod OptionFields s -> Parser s
strOption
          ( forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"changelog"
              forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'l'
              forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"FILE"
              forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Dump version changes to a file"
              forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer (FilePath -> Completer
bashCompleter FilePath
"file")
          )
      )
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ReadM a -> Mod OptionFields a -> Parser a
option
      forall a. Read a => ReadM a
auto
      ( forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'j'
          forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"NUM"
          forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Number of threads (0: detected number of processors)"
          forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Int
0
          forall a. Semigroup a => a -> a -> a
<> forall a (f :: * -> *). Show a => Mod f a
showDefault
      )
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ReadM a -> Mod OptionFields a -> Parser a
option
      forall a. Read a => ReadM a
auto
      ( forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'r'
          forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"retry"
          forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"NUM"
          forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Times to retry of some rules (nvchecker, prefetch, nix-build, etc.)"
          forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Int
3
          forall a. Semigroup a => a -> a -> a
<> forall a (f :: * -> *). Show a => Mod f a
showDefault
      )
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch (forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"timing" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
't' forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Show build time")
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch (forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"verbose" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'v' forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Verbose mode")
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
      ( forall s. IsString s => Mod OptionFields s -> Parser s
strOption
          ( forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'f'
              forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"filter"
              forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"REGEX"
              forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Regex to filter packages to be updated"
          )
      )
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
      ( forall s. IsString s => Mod OptionFields s -> Parser s
strOption
          ( forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'k'
              forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"keyfile"
              forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"FILE"
              forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Nvchecker keyfile"
              forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer (FilePath -> Completer
bashCompleter FilePath
"file")
          )
      )
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument
      ReadM Target
targetParser
      ( forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"TARGET"
          forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Two targets are available: 1.build  2.clean"
          forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Target
Build
          forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer ([FilePath] -> Completer
listCompleter [forall a. Show a => a -> FilePath
show Target
Build, forall a. Show a => a -> FilePath
show Target
Clean])
          forall a. Semigroup a => a -> a -> a
<> forall a (f :: * -> *). Show a => Mod f a
showDefault
      )

version :: String
version :: FilePath
version = $(simpleVersion Paths.version)

-- | Parse nvfetcher CLI options
getCLIOptions :: Parser a -> IO a
getCLIOptions :: forall a. Parser a -> IO a
getCLIOptions Parser a
parser = do
  (a
opts, ()) <-
    forall a b.
FilePath
-> FilePath
-> FilePath
-> Parser a
-> ExceptT b (Writer (Mod CommandFields b)) ()
-> IO (a, b)
simpleOptions
      FilePath
version
      FilePath
"nvfetcher"
      FilePath
"generate nix sources expr for the latest version of packages"
      Parser a
parser
      forall (f :: * -> *) a. Alternative f => f a
empty
  forall (f :: * -> *) a. Applicative f => a -> f a
pure a
opts