{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Options (parserInfo) where

import Control.Monad.Logger.CallStack (LogLevel (LevelWarn))
import Defaults (Defaults (..), dCabalName, dHomePage, dName)
import Distribution.SPDX.LicenseId (LicenseId (Unlicense))
import qualified Environment (T (..))
import Network.URI (parseURI)
import Options.Applicative
  ( HasValue,
    Mod,
    Parser,
    ParserInfo,
    auto,
    fullDesc,
    help,
    helper,
    hidden,
    info,
    internal,
    long,
    metavar,
    option,
    progDesc,
    showDefault,
    strOption,
    value,
    (<**>),
  )
import Options.Applicative.Builder (maybeReader)

parserInfo :: Defaults -> ParserInfo Environment.T
parserInfo :: Defaults -> ParserInfo T
parserInfo Defaults
ds =
  Parser T -> InfoMod T -> ParserInfo T
forall a. Parser a -> InfoMod a -> ParserInfo a
info
    (Defaults -> Parser T
parser Defaults
ds Parser T -> Parser (T -> T) -> Parser T
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (T -> T)
forall a. Parser (a -> a)
helper)
    ( InfoMod T
forall a. InfoMod a
fullDesc
        InfoMod T -> InfoMod T -> InfoMod T
forall a. Semigroup a => a -> a -> a
<> FilePath -> InfoMod T
forall a. FilePath -> InfoMod a
progDesc
          ( [FilePath] -> FilePath
unlines
              [ FilePath
"Initialise a new project using the current checked out repository.",
                FilePath
"WARNING: THIS WILL MODIFY THE CURRENT CONTENTS OF YOUR CHECKED OUT REPOSITORY!"
              ]
          )
    )

parser :: Defaults -> Parser Environment.T
parser :: Defaults -> Parser T
parser ds :: Defaults
ds@(Defaults {Year
FilePath
Text
dOrigin :: Text
dAuthor :: Text
dMaintainer :: Text
dPath :: FilePath
dYear :: Year
dOrigin :: Defaults -> Text
dAuthor :: Defaults -> Text
dMaintainer :: Defaults -> Text
dPath :: Defaults -> FilePath
dYear :: Defaults -> Year
..}) = do
  Text
name <-
    Mod OptionFields Text -> Parser Text
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
      ( FilePath -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"name"
          Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Text
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Name of the new project."
          Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Text
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar
            FilePath
"NAME"
          Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> Maybe Text -> Mod OptionFields Text
forall (f :: * -> *) a. (HasValue f, Show a) => Maybe a -> Mod f a
maybeDefault (Defaults -> Maybe Text
dName Defaults
ds)
      )
  Text
cabalName <-
    Mod OptionFields Text -> Parser Text
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
      ( FilePath -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"cabal-name"
          Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Text
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Name to use in cabal."
          Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Text
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"CABAL_NAME"
          Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> Maybe Text -> Mod OptionFields Text
forall (f :: * -> *) a. (HasValue f, Show a) => Maybe a -> Mod f a
maybeDefault (Defaults -> Maybe Text
dCabalName Defaults
ds)
      )
  URI
homepage <-
    ReadM URI -> Mod OptionFields URI -> Parser URI
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
      ((FilePath -> Maybe URI) -> ReadM URI
forall a. (FilePath -> Maybe a) -> ReadM a
maybeReader FilePath -> Maybe URI
parseURI)
      ( FilePath -> Mod OptionFields URI
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"homepage"
          Mod OptionFields URI
-> Mod OptionFields URI -> Mod OptionFields URI
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields URI
forall (f :: * -> *) a. FilePath -> Mod f a
help
            FilePath
"Homepage of the new project."
          Mod OptionFields URI
-> Mod OptionFields URI -> Mod OptionFields URI
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields URI
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"URL"
          Mod OptionFields URI
-> Mod OptionFields URI -> Mod OptionFields URI
forall a. Semigroup a => a -> a -> a
<> Maybe URI -> Mod OptionFields URI
forall (f :: * -> *) a. (HasValue f, Show a) => Maybe a -> Mod f a
maybeDefault (Defaults -> Maybe URI
dHomePage Defaults
ds)
      )
  Text
author <-
    Mod OptionFields Text -> Parser Text
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
      ( FilePath -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"author"
          Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Text
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Name of the author of the project."
          Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Text
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"AUTHOR"
          Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> Text -> Mod OptionFields Text
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Text
dAuthor
          Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields Text
forall a (f :: * -> *). Show a => Mod f a
showDefault
      )
  Text
maintainer <-
    Mod OptionFields Text -> Parser Text
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
      ( FilePath -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"maintainer"
          Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Text
forall (f :: * -> *) a. FilePath -> Mod f a
help
            FilePath
"Email of the maintainer of the project."
          Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Text
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"MAINTAINER"
          Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> Text -> Mod OptionFields Text
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Text
dMaintainer
          Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields Text
forall a (f :: * -> *). Show a => Mod f a
showDefault
      )
  LicenseId
licence <-
    ReadM LicenseId -> Mod OptionFields LicenseId -> Parser LicenseId
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
      ReadM LicenseId
forall a. Read a => ReadM a
auto
      ( FilePath -> Mod OptionFields LicenseId
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"licence"
          Mod OptionFields LicenseId
-> Mod OptionFields LicenseId -> Mod OptionFields LicenseId
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields LicenseId
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Licence of the project."
          Mod OptionFields LicenseId
-> Mod OptionFields LicenseId -> Mod OptionFields LicenseId
forall a. Semigroup a => a -> a -> a
<> LicenseId -> Mod OptionFields LicenseId
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value LicenseId
Unlicense
          Mod OptionFields LicenseId
-> Mod OptionFields LicenseId -> Mod OptionFields LicenseId
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields LicenseId
forall a (f :: * -> *). Show a => Mod f a
showDefault
          Mod OptionFields LicenseId
-> Mod OptionFields LicenseId -> Mod OptionFields LicenseId
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields LicenseId
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"LICENCE"
      )
  FilePath
path <-
    ReadM FilePath -> Mod OptionFields FilePath -> Parser FilePath
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
      ReadM FilePath
forall a. Read a => ReadM a
auto
      ( FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"path"
          Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Project path.  Only used for testing."
          Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value FilePath
dPath
          Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields FilePath
forall a (f :: * -> *). Show a => Mod f a
showDefault
          Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"PATH"
          Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields FilePath
forall (f :: * -> *) a. Mod f a
hidden
          Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields FilePath
forall (f :: * -> *) a. Mod f a
internal
      )
  Year
year <-
    ReadM Year -> Mod OptionFields Year -> Parser Year
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
      ReadM Year
forall a. Read a => ReadM a
auto
      ( FilePath -> Mod OptionFields Year
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"year"
          Mod OptionFields Year
-> Mod OptionFields Year -> Mod OptionFields Year
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Year
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Copyright year.  Only used for testing."
          Mod OptionFields Year
-> Mod OptionFields Year -> Mod OptionFields Year
forall a. Semigroup a => a -> a -> a
<> Year -> Mod OptionFields Year
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Year
dYear
          Mod OptionFields Year
-> Mod OptionFields Year -> Mod OptionFields Year
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields Year
forall a (f :: * -> *). Show a => Mod f a
showDefault
          Mod OptionFields Year
-> Mod OptionFields Year -> Mod OptionFields Year
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Year
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"YEAR"
          Mod OptionFields Year
-> Mod OptionFields Year -> Mod OptionFields Year
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields Year
forall (f :: * -> *) a. Mod f a
hidden
          Mod OptionFields Year
-> Mod OptionFields Year -> Mod OptionFields Year
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields Year
forall (f :: * -> *) a. Mod f a
internal
      )
  LogLevel
verbosity <-
    ReadM LogLevel -> Mod OptionFields LogLevel -> Parser LogLevel
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
      ReadM LogLevel
forall a. Read a => ReadM a
auto
      ( FilePath -> Mod OptionFields LogLevel
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"verbosity"
          Mod OptionFields LogLevel
-> Mod OptionFields LogLevel -> Mod OptionFields LogLevel
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields LogLevel
forall (f :: * -> *) a. FilePath -> Mod f a
help
            FilePath
"Verbosity of information printed to stderr."
          Mod OptionFields LogLevel
-> Mod OptionFields LogLevel -> Mod OptionFields LogLevel
forall a. Semigroup a => a -> a -> a
<> LogLevel -> Mod OptionFields LogLevel
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value LogLevel
LevelWarn
          Mod OptionFields LogLevel
-> Mod OptionFields LogLevel -> Mod OptionFields LogLevel
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields LogLevel
forall a (f :: * -> *). Show a => Mod f a
showDefault
          Mod OptionFields LogLevel
-> Mod OptionFields LogLevel -> Mod OptionFields LogLevel
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields LogLevel
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"VERBOSITY"
      )
  pure Environment.T {Year
FilePath
LicenseId
Text
URI
LogLevel
name :: Text
cabalName :: Text
homepage :: URI
author :: Text
maintainer :: Text
licence :: LicenseId
path :: FilePath
year :: Year
verbosity :: LogLevel
name :: Text
cabalName :: Text
homepage :: URI
author :: Text
maintainer :: Text
licence :: LicenseId
path :: FilePath
year :: Year
verbosity :: LogLevel
..}

maybeDefault :: (HasValue f, Show a) => Maybe a -> Mod f a
maybeDefault :: forall (f :: * -> *) a. (HasValue f, Show a) => Maybe a -> Mod f a
maybeDefault (Just a
a) = a -> Mod f a
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value a
a Mod f a -> Mod f a -> Mod f a
forall a. Semigroup a => a -> a -> a
<> Mod f a
forall a (f :: * -> *). Show a => Mod f a
showDefault
maybeDefault Maybe a
Nothing = Mod f a
forall a. Monoid a => a
mempty