{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} module Feedback.Loop.OptParse where import Control.Monad import qualified Data.Map as M import qualified Data.Text as T import Feedback.Common.OptParse import Feedback.Common.Output import System.Exit import Text.Colour import Text.Colour.Layout #ifdef MIN_VERSION_safe_coloured_text_terminfo import Text.Colour.Term (putChunksLocale) #endif import Text.Show.Pretty (pPrint) combineToSettings :: Flags -> Environment -> Maybe Configuration -> IO LoopSettings combineToSettings :: Flags -> Environment -> Maybe Configuration -> IO LoopSettings combineToSettings flags :: Flags flags@Flags {String Maybe String OutputFlags flagOutputFlags :: Flags -> OutputFlags flagConfigFile :: Flags -> Maybe String flagCommand :: Flags -> String flagOutputFlags :: OutputFlags flagConfigFile :: Maybe String flagCommand :: String ..} Environment environment Maybe Configuration mConf = do let loops :: Map String LoopConfiguration loops = forall b a. b -> (a -> b) -> Maybe a -> b maybe forall k a. Map k a M.empty Configuration -> Map String LoopConfiguration configLoops Maybe Configuration mConf Maybe LoopConfiguration mLoopConfig <- case String flagCommand of String "" -> forall (f :: * -> *) a. Applicative f => a -> f a pure forall a. Maybe a Nothing String _ -> forall a. a -> Maybe a Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> case forall k a. Ord k => k -> Map k a -> Maybe a M.lookup String flagCommand Map String LoopConfiguration loops of Maybe LoopConfiguration Nothing -> do forall (f :: * -> *). Applicative f => Bool -> f () -> f () when (Bool -> Bool not (forall (t :: * -> *) a. Foldable t => t a -> Bool null Map String LoopConfiguration loops)) forall a b. (a -> b) -> a -> b $ String -> IO () putStrLn forall a b. (a -> b) -> a -> b $ [String] -> String unwords [ String "No loop found with name", forall a. Show a => a -> String show String flagCommand forall a. Semigroup a => a -> a -> a <> String ",", String "interpreting it as a standalone command." ] forall (f :: * -> *) a. Applicative f => a -> f a pure forall a b. (a -> b) -> a -> b $ Command -> LoopConfiguration makeLoopConfiguration forall a b. (a -> b) -> a -> b $ String -> Command CommandArgs String flagCommand Just LoopConfiguration config -> do String -> IO () putStrLn forall a b. (a -> b) -> a -> b $ [String] -> String unwords [ String "Interpreting", forall a. Show a => a -> String show String flagCommand, String "as the name of a configured loop." ] forall (f :: * -> *) a. Applicative f => a -> f a pure LoopConfiguration config case Maybe LoopConfiguration mLoopConfig of Maybe LoopConfiguration Nothing -> do [Chunk] -> IO () put forall a b. (a -> b) -> a -> b $ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b] concatMap (forall a. Semigroup a => a -> a -> a <> [Chunk "\n"]) forall a b. (a -> b) -> a -> b $ Maybe Configuration -> [[Chunk]] prettyConfiguration Maybe Configuration mConf forall a. IO a exitSuccess Just LoopConfiguration loopConfig -> do LoopSettings loopSets <- Flags -> Environment -> Maybe OutputConfiguration -> LoopConfiguration -> IO LoopSettings combineToLoopSettings Flags flags Environment environment (Maybe Configuration mConf forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= Configuration -> Maybe OutputConfiguration configOutputConfiguration) LoopConfiguration loopConfig forall (f :: * -> *). Applicative f => Bool -> f () -> f () when (OutputFlags -> Bool outputFlagDebug OutputFlags flagOutputFlags) forall a b. (a -> b) -> a -> b $ forall a. Show a => a -> IO () pPrint LoopSettings loopSets forall (f :: * -> *) a. Applicative f => a -> f a pure LoopSettings loopSets where #ifdef MIN_VERSION_safe_coloured_text_terminfo put :: [Chunk] -> IO () put = [Chunk] -> IO () putChunksLocale #else put = putChunksLocaleWith WithoutColours #endif prettyConfiguration :: Maybe Configuration -> [[Chunk]] prettyConfiguration :: Maybe Configuration -> [[Chunk]] prettyConfiguration Maybe Configuration mConf = case Maybe Configuration mConf of Maybe Configuration Nothing -> [[Colour -> Chunk -> Chunk fore Colour blue Chunk "No feedback loops have been configured here."]] Just Configuration conf -> [ [Colour -> Chunk -> Chunk fore Colour blue Chunk "The following feedback loops are available:"], [Chunk ""], [[Chunk]] -> [Chunk] layoutAsTable ( forall a b. (a -> b) -> [a] -> [b] map (forall a b c. (a -> b -> c) -> (a, b) -> c uncurry String -> LoopConfiguration -> [Chunk] loopConfigLine) (forall k a. Map k a -> [(k, a)] M.toList (Configuration -> Map String LoopConfiguration configLoops Configuration conf)) ), [Colour -> Chunk -> Chunk fore Colour blue Chunk "Run ", Colour -> Chunk -> Chunk fore Colour yellow Chunk "feedback loopname", Colour -> Chunk -> Chunk fore Colour blue Chunk " to activate a feedback loop."] ] loopConfigLine :: String -> LoopConfiguration -> [Chunk] loopConfigLine :: String -> LoopConfiguration -> [Chunk] loopConfigLine String loopName LoopConfiguration {Maybe String OutputConfiguration FilterConfiguration RunConfiguration loopConfigOutputConfiguration :: LoopConfiguration -> OutputConfiguration loopConfigFilterConfiguration :: LoopConfiguration -> FilterConfiguration loopConfigRunConfiguration :: LoopConfiguration -> RunConfiguration loopConfigDescription :: LoopConfiguration -> Maybe String loopConfigOutputConfiguration :: OutputConfiguration loopConfigFilterConfiguration :: FilterConfiguration loopConfigRunConfiguration :: RunConfiguration loopConfigDescription :: Maybe String ..} = [ String -> Chunk loopNameChunk forall a b. (a -> b) -> a -> b $ String loopName forall a. Semigroup a => a -> a -> a <> String ":", forall b a. b -> (a -> b) -> Maybe a -> b maybe Chunk "no description" (Text -> Chunk chunk forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> Text T.pack) Maybe String loopConfigDescription ]