{-# 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 (pretty)
import Path
import Path.IO
import Paths_feedback

data LoopSettings = LoopSettings
  { LoopSettings -> RunSettings
loopSettingRunSettings :: !RunSettings,
    LoopSettings -> FilterSettings
loopSettingFilterSettings :: !FilterSettings,
    LoopSettings -> OutputSettings
loopSettingOutputSettings :: !OutputSettings,
    LoopSettings -> HooksSettings
loopSettingHooksSettings :: !HooksSettings
  }
  deriving (Int -> LoopSettings -> ShowS
[LoopSettings] -> ShowS
LoopSettings -> FilePath
(Int -> LoopSettings -> ShowS)
-> (LoopSettings -> FilePath)
-> ([LoopSettings] -> ShowS)
-> Show LoopSettings
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LoopSettings -> ShowS
showsPrec :: Int -> LoopSettings -> ShowS
$cshow :: LoopSettings -> FilePath
show :: LoopSettings -> FilePath
$cshowList :: [LoopSettings] -> ShowS
showList :: [LoopSettings] -> ShowS
Show, LoopSettings -> LoopSettings -> Bool
(LoopSettings -> LoopSettings -> Bool)
-> (LoopSettings -> LoopSettings -> Bool) -> Eq LoopSettings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LoopSettings -> LoopSettings -> Bool
== :: LoopSettings -> LoopSettings -> Bool
$c/= :: LoopSettings -> LoopSettings -> Bool
/= :: LoopSettings -> LoopSettings -> Bool
Eq, (forall x. LoopSettings -> Rep LoopSettings x)
-> (forall x. Rep LoopSettings x -> LoopSettings)
-> Generic LoopSettings
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
$cfrom :: forall x. LoopSettings -> Rep LoopSettings x
from :: forall x. LoopSettings -> Rep LoopSettings x
$cto :: forall x. Rep LoopSettings x -> LoopSettings
to :: forall x. Rep LoopSettings x -> LoopSettings
Generic)

combineToLoopSettings :: Flags -> Environment -> Maybe OutputConfiguration -> LoopConfiguration -> IO LoopSettings
combineToLoopSettings :: Flags
-> Environment
-> Maybe OutputConfiguration
-> LoopConfiguration
-> IO LoopSettings
combineToLoopSettings Flags {FilePath
Maybe FilePath
OutputFlags
flagCommand :: FilePath
flagConfigFile :: Maybe FilePath
flagOutputFlags :: OutputFlags
flagCommand :: Flags -> FilePath
flagConfigFile :: Flags -> Maybe FilePath
flagOutputFlags :: Flags -> OutputFlags
..} Environment {} Maybe OutputConfiguration
mDefaultOutputConfig LoopConfiguration {Maybe FilePath
HooksConfiguration
OutputConfiguration
FilterConfiguration
RunConfiguration
loopConfigDescription :: Maybe FilePath
loopConfigRunConfiguration :: RunConfiguration
loopConfigFilterConfiguration :: FilterConfiguration
loopConfigOutputConfiguration :: OutputConfiguration
loopConfigHooksConfiguration :: HooksConfiguration
loopConfigDescription :: LoopConfiguration -> Maybe FilePath
loopConfigRunConfiguration :: LoopConfiguration -> RunConfiguration
loopConfigFilterConfiguration :: LoopConfiguration -> FilterConfiguration
loopConfigOutputConfiguration :: LoopConfiguration -> OutputConfiguration
loopConfigHooksConfiguration :: LoopConfiguration -> HooksConfiguration
..} = do
  RunSettings
loopSettingRunSettings <- RunConfiguration -> IO RunSettings
combineToRunSettings RunConfiguration
loopConfigRunConfiguration
  let loopSettingFilterSettings :: FilterSettings
loopSettingFilterSettings = FilterConfiguration -> FilterSettings
combineToFilterSettings FilterConfiguration
loopConfigFilterConfiguration

  let outputConfig :: OutputConfiguration
outputConfig = OutputConfiguration
-> (OutputConfiguration -> OutputConfiguration)
-> Maybe OutputConfiguration
-> OutputConfiguration
forall b a. b -> (a -> b) -> Maybe a -> b
maybe OutputConfiguration
loopConfigOutputConfiguration (OutputConfiguration -> OutputConfiguration -> OutputConfiguration
forall a. Semigroup a => a -> a -> a
<> OutputConfiguration
loopConfigOutputConfiguration) Maybe OutputConfiguration
mDefaultOutputConfig
  let loopSettingOutputSettings :: OutputSettings
loopSettingOutputSettings = OutputFlags -> OutputConfiguration -> OutputSettings
combineToOutputSettings OutputFlags
flagOutputFlags OutputConfiguration
outputConfig
  HooksSettings
loopSettingHooksSettings <- HooksConfiguration -> IO HooksSettings
combineToHooksSettings HooksConfiguration
loopConfigHooksConfiguration
  LoopSettings -> IO LoopSettings
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LoopSettings {HooksSettings
OutputSettings
FilterSettings
RunSettings
loopSettingRunSettings :: RunSettings
loopSettingFilterSettings :: FilterSettings
loopSettingOutputSettings :: OutputSettings
loopSettingHooksSettings :: HooksSettings
loopSettingRunSettings :: RunSettings
loopSettingFilterSettings :: FilterSettings
loopSettingOutputSettings :: OutputSettings
loopSettingHooksSettings :: HooksSettings
..}

data RunSettings = RunSettings
  { RunSettings -> Command
runSettingCommand :: !Command,
    RunSettings -> Map FilePath FilePath
runSettingExtraEnv :: !(Map String String),
    RunSettings -> Maybe (Path Abs Dir)
runSettingWorkingDir :: !(Maybe (Path Abs Dir))
  }
  deriving (Int -> RunSettings -> ShowS
[RunSettings] -> ShowS
RunSettings -> FilePath
(Int -> RunSettings -> ShowS)
-> (RunSettings -> FilePath)
-> ([RunSettings] -> ShowS)
-> Show RunSettings
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RunSettings -> ShowS
showsPrec :: Int -> RunSettings -> ShowS
$cshow :: RunSettings -> FilePath
show :: RunSettings -> FilePath
$cshowList :: [RunSettings] -> ShowS
showList :: [RunSettings] -> ShowS
Show, RunSettings -> RunSettings -> Bool
(RunSettings -> RunSettings -> Bool)
-> (RunSettings -> RunSettings -> Bool) -> Eq RunSettings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RunSettings -> RunSettings -> Bool
== :: RunSettings -> RunSettings -> Bool
$c/= :: RunSettings -> RunSettings -> Bool
/= :: RunSettings -> RunSettings -> Bool
Eq, (forall x. RunSettings -> Rep RunSettings x)
-> (forall x. Rep RunSettings x -> RunSettings)
-> Generic RunSettings
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
$cfrom :: forall x. RunSettings -> Rep RunSettings x
from :: forall x. RunSettings -> Rep RunSettings x
$cto :: forall x. Rep RunSettings x -> RunSettings
to :: forall x. Rep RunSettings x -> RunSettings
Generic)

combineToRunSettings :: RunConfiguration -> IO RunSettings
combineToRunSettings :: RunConfiguration -> IO RunSettings
combineToRunSettings RunConfiguration {Maybe FilePath
Map FilePath FilePath
Command
runConfigCommand :: Command
runConfigExtraEnv :: Map FilePath FilePath
runConfigWorkingDir :: Maybe FilePath
runConfigCommand :: RunConfiguration -> Command
runConfigExtraEnv :: RunConfiguration -> Map FilePath FilePath
runConfigWorkingDir :: RunConfiguration -> Maybe FilePath
..} = do
  let runSettingCommand :: Command
runSettingCommand = Command
runConfigCommand
  let runSettingExtraEnv :: Map FilePath FilePath
runSettingExtraEnv = Map FilePath FilePath
runConfigExtraEnv
  Maybe (Path Abs Dir)
runSettingWorkingDir <- (FilePath -> IO (Path Abs Dir))
-> Maybe FilePath -> IO (Maybe (Path Abs Dir))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM FilePath -> IO (Path Abs Dir)
forall (m :: * -> *). MonadIO m => FilePath -> m (Path Abs Dir)
resolveDir' Maybe FilePath
runConfigWorkingDir
  RunSettings -> IO RunSettings
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RunSettings {Maybe (Path Abs Dir)
Map FilePath FilePath
Command
runSettingCommand :: Command
runSettingExtraEnv :: Map FilePath FilePath
runSettingWorkingDir :: Maybe (Path Abs Dir)
runSettingCommand :: Command
runSettingExtraEnv :: Map FilePath FilePath
runSettingWorkingDir :: Maybe (Path Abs Dir)
..}

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

combineToFilterSettings :: FilterConfiguration -> FilterSettings
combineToFilterSettings :: FilterConfiguration -> FilterSettings
combineToFilterSettings FilterConfiguration {Maybe Bool
Maybe FilePath
filterConfigGitignore :: Maybe Bool
filterConfigFind :: Maybe FilePath
filterConfigGitignore :: FilterConfiguration -> Maybe Bool
filterConfigFind :: FilterConfiguration -> Maybe FilePath
..} =
  let filterSettingGitignore :: Bool
filterSettingGitignore = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
True Maybe Bool
filterConfigGitignore
      filterSettingFind :: Maybe FilePath
filterSettingFind = Maybe FilePath
filterConfigFind
   in FilterSettings {Bool
Maybe FilePath
filterSettingGitignore :: Bool
filterSettingFind :: Maybe FilePath
filterSettingGitignore :: Bool
filterSettingFind :: Maybe FilePath
..}

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

combineToOutputSettings :: OutputFlags -> OutputConfiguration -> OutputSettings
combineToOutputSettings :: OutputFlags -> OutputConfiguration -> OutputSettings
combineToOutputSettings OutputFlags {Bool
Maybe Clear
outputFlagClear :: Maybe Clear
outputFlagDebug :: Bool
outputFlagClear :: OutputFlags -> Maybe Clear
outputFlagDebug :: OutputFlags -> Bool
..} OutputConfiguration
mConf =
  let outputSettingClear :: Clear
outputSettingClear =
        Clear -> Maybe Clear -> Clear
forall a. a -> Maybe a -> a
fromMaybe (if Bool
outputFlagDebug then Clear
DoNotClearScreen else Clear
ClearScreen) (Maybe Clear -> Clear) -> Maybe Clear -> Clear
forall a b. (a -> b) -> a -> b
$
          Maybe Clear
outputFlagClear Maybe Clear -> Maybe Clear -> Maybe Clear
forall a. Maybe a -> Maybe a -> Maybe a
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 HooksSettings = HooksSettings
  { HooksSettings -> Maybe RunSettings
hooksSettingBeforeAll :: Maybe RunSettings,
    HooksSettings -> Maybe RunSettings
hooksSettingAfterFirst :: Maybe RunSettings
  }
  deriving (Int -> HooksSettings -> ShowS
[HooksSettings] -> ShowS
HooksSettings -> FilePath
(Int -> HooksSettings -> ShowS)
-> (HooksSettings -> FilePath)
-> ([HooksSettings] -> ShowS)
-> Show HooksSettings
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HooksSettings -> ShowS
showsPrec :: Int -> HooksSettings -> ShowS
$cshow :: HooksSettings -> FilePath
show :: HooksSettings -> FilePath
$cshowList :: [HooksSettings] -> ShowS
showList :: [HooksSettings] -> ShowS
Show, HooksSettings -> HooksSettings -> Bool
(HooksSettings -> HooksSettings -> Bool)
-> (HooksSettings -> HooksSettings -> Bool) -> Eq HooksSettings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HooksSettings -> HooksSettings -> Bool
== :: HooksSettings -> HooksSettings -> Bool
$c/= :: HooksSettings -> HooksSettings -> Bool
/= :: HooksSettings -> HooksSettings -> Bool
Eq, (forall x. HooksSettings -> Rep HooksSettings x)
-> (forall x. Rep HooksSettings x -> HooksSettings)
-> Generic HooksSettings
forall x. Rep HooksSettings x -> HooksSettings
forall x. HooksSettings -> Rep HooksSettings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. HooksSettings -> Rep HooksSettings x
from :: forall x. HooksSettings -> Rep HooksSettings x
$cto :: forall x. Rep HooksSettings x -> HooksSettings
to :: forall x. Rep HooksSettings x -> HooksSettings
Generic)

combineToHooksSettings :: HooksConfiguration -> IO HooksSettings
combineToHooksSettings :: HooksConfiguration -> IO HooksSettings
combineToHooksSettings HooksConfiguration {Maybe RunConfiguration
hooksConfigurationBeforeAll :: Maybe RunConfiguration
hooksConfigurationAfterFirst :: Maybe RunConfiguration
hooksConfigurationBeforeAll :: HooksConfiguration -> Maybe RunConfiguration
hooksConfigurationAfterFirst :: HooksConfiguration -> Maybe RunConfiguration
..} = do
  Maybe RunSettings
hooksSettingBeforeAll <- (RunConfiguration -> IO RunSettings)
-> Maybe RunConfiguration -> IO (Maybe RunSettings)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM RunConfiguration -> IO RunSettings
combineToRunSettings Maybe RunConfiguration
hooksConfigurationBeforeAll
  Maybe RunSettings
hooksSettingAfterFirst <- (RunConfiguration -> IO RunSettings)
-> Maybe RunConfiguration -> IO (Maybe RunSettings)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM RunConfiguration -> IO RunSettings
combineToRunSettings Maybe RunConfiguration
hooksConfigurationAfterFirst
  HooksSettings -> IO HooksSettings
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HooksSettings {Maybe RunSettings
hooksSettingBeforeAll :: Maybe RunSettings
hooksSettingAfterFirst :: Maybe RunSettings
hooksSettingBeforeAll :: Maybe RunSettings
hooksSettingAfterFirst :: Maybe RunSettings
..}

data Configuration = Configuration
  { Configuration -> Map FilePath LoopConfiguration
configLoops :: !(Map String LoopConfiguration),
    Configuration -> Maybe OutputConfiguration
configOutputConfiguration :: !(Maybe OutputConfiguration)
  }
  deriving stock (Int -> Configuration -> ShowS
[Configuration] -> ShowS
Configuration -> FilePath
(Int -> Configuration -> ShowS)
-> (Configuration -> FilePath)
-> ([Configuration] -> ShowS)
-> Show Configuration
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Configuration -> ShowS
showsPrec :: Int -> Configuration -> ShowS
$cshow :: Configuration -> FilePath
show :: Configuration -> FilePath
$cshowList :: [Configuration] -> ShowS
showList :: [Configuration] -> ShowS
Show, Configuration -> Configuration -> Bool
(Configuration -> Configuration -> Bool)
-> (Configuration -> Configuration -> Bool) -> Eq Configuration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Configuration -> Configuration -> Bool
== :: Configuration -> Configuration -> Bool
$c/= :: Configuration -> Configuration -> Bool
/= :: Configuration -> Configuration -> Bool
Eq, (forall x. Configuration -> Rep Configuration x)
-> (forall x. Rep Configuration x -> Configuration)
-> Generic Configuration
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
$cfrom :: forall x. Configuration -> Rep Configuration x
from :: forall x. Configuration -> Rep Configuration x
$cto :: forall x. Rep Configuration x -> Configuration
to :: forall x. Rep Configuration x -> Configuration
Generic)
  deriving (Maybe Configuration
Value -> Parser [Configuration]
Value -> Parser Configuration
(Value -> Parser Configuration)
-> (Value -> Parser [Configuration])
-> Maybe Configuration
-> FromJSON Configuration
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Configuration
parseJSON :: Value -> Parser Configuration
$cparseJSONList :: Value -> Parser [Configuration]
parseJSONList :: Value -> Parser [Configuration]
$comittedField :: Maybe Configuration
omittedField :: Maybe Configuration
FromJSON, [Configuration] -> Value
[Configuration] -> Encoding
Configuration -> Bool
Configuration -> Value
Configuration -> Encoding
(Configuration -> Value)
-> (Configuration -> Encoding)
-> ([Configuration] -> Value)
-> ([Configuration] -> Encoding)
-> (Configuration -> Bool)
-> ToJSON Configuration
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Configuration -> Value
toJSON :: Configuration -> Value
$ctoEncoding :: Configuration -> Encoding
toEncoding :: Configuration -> Encoding
$ctoJSONList :: [Configuration] -> Value
toJSONList :: [Configuration] -> Value
$ctoEncodingList :: [Configuration] -> Encoding
toEncodingList :: [Configuration] -> Encoding
$comitField :: Configuration -> Bool
omitField :: Configuration -> Bool
ToJSON) via (Autodocodec Configuration)

instance HasCodec Configuration where
  codec :: JSONCodec Configuration
codec =
    Text
-> ObjectCodec Configuration Configuration
-> JSONCodec Configuration
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"Configuration" (ObjectCodec Configuration Configuration
 -> JSONCodec Configuration)
-> ObjectCodec Configuration Configuration
-> JSONCodec Configuration
forall a b. (a -> b) -> a -> b
$
      Map FilePath LoopConfiguration
-> Maybe OutputConfiguration -> Configuration
Configuration
        (Map FilePath LoopConfiguration
 -> Maybe OutputConfiguration -> Configuration)
-> Codec Object Configuration (Map FilePath LoopConfiguration)
-> Codec
     Object Configuration (Maybe OutputConfiguration -> Configuration)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> Map FilePath LoopConfiguration
-> ObjectCodec
     (Map FilePath LoopConfiguration) (Map FilePath LoopConfiguration)
forall output.
(Eq output, HasCodec output) =>
Text -> output -> ObjectCodec output output
optionalFieldWithOmittedDefault' Text
"loops" Map FilePath LoopConfiguration
forall k a. Map k a
M.empty
          ObjectCodec
  (Map FilePath LoopConfiguration) (Map FilePath LoopConfiguration)
-> (Configuration -> Map FilePath LoopConfiguration)
-> Codec Object Configuration (Map FilePath LoopConfiguration)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Configuration -> Map FilePath LoopConfiguration
configLoops
        Codec
  Object Configuration (Maybe OutputConfiguration -> Configuration)
-> Codec Object Configuration (Maybe OutputConfiguration)
-> ObjectCodec Configuration Configuration
forall a b.
Codec Object Configuration (a -> b)
-> Codec Object Configuration a -> Codec Object Configuration b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> Text
-> ObjectCodec
     (Maybe OutputConfiguration) (Maybe OutputConfiguration)
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec (Maybe output) (Maybe output)
optionalField Text
"output" Text
"default output configuration"
          ObjectCodec (Maybe OutputConfiguration) (Maybe OutputConfiguration)
-> (Configuration -> Maybe OutputConfiguration)
-> Codec Object Configuration (Maybe OutputConfiguration)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= Configuration -> Maybe OutputConfiguration
configOutputConfiguration

emptyConfiguration :: Configuration
emptyConfiguration :: Configuration
emptyConfiguration =
  Configuration
    { configLoops :: Map FilePath LoopConfiguration
configLoops = Map FilePath LoopConfiguration
forall a. Monoid a => a
mempty,
      configOutputConfiguration :: Maybe OutputConfiguration
configOutputConfiguration = Maybe OutputConfiguration
forall a. Monoid a => a
mempty
    }

data LoopConfiguration = LoopConfiguration
  { LoopConfiguration -> Maybe FilePath
loopConfigDescription :: !(Maybe String),
    LoopConfiguration -> RunConfiguration
loopConfigRunConfiguration :: !RunConfiguration,
    LoopConfiguration -> FilterConfiguration
loopConfigFilterConfiguration :: !FilterConfiguration,
    LoopConfiguration -> OutputConfiguration
loopConfigOutputConfiguration :: !OutputConfiguration,
    LoopConfiguration -> HooksConfiguration
loopConfigHooksConfiguration :: !HooksConfiguration
  }
  deriving stock (Int -> LoopConfiguration -> ShowS
[LoopConfiguration] -> ShowS
LoopConfiguration -> FilePath
(Int -> LoopConfiguration -> ShowS)
-> (LoopConfiguration -> FilePath)
-> ([LoopConfiguration] -> ShowS)
-> Show LoopConfiguration
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LoopConfiguration -> ShowS
showsPrec :: Int -> LoopConfiguration -> ShowS
$cshow :: LoopConfiguration -> FilePath
show :: LoopConfiguration -> FilePath
$cshowList :: [LoopConfiguration] -> ShowS
showList :: [LoopConfiguration] -> ShowS
Show, LoopConfiguration -> LoopConfiguration -> Bool
(LoopConfiguration -> LoopConfiguration -> Bool)
-> (LoopConfiguration -> LoopConfiguration -> Bool)
-> Eq LoopConfiguration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LoopConfiguration -> LoopConfiguration -> Bool
== :: LoopConfiguration -> LoopConfiguration -> Bool
$c/= :: LoopConfiguration -> LoopConfiguration -> Bool
/= :: LoopConfiguration -> LoopConfiguration -> Bool
Eq, (forall x. LoopConfiguration -> Rep LoopConfiguration x)
-> (forall x. Rep LoopConfiguration x -> LoopConfiguration)
-> Generic LoopConfiguration
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
$cfrom :: forall x. LoopConfiguration -> Rep LoopConfiguration x
from :: forall x. LoopConfiguration -> Rep LoopConfiguration x
$cto :: forall x. Rep LoopConfiguration x -> LoopConfiguration
to :: forall x. Rep LoopConfiguration x -> LoopConfiguration
Generic)
  deriving (Maybe LoopConfiguration
Value -> Parser [LoopConfiguration]
Value -> Parser LoopConfiguration
(Value -> Parser LoopConfiguration)
-> (Value -> Parser [LoopConfiguration])
-> Maybe LoopConfiguration
-> FromJSON LoopConfiguration
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser LoopConfiguration
parseJSON :: Value -> Parser LoopConfiguration
$cparseJSONList :: Value -> Parser [LoopConfiguration]
parseJSONList :: Value -> Parser [LoopConfiguration]
$comittedField :: Maybe LoopConfiguration
omittedField :: Maybe LoopConfiguration
FromJSON, [LoopConfiguration] -> Value
[LoopConfiguration] -> Encoding
LoopConfiguration -> Bool
LoopConfiguration -> Value
LoopConfiguration -> Encoding
(LoopConfiguration -> Value)
-> (LoopConfiguration -> Encoding)
-> ([LoopConfiguration] -> Value)
-> ([LoopConfiguration] -> Encoding)
-> (LoopConfiguration -> Bool)
-> ToJSON LoopConfiguration
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: LoopConfiguration -> Value
toJSON :: LoopConfiguration -> Value
$ctoEncoding :: LoopConfiguration -> Encoding
toEncoding :: LoopConfiguration -> Encoding
$ctoJSONList :: [LoopConfiguration] -> Value
toJSONList :: [LoopConfiguration] -> Value
$ctoEncodingList :: [LoopConfiguration] -> Encoding
toEncodingList :: [LoopConfiguration] -> Encoding
$comitField :: LoopConfiguration -> Bool
omitField :: LoopConfiguration -> Bool
ToJSON) via (Autodocodec LoopConfiguration)

instance HasCodec LoopConfiguration where
  codec :: JSONCodec LoopConfiguration
codec =
    Text -> JSONCodec LoopConfiguration -> JSONCodec LoopConfiguration
forall input output.
Text -> ValueCodec input output -> ValueCodec input output
named
      Text
"LoopConfiguration"
      ( (Either FilePath LoopConfiguration -> LoopConfiguration)
-> (LoopConfiguration -> Either FilePath LoopConfiguration)
-> Codec
     Value
     (Either FilePath LoopConfiguration)
     (Either FilePath LoopConfiguration)
-> JSONCodec LoopConfiguration
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Either FilePath LoopConfiguration -> LoopConfiguration
f LoopConfiguration -> Either FilePath LoopConfiguration
g (Codec
   Value
   (Either FilePath LoopConfiguration)
   (Either FilePath LoopConfiguration)
 -> JSONCodec LoopConfiguration)
-> Codec
     Value
     (Either FilePath LoopConfiguration)
     (Either FilePath LoopConfiguration)
-> JSONCodec LoopConfiguration
forall a b. (a -> b) -> a -> b
$
          Codec Value FilePath FilePath
-> JSONCodec LoopConfiguration
-> Codec
     Value
     (Either FilePath LoopConfiguration)
     (Either FilePath LoopConfiguration)
forall context input1 output1 input2 output2.
Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
eitherCodec (Codec Value FilePath FilePath
forall value. HasCodec value => JSONCodec value
codec Codec Value FilePath FilePath
-> Text -> Codec Value FilePath FilePath
forall input output.
ValueCodec input output -> Text -> ValueCodec input output
<?> Text
"A bare command without any extra configuration") (JSONCodec LoopConfiguration
 -> Codec
      Value
      (Either FilePath LoopConfiguration)
      (Either FilePath LoopConfiguration))
-> JSONCodec LoopConfiguration
-> Codec
     Value
     (Either FilePath LoopConfiguration)
     (Either FilePath LoopConfiguration)
forall a b. (a -> b) -> a -> b
$
            Text
-> ObjectCodec LoopConfiguration LoopConfiguration
-> JSONCodec LoopConfiguration
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"LoopConfiguration" ObjectCodec LoopConfiguration LoopConfiguration
loopConfigurationObjectCodec
      )
      JSONCodec LoopConfiguration
-> [Text] -> JSONCodec LoopConfiguration
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 four 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",
          Item [Text]
"* Hooks configuration: What to around commands"
        ]
      f :: Either FilePath LoopConfiguration -> LoopConfiguration
f = \case
        Left FilePath
s -> Command -> LoopConfiguration
makeLoopConfiguration (FilePath -> Command
CommandScript FilePath
s)
        Right LoopConfiguration
loopConfig -> LoopConfiguration
loopConfig
      g :: LoopConfiguration -> Either FilePath 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
              CommandScript FilePath
cmd | LoopConfiguration
loopConfig LoopConfiguration -> LoopConfiguration -> Bool
forall a. Eq a => a -> a -> Bool
== Command -> LoopConfiguration
makeLoopConfiguration Command
c -> FilePath -> Either FilePath LoopConfiguration
forall a b. a -> Either a b
Left FilePath
cmd
              Command
_ -> LoopConfiguration -> Either FilePath LoopConfiguration
forall a b. b -> Either a b
Right LoopConfiguration
loopConfig

loopConfigurationObjectCodec :: JSONObjectCodec LoopConfiguration
loopConfigurationObjectCodec :: ObjectCodec LoopConfiguration LoopConfiguration
loopConfigurationObjectCodec =
  Maybe FilePath
-> RunConfiguration
-> FilterConfiguration
-> OutputConfiguration
-> HooksConfiguration
-> LoopConfiguration
LoopConfiguration
    (Maybe FilePath
 -> RunConfiguration
 -> FilterConfiguration
 -> OutputConfiguration
 -> HooksConfiguration
 -> LoopConfiguration)
-> Codec Object LoopConfiguration (Maybe FilePath)
-> Codec
     Object
     LoopConfiguration
     (RunConfiguration
      -> FilterConfiguration
      -> OutputConfiguration
      -> HooksConfiguration
      -> LoopConfiguration)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> ObjectCodec (Maybe FilePath) (Maybe FilePath)
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec (Maybe output) (Maybe output)
optionalField Text
"description" Text
"description of when to use this feedback loop"
      ObjectCodec (Maybe FilePath) (Maybe FilePath)
-> (LoopConfiguration -> Maybe FilePath)
-> Codec Object LoopConfiguration (Maybe FilePath)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= LoopConfiguration -> Maybe FilePath
loopConfigDescription
    Codec
  Object
  LoopConfiguration
  (RunConfiguration
   -> FilterConfiguration
   -> OutputConfiguration
   -> HooksConfiguration
   -> LoopConfiguration)
-> Codec Object LoopConfiguration RunConfiguration
-> Codec
     Object
     LoopConfiguration
     (FilterConfiguration
      -> OutputConfiguration -> HooksConfiguration -> LoopConfiguration)
forall a b.
Codec Object LoopConfiguration (a -> b)
-> Codec Object LoopConfiguration a
-> Codec Object LoopConfiguration b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Codec Object RunConfiguration RunConfiguration
-> Codec Object RunConfiguration RunConfiguration
-> Codec Object RunConfiguration RunConfiguration
forall context input output input'.
Codec context input output
-> Codec context input' output -> Codec context input output
parseAlternative
      (Text -> Text -> Codec Object RunConfiguration RunConfiguration
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec output output
requiredField Text
"run" Text
"run configuration for this loop")
      Codec Object RunConfiguration RunConfiguration
runConfigurationObjectCodec
      Codec Object RunConfiguration RunConfiguration
-> (LoopConfiguration -> RunConfiguration)
-> Codec Object LoopConfiguration RunConfiguration
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= LoopConfiguration -> RunConfiguration
loopConfigRunConfiguration
    Codec
  Object
  LoopConfiguration
  (FilterConfiguration
   -> OutputConfiguration -> HooksConfiguration -> LoopConfiguration)
-> Codec Object LoopConfiguration FilterConfiguration
-> Codec
     Object
     LoopConfiguration
     (OutputConfiguration -> HooksConfiguration -> LoopConfiguration)
forall a b.
Codec Object LoopConfiguration (a -> b)
-> Codec Object LoopConfiguration a
-> Codec Object LoopConfiguration b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Codec Object FilterConfiguration FilterConfiguration
-> Codec Object FilterConfiguration FilterConfiguration
-> Codec Object FilterConfiguration FilterConfiguration
forall context input output input'.
Codec context input output
-> Codec context input' output -> Codec context input output
parseAlternative
      (Text
-> Text -> Codec Object FilterConfiguration FilterConfiguration
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec output output
requiredField Text
"filter" Text
"filter configuration for this loop")
      Codec Object FilterConfiguration FilterConfiguration
filterConfigurationObjectCodec
      Codec Object FilterConfiguration FilterConfiguration
-> (LoopConfiguration -> FilterConfiguration)
-> Codec Object LoopConfiguration FilterConfiguration
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= LoopConfiguration -> FilterConfiguration
loopConfigFilterConfiguration
    Codec
  Object
  LoopConfiguration
  (OutputConfiguration -> HooksConfiguration -> LoopConfiguration)
-> Codec Object LoopConfiguration OutputConfiguration
-> Codec
     Object LoopConfiguration (HooksConfiguration -> LoopConfiguration)
forall a b.
Codec Object LoopConfiguration (a -> b)
-> Codec Object LoopConfiguration a
-> Codec Object LoopConfiguration b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Codec Object OutputConfiguration OutputConfiguration
-> Codec Object OutputConfiguration OutputConfiguration
-> Codec Object OutputConfiguration OutputConfiguration
forall context input output input'.
Codec context input output
-> Codec context input' output -> Codec context input output
parseAlternative
      (Text
-> Text -> Codec Object OutputConfiguration OutputConfiguration
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec output output
requiredField Text
"output" Text
"output configuration for this loop")
      Codec Object OutputConfiguration OutputConfiguration
outputConfigurationObjectCodec
      Codec Object OutputConfiguration OutputConfiguration
-> (LoopConfiguration -> OutputConfiguration)
-> Codec Object LoopConfiguration OutputConfiguration
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= LoopConfiguration -> OutputConfiguration
loopConfigOutputConfiguration
    Codec
  Object LoopConfiguration (HooksConfiguration -> LoopConfiguration)
-> Codec Object LoopConfiguration HooksConfiguration
-> ObjectCodec LoopConfiguration LoopConfiguration
forall a b.
Codec Object LoopConfiguration (a -> b)
-> Codec Object LoopConfiguration a
-> Codec Object LoopConfiguration b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Codec Object HooksConfiguration HooksConfiguration
-> Codec Object HooksConfiguration HooksConfiguration
-> Codec Object HooksConfiguration HooksConfiguration
forall context input output input'.
Codec context input output
-> Codec context input' output -> Codec context input output
parseAlternative
      (Text -> Text -> Codec Object HooksConfiguration HooksConfiguration
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec output output
requiredField Text
"hooks" Text
"hooks configuration for this loop")
      Codec Object HooksConfiguration HooksConfiguration
hooksConfigurationObjectCodec
      Codec Object HooksConfiguration HooksConfiguration
-> (LoopConfiguration -> HooksConfiguration)
-> Codec Object LoopConfiguration HooksConfiguration
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= LoopConfiguration -> HooksConfiguration
loopConfigHooksConfiguration

makeLoopConfiguration :: Command -> LoopConfiguration
makeLoopConfiguration :: Command -> LoopConfiguration
makeLoopConfiguration Command
c =
  LoopConfiguration
    { loopConfigDescription :: Maybe FilePath
loopConfigDescription = Maybe FilePath
forall a. Maybe a
Nothing,
      loopConfigRunConfiguration :: RunConfiguration
loopConfigRunConfiguration = Command -> RunConfiguration
makeRunConfiguration Command
c,
      loopConfigFilterConfiguration :: FilterConfiguration
loopConfigFilterConfiguration = FilterConfiguration
emptyFilterConfiguration,
      loopConfigOutputConfiguration :: OutputConfiguration
loopConfigOutputConfiguration = OutputConfiguration
emptyOutputConfiguration,
      loopConfigHooksConfiguration :: HooksConfiguration
loopConfigHooksConfiguration = HooksConfiguration
emptyHooksConfiguration
    }

data RunConfiguration = RunConfiguration
  { RunConfiguration -> Command
runConfigCommand :: !Command,
    RunConfiguration -> Map FilePath FilePath
runConfigExtraEnv :: !(Map String String),
    RunConfiguration -> Maybe FilePath
runConfigWorkingDir :: !(Maybe FilePath)
  }
  deriving stock (Int -> RunConfiguration -> ShowS
[RunConfiguration] -> ShowS
RunConfiguration -> FilePath
(Int -> RunConfiguration -> ShowS)
-> (RunConfiguration -> FilePath)
-> ([RunConfiguration] -> ShowS)
-> Show RunConfiguration
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RunConfiguration -> ShowS
showsPrec :: Int -> RunConfiguration -> ShowS
$cshow :: RunConfiguration -> FilePath
show :: RunConfiguration -> FilePath
$cshowList :: [RunConfiguration] -> ShowS
showList :: [RunConfiguration] -> ShowS
Show, RunConfiguration -> RunConfiguration -> Bool
(RunConfiguration -> RunConfiguration -> Bool)
-> (RunConfiguration -> RunConfiguration -> Bool)
-> Eq RunConfiguration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RunConfiguration -> RunConfiguration -> Bool
== :: RunConfiguration -> RunConfiguration -> Bool
$c/= :: RunConfiguration -> RunConfiguration -> Bool
/= :: RunConfiguration -> RunConfiguration -> Bool
Eq, (forall x. RunConfiguration -> Rep RunConfiguration x)
-> (forall x. Rep RunConfiguration x -> RunConfiguration)
-> Generic RunConfiguration
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
$cfrom :: forall x. RunConfiguration -> Rep RunConfiguration x
from :: forall x. RunConfiguration -> Rep RunConfiguration x
$cto :: forall x. Rep RunConfiguration x -> RunConfiguration
to :: forall x. Rep RunConfiguration x -> RunConfiguration
Generic)
  deriving (Maybe RunConfiguration
Value -> Parser [RunConfiguration]
Value -> Parser RunConfiguration
(Value -> Parser RunConfiguration)
-> (Value -> Parser [RunConfiguration])
-> Maybe RunConfiguration
-> FromJSON RunConfiguration
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser RunConfiguration
parseJSON :: Value -> Parser RunConfiguration
$cparseJSONList :: Value -> Parser [RunConfiguration]
parseJSONList :: Value -> Parser [RunConfiguration]
$comittedField :: Maybe RunConfiguration
omittedField :: Maybe RunConfiguration
FromJSON, [RunConfiguration] -> Value
[RunConfiguration] -> Encoding
RunConfiguration -> Bool
RunConfiguration -> Value
RunConfiguration -> Encoding
(RunConfiguration -> Value)
-> (RunConfiguration -> Encoding)
-> ([RunConfiguration] -> Value)
-> ([RunConfiguration] -> Encoding)
-> (RunConfiguration -> Bool)
-> ToJSON RunConfiguration
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: RunConfiguration -> Value
toJSON :: RunConfiguration -> Value
$ctoEncoding :: RunConfiguration -> Encoding
toEncoding :: RunConfiguration -> Encoding
$ctoJSONList :: [RunConfiguration] -> Value
toJSONList :: [RunConfiguration] -> Value
$ctoEncodingList :: [RunConfiguration] -> Encoding
toEncodingList :: [RunConfiguration] -> Encoding
$comitField :: RunConfiguration -> Bool
omitField :: RunConfiguration -> Bool
ToJSON) via (Autodocodec RunConfiguration)

instance HasCodec RunConfiguration where
  codec :: JSONCodec RunConfiguration
codec =
    Text -> JSONCodec RunConfiguration -> JSONCodec RunConfiguration
forall input output.
Text -> ValueCodec input output -> ValueCodec input output
named Text
"RunConfiguration" (JSONCodec RunConfiguration -> JSONCodec RunConfiguration)
-> JSONCodec RunConfiguration -> JSONCodec RunConfiguration
forall a b. (a -> b) -> a -> b
$
      (Either FilePath RunConfiguration -> RunConfiguration)
-> (RunConfiguration -> Either FilePath RunConfiguration)
-> Codec
     Value
     (Either FilePath RunConfiguration)
     (Either FilePath RunConfiguration)
-> JSONCodec RunConfiguration
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Either FilePath RunConfiguration -> RunConfiguration
f RunConfiguration -> Either FilePath RunConfiguration
g (Codec
   Value
   (Either FilePath RunConfiguration)
   (Either FilePath RunConfiguration)
 -> JSONCodec RunConfiguration)
-> Codec
     Value
     (Either FilePath RunConfiguration)
     (Either FilePath RunConfiguration)
-> JSONCodec RunConfiguration
forall a b. (a -> b) -> a -> b
$
        Codec Value FilePath FilePath
-> JSONCodec RunConfiguration
-> Codec
     Value
     (Either FilePath RunConfiguration)
     (Either FilePath RunConfiguration)
forall context input1 output1 input2 output2.
Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
eitherCodec
          (Codec Value FilePath FilePath
forall value. HasCodec value => JSONCodec value
codec Codec Value FilePath FilePath
-> Text -> Codec Value FilePath FilePath
forall input output.
ValueCodec input output -> Text -> ValueCodec input output
<?> Text
"A bare command without any extra configuration")
          (Text
-> Codec Object RunConfiguration RunConfiguration
-> JSONCodec RunConfiguration
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"RunConfiguration" Codec Object RunConfiguration RunConfiguration
runConfigurationObjectCodec)
    where
      f :: Either FilePath RunConfiguration -> RunConfiguration
f = \case
        Left FilePath
s -> Command -> RunConfiguration
makeRunConfiguration (FilePath -> Command
CommandScript FilePath
s)
        Right RunConfiguration
loopConfig -> RunConfiguration
loopConfig
      g :: RunConfiguration -> Either FilePath RunConfiguration
g RunConfiguration
runConfig =
        let c :: Command
c = RunConfiguration -> Command
runConfigCommand RunConfiguration
runConfig
         in case Command
c of
              CommandScript FilePath
cmd | RunConfiguration
runConfig RunConfiguration -> RunConfiguration -> Bool
forall a. Eq a => a -> a -> Bool
== Command -> RunConfiguration
makeRunConfiguration Command
c -> FilePath -> Either FilePath RunConfiguration
forall a b. a -> Either a b
Left FilePath
cmd
              Command
_ -> RunConfiguration -> Either FilePath RunConfiguration
forall a b. b -> Either a b
Right RunConfiguration
runConfig

runConfigurationObjectCodec :: JSONObjectCodec RunConfiguration
runConfigurationObjectCodec :: Codec Object RunConfiguration RunConfiguration
runConfigurationObjectCodec =
  Command
-> Map FilePath FilePath -> Maybe FilePath -> RunConfiguration
RunConfiguration
    (Command
 -> Map FilePath FilePath -> Maybe FilePath -> RunConfiguration)
-> Codec Object RunConfiguration Command
-> Codec
     Object
     RunConfiguration
     (Map FilePath FilePath -> Maybe FilePath -> RunConfiguration)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSONObjectCodec Command
commandObjectCodec
      JSONObjectCodec Command
-> (RunConfiguration -> Command)
-> Codec Object RunConfiguration Command
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= RunConfiguration -> Command
runConfigCommand
    Codec
  Object
  RunConfiguration
  (Map FilePath FilePath -> Maybe FilePath -> RunConfiguration)
-> Codec Object RunConfiguration (Map FilePath FilePath)
-> Codec
     Object RunConfiguration (Maybe FilePath -> RunConfiguration)
forall a b.
Codec Object RunConfiguration (a -> b)
-> Codec Object RunConfiguration a
-> Codec Object RunConfiguration b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> Map FilePath FilePath
-> Text
-> ObjectCodec (Map FilePath FilePath) (Map FilePath FilePath)
forall output.
(Eq output, HasCodec output) =>
Text -> output -> Text -> ObjectCodec output output
optionalFieldWithOmittedDefault Text
"env" Map FilePath FilePath
forall k a. Map k a
M.empty Text
"extra environment variables to set"
      ObjectCodec (Map FilePath FilePath) (Map FilePath FilePath)
-> (RunConfiguration -> Map FilePath FilePath)
-> Codec Object RunConfiguration (Map FilePath FilePath)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= RunConfiguration -> Map FilePath FilePath
runConfigExtraEnv
    Codec Object RunConfiguration (Maybe FilePath -> RunConfiguration)
-> Codec Object RunConfiguration (Maybe FilePath)
-> Codec Object RunConfiguration RunConfiguration
forall a b.
Codec Object RunConfiguration (a -> b)
-> Codec Object RunConfiguration a
-> Codec Object RunConfiguration b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Text -> ObjectCodec (Maybe FilePath) (Maybe FilePath)
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec (Maybe output) (Maybe output)
optionalField Text
"working-dir" Text
"where the process will be run"
      ObjectCodec (Maybe FilePath) (Maybe FilePath)
-> (RunConfiguration -> Maybe FilePath)
-> Codec Object RunConfiguration (Maybe FilePath)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= RunConfiguration -> Maybe FilePath
runConfigWorkingDir

makeRunConfiguration :: Command -> RunConfiguration
makeRunConfiguration :: Command -> RunConfiguration
makeRunConfiguration Command
c =
  RunConfiguration
    { runConfigCommand :: Command
runConfigCommand = Command
c,
      runConfigExtraEnv :: Map FilePath FilePath
runConfigExtraEnv = Map FilePath FilePath
forall k a. Map k a
M.empty,
      runConfigWorkingDir :: Maybe FilePath
runConfigWorkingDir = Maybe FilePath
forall a. Maybe a
Nothing
    }

data FilterConfiguration = FilterConfiguration
  { FilterConfiguration -> Maybe Bool
filterConfigGitignore :: !(Maybe Bool),
    FilterConfiguration -> Maybe FilePath
filterConfigFind :: !(Maybe String)
  }
  deriving stock (Int -> FilterConfiguration -> ShowS
[FilterConfiguration] -> ShowS
FilterConfiguration -> FilePath
(Int -> FilterConfiguration -> ShowS)
-> (FilterConfiguration -> FilePath)
-> ([FilterConfiguration] -> ShowS)
-> Show FilterConfiguration
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FilterConfiguration -> ShowS
showsPrec :: Int -> FilterConfiguration -> ShowS
$cshow :: FilterConfiguration -> FilePath
show :: FilterConfiguration -> FilePath
$cshowList :: [FilterConfiguration] -> ShowS
showList :: [FilterConfiguration] -> ShowS
Show, FilterConfiguration -> FilterConfiguration -> Bool
(FilterConfiguration -> FilterConfiguration -> Bool)
-> (FilterConfiguration -> FilterConfiguration -> Bool)
-> Eq FilterConfiguration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FilterConfiguration -> FilterConfiguration -> Bool
== :: FilterConfiguration -> FilterConfiguration -> Bool
$c/= :: FilterConfiguration -> FilterConfiguration -> Bool
/= :: FilterConfiguration -> FilterConfiguration -> Bool
Eq, (forall x. FilterConfiguration -> Rep FilterConfiguration x)
-> (forall x. Rep FilterConfiguration x -> FilterConfiguration)
-> Generic FilterConfiguration
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
$cfrom :: forall x. FilterConfiguration -> Rep FilterConfiguration x
from :: forall x. FilterConfiguration -> Rep FilterConfiguration x
$cto :: forall x. Rep FilterConfiguration x -> FilterConfiguration
to :: forall x. Rep FilterConfiguration x -> FilterConfiguration
Generic)
  deriving (Maybe FilterConfiguration
Value -> Parser [FilterConfiguration]
Value -> Parser FilterConfiguration
(Value -> Parser FilterConfiguration)
-> (Value -> Parser [FilterConfiguration])
-> Maybe FilterConfiguration
-> FromJSON FilterConfiguration
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser FilterConfiguration
parseJSON :: Value -> Parser FilterConfiguration
$cparseJSONList :: Value -> Parser [FilterConfiguration]
parseJSONList :: Value -> Parser [FilterConfiguration]
$comittedField :: Maybe FilterConfiguration
omittedField :: Maybe FilterConfiguration
FromJSON, [FilterConfiguration] -> Value
[FilterConfiguration] -> Encoding
FilterConfiguration -> Bool
FilterConfiguration -> Value
FilterConfiguration -> Encoding
(FilterConfiguration -> Value)
-> (FilterConfiguration -> Encoding)
-> ([FilterConfiguration] -> Value)
-> ([FilterConfiguration] -> Encoding)
-> (FilterConfiguration -> Bool)
-> ToJSON FilterConfiguration
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: FilterConfiguration -> Value
toJSON :: FilterConfiguration -> Value
$ctoEncoding :: FilterConfiguration -> Encoding
toEncoding :: FilterConfiguration -> Encoding
$ctoJSONList :: [FilterConfiguration] -> Value
toJSONList :: [FilterConfiguration] -> Value
$ctoEncodingList :: [FilterConfiguration] -> Encoding
toEncodingList :: [FilterConfiguration] -> Encoding
$comitField :: FilterConfiguration -> Bool
omitField :: FilterConfiguration -> Bool
ToJSON) via (Autodocodec FilterConfiguration)

instance HasCodec FilterConfiguration where
  codec :: JSONCodec FilterConfiguration
codec =
    Text
-> JSONCodec FilterConfiguration -> JSONCodec FilterConfiguration
forall input output.
Text -> ValueCodec input output -> ValueCodec input output
named
      Text
"FilterConfiguration"
      ( Text
-> Codec Object FilterConfiguration FilterConfiguration
-> JSONCodec FilterConfiguration
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"FilterConfiguration" Codec Object FilterConfiguration FilterConfiguration
filterConfigurationObjectCodec
      )
      JSONCodec FilterConfiguration
-> [Text] -> JSONCodec FilterConfiguration
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 :: Codec Object FilterConfiguration FilterConfiguration
filterConfigurationObjectCodec =
  Maybe Bool -> Maybe FilePath -> FilterConfiguration
FilterConfiguration
    (Maybe Bool -> Maybe FilePath -> FilterConfiguration)
-> Codec Object FilterConfiguration (Maybe Bool)
-> Codec
     Object FilterConfiguration (Maybe FilePath -> FilterConfiguration)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> ObjectCodec (Maybe Bool) (Maybe Bool)
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."
      ObjectCodec (Maybe Bool) (Maybe Bool)
-> (FilterConfiguration -> Maybe Bool)
-> Codec Object FilterConfiguration (Maybe Bool)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= FilterConfiguration -> Maybe Bool
filterConfigGitignore
    Codec
  Object FilterConfiguration (Maybe FilePath -> FilterConfiguration)
-> Codec Object FilterConfiguration (Maybe FilePath)
-> Codec Object FilterConfiguration FilterConfiguration
forall a b.
Codec Object FilterConfiguration (a -> b)
-> Codec Object FilterConfiguration a
-> Codec Object FilterConfiguration b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Text -> ObjectCodec (Maybe FilePath) (Maybe FilePath)
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"
      ObjectCodec (Maybe FilePath) (Maybe FilePath)
-> (FilterConfiguration -> Maybe FilePath)
-> Codec Object FilterConfiguration (Maybe FilePath)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= FilterConfiguration -> Maybe FilePath
filterConfigFind

emptyFilterConfiguration :: FilterConfiguration
emptyFilterConfiguration :: FilterConfiguration
emptyFilterConfiguration =
  FilterConfiguration
    { filterConfigGitignore :: Maybe Bool
filterConfigGitignore = Maybe Bool
forall a. Maybe a
Nothing,
      filterConfigFind :: Maybe FilePath
filterConfigFind = Maybe FilePath
forall a. Maybe a
Nothing
    }

data OutputConfiguration = OutputConfiguration
  { OutputConfiguration -> Maybe Clear
outputConfigClear :: !(Maybe Clear)
  }
  deriving stock (Int -> OutputConfiguration -> ShowS
[OutputConfiguration] -> ShowS
OutputConfiguration -> FilePath
(Int -> OutputConfiguration -> ShowS)
-> (OutputConfiguration -> FilePath)
-> ([OutputConfiguration] -> ShowS)
-> Show OutputConfiguration
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OutputConfiguration -> ShowS
showsPrec :: Int -> OutputConfiguration -> ShowS
$cshow :: OutputConfiguration -> FilePath
show :: OutputConfiguration -> FilePath
$cshowList :: [OutputConfiguration] -> ShowS
showList :: [OutputConfiguration] -> ShowS
Show, OutputConfiguration -> OutputConfiguration -> Bool
(OutputConfiguration -> OutputConfiguration -> Bool)
-> (OutputConfiguration -> OutputConfiguration -> Bool)
-> Eq OutputConfiguration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OutputConfiguration -> OutputConfiguration -> Bool
== :: OutputConfiguration -> OutputConfiguration -> Bool
$c/= :: OutputConfiguration -> OutputConfiguration -> Bool
/= :: OutputConfiguration -> OutputConfiguration -> Bool
Eq, (forall x. OutputConfiguration -> Rep OutputConfiguration x)
-> (forall x. Rep OutputConfiguration x -> OutputConfiguration)
-> Generic OutputConfiguration
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
$cfrom :: forall x. OutputConfiguration -> Rep OutputConfiguration x
from :: forall x. OutputConfiguration -> Rep OutputConfiguration x
$cto :: forall x. Rep OutputConfiguration x -> OutputConfiguration
to :: forall x. Rep OutputConfiguration x -> OutputConfiguration
Generic)
  deriving (Maybe OutputConfiguration
Value -> Parser [OutputConfiguration]
Value -> Parser OutputConfiguration
(Value -> Parser OutputConfiguration)
-> (Value -> Parser [OutputConfiguration])
-> Maybe OutputConfiguration
-> FromJSON OutputConfiguration
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser OutputConfiguration
parseJSON :: Value -> Parser OutputConfiguration
$cparseJSONList :: Value -> Parser [OutputConfiguration]
parseJSONList :: Value -> Parser [OutputConfiguration]
$comittedField :: Maybe OutputConfiguration
omittedField :: Maybe OutputConfiguration
FromJSON, [OutputConfiguration] -> Value
[OutputConfiguration] -> Encoding
OutputConfiguration -> Bool
OutputConfiguration -> Value
OutputConfiguration -> Encoding
(OutputConfiguration -> Value)
-> (OutputConfiguration -> Encoding)
-> ([OutputConfiguration] -> Value)
-> ([OutputConfiguration] -> Encoding)
-> (OutputConfiguration -> Bool)
-> ToJSON OutputConfiguration
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: OutputConfiguration -> Value
toJSON :: OutputConfiguration -> Value
$ctoEncoding :: OutputConfiguration -> Encoding
toEncoding :: OutputConfiguration -> Encoding
$ctoJSONList :: [OutputConfiguration] -> Value
toJSONList :: [OutputConfiguration] -> Value
$ctoEncodingList :: [OutputConfiguration] -> Encoding
toEncodingList :: [OutputConfiguration] -> Encoding
$comitField :: OutputConfiguration -> Bool
omitField :: OutputConfiguration -> Bool
ToJSON) via (Autodocodec OutputConfiguration)

instance HasCodec OutputConfiguration where
  codec :: JSONCodec OutputConfiguration
codec =
    Text
-> JSONCodec OutputConfiguration -> JSONCodec OutputConfiguration
forall input output.
Text -> ValueCodec input output -> ValueCodec input output
named Text
"OutputConfiguration" (JSONCodec OutputConfiguration -> JSONCodec OutputConfiguration)
-> JSONCodec OutputConfiguration -> JSONCodec OutputConfiguration
forall a b. (a -> b) -> a -> b
$
      Text
-> Codec Object OutputConfiguration OutputConfiguration
-> JSONCodec OutputConfiguration
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"OutputConfiguration" Codec Object OutputConfiguration OutputConfiguration
outputConfigurationObjectCodec

outputConfigurationObjectCodec :: JSONObjectCodec OutputConfiguration
outputConfigurationObjectCodec :: Codec Object OutputConfiguration OutputConfiguration
outputConfigurationObjectCodec =
  Maybe Clear -> OutputConfiguration
OutputConfiguration
    (Maybe Clear -> OutputConfiguration)
-> Codec Object OutputConfiguration (Maybe Clear)
-> Codec Object OutputConfiguration OutputConfiguration
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> ObjectCodec (Maybe Clear) (Maybe Clear)
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec (Maybe output) (Maybe output)
optionalField Text
"clear" Text
"whether to clear the screen runs"
      ObjectCodec (Maybe Clear) (Maybe Clear)
-> (OutputConfiguration -> Maybe Clear)
-> Codec Object OutputConfiguration (Maybe Clear)
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 Maybe Clear -> Maybe Clear -> Maybe Clear
forall a. Maybe a -> Maybe a -> Maybe a
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 = Maybe Clear
forall a. Maybe a
Nothing
    }

data HooksConfiguration = HooksConfiguration
  { HooksConfiguration -> Maybe RunConfiguration
hooksConfigurationBeforeAll :: !(Maybe RunConfiguration),
    HooksConfiguration -> Maybe RunConfiguration
hooksConfigurationAfterFirst :: !(Maybe RunConfiguration)
  }
  deriving (Int -> HooksConfiguration -> ShowS
[HooksConfiguration] -> ShowS
HooksConfiguration -> FilePath
(Int -> HooksConfiguration -> ShowS)
-> (HooksConfiguration -> FilePath)
-> ([HooksConfiguration] -> ShowS)
-> Show HooksConfiguration
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HooksConfiguration -> ShowS
showsPrec :: Int -> HooksConfiguration -> ShowS
$cshow :: HooksConfiguration -> FilePath
show :: HooksConfiguration -> FilePath
$cshowList :: [HooksConfiguration] -> ShowS
showList :: [HooksConfiguration] -> ShowS
Show, HooksConfiguration -> HooksConfiguration -> Bool
(HooksConfiguration -> HooksConfiguration -> Bool)
-> (HooksConfiguration -> HooksConfiguration -> Bool)
-> Eq HooksConfiguration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HooksConfiguration -> HooksConfiguration -> Bool
== :: HooksConfiguration -> HooksConfiguration -> Bool
$c/= :: HooksConfiguration -> HooksConfiguration -> Bool
/= :: HooksConfiguration -> HooksConfiguration -> Bool
Eq, (forall x. HooksConfiguration -> Rep HooksConfiguration x)
-> (forall x. Rep HooksConfiguration x -> HooksConfiguration)
-> Generic HooksConfiguration
forall x. Rep HooksConfiguration x -> HooksConfiguration
forall x. HooksConfiguration -> Rep HooksConfiguration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. HooksConfiguration -> Rep HooksConfiguration x
from :: forall x. HooksConfiguration -> Rep HooksConfiguration x
$cto :: forall x. Rep HooksConfiguration x -> HooksConfiguration
to :: forall x. Rep HooksConfiguration x -> HooksConfiguration
Generic)

instance HasCodec HooksConfiguration where
  codec :: JSONCodec HooksConfiguration
codec =
    Text
-> JSONCodec HooksConfiguration -> JSONCodec HooksConfiguration
forall input output.
Text -> ValueCodec input output -> ValueCodec input output
named Text
"HooksConfiguration" (JSONCodec HooksConfiguration -> JSONCodec HooksConfiguration)
-> JSONCodec HooksConfiguration -> JSONCodec HooksConfiguration
forall a b. (a -> b) -> a -> b
$
      Text
-> Codec Object HooksConfiguration HooksConfiguration
-> JSONCodec HooksConfiguration
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
object Text
"HooksConfiguration" Codec Object HooksConfiguration HooksConfiguration
hooksConfigurationObjectCodec

hooksConfigurationObjectCodec :: JSONObjectCodec HooksConfiguration
hooksConfigurationObjectCodec :: Codec Object HooksConfiguration HooksConfiguration
hooksConfigurationObjectCodec =
  Maybe RunConfiguration
-> Maybe RunConfiguration -> HooksConfiguration
HooksConfiguration
    (Maybe RunConfiguration
 -> Maybe RunConfiguration -> HooksConfiguration)
-> Codec Object HooksConfiguration (Maybe RunConfiguration)
-> Codec
     Object
     HooksConfiguration
     (Maybe RunConfiguration -> HooksConfiguration)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> Text
-> ObjectCodec (Maybe RunConfiguration) (Maybe RunConfiguration)
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec (Maybe output) (Maybe output)
optionalField Text
"before-all" Text
"The hook to run before the first run"
      ObjectCodec (Maybe RunConfiguration) (Maybe RunConfiguration)
-> (HooksConfiguration -> Maybe RunConfiguration)
-> Codec Object HooksConfiguration (Maybe RunConfiguration)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= HooksConfiguration -> Maybe RunConfiguration
hooksConfigurationBeforeAll
    Codec
  Object
  HooksConfiguration
  (Maybe RunConfiguration -> HooksConfiguration)
-> Codec Object HooksConfiguration (Maybe RunConfiguration)
-> Codec Object HooksConfiguration HooksConfiguration
forall a b.
Codec Object HooksConfiguration (a -> b)
-> Codec Object HooksConfiguration a
-> Codec Object HooksConfiguration b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> Text
-> ObjectCodec (Maybe RunConfiguration) (Maybe RunConfiguration)
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec (Maybe output) (Maybe output)
optionalField Text
"after-first" Text
"The hook to run after the first run"
      ObjectCodec (Maybe RunConfiguration) (Maybe RunConfiguration)
-> (HooksConfiguration -> Maybe RunConfiguration)
-> Codec Object HooksConfiguration (Maybe RunConfiguration)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
.= HooksConfiguration -> Maybe RunConfiguration
hooksConfigurationAfterFirst

emptyHooksConfiguration :: HooksConfiguration
emptyHooksConfiguration :: HooksConfiguration
emptyHooksConfiguration =
  HooksConfiguration
    { hooksConfigurationBeforeAll :: Maybe RunConfiguration
hooksConfigurationBeforeAll = Maybe RunConfiguration
forall a. Maybe a
Nothing,
      hooksConfigurationAfterFirst :: Maybe RunConfiguration
hooksConfigurationAfterFirst = Maybe RunConfiguration
forall a. Maybe a
Nothing
    }

getConfiguration :: Flags -> Environment -> IO (Maybe Configuration)
getConfiguration :: Flags -> Environment -> IO (Maybe Configuration)
getConfiguration Flags {FilePath
Maybe FilePath
OutputFlags
flagCommand :: Flags -> FilePath
flagConfigFile :: Flags -> Maybe FilePath
flagOutputFlags :: Flags -> OutputFlags
flagCommand :: FilePath
flagConfigFile :: Maybe FilePath
flagOutputFlags :: OutputFlags
..} Environment {Maybe FilePath
envConfigFile :: Maybe FilePath
envConfigFile :: Environment -> Maybe FilePath
..} = do
  Path Abs File
fp <- case Maybe FilePath
flagConfigFile Maybe FilePath -> Maybe FilePath -> Maybe FilePath
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe FilePath
envConfigFile of
    Maybe FilePath
Nothing -> IO (Path Abs File)
defaultConfigFile
    Just FilePath
cf -> FilePath -> IO (Path Abs File)
forall (m :: * -> *). MonadIO m => FilePath -> m (Path Abs File)
resolveFile' FilePath
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 = Path Abs File -> IO (Maybe Configuration)
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 <- IO (Path Abs Dir)
forall (m :: * -> *). MonadIO m => m (Path Abs Dir)
getCurrentDir
  Path Abs Dir -> FilePath -> IO (Path Abs File)
forall (m :: * -> *).
MonadIO m =>
Path Abs Dir -> FilePath -> m (Path Abs File)
resolveFile Path Abs Dir
here FilePath
"feedback.yaml"

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

getEnvironment :: IO Environment
getEnvironment :: IO Environment
getEnvironment = (Info Error -> Info Error)
-> Parser Error Environment -> IO Environment
forall e a.
AsUnset e =>
(Info Error -> Info e) -> Parser e a -> IO a
Env.parse (FilePath -> Info Error -> Info Error
forall e. FilePath -> Info e -> Info e
Env.header FilePath
"Environment") Parser Error Environment
environmentParser

environmentParser :: Env.Parser Env.Error Environment
environmentParser :: Parser Error Environment
environmentParser =
  FilePath -> Parser Error Environment -> Parser Error Environment
forall e a. FilePath -> Parser e a -> Parser e a
Env.prefixed FilePath
"FEEDBACK_" (Parser Error Environment -> Parser Error Environment)
-> Parser Error Environment -> Parser Error Environment
forall a b. (a -> b) -> a -> b
$
    Maybe FilePath -> Environment
Environment
      (Maybe FilePath -> Environment)
-> Parser Error (Maybe FilePath) -> Parser Error Environment
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Reader Error (Maybe FilePath)
-> FilePath
-> Mod Var (Maybe FilePath)
-> Parser Error (Maybe FilePath)
forall e a.
AsUnset e =>
Reader e a -> FilePath -> Mod Var a -> Parser e a
Env.var ((FilePath -> Maybe FilePath)
-> Either Error FilePath -> Either Error (Maybe FilePath)
forall a b. (a -> b) -> Either Error a -> Either Error b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (Either Error FilePath -> Either Error (Maybe FilePath))
-> (FilePath -> Either Error FilePath)
-> Reader Error (Maybe FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Either Error FilePath
forall s e. IsString s => Reader e s
Env.str) FilePath
"CONFIG_FILE" (Maybe FilePath -> Mod Var (Maybe FilePath)
forall a. a -> Mod Var a
Env.def Maybe FilePath
forall a. Maybe a
Nothing Mod Var (Maybe FilePath)
-> Mod Var (Maybe FilePath) -> Mod Var (Maybe FilePath)
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod Var (Maybe FilePath)
forall (t :: * -> *) a. HasHelp t => FilePath -> Mod t a
Env.help FilePath
"Config file")

getFlags :: IO Flags
getFlags :: IO Flags
getFlags = ParserPrefs -> ParserInfo Flags -> IO Flags
forall a. ParserPrefs -> ParserInfo a -> IO a
customExecParser ParserPrefs
prefs_ ParserInfo Flags
flagsParser

prefs_ :: OptParse.ParserPrefs
prefs_ :: ParserPrefs
prefs_ =
  ParserPrefs
OptParse.defaultPrefs
    { OptParse.prefShowHelpOnError = True,
      OptParse.prefShowHelpOnEmpty = True
    }

flagsParser :: OptParse.ParserInfo Flags
flagsParser :: ParserInfo Flags
flagsParser =
  Parser Flags -> InfoMod Flags -> ParserInfo Flags
forall a. Parser a -> InfoMod a -> ParserInfo a
OptParse.info
    (Parser (Flags -> Flags)
forall a. Parser (a -> a)
OptParse.helper Parser (Flags -> Flags) -> Parser Flags -> Parser Flags
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Flags
parseFlags)
    ( [InfoMod Flags] -> InfoMod Flags
forall a. Monoid a => [a] -> a
mconcat
        [ FilePath -> InfoMod Flags
forall a. FilePath -> InfoMod a
OptParse.progDesc FilePath
versionStr,
          Item [InfoMod Flags]
InfoMod Flags
forall a. InfoMod a
OptParse.fullDesc,
          Maybe Doc -> InfoMod Flags
forall a. Maybe Doc -> InfoMod a
OptParse.footerDoc (Doc -> Maybe Doc
forall a. a -> Maybe a
Just (Doc -> Maybe Doc) -> Doc -> Maybe Doc
forall a b. (a -> b) -> a -> b
$ FilePath -> Doc
forall ann. FilePath -> Doc ann
forall a ann. Pretty a => a -> Doc ann
OptParse.pretty FilePath
footerStr)
        ]
    )
  where
    versionStr :: FilePath
versionStr =
      FilePath
"Version: " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> Version -> FilePath
showVersion Version
version
    footerStr :: FilePath
footerStr =
      [FilePath] -> FilePath
unlines
        [ Parser Error Environment -> FilePath
forall e a. Parser e a -> FilePath
Env.helpDoc Parser Error Environment
environmentParser,
          FilePath
Item [FilePath]
"",
          FilePath
Item [FilePath]
"Configuration file format:",
          Text -> FilePath
T.unpack (forall a. HasCodec a => Text
renderColouredSchemaViaCodec @Configuration)
        ]

data Flags = Flags
  { Flags -> FilePath
flagCommand :: !String,
    Flags -> Maybe FilePath
flagConfigFile :: !(Maybe FilePath),
    Flags -> OutputFlags
flagOutputFlags :: !OutputFlags
  }
  deriving (Int -> Flags -> ShowS
[Flags] -> ShowS
Flags -> FilePath
(Int -> Flags -> ShowS)
-> (Flags -> FilePath) -> ([Flags] -> ShowS) -> Show Flags
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Flags -> ShowS
showsPrec :: Int -> Flags -> ShowS
$cshow :: Flags -> FilePath
show :: Flags -> FilePath
$cshowList :: [Flags] -> ShowS
showList :: [Flags] -> ShowS
Show, Flags -> Flags -> Bool
(Flags -> Flags -> Bool) -> (Flags -> Flags -> Bool) -> Eq Flags
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Flags -> Flags -> Bool
== :: Flags -> Flags -> Bool
$c/= :: Flags -> Flags -> Bool
/= :: Flags -> Flags -> Bool
Eq, (forall x. Flags -> Rep Flags x)
-> (forall x. Rep Flags x -> Flags) -> Generic Flags
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
$cfrom :: forall x. Flags -> Rep Flags x
from :: forall x. Flags -> Rep Flags x
$cto :: forall x. Rep Flags x -> Flags
to :: forall x. Rep Flags x -> Flags
Generic)

data OutputFlags = OutputFlags
  { OutputFlags -> Maybe Clear
outputFlagClear :: !(Maybe Clear),
    OutputFlags -> Bool
outputFlagDebug :: Bool
  }
  deriving (Int -> OutputFlags -> ShowS
[OutputFlags] -> ShowS
OutputFlags -> FilePath
(Int -> OutputFlags -> ShowS)
-> (OutputFlags -> FilePath)
-> ([OutputFlags] -> ShowS)
-> Show OutputFlags
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OutputFlags -> ShowS
showsPrec :: Int -> OutputFlags -> ShowS
$cshow :: OutputFlags -> FilePath
show :: OutputFlags -> FilePath
$cshowList :: [OutputFlags] -> ShowS
showList :: [OutputFlags] -> ShowS
Show, OutputFlags -> OutputFlags -> Bool
(OutputFlags -> OutputFlags -> Bool)
-> (OutputFlags -> OutputFlags -> Bool) -> Eq OutputFlags
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OutputFlags -> OutputFlags -> Bool
== :: OutputFlags -> OutputFlags -> Bool
$c/= :: OutputFlags -> OutputFlags -> Bool
/= :: OutputFlags -> OutputFlags -> Bool
Eq, (forall x. OutputFlags -> Rep OutputFlags x)
-> (forall x. Rep OutputFlags x -> OutputFlags)
-> Generic OutputFlags
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
$cfrom :: forall x. OutputFlags -> Rep OutputFlags x
from :: forall x. OutputFlags -> Rep OutputFlags x
$cto :: forall x. Rep OutputFlags x -> OutputFlags
to :: forall x. Rep OutputFlags x -> OutputFlags
Generic)

parseFlags :: OptParse.Parser Flags
parseFlags :: Parser Flags
parseFlags =
  FilePath -> Maybe FilePath -> OutputFlags -> Flags
Flags
    (FilePath -> Maybe FilePath -> OutputFlags -> Flags)
-> Parser FilePath
-> Parser (Maybe FilePath -> OutputFlags -> Flags)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser FilePath
parseCommandFlags
    Parser (Maybe FilePath -> OutputFlags -> Flags)
-> Parser (Maybe FilePath) -> Parser (OutputFlags -> Flags)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser FilePath -> Parser (Maybe FilePath)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
      ( Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
          ( [Mod OptionFields FilePath] -> Mod OptionFields FilePath
forall a. Monoid a => [a] -> a
mconcat
              [ Char -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'c',
                FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"config-file",
                FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Path to an altenative config file",
                FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"FILEPATH"
              ]
          )
      )
    Parser (OutputFlags -> Flags) -> Parser OutputFlags -> Parser Flags
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser OutputFlags
parseOutputFlags

parseCommandFlags :: OptParse.Parser String
parseCommandFlags :: Parser FilePath
parseCommandFlags =
  let commandArg :: Parser FilePath
commandArg =
        Mod ArgumentFields FilePath -> Parser FilePath
forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument
          ( [Mod ArgumentFields FilePath] -> Mod ArgumentFields FilePath
forall a. Monoid a => [a] -> a
mconcat
              [ FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"The command to run",
                FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"COMMAND",
                Completer -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer (IO [FilePath] -> Completer
listIOCompleter IO [FilePath]
defaultConfigFileCompleter)
              ]
          )
   in [FilePath] -> FilePath
unwords ([FilePath] -> FilePath) -> Parser [FilePath] -> Parser FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser FilePath -> Parser [FilePath]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser FilePath
commandArg

defaultConfigFileCompleter :: IO [String]
defaultConfigFileCompleter :: IO [FilePath]
defaultConfigFileCompleter = do
  Maybe Configuration
mConfig <- IO (Path Abs File)
defaultConfigFile IO (Path Abs File)
-> (Path Abs File -> IO (Maybe Configuration))
-> IO (Maybe Configuration)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Path Abs File -> IO (Maybe Configuration)
getConfigurationFromFile
  [FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ Map FilePath LoopConfiguration -> [FilePath]
forall k a. Map k a -> [k]
M.keys (Map FilePath LoopConfiguration
-> (Configuration -> Map FilePath LoopConfiguration)
-> Maybe Configuration
-> Map FilePath LoopConfiguration
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Configuration -> Map FilePath LoopConfiguration
configLoops Maybe Configuration
mConfig)

parseOutputFlags :: OptParse.Parser OutputFlags
parseOutputFlags :: Parser OutputFlags
parseOutputFlags =
  Maybe Clear -> Bool -> OutputFlags
OutputFlags
    (Maybe Clear -> Bool -> OutputFlags)
-> Parser (Maybe Clear) -> Parser (Bool -> OutputFlags)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Maybe Clear)
parseClearFlag
    Parser (Bool -> OutputFlags) -> Parser Bool -> Parser OutputFlags
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch
      ( [Mod FlagFields Bool] -> Mod FlagFields Bool
forall a. Monoid a => [a] -> a
mconcat
          [ Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'd',
            FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"debug",
            FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"show debug information"
          ]
      )

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

instance HasCodec Command where
  codec :: JSONCodec Command
codec = (FilePath -> Command)
-> (Command -> FilePath)
-> Codec Value FilePath FilePath
-> JSONCodec Command
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec FilePath -> Command
CommandScript Command -> FilePath
unScript Codec Value FilePath FilePath
forall value. HasCodec value => JSONCodec value
codec

commandObjectCodec :: JSONObjectCodec Command
commandObjectCodec :: JSONObjectCodec Command
commandObjectCodec =
  JSONObjectCodec Command
-> JSONObjectCodec Command -> JSONObjectCodec Command
forall context input output input'.
Codec context input output
-> Codec context input' output -> Codec context input output
parseAlternative
    (Text -> Text -> JSONObjectCodec Command
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec output output
requiredField Text
"script" Text
"the script to run on change")
    (Text -> Text -> JSONObjectCodec Command
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec output output
requiredField Text
"command" Text
"the command to run on change (alias for 'script' for backward compatibility)")

data Clear = ClearScreen | DoNotClearScreen
  deriving (Int -> Clear -> ShowS
[Clear] -> ShowS
Clear -> FilePath
(Int -> Clear -> ShowS)
-> (Clear -> FilePath) -> ([Clear] -> ShowS) -> Show Clear
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Clear -> ShowS
showsPrec :: Int -> Clear -> ShowS
$cshow :: Clear -> FilePath
show :: Clear -> FilePath
$cshowList :: [Clear] -> ShowS
showList :: [Clear] -> ShowS
Show, Clear -> Clear -> Bool
(Clear -> Clear -> Bool) -> (Clear -> Clear -> Bool) -> Eq Clear
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Clear -> Clear -> Bool
== :: Clear -> Clear -> Bool
$c/= :: Clear -> Clear -> Bool
/= :: Clear -> Clear -> Bool
Eq, (forall x. Clear -> Rep Clear x)
-> (forall x. Rep Clear x -> Clear) -> Generic Clear
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
$cfrom :: forall x. Clear -> Rep Clear x
from :: forall x. Clear -> Rep Clear x
$cto :: forall x. Rep Clear x -> Clear
to :: forall x. Rep Clear x -> Clear
Generic)

instance HasCodec Clear where
  codec :: JSONCodec Clear
codec = (Bool -> Clear)
-> (Clear -> Bool) -> Codec Value Bool Bool -> JSONCodec Clear
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 Codec Value Bool Bool
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 =
  Parser Clear -> Parser (Maybe Clear)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Clear -> Parser (Maybe Clear))
-> Parser Clear -> Parser (Maybe Clear)
forall a b. (a -> b) -> a -> b
$
    Clear -> Mod FlagFields Clear -> Parser Clear
forall a. a -> Mod FlagFields a -> Parser a
flag'
      Clear
ClearScreen
      ( [Mod FlagFields Clear] -> Mod FlagFields Clear
forall a. Monoid a => [a] -> a
mconcat
          [ FilePath -> Mod FlagFields Clear
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"clear",
            FilePath -> Mod FlagFields Clear
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"clear the screen between feedback"
          ]
      )
      Parser Clear -> Parser Clear -> Parser Clear
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Clear -> Mod FlagFields Clear -> Parser Clear
forall a. a -> Mod FlagFields a -> Parser a
flag'
        Clear
DoNotClearScreen
        ( [Mod FlagFields Clear] -> Mod FlagFields Clear
forall a. Monoid a => [a] -> a
mconcat
            [ FilePath -> Mod FlagFields Clear
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"no-clear",
              FilePath -> Mod FlagFields Clear
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"do not clear the screen between feedback"
            ]
        )