{-# 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,
    RunSettings -> Map String String
runSettingExtraEnv :: !(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,
    RunConfiguration -> Map String String
runConfigExtraEnv :: !(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"
            ]
        )