module Hix.Options where

import Options.Applicative (
  CommandFields,
  Mod,
  Parser,
  bashCompleter,
  command,
  completer,
  customExecParser,
  fullDesc,
  header,
  help,
  helper,
  hsubparser,
  info,
  long,
  option,
  prefs,
  progDesc,
  short,
  showHelpOnEmpty,
  showHelpOnError,
  strOption,
  switch,
  value,
  )
import Path (Abs, Dir, File, Path, SomeBase, parseRelDir, parseSomeDir)
import Prelude hiding (Mod, mod)

import qualified Hix.Data.BootstrapProjectConfig
import Hix.Data.BootstrapProjectConfig (BootstrapProjectConfig (BootstrapProjectConfig))
import Hix.Data.ComponentConfig (
  ComponentName (ComponentName),
  EnvName,
  ModuleName,
  PackageName (PackageName),
  SourceDir (SourceDir),
  )
import Hix.Data.GhciConfig (EnvConfig, GhciConfig, RunnerName)
import qualified Hix.Data.NewProjectConfig
import Hix.Data.NewProjectConfig (NewProjectConfig (NewProjectConfig))
import Hix.Data.PreprocConfig (PreprocConfig)
import Hix.Optparse (JsonConfig, absFileOption, jsonOption)

data PreprocOptions =
  PreprocOptions {
    PreprocOptions -> Maybe (Either PreprocConfig JsonConfig)
config :: Maybe (Either PreprocConfig JsonConfig),
    PreprocOptions -> Path Abs File
source :: Path Abs File,
    PreprocOptions -> Path Abs File
inFile :: Path Abs File,
    PreprocOptions -> Path Abs File
outFile :: Path Abs File
  }
  deriving stock (Int -> PreprocOptions -> ShowS
[PreprocOptions] -> ShowS
PreprocOptions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PreprocOptions] -> ShowS
$cshowList :: [PreprocOptions] -> ShowS
show :: PreprocOptions -> String
$cshow :: PreprocOptions -> String
showsPrec :: Int -> PreprocOptions -> ShowS
$cshowsPrec :: Int -> PreprocOptions -> ShowS
Show, forall x. Rep PreprocOptions x -> PreprocOptions
forall x. PreprocOptions -> Rep PreprocOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PreprocOptions x -> PreprocOptions
$cfrom :: forall x. PreprocOptions -> Rep PreprocOptions x
Generic)

data PackageSpec =
  PackageSpec {
    PackageSpec -> PackageName
name :: PackageName,
    PackageSpec -> Maybe (SomeBase Dir)
dir :: Maybe (SomeBase Dir)
  }
  deriving stock (PackageSpec -> PackageSpec -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PackageSpec -> PackageSpec -> Bool
$c/= :: PackageSpec -> PackageSpec -> Bool
== :: PackageSpec -> PackageSpec -> Bool
$c== :: PackageSpec -> PackageSpec -> Bool
Eq, Int -> PackageSpec -> ShowS
[PackageSpec] -> ShowS
PackageSpec -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PackageSpec] -> ShowS
$cshowList :: [PackageSpec] -> ShowS
show :: PackageSpec -> String
$cshow :: PackageSpec -> String
showsPrec :: Int -> PackageSpec -> ShowS
$cshowsPrec :: Int -> PackageSpec -> ShowS
Show, forall x. Rep PackageSpec x -> PackageSpec
forall x. PackageSpec -> Rep PackageSpec x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PackageSpec x -> PackageSpec
$cfrom :: forall x. PackageSpec -> Rep PackageSpec x
Generic)

data ComponentSpec =
  ComponentSpec {
    ComponentSpec -> ComponentName
name :: ComponentName,
    ComponentSpec -> Maybe SourceDir
dir :: Maybe SourceDir
  }
  deriving stock (ComponentSpec -> ComponentSpec -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ComponentSpec -> ComponentSpec -> Bool
$c/= :: ComponentSpec -> ComponentSpec -> Bool
== :: ComponentSpec -> ComponentSpec -> Bool
$c== :: ComponentSpec -> ComponentSpec -> Bool
Eq, Int -> ComponentSpec -> ShowS
[ComponentSpec] -> ShowS
ComponentSpec -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ComponentSpec] -> ShowS
$cshowList :: [ComponentSpec] -> ShowS
show :: ComponentSpec -> String
$cshow :: ComponentSpec -> String
showsPrec :: Int -> ComponentSpec -> ShowS
$cshowsPrec :: Int -> ComponentSpec -> ShowS
Show, forall x. Rep ComponentSpec x -> ComponentSpec
forall x. ComponentSpec -> Rep ComponentSpec x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ComponentSpec x -> ComponentSpec
$cfrom :: forall x. ComponentSpec -> Rep ComponentSpec x
Generic)

data ComponentCoords =
  ComponentCoords {
    ComponentCoords -> PackageSpec
package :: PackageSpec,
    ComponentCoords -> ComponentSpec
component :: ComponentSpec
  }
  deriving stock (ComponentCoords -> ComponentCoords -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ComponentCoords -> ComponentCoords -> Bool
$c/= :: ComponentCoords -> ComponentCoords -> Bool
== :: ComponentCoords -> ComponentCoords -> Bool
$c== :: ComponentCoords -> ComponentCoords -> Bool
Eq, Int -> ComponentCoords -> ShowS
[ComponentCoords] -> ShowS
ComponentCoords -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ComponentCoords] -> ShowS
$cshowList :: [ComponentCoords] -> ShowS
show :: ComponentCoords -> String
$cshow :: ComponentCoords -> String
showsPrec :: Int -> ComponentCoords -> ShowS
$cshowsPrec :: Int -> ComponentCoords -> ShowS
Show, forall x. Rep ComponentCoords x -> ComponentCoords
forall x. ComponentCoords -> Rep ComponentCoords x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ComponentCoords x -> ComponentCoords
$cfrom :: forall x. ComponentCoords -> Rep ComponentCoords x
Generic)

data TargetSpec =
  TargetForFile (Path Abs File)
  |
  TargetForComponent ComponentCoords
  deriving stock (TargetSpec -> TargetSpec -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TargetSpec -> TargetSpec -> Bool
$c/= :: TargetSpec -> TargetSpec -> Bool
== :: TargetSpec -> TargetSpec -> Bool
$c== :: TargetSpec -> TargetSpec -> Bool
Eq, Int -> TargetSpec -> ShowS
[TargetSpec] -> ShowS
TargetSpec -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TargetSpec] -> ShowS
$cshowList :: [TargetSpec] -> ShowS
show :: TargetSpec -> String
$cshow :: TargetSpec -> String
showsPrec :: Int -> TargetSpec -> ShowS
$cshowsPrec :: Int -> TargetSpec -> ShowS
Show, forall x. Rep TargetSpec x -> TargetSpec
forall x. TargetSpec -> Rep TargetSpec x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TargetSpec x -> TargetSpec
$cfrom :: forall x. TargetSpec -> Rep TargetSpec x
Generic)

data TestOptions =
  TestOptions {
    TestOptions -> ModuleName
mod :: ModuleName,
    TestOptions -> Maybe Text
test :: Maybe Text,
    TestOptions -> Maybe RunnerName
runner :: Maybe RunnerName
  }
  deriving stock (TestOptions -> TestOptions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TestOptions -> TestOptions -> Bool
$c/= :: TestOptions -> TestOptions -> Bool
== :: TestOptions -> TestOptions -> Bool
$c== :: TestOptions -> TestOptions -> Bool
Eq, Int -> TestOptions -> ShowS
[TestOptions] -> ShowS
TestOptions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TestOptions] -> ShowS
$cshowList :: [TestOptions] -> ShowS
show :: TestOptions -> String
$cshow :: TestOptions -> String
showsPrec :: Int -> TestOptions -> ShowS
$cshowsPrec :: Int -> TestOptions -> ShowS
Show, forall x. Rep TestOptions x -> TestOptions
forall x. TestOptions -> Rep TestOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TestOptions x -> TestOptions
$cfrom :: forall x. TestOptions -> Rep TestOptions x
Generic)

data EnvRunnerOptions =
  EnvRunnerOptions {
    EnvRunnerOptions -> Either EnvConfig JsonConfig
config :: Either EnvConfig JsonConfig,
    EnvRunnerOptions -> Maybe TargetSpec
component :: Maybe TargetSpec
  }
  deriving stock (Int -> EnvRunnerOptions -> ShowS
[EnvRunnerOptions] -> ShowS
EnvRunnerOptions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EnvRunnerOptions] -> ShowS
$cshowList :: [EnvRunnerOptions] -> ShowS
show :: EnvRunnerOptions -> String
$cshow :: EnvRunnerOptions -> String
showsPrec :: Int -> EnvRunnerOptions -> ShowS
$cshowsPrec :: Int -> EnvRunnerOptions -> ShowS
Show, forall x. Rep EnvRunnerOptions x -> EnvRunnerOptions
forall x. EnvRunnerOptions -> Rep EnvRunnerOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EnvRunnerOptions x -> EnvRunnerOptions
$cfrom :: forall x. EnvRunnerOptions -> Rep EnvRunnerOptions x
Generic)

data GhciOptions =
  GhciOptions {
    GhciOptions -> Either GhciConfig JsonConfig
config :: Either GhciConfig JsonConfig,
    GhciOptions -> TargetSpec
component :: TargetSpec,
    GhciOptions -> TestOptions
test :: TestOptions
  }
  deriving stock (Int -> GhciOptions -> ShowS
[GhciOptions] -> ShowS
GhciOptions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GhciOptions] -> ShowS
$cshowList :: [GhciOptions] -> ShowS
show :: GhciOptions -> String
$cshow :: GhciOptions -> String
showsPrec :: Int -> GhciOptions -> ShowS
$cshowsPrec :: Int -> GhciOptions -> ShowS
Show, forall x. Rep GhciOptions x -> GhciOptions
forall x. GhciOptions -> Rep GhciOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GhciOptions x -> GhciOptions
$cfrom :: forall x. GhciOptions -> Rep GhciOptions x
Generic)

data NewOptions =
  NewOptions {
    NewOptions -> NewProjectConfig
config :: NewProjectConfig
  }
  deriving stock (NewOptions -> NewOptions -> Bool
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
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. 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)

data BootstrapOptions =
  BootstrapOptions {
    BootstrapOptions -> BootstrapProjectConfig
config :: BootstrapProjectConfig
  }
  deriving stock (BootstrapOptions -> BootstrapOptions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BootstrapOptions -> BootstrapOptions -> Bool
$c/= :: BootstrapOptions -> BootstrapOptions -> Bool
== :: BootstrapOptions -> BootstrapOptions -> Bool
$c== :: BootstrapOptions -> BootstrapOptions -> Bool
Eq, Int -> BootstrapOptions -> ShowS
[BootstrapOptions] -> ShowS
BootstrapOptions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BootstrapOptions] -> ShowS
$cshowList :: [BootstrapOptions] -> ShowS
show :: BootstrapOptions -> String
$cshow :: BootstrapOptions -> String
showsPrec :: Int -> BootstrapOptions -> ShowS
$cshowsPrec :: Int -> BootstrapOptions -> ShowS
Show, forall x. Rep BootstrapOptions x -> BootstrapOptions
forall x. BootstrapOptions -> Rep BootstrapOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BootstrapOptions x -> BootstrapOptions
$cfrom :: forall x. BootstrapOptions -> Rep BootstrapOptions x
Generic)

data EnvRunnerCommandOptions =
  EnvRunnerCommandOptions {
    EnvRunnerCommandOptions -> EnvRunnerOptions
options :: EnvRunnerOptions,
    EnvRunnerCommandOptions -> TestOptions
test :: TestOptions
  }
  deriving stock (Int -> EnvRunnerCommandOptions -> ShowS
[EnvRunnerCommandOptions] -> ShowS
EnvRunnerCommandOptions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EnvRunnerCommandOptions] -> ShowS
$cshowList :: [EnvRunnerCommandOptions] -> ShowS
show :: EnvRunnerCommandOptions -> String
$cshow :: EnvRunnerCommandOptions -> String
showsPrec :: Int -> EnvRunnerCommandOptions -> ShowS
$cshowsPrec :: Int -> EnvRunnerCommandOptions -> ShowS
Show, forall x. Rep EnvRunnerCommandOptions x -> EnvRunnerCommandOptions
forall x. EnvRunnerCommandOptions -> Rep EnvRunnerCommandOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EnvRunnerCommandOptions x -> EnvRunnerCommandOptions
$cfrom :: forall x. EnvRunnerCommandOptions -> Rep EnvRunnerCommandOptions x
Generic)

data Command =
  Preproc PreprocOptions
  |
  EnvRunner EnvRunnerCommandOptions
  |
  GhcidCmd GhciOptions
  |
  GhciCmd GhciOptions
  |
  NewCmd NewOptions
  |
  BootstrapCmd BootstrapOptions
  deriving stock (Int -> Command -> ShowS
[Command] -> ShowS
Command -> String
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
verbose :: Maybe Bool
  }
  deriving stock (GlobalOptions -> GlobalOptions -> Bool
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
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. 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
forall a. a -> Default a
def :: GlobalOptions
$cdef :: GlobalOptions
Default)

data Options =
  Options {
    Options -> GlobalOptions
global :: GlobalOptions,
    Options -> Command
cmd :: Command
  }
  deriving stock (Int -> Options -> ShowS
[Options] -> ShowS
Options -> String
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)

fileParser ::
  String ->
  String ->
  Parser (Path Abs File)
fileParser :: String -> String -> Parser (Path Abs File)
fileParser String
longName String
helpText =
  forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM (Path Abs File)
absFileOption (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
longName forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer (String -> Completer
bashCompleter String
"file") forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
helpText)

jsonConfigParser ::
  Parser JsonConfig
jsonConfigParser :: Parser JsonConfig
jsonConfigParser =
  forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM JsonConfig
jsonOption (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"config" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'c' forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"The Hix-generated config, file or text")

preprocParser :: Parser PreprocOptions
preprocParser :: Parser PreprocOptions
preprocParser =
  Maybe (Either PreprocConfig JsonConfig)
-> Path Abs File
-> Path Abs File
-> Path Abs File
-> PreprocOptions
PreprocOptions
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser JsonConfig
jsonConfigParser)
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
  String -> String -> Parser (Path Abs File)
fileParser String
"source" String
"The original source file"
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
  String -> String -> Parser (Path Abs File)
fileParser String
"in" String
"The prepared input file"
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
  String -> String -> Parser (Path Abs File)
fileParser String
"out" String
"The path to the output file"

packageSpecParser :: Parser PackageSpec
packageSpecParser :: Parser PackageSpec
packageSpecParser = do
  Text
name <- forall s. IsString s => Mod OptionFields s -> Parser s
strOption (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"package" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'p' forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"The name or directory of the test package")
  pure PackageSpec {$sel:name:PackageSpec :: PackageName
name = Text -> PackageName
PackageName Text
name, $sel:dir:PackageSpec :: Maybe (SomeBase Dir)
dir = forall (m :: * -> *). MonadThrow m => String -> m (SomeBase Dir)
parseSomeDir (forall a. ToString a => a -> String
toString Text
name)}

componentSpecParser :: Parser ComponentSpec
componentSpecParser :: Parser ComponentSpec
componentSpecParser = do
  Text
name <- forall s. IsString s => Mod OptionFields s -> Parser s
strOption (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"component" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'c' forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
h forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Text
"test")
  pure ComponentSpec {$sel:name:ComponentSpec :: ComponentName
name = Text -> ComponentName
ComponentName Text
name, $sel:dir:ComponentSpec :: Maybe SourceDir
dir = Path Rel Dir -> SourceDir
SourceDir forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadThrow m => String -> m (Path Rel Dir)
parseRelDir (forall a. ToString a => a -> String
toString Text
name)}
  where
    h :: String
h = String
"The name or relative directory of the test component"

componentForModuleParser :: Parser ComponentCoords
componentForModuleParser :: Parser ComponentCoords
componentForModuleParser =
  PackageSpec -> ComponentSpec -> ComponentCoords
ComponentCoords
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  Parser PackageSpec
packageSpecParser
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
  Parser ComponentSpec
componentSpecParser

componentForFileParser :: Parser TargetSpec
componentForFileParser :: Parser TargetSpec
componentForFileParser =
  Path Abs File -> TargetSpec
TargetForFile
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM (Path Abs File)
absFileOption (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"file" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'f' forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"The absolute file path of the test module")

targetSpecParser :: Parser TargetSpec
targetSpecParser :: Parser TargetSpec
targetSpecParser =
  ComponentCoords -> TargetSpec
TargetForComponent forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ComponentCoords
componentForModuleParser
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Parser TargetSpec
componentForFileParser

envNameParser :: Parser EnvName
envNameParser :: Parser EnvName
envNameParser =
  forall s. IsString s => Mod OptionFields s -> Parser s
strOption (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"env" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'e' forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"The name of the environment")

testParser :: Parser (Maybe Text)
testParser :: Parser (Maybe Text)
testParser =
  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
"test" 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. String -> Mod f a
help String
"The Haskell function that should be executed"))

runnerParser :: Parser (Maybe RunnerName)
runnerParser :: Parser (Maybe RunnerName)
runnerParser =
  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
"run"
    forall a. Semigroup a => a -> a -> a
<>
    forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'r'
    forall a. Semigroup a => a -> a -> a
<>
    forall (f :: * -> *) a. String -> Mod f a
help String
"The name of the command defined in the Hix option 'ghci.run'"
  ))

moduleParser :: Parser ModuleName
moduleParser :: Parser ModuleName
moduleParser =
  forall s. IsString s => Mod OptionFields s -> Parser s
strOption (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"module" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'm' forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"The module containing the test function" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasValue f => a -> Mod f a
value ModuleName
"Main")

testOptionsParser :: Parser TestOptions
testOptionsParser :: Parser TestOptions
testOptionsParser = do
  Maybe Text
test <- Parser (Maybe Text)
testParser
  Maybe RunnerName
runner <- Parser (Maybe RunnerName)
runnerParser
  ModuleName
mod <- Parser ModuleName
moduleParser
  pure TestOptions {Maybe Text
Maybe RunnerName
ModuleName
mod :: ModuleName
runner :: Maybe RunnerName
test :: Maybe Text
$sel:runner:TestOptions :: Maybe RunnerName
$sel:test:TestOptions :: Maybe Text
$sel:mod:TestOptions :: ModuleName
..}

envParser :: Parser EnvRunnerCommandOptions
envParser :: Parser EnvRunnerCommandOptions
envParser = do
  EnvRunnerOptions
options <- do
    Either EnvConfig JsonConfig
config <- forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser JsonConfig
jsonConfigParser
    Maybe TargetSpec
component <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser TargetSpec
targetSpecParser
    pure EnvRunnerOptions {Maybe TargetSpec
Either EnvConfig JsonConfig
component :: Maybe TargetSpec
config :: Either EnvConfig JsonConfig
$sel:component:EnvRunnerOptions :: Maybe TargetSpec
$sel:config:EnvRunnerOptions :: Either EnvConfig JsonConfig
..}
  TestOptions
test <- Parser TestOptions
testOptionsParser
  pure EnvRunnerCommandOptions {EnvRunnerOptions
TestOptions
test :: TestOptions
options :: EnvRunnerOptions
$sel:test:EnvRunnerCommandOptions :: TestOptions
$sel:options:EnvRunnerCommandOptions :: EnvRunnerOptions
..}

ghciParser :: Parser GhciOptions
ghciParser :: Parser GhciOptions
ghciParser = do
  Either GhciConfig JsonConfig
config <- forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser JsonConfig
jsonConfigParser
  TargetSpec
component <- Parser TargetSpec
targetSpecParser
  TestOptions
test <- Parser TestOptions
testOptionsParser
  pure GhciOptions {Either GhciConfig JsonConfig
TestOptions
TargetSpec
test :: TestOptions
component :: TargetSpec
config :: Either GhciConfig JsonConfig
$sel:test:GhciOptions :: TestOptions
$sel:component:GhciOptions :: TargetSpec
$sel:config:GhciOptions :: Either GhciConfig JsonConfig
..}

newParser :: Parser NewOptions
newParser :: Parser NewOptions
newParser = do
  ProjectName
name <- forall s. IsString s => Mod OptionFields s -> Parser s
strOption (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"name" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'n' forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"The name of the new project and its main package")
  Bool
packages <- Mod FlagFields Bool -> Parser Bool
switch (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"packages" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'p' forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Store packages in the 'packages/' subdirectory")
  HixUrl
hixUrl <- forall s. IsString s => Mod OptionFields s -> Parser s
strOption (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"hix-url" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"The URL to the Hix repository" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasValue f => a -> Mod f a
value forall a. Default a => a
def)
  Author
author <- forall s. IsString s => Mod OptionFields s -> Parser s
strOption (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"author" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'a' forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Your name")
  pure NewOptions {$sel:config:NewOptions :: NewProjectConfig
config = NewProjectConfig {Bool
Author
HixUrl
ProjectName
$sel:author:NewProjectConfig :: Author
$sel:hixUrl:NewProjectConfig :: HixUrl
$sel:packages:NewProjectConfig :: Bool
$sel:name:NewProjectConfig :: ProjectName
author :: Author
hixUrl :: HixUrl
packages :: Bool
name :: ProjectName
..}}

bootstrapParser :: Parser BootstrapOptions
bootstrapParser :: Parser BootstrapOptions
bootstrapParser = do
  HixUrl
hixUrl <- forall s. IsString s => Mod OptionFields s -> Parser s
strOption (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"hix-url" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"The URL to the Hix repository" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasValue f => a -> Mod f a
value forall a. Default a => a
def)
  pure BootstrapOptions {$sel:config:BootstrapOptions :: BootstrapProjectConfig
config = BootstrapProjectConfig {HixUrl
$sel:hixUrl:BootstrapProjectConfig :: HixUrl
hixUrl :: HixUrl
..}}

commands ::
  Mod CommandFields Command
commands :: Mod CommandFields Command
commands =
  forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"preproc" (PreprocOptions -> Command
Preproc forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parser a -> InfoMod a -> ParserInfo a
info Parser PreprocOptions
preprocParser (forall a. String -> InfoMod a
progDesc String
"Preprocess a source file for use with ghcid"))
  forall a. Semigroup a => a -> a -> a
<>
  forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"env" (EnvRunnerCommandOptions -> Command
EnvRunner forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parser a -> InfoMod a -> ParserInfo a
info Parser EnvRunnerCommandOptions
envParser (forall a. String -> InfoMod a
progDesc String
"Print the env runner for a component or a named env"))
  forall a. Semigroup a => a -> a -> a
<>
  forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"ghci-cmd" (GhciOptions -> Command
GhciCmd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parser a -> InfoMod a -> ParserInfo a
info Parser GhciOptions
ghciParser (forall a. String -> InfoMod a
progDesc String
"Print a ghci cmdline to load a module in a Hix env"))
  forall a. Semigroup a => a -> a -> a
<>
  forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"ghcid-cmd" (GhciOptions -> Command
GhcidCmd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parser a -> InfoMod a -> ParserInfo a
info Parser GhciOptions
ghciParser (forall a. String -> InfoMod a
progDesc String
"Print a ghcid cmdline to run a function in a Hix env"))
  forall a. Semigroup a => a -> a -> a
<>
  forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"new" (NewOptions -> Command
NewCmd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parser a -> InfoMod a -> ParserInfo a
info Parser NewOptions
newParser (forall a. String -> InfoMod a
progDesc String
"Create a new Hix project in the current directory"))
  forall a. Semigroup a => a -> a -> a
<>
  forall a. String -> ParserInfo a -> Mod CommandFields a
command String
"bootstrap" (BootstrapOptions -> Command
BootstrapCmd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parser a -> InfoMod a -> ParserInfo a
info Parser BootstrapOptions
bootstrapParser (forall a. String -> InfoMod a
progDesc String
"Bootstrap an existing Cabal project in the current directory"))

globalParser :: Parser GlobalOptions
globalParser :: Parser GlobalOptions
globalParser = do
  Maybe Bool
verbose <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Mod FlagFields Bool -> Parser Bool
switch (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"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. String -> Mod f a
help String
"Verbose output"))
  pure GlobalOptions {Maybe Bool
verbose :: Maybe Bool
$sel:verbose:GlobalOptions :: Maybe Bool
..}

appParser ::
  Parser Options
appParser :: Parser Options
appParser =
  GlobalOptions -> Command -> Options
Options forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser GlobalOptions
globalParser forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Mod CommandFields a -> Parser a
hsubparser Mod CommandFields Command
commands

parseCli ::
  IO Options
parseCli :: IO Options
parseCli = do
  forall a. ParserPrefs -> ParserInfo a -> IO a
customExecParser ParserPrefs
parserPrefs (forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser Options
appParser forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> forall a. Parser (a -> a)
helper) forall {a}. InfoMod a
desc)
  where
    parserPrefs :: ParserPrefs
parserPrefs =
      PrefsMod -> ParserPrefs
prefs (PrefsMod
showHelpOnEmpty forall a. Semigroup a => a -> a -> a
<> PrefsMod
showHelpOnError)
    desc :: InfoMod a
desc =
      forall {a}. InfoMod a
fullDesc forall a. Semigroup a => a -> a -> a
<> forall a. String -> InfoMod a
header String
"Tools for maintaining Hix projects"