{-# 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
  ]