even further optparse refactor

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 ->
+        Left c -> makeLoopConfiguration c
-          LoopConfiguration
-            { loopConfigCommand = c,
-              loopConfigOutputConfiguration = Nothing
-            }
         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)
   }

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)
+      (processWorker loopSettingCommand eventChan outputChan)
-      (outputWorker settingOutputSettings outputChan)
+      (outputWorker loopSettingOutputSettings outputChan)
     stopListeningAction
 
 eventFilter :: Path Abs Dir -> FS.Event -> Bool

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
+getLoopSettings :: IO LoopSettings
-getSettings = do
+getLoopSettings = do
   flags <- getFlags
   env <- getEnvironment
   config <- getConfiguration flags env
   combineToSettings flags env config
 
-data Settings = Settings
+combineToSettings :: Flags -> Environment -> Maybe Configuration -> IO LoopSettings
-  { settingCommand :: !String,
+combineToSettings flags@Flags {..} environment mConf = do
-    settingOutputSettings :: !OutputSettings
-  }
-  deriving (Show, Eq, Generic)
-
--- | Combine everything to 'Settings'
-combineToSettings :: Flags -> Environment -> Maybe Configuration -> IO Settings
-combineToSettings Flags {..} Environment {} mConf = do
   let loops = maybe M.empty configLoops mConf
-  let defaultOutputConfig = mConf >>= configOutputConfiguration
+  loopConfig <- case M.lookup flagCommand loops of
-  (settingCommand, outputConfig) <- 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)
+      pure $ makeLoopConfiguration flagCommand
-    Just LoopConfiguration {..} -> do
+    Just config -> do
       putStrLn $
         unwords
           [ "Interpreting",
             show flagCommand,
             "as the name of a configured loop."
           ]
-      pure (loopConfigCommand, liftA2 (<>) loopConfigOutputConfiguration defaultOutputConfig)
+      pure config
-  let settingOutputSettings = combineToOutputSettings flagOutputFlags outputConfig
+  loopSets <-
-  let settings = Settings {..}
+    combineToLoopSettings
-  when flagDebug $ pPrint settings
+      flags
-  pure settings
+      environment
+      (mConf >>= configOutputConfiguration)
+      loopConfig
+  when flagDebug $ pPrint loopSets
+  pure loopSets