{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeApplications #-}
module Feedback.Common.OptParse where
import Autodocodec
import Autodocodec.Yaml
import Control.Applicative
import Data.Map (Map)
import qualified Data.Map as M
import Data.Maybe
import qualified Data.Text as T
import Data.Version
import Data.Yaml (FromJSON, ToJSON)
import qualified Env
import GHC.Generics (Generic)
import Options.Applicative as OptParse
import qualified Options.Applicative.Help as OptParse (string)
import Path
import Path.IO
import Paths_feedback
data LoopSettings = LoopSettings
{ LoopSettings -> RunSettings
loopSettingRunSettings :: !RunSettings,
LoopSettings -> FilterSettings
loopSettingFilterSettings :: !FilterSettings,
LoopSettings -> OutputSettings
loopSettingOutputSettings :: !OutputSettings
}
deriving (Int -> LoopSettings -> ShowS
[LoopSettings] -> ShowS
LoopSettings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LoopSettings] -> ShowS
$cshowList :: [LoopSettings] -> ShowS
show :: LoopSettings -> String
$cshow :: LoopSettings -> String
showsPrec :: Int -> LoopSettings -> ShowS
$cshowsPrec :: Int -> LoopSettings -> ShowS
Show, LoopSettings -> LoopSettings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LoopSettings -> LoopSettings -> Bool
$c/= :: LoopSettings -> LoopSettings -> Bool
== :: LoopSettings -> LoopSettings -> Bool
$c== :: LoopSettings -> LoopSettings -> Bool
Eq, forall x. Rep LoopSettings x -> LoopSettings
forall x. LoopSettings -> Rep LoopSettings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LoopSettings x -> LoopSettings
$cfrom :: forall x. LoopSettings -> Rep LoopSettings x
Generic)
combineToLoopSettings :: Flags -> Environment -> Maybe OutputConfiguration -> LoopConfiguration -> IO LoopSettings
combineToLoopSettings :: Flags
-> Environment
-> Maybe OutputConfiguration
-> LoopConfiguration
-> IO LoopSettings
combineToLoopSettings Flags {String
Maybe String
OutputFlags
flagOutputFlags :: Flags -> OutputFlags
flagConfigFile :: Flags -> Maybe String
flagCommand :: Flags -> String
flagOutputFlags :: OutputFlags
flagConfigFile :: Maybe String
flagCommand :: String
..} Environment {} Maybe OutputConfiguration
mDefaultOutputConfig LoopConfiguration {Maybe String
OutputConfiguration
FilterConfiguration
RunConfiguration
loopConfigOutputConfiguration :: LoopConfiguration -> OutputConfiguration
loopConfigFilterConfiguration :: LoopConfiguration -> FilterConfiguration
loopConfigRunConfiguration :: LoopConfiguration -> RunConfiguration
loopConfigDescription :: LoopConfiguration -> Maybe String
loopConfigOutputConfiguration :: OutputConfiguration
loopConfigFilterConfiguration :: FilterConfiguration
loopConfigRunConfiguration :: RunConfiguration
loopConfigDescription :: Maybe String
..} = do
RunSettings
loopSettingRunSettings <- RunConfiguration -> IO RunSettings
combineToRunSettings RunConfiguration
loopConfigRunConfiguration
let loopSettingFilterSettings :: FilterSettings
loopSettingFilterSettings = FilterConfiguration -> FilterSettings
combineToFilterSettings FilterConfiguration
loopConfigFilterConfiguration
let outputConfig :: OutputConfiguration
outputConfig = forall b a. b -> (a -> b) -> Maybe a -> b
maybe OutputConfiguration
loopConfigOutputConfiguration (forall a. Semigroup a => a -> a -> a
<> OutputConfiguration
loopConfigOutputConfiguration) Maybe OutputConfiguration
mDefaultOutputConfig
let loopSettingOutputSettings :: OutputSettings
loopSettingOutputSettings = OutputFlags -> OutputConfiguration -> OutputSettings
combineToOutputSettings OutputFlags
flagOutputFlags OutputConfiguration
outputConfig
forall (f :: * -> *) a. Applicative f => a -> f a
pure LoopSettings {FilterSettings
OutputSettings
RunSettings
loopSettingOutputSettings :: OutputSettings
loopSettingFilterSettings :: FilterSettings
loopSettingRunSettings :: RunSettings
loopSettingOutputSettings :: OutputSettings
loopSettingFilterSettings :: FilterSettings
loopSettingRunSettings :: RunSettings
..}
data RunSettings = RunSettings
{ RunSettings -> Command
runSettingCommand :: !Command,
:: !(Map String String),
RunSettings -> Maybe (Path Abs Dir)
runSettingWorkingDir :: !(Maybe (Path Abs Dir))
}
deriving (Int -> RunSettings -> ShowS
[RunSettings] -> ShowS
RunSettings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RunSettings] -> ShowS
$cshowList :: [RunSettings] -> ShowS
show :: RunSettings -> String
$cshow :: RunSettings -> String
showsPrec :: Int -> RunSettings -> ShowS
$cshowsPrec :: Int -> RunSettings -> ShowS
Show, RunSettings -> RunSettings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RunSettings -> RunSettings -> Bool
$c/= :: RunSettings -> RunSettings -> Bool
== :: RunSettings -> RunSettings -> Bool
$c== :: RunSettings -> RunSettings -> Bool
Eq, forall x. Rep RunSettings x -> RunSettings
forall x. RunSettings -> Rep RunSettings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RunSettings x -> RunSettings
$cfrom :: forall x. RunSettings -> Rep RunSettings x
Generic)
combineToRunSettings :: RunConfiguration -> IO RunSettings
combineToRunSettings :: RunConfiguration -> IO RunSettings
combineToRunSettings RunConfiguration {Maybe String
Map String String
Command
runConfigWorkingDir :: RunConfiguration -> Maybe String
runConfigExtraEnv :: RunConfiguration -> Map String String
runConfigCommand :: RunConfiguration -> Command
runConfigWorkingDir :: Maybe String
runConfigExtraEnv :: Map String String
runConfigCommand :: Command
..} = do
let runSettingCommand :: Command
runSettingCommand = Command
runConfigCommand
let runSettingExtraEnv :: Map String String
runSettingExtraEnv = Map String String
runConfigExtraEnv
Maybe (Path Abs Dir)
runSettingWorkingDir <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). MonadIO m => String -> m (Path Abs Dir)
resolveDir' Maybe String
runConfigWorkingDir
forall (f :: * -> *) a. Applicative f => a -> f a
pure RunSettings {Maybe (Path Abs Dir)
Map String String
Command
runSettingWorkingDir :: Maybe (Path Abs Dir)
runSettingExtraEnv :: Map String String
runSettingCommand :: Command
runSettingWorkingDir :: Maybe (Path Abs Dir)
runSettingExtraEnv :: Map String String
runSettingCommand :: Command
..}
data OutputSettings = OutputSettings
{ OutputSettings -> Clear
outputSettingClear :: !Clear
}
deriving (Int -> OutputSettings -> ShowS
[OutputSettings] -> ShowS
OutputSettings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OutputSettings] -> ShowS
$cshowList :: [OutputSettings] -> ShowS
show :: OutputSettings -> String
$cshow :: OutputSettings -> String
showsPrec :: Int -> OutputSettings -> ShowS
$cshowsPrec :: Int -> OutputSettings -> ShowS
Show, OutputSettings -> OutputSettings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OutputSettings -> OutputSettings -> Bool
$c/= :: OutputSettings -> OutputSettings -> Bool
== :: OutputSettings -> OutputSettings -> Bool
$c== :: OutputSettings -> OutputSettings -> Bool
Eq, forall x. Rep OutputSettings x -> OutputSettings
forall x. OutputSettings -> Rep OutputSettings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OutputSettings x -> OutputSettings
$cfrom :: forall x. OutputSettings -> Rep OutputSettings x
Generic)
data FilterSettings = FilterSettings
{ FilterSettings -> Bool
filterSettingGitignore :: !Bool,
FilterSettings -> Maybe String
filterSettingFind :: !(Maybe String)
}
deriving (Int -> FilterSettings -> ShowS
[FilterSettings] -> ShowS
FilterSettings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FilterSettings] -> ShowS
$cshowList :: [FilterSettings] -> ShowS
show :: FilterSettings -> String
$cshow :: FilterSettings -> String
showsPrec :: Int -> FilterSettings -> ShowS
$cshowsPrec :: Int -> FilterSettings -> ShowS
Show, FilterSettings -> FilterSettings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FilterSettings -> FilterSettings -> Bool
$c/= :: FilterSettings -> FilterSettings -> Bool
== :: FilterSettings -> FilterSettings -> Bool
$c== :: FilterSettings -> FilterSettings -> Bool
Eq, forall x. Rep FilterSettings x -> FilterSettings
forall x. FilterSettings -> Rep FilterSettings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FilterSettings x -> FilterSettings
$cfrom :: forall x. FilterSettings -> Rep FilterSettings x
Generic)
combineToFilterSettings :: FilterConfiguration -> FilterSettings
combineToFilterSettings :: FilterConfiguration -> FilterSettings
combineToFilterSettings FilterConfiguration {Maybe Bool
Maybe String
filterConfigFind :: FilterConfiguration -> Maybe String
filterConfigGitignore :: FilterConfiguration -> Maybe Bool
filterConfigFind :: Maybe String
filterConfigGitignore :: Maybe Bool
..} =
let filterSettingGitignore :: Bool
filterSettingGitignore = forall a. a -> Maybe a -> a
fromMaybe Bool
True Maybe Bool
filterConfigGitignore
filterSettingFind :: Maybe String
filterSettingFind = Maybe String
filterConfigFind
in FilterSettings {Bool
Maybe String
filterSettingFind :: Maybe String
filterSettingGitignore :: Bool
filterSettingFind :: Maybe String
filterSettingGitignore :: Bool
..}
combineToOutputSettings :: OutputFlags -> OutputConfiguration -> OutputSettings
combineToOutputSettings :: OutputFlags -> OutputConfiguration -> OutputSettings
combineToOutputSettings OutputFlags {Bool
Maybe Clear
outputFlagDebug :: OutputFlags -> Bool
outputFlagClear :: OutputFlags -> Maybe Clear
outputFlagDebug :: Bool
outputFlagClear :: Maybe Clear
..} OutputConfiguration
mConf =
let outputSettingClear :: Clear
outputSettingClear =
forall a. a -> Maybe a -> a
fromMaybe (if Bool
outputFlagDebug then Clear
DoNotClearScreen else Clear
ClearScreen) forall a b. (a -> b) -> a -> b
$
Maybe Clear
outputFlagClear forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> OutputConfiguration -> Maybe Clear
outputConfigClear OutputConfiguration
mConf
in OutputSettings {Clear
outputSettingClear :: Clear
outputSettingClear :: Clear
..}
data Configuration = Configuration
{ Configuration -> Map String LoopConfiguration
configLoops :: !(Map String LoopConfiguration),
Configuration -> Maybe OutputConfiguration
configOutputConfiguration :: !(Maybe OutputConfiguration)
}
deriving stock (Int -> Configuration -> ShowS
[Configuration] -> ShowS
Configuration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Configuration] -> ShowS
$cshowList :: [Configuration] -> ShowS
show :: Configuration -> String
$cshow :: Configuration -> String
showsPrec :: Int -> Configuration -> ShowS
$cshowsPrec :: Int -> Configuration -> ShowS
Show, Configuration -> Configuration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Configuration -> Configuration -> Bool
$c/= :: Configuration -> Configuration -> Bool
== :: Configuration -> Configuration -> Bool
$c== :: Configuration -> Configuration -> Bool
Eq, forall x. Rep Configuration x -> Configuration
forall x. Configuration -> Rep Configuration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Configuration x -> Configuration
$cfrom :: forall x. Configuration -> Rep Configuration x
Generic)
deriving (Value -> Parser [Configuration]
Value -> Parser Configuration
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Configuration]
$cparseJSONList :: Value -> Parser [Configuration]
parseJSON :: Value -> Parser Configuration
$cparseJSON :: Value -> Parser Configuration
FromJSON, [Configuration] -> Encoding
[Configuration] -> Value
Configuration -> Encoding
Configuration -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Configuration] -> Encoding
$ctoEncodingList :: [Configuration] -> Encoding
toJSONList :: [Configuration] -> Value
$ctoJSONList :: [Configuration] -> Value
toEncoding :: Configuration -> Encoding
$ctoEncoding :: Configuration -> Encoding
toJSON :: Configuration -> Value
$ctoJSON :: Configuration -> Value
ToJSON) via (Autodocodec Configuration)
instance HasCodec Configuration where
codec :: JSONCodec Configuration
codec =
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"Configuration" forall a b. (a -> b) -> a -> b
$
Map String LoopConfiguration
-> Maybe OutputConfiguration -> Configuration
Configuration
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall output.
(Eq output, HasCodec output) =>
Text -> output -> ObjectCodec output output
optionalFieldWithOmittedDefault' Text
"loops" forall k a. Map k a
M.empty forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Configuration -> Map String LoopConfiguration
configLoops
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall output.
HasCodec output =>
Text -> Text -> ObjectCodec (Maybe output) (Maybe output)
optionalField Text
"output" Text
"default output configuration" forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Configuration -> Maybe OutputConfiguration
configOutputConfiguration
data LoopConfiguration = LoopConfiguration
{ LoopConfiguration -> Maybe String
loopConfigDescription :: !(Maybe String),
LoopConfiguration -> RunConfiguration
loopConfigRunConfiguration :: !RunConfiguration,
LoopConfiguration -> FilterConfiguration
loopConfigFilterConfiguration :: !FilterConfiguration,
LoopConfiguration -> OutputConfiguration
loopConfigOutputConfiguration :: !OutputConfiguration
}
deriving stock (Int -> LoopConfiguration -> ShowS
[LoopConfiguration] -> ShowS
LoopConfiguration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LoopConfiguration] -> ShowS
$cshowList :: [LoopConfiguration] -> ShowS
show :: LoopConfiguration -> String
$cshow :: LoopConfiguration -> String
showsPrec :: Int -> LoopConfiguration -> ShowS
$cshowsPrec :: Int -> LoopConfiguration -> ShowS
Show, LoopConfiguration -> LoopConfiguration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LoopConfiguration -> LoopConfiguration -> Bool
$c/= :: LoopConfiguration -> LoopConfiguration -> Bool
== :: LoopConfiguration -> LoopConfiguration -> Bool
$c== :: LoopConfiguration -> LoopConfiguration -> Bool
Eq, forall x. Rep LoopConfiguration x -> LoopConfiguration
forall x. LoopConfiguration -> Rep LoopConfiguration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LoopConfiguration x -> LoopConfiguration
$cfrom :: forall x. LoopConfiguration -> Rep LoopConfiguration x
Generic)
deriving (Value -> Parser [LoopConfiguration]
Value -> Parser LoopConfiguration
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [LoopConfiguration]
$cparseJSONList :: Value -> Parser [LoopConfiguration]
parseJSON :: Value -> Parser LoopConfiguration
$cparseJSON :: Value -> Parser LoopConfiguration
FromJSON, [LoopConfiguration] -> Encoding
[LoopConfiguration] -> Value
LoopConfiguration -> Encoding
LoopConfiguration -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [LoopConfiguration] -> Encoding
$ctoEncodingList :: [LoopConfiguration] -> Encoding
toJSONList :: [LoopConfiguration] -> Value
$ctoJSONList :: [LoopConfiguration] -> Value
toEncoding :: LoopConfiguration -> Encoding
$ctoEncoding :: LoopConfiguration -> Encoding
toJSON :: LoopConfiguration -> Value
$ctoJSON :: LoopConfiguration -> Value
ToJSON) via (Autodocodec LoopConfiguration)
instance HasCodec LoopConfiguration where
codec :: JSONCodec LoopConfiguration
codec =
forall input output.
Text -> ValueCodec input output -> ValueCodec input output
named
Text
"LoopConfiguration"
( forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Either String LoopConfiguration -> LoopConfiguration
f LoopConfiguration -> Either String LoopConfiguration
g forall a b. (a -> b) -> a -> b
$
forall context input1 output1 input2 output2.
Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
eitherCodec (forall value. HasCodec value => JSONCodec value
codec forall input output.
ValueCodec input output -> Text -> ValueCodec input output
<?> Text
"A bare command without any extra configuration") forall a b. (a -> b) -> a -> b
$
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"LoopConfiguration" JSONObjectCodec LoopConfiguration
loopConfigurationObjectCodec
)
forall input output.
ValueCodec input output -> [Text] -> ValueCodec input output
<??> [Text]
loopConfigDocs
where
loopConfigDocs :: [Text]
loopConfigDocs =
[ Item [Text]
"A LoopConfiguration specifies an entire feedback loop.",
Item [Text]
"",
Item [Text]
"It consists of three parts:",
Item [Text]
"* Filter Configuration: Which files to watch",
Item [Text]
"* Run Configuration: What to do when those files change",
Item [Text]
"* Output Configuration: What to see"
]
f :: Either String LoopConfiguration -> LoopConfiguration
f = \case
Left String
s -> Command -> LoopConfiguration
makeLoopConfiguration (String -> Command
CommandArgs String
s)
Right LoopConfiguration
loopConfig -> LoopConfiguration
loopConfig
g :: LoopConfiguration -> Either String LoopConfiguration
g LoopConfiguration
loopConfig =
let runConfig :: RunConfiguration
runConfig = LoopConfiguration -> RunConfiguration
loopConfigRunConfiguration LoopConfiguration
loopConfig
c :: Command
c = RunConfiguration -> Command
runConfigCommand RunConfiguration
runConfig
in case Command
c of
CommandArgs String
cmd | LoopConfiguration
loopConfig forall a. Eq a => a -> a -> Bool
== Command -> LoopConfiguration
makeLoopConfiguration Command
c -> forall a b. a -> Either a b
Left String
cmd
Command
_ -> forall a b. b -> Either a b
Right LoopConfiguration
loopConfig
loopConfigurationObjectCodec :: JSONObjectCodec LoopConfiguration
loopConfigurationObjectCodec :: JSONObjectCodec LoopConfiguration
loopConfigurationObjectCodec =
Maybe String
-> RunConfiguration
-> FilterConfiguration
-> OutputConfiguration
-> LoopConfiguration
LoopConfiguration
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall output.
HasCodec output =>
Text -> Text -> ObjectCodec (Maybe output) (Maybe output)
optionalField Text
"description" Text
"description of when to use this feedback loop" forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= LoopConfiguration -> Maybe String
loopConfigDescription
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall context input output input'.
Codec context input output
-> Codec context input' output -> Codec context input output
parseAlternative
(forall output.
HasCodec output =>
Text -> Text -> ObjectCodec output output
requiredField Text
"run" Text
"run configuration for this loop")
JSONObjectCodec RunConfiguration
runConfigurationObjectCodec
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= LoopConfiguration -> RunConfiguration
loopConfigRunConfiguration
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall context input output input'.
Codec context input output
-> Codec context input' output -> Codec context input output
parseAlternative
(forall output.
HasCodec output =>
Text -> Text -> ObjectCodec output output
requiredField Text
"filter" Text
"filter configuration for this loop")
JSONObjectCodec FilterConfiguration
filterConfigurationObjectCodec
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= LoopConfiguration -> FilterConfiguration
loopConfigFilterConfiguration
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall context input output input'.
Codec context input output
-> Codec context input' output -> Codec context input output
parseAlternative
(forall output.
HasCodec output =>
Text -> Text -> ObjectCodec output output
requiredField Text
"output" Text
"output configuration for this loop")
JSONObjectCodec OutputConfiguration
outputConfigurationObjectCodec
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= LoopConfiguration -> OutputConfiguration
loopConfigOutputConfiguration
makeLoopConfiguration :: Command -> LoopConfiguration
makeLoopConfiguration :: Command -> LoopConfiguration
makeLoopConfiguration Command
c =
LoopConfiguration
{ loopConfigDescription :: Maybe String
loopConfigDescription = forall a. Maybe a
Nothing,
loopConfigRunConfiguration :: RunConfiguration
loopConfigRunConfiguration = Command -> RunConfiguration
makeRunConfiguration Command
c,
loopConfigFilterConfiguration :: FilterConfiguration
loopConfigFilterConfiguration = FilterConfiguration
emptyFilterConfiguration,
loopConfigOutputConfiguration :: OutputConfiguration
loopConfigOutputConfiguration = OutputConfiguration
emptyOutputConfiguration
}
data RunConfiguration = RunConfiguration
{ RunConfiguration -> Command
runConfigCommand :: !Command,
:: !(Map String String),
RunConfiguration -> Maybe String
runConfigWorkingDir :: !(Maybe FilePath)
}
deriving stock (Int -> RunConfiguration -> ShowS
[RunConfiguration] -> ShowS
RunConfiguration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RunConfiguration] -> ShowS
$cshowList :: [RunConfiguration] -> ShowS
show :: RunConfiguration -> String
$cshow :: RunConfiguration -> String
showsPrec :: Int -> RunConfiguration -> ShowS
$cshowsPrec :: Int -> RunConfiguration -> ShowS
Show, RunConfiguration -> RunConfiguration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RunConfiguration -> RunConfiguration -> Bool
$c/= :: RunConfiguration -> RunConfiguration -> Bool
== :: RunConfiguration -> RunConfiguration -> Bool
$c== :: RunConfiguration -> RunConfiguration -> Bool
Eq, forall x. Rep RunConfiguration x -> RunConfiguration
forall x. RunConfiguration -> Rep RunConfiguration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RunConfiguration x -> RunConfiguration
$cfrom :: forall x. RunConfiguration -> Rep RunConfiguration x
Generic)
deriving (Value -> Parser [RunConfiguration]
Value -> Parser RunConfiguration
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [RunConfiguration]
$cparseJSONList :: Value -> Parser [RunConfiguration]
parseJSON :: Value -> Parser RunConfiguration
$cparseJSON :: Value -> Parser RunConfiguration
FromJSON, [RunConfiguration] -> Encoding
[RunConfiguration] -> Value
RunConfiguration -> Encoding
RunConfiguration -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [RunConfiguration] -> Encoding
$ctoEncodingList :: [RunConfiguration] -> Encoding
toJSONList :: [RunConfiguration] -> Value
$ctoJSONList :: [RunConfiguration] -> Value
toEncoding :: RunConfiguration -> Encoding
$ctoEncoding :: RunConfiguration -> Encoding
toJSON :: RunConfiguration -> Value
$ctoJSON :: RunConfiguration -> Value
ToJSON) via (Autodocodec RunConfiguration)
instance HasCodec RunConfiguration where
codec :: JSONCodec RunConfiguration
codec =
forall input output.
Text -> ValueCodec input output -> ValueCodec input output
named Text
"RunConfiguration" forall a b. (a -> b) -> a -> b
$
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"RunConfiguration" JSONObjectCodec RunConfiguration
runConfigurationObjectCodec
runConfigurationObjectCodec :: JSONObjectCodec RunConfiguration
runConfigurationObjectCodec :: JSONObjectCodec RunConfiguration
runConfigurationObjectCodec =
Command -> Map String String -> Maybe String -> RunConfiguration
RunConfiguration
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSONObjectCodec Command
commandObjectCodec forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= RunConfiguration -> Command
runConfigCommand
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall output.
(Eq output, HasCodec output) =>
Text -> output -> Text -> ObjectCodec output output
optionalFieldWithOmittedDefault Text
"env" forall k a. Map k a
M.empty Text
"extra environment variables to set" forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= RunConfiguration -> Map String String
runConfigExtraEnv
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall output.
HasCodec output =>
Text -> Text -> ObjectCodec (Maybe output) (Maybe output)
optionalField Text
"working-dir" Text
"where the process will be run" forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= RunConfiguration -> Maybe String
runConfigWorkingDir
makeRunConfiguration :: Command -> RunConfiguration
makeRunConfiguration :: Command -> RunConfiguration
makeRunConfiguration Command
c =
RunConfiguration
{ runConfigCommand :: Command
runConfigCommand = Command
c,
runConfigExtraEnv :: Map String String
runConfigExtraEnv = forall k a. Map k a
M.empty,
runConfigWorkingDir :: Maybe String
runConfigWorkingDir = forall a. Maybe a
Nothing
}
data FilterConfiguration = FilterConfiguration
{ FilterConfiguration -> Maybe Bool
filterConfigGitignore :: !(Maybe Bool),
FilterConfiguration -> Maybe String
filterConfigFind :: !(Maybe String)
}
deriving stock (Int -> FilterConfiguration -> ShowS
[FilterConfiguration] -> ShowS
FilterConfiguration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FilterConfiguration] -> ShowS
$cshowList :: [FilterConfiguration] -> ShowS
show :: FilterConfiguration -> String
$cshow :: FilterConfiguration -> String
showsPrec :: Int -> FilterConfiguration -> ShowS
$cshowsPrec :: Int -> FilterConfiguration -> ShowS
Show, FilterConfiguration -> FilterConfiguration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FilterConfiguration -> FilterConfiguration -> Bool
$c/= :: FilterConfiguration -> FilterConfiguration -> Bool
== :: FilterConfiguration -> FilterConfiguration -> Bool
$c== :: FilterConfiguration -> FilterConfiguration -> Bool
Eq, forall x. Rep FilterConfiguration x -> FilterConfiguration
forall x. FilterConfiguration -> Rep FilterConfiguration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FilterConfiguration x -> FilterConfiguration
$cfrom :: forall x. FilterConfiguration -> Rep FilterConfiguration x
Generic)
deriving (Value -> Parser [FilterConfiguration]
Value -> Parser FilterConfiguration
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [FilterConfiguration]
$cparseJSONList :: Value -> Parser [FilterConfiguration]
parseJSON :: Value -> Parser FilterConfiguration
$cparseJSON :: Value -> Parser FilterConfiguration
FromJSON, [FilterConfiguration] -> Encoding
[FilterConfiguration] -> Value
FilterConfiguration -> Encoding
FilterConfiguration -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [FilterConfiguration] -> Encoding
$ctoEncodingList :: [FilterConfiguration] -> Encoding
toJSONList :: [FilterConfiguration] -> Value
$ctoJSONList :: [FilterConfiguration] -> Value
toEncoding :: FilterConfiguration -> Encoding
$ctoEncoding :: FilterConfiguration -> Encoding
toJSON :: FilterConfiguration -> Value
$ctoJSON :: FilterConfiguration -> Value
ToJSON) via (Autodocodec FilterConfiguration)
instance HasCodec FilterConfiguration where
codec :: JSONCodec FilterConfiguration
codec =
forall input output.
Text -> ValueCodec input output -> ValueCodec input output
named
Text
"FilterConfiguration"
( forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"FilterConfiguration" JSONObjectCodec FilterConfiguration
filterConfigurationObjectCodec
)
forall input output.
ValueCodec input output -> [Text] -> ValueCodec input output
<??> [Text]
filterConfigurationDocs
where
filterConfigurationDocs :: [Text]
filterConfigurationDocs =
[ Item [Text]
"By default, standard filters are applied and,",
Item [Text]
"if in a git repository, only files in the git repository are considered.",
Item [Text]
"If either 'git' or 'find' configuration are specified, only those are used."
]
filterConfigurationObjectCodec :: JSONObjectCodec FilterConfiguration
filterConfigurationObjectCodec :: JSONObjectCodec FilterConfiguration
filterConfigurationObjectCodec =
Maybe Bool -> Maybe String -> FilterConfiguration
FilterConfiguration
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall output.
HasCodec output =>
Text -> Text -> ObjectCodec (Maybe output) (Maybe output)
optionalField Text
"git" Text
"whether to ignore files that are not in the git repo\nConcretely, this uses `git ls-files` to find files that are in the repo, so files that have been added but are also ignored by .gitignore will still be watched." forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= FilterConfiguration -> Maybe Bool
filterConfigGitignore
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall output.
HasCodec output =>
Text -> Text -> ObjectCodec (Maybe output) (Maybe output)
optionalField Text
"find" Text
"arguments for the 'find' command to find files to be notified about" forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= FilterConfiguration -> Maybe String
filterConfigFind
emptyFilterConfiguration :: FilterConfiguration
emptyFilterConfiguration :: FilterConfiguration
emptyFilterConfiguration =
FilterConfiguration
{ filterConfigGitignore :: Maybe Bool
filterConfigGitignore = forall a. Maybe a
Nothing,
filterConfigFind :: Maybe String
filterConfigFind = forall a. Maybe a
Nothing
}
data OutputConfiguration = OutputConfiguration
{ OutputConfiguration -> Maybe Clear
outputConfigClear :: !(Maybe Clear)
}
deriving stock (Int -> OutputConfiguration -> ShowS
[OutputConfiguration] -> ShowS
OutputConfiguration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OutputConfiguration] -> ShowS
$cshowList :: [OutputConfiguration] -> ShowS
show :: OutputConfiguration -> String
$cshow :: OutputConfiguration -> String
showsPrec :: Int -> OutputConfiguration -> ShowS
$cshowsPrec :: Int -> OutputConfiguration -> ShowS
Show, OutputConfiguration -> OutputConfiguration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OutputConfiguration -> OutputConfiguration -> Bool
$c/= :: OutputConfiguration -> OutputConfiguration -> Bool
== :: OutputConfiguration -> OutputConfiguration -> Bool
$c== :: OutputConfiguration -> OutputConfiguration -> Bool
Eq, forall x. Rep OutputConfiguration x -> OutputConfiguration
forall x. OutputConfiguration -> Rep OutputConfiguration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OutputConfiguration x -> OutputConfiguration
$cfrom :: forall x. OutputConfiguration -> Rep OutputConfiguration x
Generic)
deriving (Value -> Parser [OutputConfiguration]
Value -> Parser OutputConfiguration
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [OutputConfiguration]
$cparseJSONList :: Value -> Parser [OutputConfiguration]
parseJSON :: Value -> Parser OutputConfiguration
$cparseJSON :: Value -> Parser OutputConfiguration
FromJSON, [OutputConfiguration] -> Encoding
[OutputConfiguration] -> Value
OutputConfiguration -> Encoding
OutputConfiguration -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [OutputConfiguration] -> Encoding
$ctoEncodingList :: [OutputConfiguration] -> Encoding
toJSONList :: [OutputConfiguration] -> Value
$ctoJSONList :: [OutputConfiguration] -> Value
toEncoding :: OutputConfiguration -> Encoding
$ctoEncoding :: OutputConfiguration -> Encoding
toJSON :: OutputConfiguration -> Value
$ctoJSON :: OutputConfiguration -> Value
ToJSON) via (Autodocodec OutputConfiguration)
instance HasCodec OutputConfiguration where
codec :: JSONCodec OutputConfiguration
codec =
forall input output.
Text -> ValueCodec input output -> ValueCodec input output
named Text
"OutputConfiguration" forall a b. (a -> b) -> a -> b
$
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"OutputConfiguration" JSONObjectCodec OutputConfiguration
outputConfigurationObjectCodec
outputConfigurationObjectCodec :: JSONObjectCodec OutputConfiguration
outputConfigurationObjectCodec :: JSONObjectCodec OutputConfiguration
outputConfigurationObjectCodec =
Maybe Clear -> OutputConfiguration
OutputConfiguration
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall output.
HasCodec output =>
Text -> Text -> ObjectCodec (Maybe output) (Maybe output)
optionalField Text
"clear" Text
"whether to clear the screen runs" forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= OutputConfiguration -> Maybe Clear
outputConfigClear
instance Semigroup OutputConfiguration where
<> :: OutputConfiguration -> OutputConfiguration -> OutputConfiguration
(<>) OutputConfiguration
oc1 OutputConfiguration
oc2 =
OutputConfiguration
{ outputConfigClear :: Maybe Clear
outputConfigClear = OutputConfiguration -> Maybe Clear
outputConfigClear OutputConfiguration
oc1 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> OutputConfiguration -> Maybe Clear
outputConfigClear OutputConfiguration
oc2
}
emptyOutputConfiguration :: OutputConfiguration
emptyOutputConfiguration :: OutputConfiguration
emptyOutputConfiguration =
OutputConfiguration
{ outputConfigClear :: Maybe Clear
outputConfigClear = forall a. Maybe a
Nothing
}
getConfiguration :: Flags -> Environment -> IO (Maybe Configuration)
getConfiguration :: Flags -> Environment -> IO (Maybe Configuration)
getConfiguration Flags {String
Maybe String
OutputFlags
flagOutputFlags :: OutputFlags
flagConfigFile :: Maybe String
flagCommand :: String
flagOutputFlags :: Flags -> OutputFlags
flagConfigFile :: Flags -> Maybe String
flagCommand :: Flags -> String
..} Environment {Maybe String
envConfigFile :: Environment -> Maybe String
envConfigFile :: Maybe String
..} = do
Path Abs File
fp <- case Maybe String
flagConfigFile forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe String
envConfigFile of
Maybe String
Nothing -> IO (Path Abs File)
defaultConfigFile
Just String
cf -> forall (m :: * -> *). MonadIO m => String -> m (Path Abs File)
resolveFile' String
cf
Path Abs File -> IO (Maybe Configuration)
getConfigurationFromFile Path Abs File
fp
getConfigurationFromFile :: Path Abs File -> IO (Maybe Configuration)
getConfigurationFromFile :: Path Abs File -> IO (Maybe Configuration)
getConfigurationFromFile = forall a r. HasCodec a => Path r File -> IO (Maybe a)
readYamlConfigFile
defaultConfigFile :: IO (Path Abs File)
defaultConfigFile :: IO (Path Abs File)
defaultConfigFile = do
Path Abs Dir
here <- forall (m :: * -> *). MonadIO m => m (Path Abs Dir)
getCurrentDir
forall (m :: * -> *).
MonadIO m =>
Path Abs Dir -> String -> m (Path Abs File)
resolveFile Path Abs Dir
here String
"feedback.yaml"
data Environment = Environment
{ Environment -> Maybe String
envConfigFile :: !(Maybe FilePath)
}
deriving (Int -> Environment -> ShowS
[Environment] -> ShowS
Environment -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Environment] -> ShowS
$cshowList :: [Environment] -> ShowS
show :: Environment -> String
$cshow :: Environment -> String
showsPrec :: Int -> Environment -> ShowS
$cshowsPrec :: Int -> Environment -> ShowS
Show, Environment -> Environment -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Environment -> Environment -> Bool
$c/= :: Environment -> Environment -> Bool
== :: Environment -> Environment -> Bool
$c== :: Environment -> Environment -> Bool
Eq, forall x. Rep Environment x -> Environment
forall x. Environment -> Rep Environment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Environment x -> Environment
$cfrom :: forall x. Environment -> Rep Environment x
Generic)
getEnvironment :: IO Environment
getEnvironment :: IO Environment
getEnvironment = forall e a.
AsUnset e =>
(Info Error -> Info e) -> Parser e a -> IO a
Env.parse (forall e. String -> Info e -> Info e
Env.header String
"Environment") Parser Error Environment
environmentParser
environmentParser :: Env.Parser Env.Error Environment
environmentParser :: Parser Error Environment
environmentParser =
forall e a. String -> Parser e a -> Parser e a
Env.prefixed String
"FEEDBACK_" forall a b. (a -> b) -> a -> b
$
Maybe String -> Environment
Environment
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e a.
AsUnset e =>
Reader e a -> String -> Mod Var a -> Parser e a
Env.var (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s e. IsString s => Reader e s
Env.str) String
"CONFIG_FILE" (forall a. a -> Mod Var a
Env.def forall a. Maybe a
Nothing forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a. HasHelp t => String -> Mod t a
Env.help String
"Config file")
getFlags :: IO Flags
getFlags :: IO Flags
getFlags = forall a. ParserPrefs -> ParserInfo a -> IO a
customExecParser ParserPrefs
prefs_ ParserInfo Flags
flagsParser
prefs_ :: OptParse.ParserPrefs
prefs_ :: ParserPrefs
prefs_ =
ParserPrefs
OptParse.defaultPrefs
{ prefShowHelpOnError :: Bool
OptParse.prefShowHelpOnError = Bool
True,
prefShowHelpOnEmpty :: Bool
OptParse.prefShowHelpOnEmpty = Bool
True
}
flagsParser :: OptParse.ParserInfo Flags
flagsParser :: ParserInfo Flags
flagsParser =
forall a. Parser a -> InfoMod a -> ParserInfo a
OptParse.info
(forall a. Parser (a -> a)
OptParse.helper forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Flags
parseFlags)
( forall a. Monoid a => [a] -> a
mconcat
[ forall a. String -> InfoMod a
OptParse.progDesc String
versionStr,
forall a. InfoMod a
OptParse.fullDesc,
forall a. Maybe Doc -> InfoMod a
OptParse.footerDoc (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> Doc
OptParse.string String
footerStr)
]
)
where
versionStr :: String
versionStr =
String
"Version: " forall a. Semigroup a => a -> a -> a
<> Version -> String
showVersion Version
version
footerStr :: String
footerStr =
[String] -> String
unlines
[ forall e a. Parser e a -> String
Env.helpDoc Parser Error Environment
environmentParser,
String
"",
String
"Configuration file format:",
Text -> String
T.unpack (forall a. HasCodec a => Text
renderColouredSchemaViaCodec @Configuration)
]
data Flags = Flags
{ Flags -> String
flagCommand :: !String,
Flags -> Maybe String
flagConfigFile :: !(Maybe FilePath),
Flags -> OutputFlags
flagOutputFlags :: !OutputFlags
}
deriving (Int -> Flags -> ShowS
[Flags] -> ShowS
Flags -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Flags] -> ShowS
$cshowList :: [Flags] -> ShowS
show :: Flags -> String
$cshow :: Flags -> String
showsPrec :: Int -> Flags -> ShowS
$cshowsPrec :: Int -> Flags -> ShowS
Show, Flags -> Flags -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Flags -> Flags -> Bool
$c/= :: Flags -> Flags -> Bool
== :: Flags -> Flags -> Bool
$c== :: Flags -> Flags -> Bool
Eq, forall x. Rep Flags x -> Flags
forall x. Flags -> Rep Flags x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Flags x -> Flags
$cfrom :: forall x. Flags -> Rep Flags x
Generic)
data OutputFlags = OutputFlags
{ OutputFlags -> Maybe Clear
outputFlagClear :: !(Maybe Clear),
OutputFlags -> Bool
outputFlagDebug :: Bool
}
deriving (Int -> OutputFlags -> ShowS
[OutputFlags] -> ShowS
OutputFlags -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OutputFlags] -> ShowS
$cshowList :: [OutputFlags] -> ShowS
show :: OutputFlags -> String
$cshow :: OutputFlags -> String
showsPrec :: Int -> OutputFlags -> ShowS
$cshowsPrec :: Int -> OutputFlags -> ShowS
Show, OutputFlags -> OutputFlags -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OutputFlags -> OutputFlags -> Bool
$c/= :: OutputFlags -> OutputFlags -> Bool
== :: OutputFlags -> OutputFlags -> Bool
$c== :: OutputFlags -> OutputFlags -> Bool
Eq, forall x. Rep OutputFlags x -> OutputFlags
forall x. OutputFlags -> Rep OutputFlags x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OutputFlags x -> OutputFlags
$cfrom :: forall x. OutputFlags -> Rep OutputFlags x
Generic)
parseFlags :: OptParse.Parser Flags
parseFlags :: Parser Flags
parseFlags =
String -> Maybe String -> OutputFlags -> Flags
Flags
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String
parseCommandFlags
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
( forall s. IsString s => Mod OptionFields s -> Parser s
strOption
( forall a. Monoid a => [a] -> a
mconcat
[ forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"config-file",
forall (f :: * -> *) a. String -> Mod f a
help String
"Path to an altenative config file",
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"FILEPATH"
]
)
)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser OutputFlags
parseOutputFlags
parseCommandFlags :: OptParse.Parser String
parseCommandFlags :: Parser String
parseCommandFlags =
let commandArg :: Parser String
commandArg =
forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument
( forall a. Monoid a => [a] -> a
mconcat
[ forall (f :: * -> *) a. String -> Mod f a
help String
"The command to run",
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"COMMAND",
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer (IO [String] -> Completer
listIOCompleter IO [String]
defaultConfigFileCompleter)
]
)
escapeChar :: Char -> String
escapeChar = \case
Char
'"' -> String
"\\\""
Char
'\'' -> String
"\\\'"
Char
c -> [Char
c]
quote :: ShowS
quote = (String
"\"" forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Semigroup a => a -> a -> a
<> String
"\"") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> String
escapeChar
quoteIfNecessary :: ShowS
quoteIfNecessary String
"" = ShowS
quote String
""
quoteIfNecessary String
s = if Char
' ' forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
s then ShowS
quote String
s else String
s
pieceBackTogether :: [String] -> String
pieceBackTogether = [String] -> String
unwords forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map ShowS
quoteIfNecessary
in [String] -> String
pieceBackTogether forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser String
commandArg
defaultConfigFileCompleter :: IO [String]
defaultConfigFileCompleter :: IO [String]
defaultConfigFileCompleter = do
Maybe Configuration
mConfig <- IO (Path Abs File)
defaultConfigFile forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Path Abs File -> IO (Maybe Configuration)
getConfigurationFromFile
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [k]
M.keys (forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Configuration -> Map String LoopConfiguration
configLoops Maybe Configuration
mConfig)
parseOutputFlags :: OptParse.Parser OutputFlags
parseOutputFlags :: Parser OutputFlags
parseOutputFlags =
Maybe Clear -> Bool -> OutputFlags
OutputFlags
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Maybe Clear)
parseClearFlag
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch (forall a. Monoid a => [a] -> a
mconcat [forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"debug", forall (f :: * -> *) a. String -> Mod f a
help String
"show debug information"])
data Command
= CommandArgs !String
| CommandScript !String
deriving (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, Command -> Command -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Command -> Command -> Bool
$c/= :: Command -> Command -> Bool
== :: Command -> Command -> Bool
$c== :: Command -> Command -> Bool
Eq, forall x. Rep Command x -> Command
forall x. Command -> Rep Command x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Command x -> Command
$cfrom :: forall x. Command -> Rep Command x
Generic)
commandObjectCodec :: JSONObjectCodec Command
commandObjectCodec :: JSONObjectCodec Command
commandObjectCodec =
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Either String String -> Command
f Command -> Either String String
g forall a b. (a -> b) -> a -> b
$
forall context input1 output1 input2 output2.
Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
eitherCodec
(forall output.
HasCodec output =>
Text -> Text -> ObjectCodec output output
requiredField Text
"command" Text
"the command to run on change")
(forall output.
HasCodec output =>
Text -> Text -> ObjectCodec output output
requiredField Text
"script" Text
"the script to run on change")
where
f :: Either String String -> Command
f = \case
Left String
c -> String -> Command
CommandArgs String
c
Right String
s -> String -> Command
CommandScript String
s
g :: Command -> Either String String
g = \case
CommandArgs String
c -> forall a b. a -> Either a b
Left String
c
CommandScript String
s -> forall a b. b -> Either a b
Right String
s
data Clear = ClearScreen | DoNotClearScreen
deriving (Int -> Clear -> ShowS
[Clear] -> ShowS
Clear -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Clear] -> ShowS
$cshowList :: [Clear] -> ShowS
show :: Clear -> String
$cshow :: Clear -> String
showsPrec :: Int -> Clear -> ShowS
$cshowsPrec :: Int -> Clear -> ShowS
Show, Clear -> Clear -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Clear -> Clear -> Bool
$c/= :: Clear -> Clear -> Bool
== :: Clear -> Clear -> Bool
$c== :: Clear -> Clear -> Bool
Eq, forall x. Rep Clear x -> Clear
forall x. Clear -> Rep Clear x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Clear x -> Clear
$cfrom :: forall x. Clear -> Rep Clear x
Generic)
instance HasCodec Clear where
codec :: JSONCodec Clear
codec = forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Bool -> Clear
f Clear -> Bool
g forall value. HasCodec value => JSONCodec value
codec
where
f :: Bool -> Clear
f Bool
True = Clear
ClearScreen
f Bool
False = Clear
DoNotClearScreen
g :: Clear -> Bool
g Clear
ClearScreen = Bool
True
g Clear
DoNotClearScreen = Bool
False
parseClearFlag :: OptParse.Parser (Maybe Clear)
parseClearFlag :: Parser (Maybe Clear)
parseClearFlag =
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$
forall a. a -> Mod FlagFields a -> Parser a
flag'
Clear
ClearScreen
( forall a. Monoid a => [a] -> a
mconcat
[ forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"clear",
forall (f :: * -> *) a. String -> Mod f a
help String
"clear the screen between feedback"
]
)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. a -> Mod FlagFields a -> Parser a
flag'
Clear
DoNotClearScreen
( forall a. Monoid a => [a] -> a
mconcat
[ forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"no-clear",
forall (f :: * -> *) a. String -> Mod f a
help String
"do not clear the screen between feedback"
]
)