{-# 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
flagCommand :: String
flagConfigFile :: Maybe String
flagOutputFlags :: OutputFlags
flagCommand :: Flags -> String
flagConfigFile :: Flags -> Maybe String
flagOutputFlags :: Flags -> OutputFlags
..} Environment
environment Maybe Configuration
mConf = do
  let loops :: Map String LoopConfiguration
loops = Map String LoopConfiguration
-> (Configuration -> Map String LoopConfiguration)
-> Maybe Configuration
-> Map String LoopConfiguration
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Map String LoopConfiguration
forall k a. Map k a
M.empty Configuration -> Map String LoopConfiguration
configLoops Maybe Configuration
mConf
  Maybe LoopConfiguration
mLoopConfig <- case String
flagCommand of
    String
"" -> Maybe LoopConfiguration -> IO (Maybe LoopConfiguration)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe LoopConfiguration
forall a. Maybe a
Nothing
    String
_ ->
      LoopConfiguration -> Maybe LoopConfiguration
forall a. a -> Maybe a
Just (LoopConfiguration -> Maybe LoopConfiguration)
-> IO LoopConfiguration -> IO (Maybe LoopConfiguration)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case String -> Map String LoopConfiguration -> Maybe LoopConfiguration
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
flagCommand Map String LoopConfiguration
loops of
        Maybe LoopConfiguration
Nothing -> do
          Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Map String LoopConfiguration -> Bool
forall a. Map String a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map String LoopConfiguration
loops)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
            String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
              [String] -> String
unwords
                [ String
"No loop found with name",
                  String -> String
forall a. Show a => a -> String
show String
flagCommand String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
",",
                  String
"interpreting it as a standalone command."
                ]
          LoopConfiguration -> IO LoopConfiguration
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LoopConfiguration -> IO LoopConfiguration)
-> LoopConfiguration -> IO LoopConfiguration
forall a b. (a -> b) -> a -> b
$ Command -> LoopConfiguration
makeLoopConfiguration (Command -> LoopConfiguration) -> Command -> LoopConfiguration
forall a b. (a -> b) -> a -> b
$ String -> Command
CommandScript String
flagCommand
        Just LoopConfiguration
config -> do
          String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
            [String] -> String
unwords
              [ String
"Interpreting",
                String -> String
forall a. Show a => a -> String
show String
flagCommand,
                String
"as the name of a configured loop."
              ]
          LoopConfiguration -> IO LoopConfiguration
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LoopConfiguration
config
  case Maybe LoopConfiguration
mLoopConfig of
    Maybe LoopConfiguration
Nothing -> do
      [Chunk] -> IO ()
put ([Chunk] -> IO ()) -> [Chunk] -> IO ()
forall a b. (a -> b) -> a -> b
$ ([Chunk] -> [Chunk]) -> [[Chunk]] -> [Chunk]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Chunk] -> [Chunk] -> [Chunk]
forall a. Semigroup a => a -> a -> a
<> [Chunk
"\n"]) ([[Chunk]] -> [Chunk]) -> [[Chunk]] -> [Chunk]
forall a b. (a -> b) -> a -> b
$ Maybe Configuration -> [[Chunk]]
prettyConfiguration Maybe Configuration
mConf
      IO LoopSettings
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 Maybe Configuration
-> (Configuration -> Maybe OutputConfiguration)
-> Maybe OutputConfiguration
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Configuration -> Maybe OutputConfiguration
configOutputConfiguration)
          LoopConfiguration
loopConfig
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (OutputFlags -> Bool
outputFlagDebug OutputFlags
flagOutputFlags) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ LoopSettings -> IO ()
forall a. Show a => a -> IO ()
pPrint LoopSettings
loopSets
      LoopSettings -> IO LoopSettings
forall a. a -> IO a
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
        ( ((String, LoopConfiguration) -> [Chunk])
-> [(String, LoopConfiguration)] -> [[Chunk]]
forall a b. (a -> b) -> [a] -> [b]
map
            ((String -> LoopConfiguration -> [Chunk])
-> (String, LoopConfiguration) -> [Chunk]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> LoopConfiguration -> [Chunk]
loopConfigLine)
            (Map String LoopConfiguration -> [(String, LoopConfiguration)]
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
HooksConfiguration
OutputConfiguration
FilterConfiguration
RunConfiguration
loopConfigDescription :: Maybe String
loopConfigRunConfiguration :: RunConfiguration
loopConfigFilterConfiguration :: FilterConfiguration
loopConfigOutputConfiguration :: OutputConfiguration
loopConfigHooksConfiguration :: HooksConfiguration
loopConfigDescription :: LoopConfiguration -> Maybe String
loopConfigRunConfiguration :: LoopConfiguration -> RunConfiguration
loopConfigFilterConfiguration :: LoopConfiguration -> FilterConfiguration
loopConfigOutputConfiguration :: LoopConfiguration -> OutputConfiguration
loopConfigHooksConfiguration :: LoopConfiguration -> HooksConfiguration
..} =
  [ String -> Chunk
loopNameChunk (String -> Chunk) -> String -> Chunk
forall a b. (a -> b) -> a -> b
$ String
loopName String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
":",
    Chunk -> (String -> Chunk) -> Maybe String -> Chunk
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Chunk
"no description" (Text -> Chunk
chunk (Text -> Chunk) -> (String -> Text) -> String -> Chunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack) Maybe String
loopConfigDescription
  ]