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 Path.IO (getCurrentDir)
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 (ChangeDir (ChangeDir), EnvConfig, GhciConfig, RunnerName)
import qualified Hix.Data.NewProjectConfig
import Hix.Data.NewProjectConfig (NewProjectConfig (NewProjectConfig))
import Hix.Data.PreprocConfig (PreprocConfig)
import Hix.Optparse (JsonConfig, absDirOption, absFileOption, jsonOption)

data PreprocOptions =
  PreprocOptions {
    PreprocOptions -> Maybe (Either PreprocConfig JsonConfig)
config :: Maybe (Either PreprocConfig JsonConfig),
    PreprocOptions -> Maybe (Path Abs Dir)
root :: Maybe (Path Abs Dir),
    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
(Int -> PreprocOptions -> ShowS)
-> (PreprocOptions -> String)
-> ([PreprocOptions] -> ShowS)
-> Show PreprocOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PreprocOptions -> ShowS
showsPrec :: Int -> PreprocOptions -> ShowS
$cshow :: PreprocOptions -> String
show :: PreprocOptions -> String
$cshowList :: [PreprocOptions] -> ShowS
showList :: [PreprocOptions] -> ShowS
Show, (forall x. PreprocOptions -> Rep PreprocOptions x)
-> (forall x. Rep PreprocOptions x -> PreprocOptions)
-> Generic PreprocOptions
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
$cfrom :: forall x. PreprocOptions -> Rep PreprocOptions x
from :: forall x. PreprocOptions -> Rep PreprocOptions x
$cto :: forall x. Rep PreprocOptions x -> PreprocOptions
to :: forall x. Rep PreprocOptions x -> PreprocOptions
Generic)

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

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

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

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

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

data EnvRunnerOptions =
  EnvRunnerOptions {
    EnvRunnerOptions -> Either EnvConfig JsonConfig
config :: Either EnvConfig JsonConfig,
    EnvRunnerOptions -> Maybe (Path Abs Dir)
root :: Maybe (Path Abs Dir),
    EnvRunnerOptions -> Maybe TargetSpec
component :: Maybe TargetSpec
  }
  deriving stock (Int -> EnvRunnerOptions -> ShowS
[EnvRunnerOptions] -> ShowS
EnvRunnerOptions -> String
(Int -> EnvRunnerOptions -> ShowS)
-> (EnvRunnerOptions -> String)
-> ([EnvRunnerOptions] -> ShowS)
-> Show EnvRunnerOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EnvRunnerOptions -> ShowS
showsPrec :: Int -> EnvRunnerOptions -> ShowS
$cshow :: EnvRunnerOptions -> String
show :: EnvRunnerOptions -> String
$cshowList :: [EnvRunnerOptions] -> ShowS
showList :: [EnvRunnerOptions] -> ShowS
Show, (forall x. EnvRunnerOptions -> Rep EnvRunnerOptions x)
-> (forall x. Rep EnvRunnerOptions x -> EnvRunnerOptions)
-> Generic EnvRunnerOptions
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
$cfrom :: forall x. EnvRunnerOptions -> Rep EnvRunnerOptions x
from :: forall x. EnvRunnerOptions -> Rep EnvRunnerOptions x
$cto :: forall x. Rep EnvRunnerOptions x -> EnvRunnerOptions
to :: forall x. Rep EnvRunnerOptions x -> EnvRunnerOptions
Generic)

newtype ExtraGhciOptions =
  ExtraGhciOptions Text
  deriving stock (ExtraGhciOptions -> ExtraGhciOptions -> Bool
(ExtraGhciOptions -> ExtraGhciOptions -> Bool)
-> (ExtraGhciOptions -> ExtraGhciOptions -> Bool)
-> Eq ExtraGhciOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExtraGhciOptions -> ExtraGhciOptions -> Bool
== :: ExtraGhciOptions -> ExtraGhciOptions -> Bool
$c/= :: ExtraGhciOptions -> ExtraGhciOptions -> Bool
/= :: ExtraGhciOptions -> ExtraGhciOptions -> Bool
Eq, Int -> ExtraGhciOptions -> ShowS
[ExtraGhciOptions] -> ShowS
ExtraGhciOptions -> String
(Int -> ExtraGhciOptions -> ShowS)
-> (ExtraGhciOptions -> String)
-> ([ExtraGhciOptions] -> ShowS)
-> Show ExtraGhciOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExtraGhciOptions -> ShowS
showsPrec :: Int -> ExtraGhciOptions -> ShowS
$cshow :: ExtraGhciOptions -> String
show :: ExtraGhciOptions -> String
$cshowList :: [ExtraGhciOptions] -> ShowS
showList :: [ExtraGhciOptions] -> ShowS
Show, (forall x. ExtraGhciOptions -> Rep ExtraGhciOptions x)
-> (forall x. Rep ExtraGhciOptions x -> ExtraGhciOptions)
-> Generic ExtraGhciOptions
forall x. Rep ExtraGhciOptions x -> ExtraGhciOptions
forall x. ExtraGhciOptions -> Rep ExtraGhciOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ExtraGhciOptions -> Rep ExtraGhciOptions x
from :: forall x. ExtraGhciOptions -> Rep ExtraGhciOptions x
$cto :: forall x. Rep ExtraGhciOptions x -> ExtraGhciOptions
to :: forall x. Rep ExtraGhciOptions x -> ExtraGhciOptions
Generic)
  deriving newtype (String -> ExtraGhciOptions
(String -> ExtraGhciOptions) -> IsString ExtraGhciOptions
forall a. (String -> a) -> IsString a
$cfromString :: String -> ExtraGhciOptions
fromString :: String -> ExtraGhciOptions
IsString)

newtype ExtraGhcidOptions =
  ExtraGhcidOptions Text
  deriving stock (ExtraGhcidOptions -> ExtraGhcidOptions -> Bool
(ExtraGhcidOptions -> ExtraGhcidOptions -> Bool)
-> (ExtraGhcidOptions -> ExtraGhcidOptions -> Bool)
-> Eq ExtraGhcidOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExtraGhcidOptions -> ExtraGhcidOptions -> Bool
== :: ExtraGhcidOptions -> ExtraGhcidOptions -> Bool
$c/= :: ExtraGhcidOptions -> ExtraGhcidOptions -> Bool
/= :: ExtraGhcidOptions -> ExtraGhcidOptions -> Bool
Eq, Int -> ExtraGhcidOptions -> ShowS
[ExtraGhcidOptions] -> ShowS
ExtraGhcidOptions -> String
(Int -> ExtraGhcidOptions -> ShowS)
-> (ExtraGhcidOptions -> String)
-> ([ExtraGhcidOptions] -> ShowS)
-> Show ExtraGhcidOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExtraGhcidOptions -> ShowS
showsPrec :: Int -> ExtraGhcidOptions -> ShowS
$cshow :: ExtraGhcidOptions -> String
show :: ExtraGhcidOptions -> String
$cshowList :: [ExtraGhcidOptions] -> ShowS
showList :: [ExtraGhcidOptions] -> ShowS
Show, (forall x. ExtraGhcidOptions -> Rep ExtraGhcidOptions x)
-> (forall x. Rep ExtraGhcidOptions x -> ExtraGhcidOptions)
-> Generic ExtraGhcidOptions
forall x. Rep ExtraGhcidOptions x -> ExtraGhcidOptions
forall x. ExtraGhcidOptions -> Rep ExtraGhcidOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ExtraGhcidOptions -> Rep ExtraGhcidOptions x
from :: forall x. ExtraGhcidOptions -> Rep ExtraGhcidOptions x
$cto :: forall x. Rep ExtraGhcidOptions x -> ExtraGhcidOptions
to :: forall x. Rep ExtraGhcidOptions x -> ExtraGhcidOptions
Generic)
  deriving newtype (String -> ExtraGhcidOptions
(String -> ExtraGhcidOptions) -> IsString ExtraGhcidOptions
forall a. (String -> a) -> IsString a
$cfromString :: String -> ExtraGhcidOptions
fromString :: String -> ExtraGhcidOptions
IsString)

data GhciOptions =
  GhciOptions {
    GhciOptions -> Either GhciConfig JsonConfig
config :: Either GhciConfig JsonConfig,
    GhciOptions -> Maybe (Path Abs Dir)
root :: Maybe (Path Abs Dir),
    GhciOptions -> TargetSpec
component :: TargetSpec,
    GhciOptions -> TestOptions
test :: TestOptions,
    GhciOptions -> Maybe ExtraGhciOptions
extra :: Maybe ExtraGhciOptions
  }
  deriving stock (Int -> GhciOptions -> ShowS
[GhciOptions] -> ShowS
GhciOptions -> String
(Int -> GhciOptions -> ShowS)
-> (GhciOptions -> String)
-> ([GhciOptions] -> ShowS)
-> Show GhciOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GhciOptions -> ShowS
showsPrec :: Int -> GhciOptions -> ShowS
$cshow :: GhciOptions -> String
show :: GhciOptions -> String
$cshowList :: [GhciOptions] -> ShowS
showList :: [GhciOptions] -> ShowS
Show, (forall x. GhciOptions -> Rep GhciOptions x)
-> (forall x. Rep GhciOptions x -> GhciOptions)
-> Generic GhciOptions
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
$cfrom :: forall x. GhciOptions -> Rep GhciOptions x
from :: forall x. GhciOptions -> Rep GhciOptions x
$cto :: forall x. Rep GhciOptions x -> GhciOptions
to :: forall x. Rep GhciOptions x -> GhciOptions
Generic)

data GhcidOptions =
  GhcidOptions {
    GhcidOptions -> GhciOptions
ghci :: GhciOptions,
    GhcidOptions -> Maybe ExtraGhcidOptions
extra :: Maybe ExtraGhcidOptions
  }
  deriving stock (Int -> GhcidOptions -> ShowS
[GhcidOptions] -> ShowS
GhcidOptions -> String
(Int -> GhcidOptions -> ShowS)
-> (GhcidOptions -> String)
-> ([GhcidOptions] -> ShowS)
-> Show GhcidOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GhcidOptions -> ShowS
showsPrec :: Int -> GhcidOptions -> ShowS
$cshow :: GhcidOptions -> String
show :: GhcidOptions -> String
$cshowList :: [GhcidOptions] -> ShowS
showList :: [GhcidOptions] -> ShowS
Show, (forall x. GhcidOptions -> Rep GhcidOptions x)
-> (forall x. Rep GhcidOptions x -> GhcidOptions)
-> Generic GhcidOptions
forall x. Rep GhcidOptions x -> GhcidOptions
forall x. GhcidOptions -> Rep GhcidOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GhcidOptions -> Rep GhcidOptions x
from :: forall x. GhcidOptions -> Rep GhcidOptions x
$cto :: forall x. Rep GhcidOptions x -> GhcidOptions
to :: forall x. Rep GhcidOptions x -> GhcidOptions
Generic)

data NewOptions =
  NewOptions {
    NewOptions -> NewProjectConfig
config :: NewProjectConfig
  }
  deriving stock (NewOptions -> NewOptions -> Bool
(NewOptions -> NewOptions -> Bool)
-> (NewOptions -> NewOptions -> Bool) -> Eq NewOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NewOptions -> NewOptions -> Bool
== :: NewOptions -> NewOptions -> Bool
$c/= :: NewOptions -> NewOptions -> Bool
/= :: 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
$cshowsPrec :: Int -> NewOptions -> ShowS
showsPrec :: Int -> NewOptions -> ShowS
$cshow :: NewOptions -> String
show :: NewOptions -> String
$cshowList :: [NewOptions] -> ShowS
showList :: [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
$cfrom :: forall x. NewOptions -> Rep NewOptions x
from :: forall x. NewOptions -> Rep NewOptions x
$cto :: forall x. Rep NewOptions x -> NewOptions
to :: forall x. Rep NewOptions x -> NewOptions
Generic)

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

data EnvRunnerCommandOptions =
  EnvRunnerCommandOptions {
    EnvRunnerCommandOptions -> EnvRunnerOptions
options :: EnvRunnerOptions,
    EnvRunnerCommandOptions -> TestOptions
test :: TestOptions,
    EnvRunnerCommandOptions -> Maybe ExtraGhciOptions
extraGhci :: Maybe ExtraGhciOptions,
    EnvRunnerCommandOptions -> Maybe ExtraGhcidOptions
extraGhcid :: Maybe ExtraGhcidOptions
  }
  deriving stock (Int -> EnvRunnerCommandOptions -> ShowS
[EnvRunnerCommandOptions] -> ShowS
EnvRunnerCommandOptions -> String
(Int -> EnvRunnerCommandOptions -> ShowS)
-> (EnvRunnerCommandOptions -> String)
-> ([EnvRunnerCommandOptions] -> ShowS)
-> Show EnvRunnerCommandOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EnvRunnerCommandOptions -> ShowS
showsPrec :: Int -> EnvRunnerCommandOptions -> ShowS
$cshow :: EnvRunnerCommandOptions -> String
show :: EnvRunnerCommandOptions -> String
$cshowList :: [EnvRunnerCommandOptions] -> ShowS
showList :: [EnvRunnerCommandOptions] -> ShowS
Show, (forall x.
 EnvRunnerCommandOptions -> Rep EnvRunnerCommandOptions x)
-> (forall x.
    Rep EnvRunnerCommandOptions x -> EnvRunnerCommandOptions)
-> Generic EnvRunnerCommandOptions
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
$cfrom :: forall x. EnvRunnerCommandOptions -> Rep EnvRunnerCommandOptions x
from :: forall x. EnvRunnerCommandOptions -> Rep EnvRunnerCommandOptions x
$cto :: forall x. Rep EnvRunnerCommandOptions x -> EnvRunnerCommandOptions
to :: forall x. Rep EnvRunnerCommandOptions x -> EnvRunnerCommandOptions
Generic)

data Command =
  Preproc PreprocOptions
  |
  EnvRunner EnvRunnerCommandOptions
  |
  GhcidCmd GhcidOptions
  |
  GhciCmd GhciOptions
  |
  NewCmd NewOptions
  |
  BootstrapCmd BootstrapOptions
  deriving stock (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
$cshowsPrec :: Int -> Command -> ShowS
showsPrec :: Int -> Command -> ShowS
$cshow :: Command -> String
show :: Command -> String
$cshowList :: [Command] -> ShowS
showList :: [Command] -> ShowS
Show)

data GlobalOptions =
  GlobalOptions {
    GlobalOptions -> Maybe Bool
verbose :: Maybe Bool,
    GlobalOptions -> Path Abs Dir
cwd :: Path Abs Dir
  }
  deriving stock (GlobalOptions -> GlobalOptions -> Bool
(GlobalOptions -> GlobalOptions -> Bool)
-> (GlobalOptions -> GlobalOptions -> Bool) -> Eq GlobalOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GlobalOptions -> GlobalOptions -> Bool
== :: GlobalOptions -> GlobalOptions -> Bool
$c/= :: GlobalOptions -> GlobalOptions -> Bool
/= :: 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
$cshowsPrec :: Int -> GlobalOptions -> ShowS
showsPrec :: Int -> GlobalOptions -> ShowS
$cshow :: GlobalOptions -> String
show :: GlobalOptions -> String
$cshowList :: [GlobalOptions] -> ShowS
showList :: [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
$cfrom :: forall x. GlobalOptions -> Rep GlobalOptions x
from :: forall x. GlobalOptions -> Rep GlobalOptions x
$cto :: forall x. Rep GlobalOptions x -> GlobalOptions
to :: forall x. Rep GlobalOptions x -> GlobalOptions
Generic)

data Options =
  Options {
    Options -> GlobalOptions
global :: GlobalOptions,
    Options -> Command
cmd :: Command
  }
  deriving stock (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
$cshowsPrec :: Int -> Options -> ShowS
showsPrec :: Int -> Options -> ShowS
$cshow :: Options -> String
show :: Options -> String
$cshowList :: [Options] -> ShowS
showList :: [Options] -> ShowS
Show)

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

rootParser :: Parser (Maybe (Path Abs Dir))
rootParser :: Parser (Maybe (Path Abs Dir))
rootParser =
  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 ReadM (Path Abs Dir)
absDirOption (String -> Mod OptionFields (Path Abs Dir)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"root" 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
"The root directory of the project"))

jsonConfigParser ::
  Parser JsonConfig
jsonConfigParser :: Parser JsonConfig
jsonConfigParser =
  ReadM JsonConfig
-> Mod OptionFields JsonConfig -> Parser JsonConfig
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM JsonConfig
jsonOption (String -> Mod OptionFields JsonConfig
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"config" Mod OptionFields JsonConfig
-> Mod OptionFields JsonConfig -> Mod OptionFields JsonConfig
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields JsonConfig
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)
-> Maybe (Path Abs Dir)
-> Path Abs File
-> Path Abs File
-> Path Abs File
-> PreprocOptions
PreprocOptions
  (Maybe (Either PreprocConfig JsonConfig)
 -> Maybe (Path Abs Dir)
 -> Path Abs File
 -> Path Abs File
 -> Path Abs File
 -> PreprocOptions)
-> Parser (Maybe (Either PreprocConfig JsonConfig))
-> Parser
     (Maybe (Path Abs Dir)
      -> Path Abs File
      -> Path Abs File
      -> Path Abs File
      -> PreprocOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  ((JsonConfig -> Either PreprocConfig JsonConfig)
-> Maybe JsonConfig -> Maybe (Either PreprocConfig JsonConfig)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap JsonConfig -> Either PreprocConfig JsonConfig
forall a b. b -> Either a b
Right (Maybe JsonConfig -> Maybe (Either PreprocConfig JsonConfig))
-> Parser (Maybe JsonConfig)
-> Parser (Maybe (Either PreprocConfig JsonConfig))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser JsonConfig -> Parser (Maybe JsonConfig)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser JsonConfig
jsonConfigParser)
  Parser
  (Maybe (Path Abs Dir)
   -> Path Abs File
   -> Path Abs File
   -> Path Abs File
   -> PreprocOptions)
-> Parser (Maybe (Path Abs Dir))
-> Parser
     (Path Abs File -> Path Abs File -> Path Abs File -> PreprocOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
  Parser (Maybe (Path Abs Dir))
rootParser
  Parser
  (Path Abs File -> Path Abs File -> Path Abs File -> PreprocOptions)
-> Parser (Path Abs File)
-> Parser (Path Abs File -> Path Abs File -> PreprocOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
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"
  Parser (Path Abs File -> Path Abs File -> PreprocOptions)
-> Parser (Path Abs File)
-> Parser (Path Abs File -> PreprocOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
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"
  Parser (Path Abs File -> PreprocOptions)
-> Parser (Path Abs File) -> Parser PreprocOptions
forall a b. Parser (a -> b) -> Parser a -> Parser b
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 (Maybe PackageSpec)
packageSpecParser :: Parser (Maybe PackageSpec)
packageSpecParser = do
  Parser Text -> Parser (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Mod OptionFields Text -> Parser Text
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (String -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"package" Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'p' Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Text
forall (f :: * -> *) a. String -> Mod f a
help String
"The name or directory of the test package")) Parser (Maybe Text)
-> (Maybe Text -> Maybe PackageSpec) -> Parser (Maybe PackageSpec)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Text -> PackageSpec) -> Maybe Text -> Maybe PackageSpec
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap \ Text
name ->
    PackageSpec {$sel:name:PackageSpec :: PackageName
name = Text -> PackageName
PackageName Text
name, $sel:dir:PackageSpec :: Maybe (SomeBase Dir)
dir = String -> Maybe (SomeBase Dir)
forall (m :: * -> *). MonadThrow m => String -> m (SomeBase Dir)
parseSomeDir (Text -> String
forall a. ToString a => a -> String
toString Text
name)}

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

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

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

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

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

testParser :: Parser (Maybe Text)
testParser :: Parser (Maybe Text)
testParser =
  Parser Text -> Parser (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Mod OptionFields Text -> Parser Text
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (String -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"test" Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
't' Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Text
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 =
  Parser RunnerName -> Parser (Maybe RunnerName)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Mod OptionFields RunnerName -> Parser RunnerName
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (
    String -> Mod OptionFields RunnerName
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"run"
    Mod OptionFields RunnerName
-> Mod OptionFields RunnerName -> Mod OptionFields RunnerName
forall a. Semigroup a => a -> a -> a
<>
    Char -> Mod OptionFields RunnerName
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'r'
    Mod OptionFields RunnerName
-> Mod OptionFields RunnerName -> Mod OptionFields RunnerName
forall a. Semigroup a => a -> a -> a
<>
    String -> Mod OptionFields RunnerName
forall (f :: * -> *) a. String -> Mod f a
help String
"The name of the command defined in the Hix option 'ghci.run'"
  ))

cdParser :: Parser ChangeDir
cdParser :: Parser ChangeDir
cdParser =
  Bool -> ChangeDir
ChangeDir (Bool -> ChangeDir) -> (Bool -> Bool) -> Bool -> ChangeDir
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not (Bool -> ChangeDir) -> Parser Bool -> Parser ChangeDir
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
"no-cd" 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 change the working directory to the package root")

moduleParser :: Parser ModuleName
moduleParser :: Parser ModuleName
moduleParser =
  Mod OptionFields ModuleName -> Parser ModuleName
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (String -> Mod OptionFields ModuleName
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"module" Mod OptionFields ModuleName
-> Mod OptionFields ModuleName -> Mod OptionFields ModuleName
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields ModuleName
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'm' Mod OptionFields ModuleName
-> Mod OptionFields ModuleName -> Mod OptionFields ModuleName
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields ModuleName
forall (f :: * -> *) a. String -> Mod f a
help String
"The module containing the test function" Mod OptionFields ModuleName
-> Mod OptionFields ModuleName -> Mod OptionFields ModuleName
forall a. Semigroup a => a -> a -> a
<> ModuleName -> Mod OptionFields ModuleName
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
  ChangeDir
cd <- Parser ChangeDir
cdParser
  pure TestOptions {Maybe Text
Maybe RunnerName
ModuleName
ChangeDir
$sel:mod:TestOptions :: ModuleName
$sel:test:TestOptions :: Maybe Text
$sel:runner:TestOptions :: Maybe RunnerName
$sel:cd:TestOptions :: ChangeDir
test :: Maybe Text
runner :: Maybe RunnerName
mod :: ModuleName
cd :: ChangeDir
..}

extraGhciParser :: Parser (Maybe ExtraGhciOptions)
extraGhciParser :: Parser (Maybe ExtraGhciOptions)
extraGhciParser =
  Parser ExtraGhciOptions -> Parser (Maybe ExtraGhciOptions)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Mod OptionFields ExtraGhciOptions -> Parser ExtraGhciOptions
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (String -> Mod OptionFields ExtraGhciOptions
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"ghci-options" Mod OptionFields ExtraGhciOptions
-> Mod OptionFields ExtraGhciOptions
-> Mod OptionFields ExtraGhciOptions
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields ExtraGhciOptions
forall (f :: * -> *) a. String -> Mod f a
help String
"Additional command line options to pass to ghci"))

extraGhcidParser :: Parser (Maybe ExtraGhcidOptions)
extraGhcidParser :: Parser (Maybe ExtraGhcidOptions)
extraGhcidParser =
  Parser ExtraGhcidOptions -> Parser (Maybe ExtraGhcidOptions)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Mod OptionFields ExtraGhcidOptions -> Parser ExtraGhcidOptions
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (String -> Mod OptionFields ExtraGhcidOptions
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"ghcid-options" Mod OptionFields ExtraGhcidOptions
-> Mod OptionFields ExtraGhcidOptions
-> Mod OptionFields ExtraGhcidOptions
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields ExtraGhcidOptions
forall (f :: * -> *) a. String -> Mod f a
help String
"Additional command line options to pass to ghcid"))

envParser :: Parser EnvRunnerCommandOptions
envParser :: Parser EnvRunnerCommandOptions
envParser = do
  EnvRunnerOptions
options <- do
    Either EnvConfig JsonConfig
config <- JsonConfig -> Either EnvConfig JsonConfig
forall a b. b -> Either a b
Right (JsonConfig -> Either EnvConfig JsonConfig)
-> Parser JsonConfig -> Parser (Either EnvConfig JsonConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser JsonConfig
jsonConfigParser
    Maybe (Path Abs Dir)
root <- Parser (Maybe (Path Abs Dir))
rootParser
    Maybe TargetSpec
component <- Parser TargetSpec -> Parser (Maybe TargetSpec)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser TargetSpec
targetSpecParser
    pure EnvRunnerOptions {Maybe (Path Abs Dir)
Maybe TargetSpec
Either EnvConfig JsonConfig
$sel:config:EnvRunnerOptions :: Either EnvConfig JsonConfig
$sel:root:EnvRunnerOptions :: Maybe (Path Abs Dir)
$sel:component:EnvRunnerOptions :: Maybe TargetSpec
config :: Either EnvConfig JsonConfig
root :: Maybe (Path Abs Dir)
component :: Maybe TargetSpec
..}
  TestOptions
test <- Parser TestOptions
testOptionsParser
  Maybe ExtraGhciOptions
extraGhci <- Parser (Maybe ExtraGhciOptions)
extraGhciParser
  Maybe ExtraGhcidOptions
extraGhcid <- Parser (Maybe ExtraGhcidOptions)
extraGhcidParser
  pure EnvRunnerCommandOptions {Maybe ExtraGhcidOptions
Maybe ExtraGhciOptions
EnvRunnerOptions
TestOptions
$sel:options:EnvRunnerCommandOptions :: EnvRunnerOptions
$sel:test:EnvRunnerCommandOptions :: TestOptions
$sel:extraGhci:EnvRunnerCommandOptions :: Maybe ExtraGhciOptions
$sel:extraGhcid:EnvRunnerCommandOptions :: Maybe ExtraGhcidOptions
options :: EnvRunnerOptions
test :: TestOptions
extraGhci :: Maybe ExtraGhciOptions
extraGhcid :: Maybe ExtraGhcidOptions
..}

ghciParser :: Parser GhciOptions
ghciParser :: Parser GhciOptions
ghciParser = do
  Either GhciConfig JsonConfig
config <- JsonConfig -> Either GhciConfig JsonConfig
forall a b. b -> Either a b
Right (JsonConfig -> Either GhciConfig JsonConfig)
-> Parser JsonConfig -> Parser (Either GhciConfig JsonConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser JsonConfig
jsonConfigParser
  Maybe (Path Abs Dir)
root <- Parser (Maybe (Path Abs Dir))
rootParser
  TargetSpec
component <- Parser TargetSpec
targetSpecParser
  TestOptions
test <- Parser TestOptions
testOptionsParser
  Maybe ExtraGhciOptions
extra <- Parser (Maybe ExtraGhciOptions)
extraGhciParser
  pure GhciOptions {Maybe (Path Abs Dir)
Maybe ExtraGhciOptions
Either GhciConfig JsonConfig
TestOptions
TargetSpec
$sel:config:GhciOptions :: Either GhciConfig JsonConfig
$sel:root:GhciOptions :: Maybe (Path Abs Dir)
$sel:component:GhciOptions :: TargetSpec
$sel:test:GhciOptions :: TestOptions
$sel:extra:GhciOptions :: Maybe ExtraGhciOptions
config :: Either GhciConfig JsonConfig
root :: Maybe (Path Abs Dir)
component :: TargetSpec
test :: TestOptions
extra :: Maybe ExtraGhciOptions
..}

ghcidParser :: Parser GhcidOptions
ghcidParser :: Parser GhcidOptions
ghcidParser = do
  GhciOptions
ghci <- Parser GhciOptions
ghciParser
  Maybe ExtraGhcidOptions
extra <- Parser (Maybe ExtraGhcidOptions)
extraGhcidParser
  pure GhcidOptions {Maybe ExtraGhcidOptions
GhciOptions
$sel:ghci:GhcidOptions :: GhciOptions
$sel:extra:GhcidOptions :: Maybe ExtraGhcidOptions
ghci :: GhciOptions
extra :: Maybe ExtraGhcidOptions
..}

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

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

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

globalParser ::
  Path Abs Dir ->
  Parser GlobalOptions
globalParser :: Path Abs Dir -> Parser GlobalOptions
globalParser Path Abs Dir
realCwd = do
  Maybe Bool
verbose <- 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
"verbose" 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
'v' 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
"Verbose output"))
  Path Abs Dir
cwd <- ReadM (Path Abs Dir)
-> Mod OptionFields (Path Abs Dir) -> Parser (Path Abs Dir)
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM (Path Abs Dir)
absDirOption (String -> Mod OptionFields (Path Abs Dir)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"cwd" 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
"Force a different working directory" Mod OptionFields (Path Abs Dir)
-> Mod OptionFields (Path Abs Dir)
-> Mod OptionFields (Path Abs Dir)
forall a. Semigroup a => a -> a -> a
<> Path Abs Dir -> Mod OptionFields (Path Abs Dir)
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Path Abs Dir
realCwd)
  pure GlobalOptions {Maybe Bool
Path Abs Dir
$sel:verbose:GlobalOptions :: Maybe Bool
$sel:cwd:GlobalOptions :: Path Abs Dir
verbose :: Maybe Bool
cwd :: Path Abs Dir
..}

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
<$> Path Abs Dir -> Parser GlobalOptions
globalParser Path Abs Dir
cwd Parser (Command -> Options) -> Parser Command -> Parser Options
forall a b. Parser (a -> b) -> Parser a -> Parser b
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
commands

parseCli ::
  IO Options
parseCli :: IO Options
parseCli = do
  Path Abs Dir
realCwd <- 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
realCwd 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 Hix projects"