{-# language TemplateHaskell #-}

-- | Code that configures presentation parser for the CLI options
module Nix.Options.Parser where

import           Nix.Prelude
import           Relude.Unsafe                  ( read )
import           GHC.Err                        ( errorWithoutStackTrace )
import           Data.Char                      ( isDigit )
import qualified Data.Text                     as Text
import           Data.Time                      ( UTCTime
                                                , defaultTimeLocale
                                                , parseTimeOrError
                                                )
import           Nix.Options
import           Options.Applicative     hiding ( ParserResult(..) )
import           Data.Version                   ( showVersion )
import           Development.GitRev             ( gitCommitDate
                                                , gitBranch
                                                , gitHash )
import           Paths_hnix                     ( version )

decodeVerbosity :: Int -> Verbosity
decodeVerbosity :: Int -> Verbosity
decodeVerbosity Int
0 = Verbosity
ErrorsOnly
decodeVerbosity Int
1 = Verbosity
Informational
decodeVerbosity Int
2 = Verbosity
Talkative
decodeVerbosity Int
3 = Verbosity
Chatty
decodeVerbosity Int
4 = Verbosity
DebugInfo
decodeVerbosity Int
_ = Verbosity
Vomit

argPair :: Mod OptionFields (Text, Text) -> Parser (Text, Text)
argPair :: Mod OptionFields (Text, Text) -> Parser (Text, Text)
argPair =
  forall a. ReadM a -> Mod OptionFields a -> Parser a
option forall a b. (a -> b) -> a -> b
$
    do
      Text
s <- forall s. IsString s => ReadM s
str
      forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        (forall a. String -> a
errorWithoutStackTrace String
"Format of --arg/--argstr in hnix is: name=expr")
        (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Text -> Text
Text.tail forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Text -> (Text, Text)
`Text.splitAt` Text
s))
        ((Char -> Bool) -> Text -> Maybe Int
Text.findIndex (forall a. Eq a => a -> a -> Bool
== Char
'=') Text
s)

nixOptions :: UTCTime -> Parser Options
nixOptions :: UTCTime -> Parser Options
nixOptions UTCTime
current =
  Verbosity
-> Bool
-> Bool
-> Bool
-> Bool
-> Maybe Path
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Maybe Path
-> Bool
-> Bool
-> Bool
-> Bool
-> Maybe Text
-> [Path]
-> Bool
-> Maybe Path
-> Bool
-> Bool
-> Bool
-> Maybe Text
-> [(Text, Text)]
-> [(Text, Text)]
-> Maybe Path
-> UTCTime
-> [Path]
-> Options
Options forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    (forall a. a -> Maybe a -> a
fromMaybe Verbosity
Informational forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
        (forall a. ReadM a -> Mod OptionFields a -> Parser a
option

          (do
            String
a <- forall s. IsString s => ReadM s
str
            forall a. a -> a -> Bool -> a
bool
              (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Argument to -v/--verbose must be a number")
              (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Int -> Verbosity
decodeVerbosity forall a b. (a -> b) -> a -> b
$ forall a. Read a => String -> a
read String
a)
              (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit String
a)
          )

          (  forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'v'
          forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"verbose"
          forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Verbose output"
          )

        )
      )
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch
        (  forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"trace"
        forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Enable tracing code (even more can be seen if built with --flags=tracing)"
        )
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch
        (  forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"thunks"
        forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Enable reporting of thunk tracing as well as regular evaluation"
        )
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch
        (  forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"values"
        forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Enable reporting of value provenance in error messages"
        )
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch
        (  forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"scopes"
        forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Enable reporting of scopes in evaluation traces"
        )
    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 => String -> Mod f a
long String
"reduce"
          forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"When done evaluating, output the evaluated part of the expression to FILE"
          )
        )
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch
        (  forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"reduce-sets"
        forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Reduce set members that aren't used; breaks if hasAttr is used"
        )
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch
        (  forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"reduce-lists"
        forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Reduce list members that aren't used; breaks if elemAt is used"
        )
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch
        (  forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"parse"
        forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Whether to parse the file (also the default right now)"
        )
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch
        (  forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"parse-only"
        forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Whether to parse only, no pretty printing or checking"
        )
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch
        (  forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"find"
        forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"If selected, find paths within attr trees"
        )
    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 => String -> Mod f a
long String
"find-file"
          forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Look up the given files in Nix's search path"
          )
        )
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch
        (  forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"strict"
        forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"When used with --eval, recursively evaluate list elements and attributes"
        )
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch
        (  forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"eval"
        forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Whether to evaluate, or just pretty-print"
        )
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch
        (  forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"json"
        forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Print the resulting value as an JSON representation"
        )
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch
        (  forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"xml"
        forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Print the resulting value as an XML representation"
        )
    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
'A'
          forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"attr"
          forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Select an attribute from the top-level Nix expression being evaluated"
          )
        )
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many
        (forall s. IsString s => Mod OptionFields s -> Parser s
strOption
          (  forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'I'
          forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"include"
          forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Add a path to the Nix expression search path"
          )
        )
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch
        (  forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"check"
        forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Whether to check for syntax fails after parsing"
        )
    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 => String -> Mod f a
long String
"read"
          forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Read in an expression tree from a binary cache"
          )
        )
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch
        (  forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"cache"
        forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Write out the parsed expression tree to a binary cache"
        )
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch
        (  forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"repl"
        forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"After performing any indicated actions, enter the REPL"
        )
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch
        (  forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"ignore-fails"
        forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Continue parsing files, even if there are fails"
        )
    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
'E'
          forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"expr"
          forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Expression to parse or evaluate")
        )
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many
        (Mod OptionFields (Text, Text) -> Parser (Text, Text)
argPair
          (  forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"arg"
          forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Argument to pass to an evaluated lambda")
        )
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many
        (Mod OptionFields (Text, Text) -> Parser (Text, Text)
argPair
          (  forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"argstr"
          forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Argument string to pass to an evaluated lambda"
          )
        )
    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 => String -> Mod f a
long String
"file"
          forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Parse all of the files given in FILE; - means stdin"
          )
        )
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ReadM a -> Mod OptionFields a -> Parser a
option
        (forall t.
ParseTime t =>
Bool -> TimeLocale -> String -> String -> t
parseTimeOrError Bool
True TimeLocale
defaultTimeLocale String
"%Y/%m/%d %H:%M:%S" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. IsString s => ReadM s
str)
        (  forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"now"
        forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasValue f => a -> Mod f a
value UTCTime
current
        forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Set current time for testing purposes"
        )
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many
        (forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument
          (  forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"FILE"
          forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Path of file to parse"
          )
        )

--  2020-09-12: CLI --version option mechanism is tied to meta modules specificly generated by Cabal. It is possible to use Template Haskell to resolve the version, as also a g
versionOpt :: Parser (a -> a)
versionOpt :: forall a. Parser (a -> a)
versionOpt = forall a. Parser (a -> a)
shortVersionOpt forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Parser (a -> a)
debugVersionOpt
 where
  shortVersionOpt :: Parser (a -> a)
  shortVersionOpt :: forall a. Parser (a -> a)
shortVersionOpt =
    forall a. String -> Mod OptionFields (a -> a) -> Parser (a -> a)
infoOption
      (Version -> String
showVersion Version
version)
      (  forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"version"
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Show release version"
      )

  --  2020-09-13: NOTE: Does not work for direct `nix-build`s, works for `nix-shell` `cabal` builds.
  debugVersionOpt :: Parser (a -> a)
  debugVersionOpt :: forall a. Parser (a -> a)
debugVersionOpt =
    forall a. String -> Mod OptionFields (a -> a) -> Parser (a -> a)
infoOption
      ( forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
          [ String
"Version: ", Version -> String
showVersion Version
version
          , String
"\nCommit: ", $(gitHash)
          , String
"\n  date: ", $(gitCommitDate)
          , String
"\n  branch: ", $(gitBranch)
          ]
      )
      (  forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"long-version"
      forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Show long debug version form"
      )

nixOptionsInfo :: UTCTime -> ParserInfo Options
nixOptionsInfo :: UTCTime -> ParserInfo Options
nixOptionsInfo UTCTime
current =
  forall a. Parser a -> InfoMod a -> ParserInfo a
info
    (forall a. Parser (a -> a)
helper forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Parser (a -> a)
versionOpt forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> UTCTime -> Parser Options
nixOptions UTCTime
current)
    (forall a. InfoMod a
fullDesc forall a. Semigroup a => a -> a -> a
<> forall a. String -> InfoMod a
progDesc forall a. Monoid a => a
mempty forall a. Semigroup a => a -> a -> a
<> forall a. String -> InfoMod a
header String
"hnix")