diff --git a/feedback/src/Feedback/Common/OptParse.hs b/feedback/src/Feedback/Common/OptParse.hs index 21ad424..3e0060a 100644 --- a/feedback/src/Feedback/Common/OptParse.hs +++ b/feedback/src/Feedback/Common/OptParse.hs @@ -24,6 +24,19 @@ import qualified Options.Applicative.Help as OptParse (string) import Path import Path.IO +data LoopSettings = LoopSettings + { loopSettingCommand :: !String, + loopSettingOutputSettings :: !OutputSettings + } + deriving (Show, Eq, Generic) + +combineToLoopSettings :: Flags -> Environment -> Maybe OutputConfiguration -> LoopConfiguration -> IO LoopSettings +combineToLoopSettings Flags {..} Environment {..} mDefaultOutputConfig LoopConfiguration {..} = do + let loopSettingCommand = loopConfigCommand + let outputConfig = liftA2 (<>) loopConfigOutputConfiguration mDefaultOutputConfig + let loopSettingOutputSettings = combineToOutputSettings flagOutputFlags outputConfig + pure LoopSettings {..} + data OutputSettings = OutputSettings { outputSettingClear :: !Clear } @@ -65,16 +78,19 @@ instance HasCodec LoopConfiguration where <*> optionalField "output" "output configuration for this loop" .= loopConfigOutputConfiguration where f = \case - Left c -> - LoopConfiguration - { loopConfigCommand = c, - loopConfigOutputConfiguration = Nothing - } + Left c -> makeLoopConfiguration c Right loopConfig -> loopConfig g loopConfig@(LoopConfiguration c mOutputConfig) = case mOutputConfig of Nothing -> Left c Just _ -> Right loopConfig +makeLoopConfiguration :: String -> LoopConfiguration +makeLoopConfiguration c = + LoopConfiguration + { loopConfigCommand = c, + loopConfigOutputConfiguration = Nothing + } + data OutputConfiguration = OutputConfiguration { outputConfigClear :: !(Maybe Clear) } diff --git a/feedback/src/Feedback/Loop.hs b/feedback/src/Feedback/Loop.hs index 9fc2c38..b7a15a4 100644 --- a/feedback/src/Feedback/Loop.hs +++ b/feedback/src/Feedback/Loop.hs @@ -21,7 +21,7 @@ import UnliftIO runFeedbackLoop :: IO () runFeedbackLoop = do - Settings {..} <- getSettings + LoopSettings {..} <- getLoopSettings eventChan <- newChan outputChan <- newChan here <- getCurrentDir @@ -36,8 +36,8 @@ runFeedbackLoop = do $ \event -> do writeChan eventChan event concurrently_ - (processWorker settingCommand eventChan outputChan) - (outputWorker settingOutputSettings outputChan) + (processWorker loopSettingCommand eventChan outputChan) + (outputWorker loopSettingOutputSettings outputChan) stopListeningAction eventFilter :: Path Abs Dir -> FS.Event -> Bool diff --git a/feedback/src/Feedback/Loop/OptParse.hs b/feedback/src/Feedback/Loop/OptParse.hs index c699e17..2df4c12 100644 --- a/feedback/src/Feedback/Loop/OptParse.hs +++ b/feedback/src/Feedback/Loop/OptParse.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingVia #-} {-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-} @@ -13,25 +12,17 @@ import Feedback.Common.OptParse import GHC.Generics (Generic) import Text.Show.Pretty (pPrint) -getSettings :: IO Settings -getSettings = do +getLoopSettings :: IO LoopSettings +getLoopSettings = do flags <- getFlags env <- getEnvironment config <- getConfiguration flags env combineToSettings flags env config -data Settings = Settings - { settingCommand :: !String, - settingOutputSettings :: !OutputSettings - } - deriving (Show, Eq, Generic) - --- | Combine everything to 'Settings' -combineToSettings :: Flags -> Environment -> Maybe Configuration -> IO Settings -combineToSettings Flags {..} Environment {} mConf = do +combineToSettings :: Flags -> Environment -> Maybe Configuration -> IO LoopSettings +combineToSettings flags@Flags {..} environment mConf = do let loops = maybe M.empty configLoops mConf - let defaultOutputConfig = mConf >>= configOutputConfiguration - (settingCommand, outputConfig) <- case M.lookup flagCommand loops of + loopConfig <- case M.lookup flagCommand loops of Nothing -> do when (not (null loops)) $ putStrLn $ @@ -40,16 +31,20 @@ combineToSettings Flags {..} Environment {} mConf = do show flagCommand <> ",", "interpreting it as a standalone command." ] - pure (flagCommand, defaultOutputConfig) - Just LoopConfiguration {..} -> do + pure $ makeLoopConfiguration flagCommand + Just config -> do putStrLn $ unwords [ "Interpreting", show flagCommand, "as the name of a configured loop." ] - pure (loopConfigCommand, liftA2 (<>) loopConfigOutputConfiguration defaultOutputConfig) - let settingOutputSettings = combineToOutputSettings flagOutputFlags outputConfig - let settings = Settings {..} - when flagDebug $ pPrint settings - pure settings + pure config + loopSets <- + combineToLoopSettings + flags + environment + (mConf >>= configOutputConfiguration) + loopConfig + when flagDebug $ pPrint loopSets + pure loopSets