{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -fno-warn-unused-pattern-binds #-}

module Feedback.Common.Output where

import qualified Data.Map as M
import Data.Maybe
import qualified Data.Text as T
import Data.Time
import Data.Word
import Feedback.Common.OptParse
import Path
import System.Exit
import Text.Colour
import Text.Printf

putTimedChunks :: TerminalCapabilities -> ZonedTime -> [Chunk] -> IO ()
putTimedChunks :: TerminalCapabilities -> ZonedTime -> [Chunk] -> IO ()
putTimedChunks TerminalCapabilities
terminalCapabilities ZonedTime
loopBegin [Chunk]
chunks = do
  ZonedTime
now <- IO ZonedTime
getZonedTime
  let timeChunk :: Chunk
timeChunk = Colour -> Chunk -> Chunk
fore Colour
yellow forall a b. (a -> b) -> a -> b
$ Text -> Chunk
chunk forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%H:%M:%S" ZonedTime
now

  let relativeTimeStr :: NominalDiffTime -> String
      relativeTimeStr :: NominalDiffTime -> String
relativeTimeStr NominalDiffTime
ndt =
        let d :: Double
d = forall a b. (Real a, Fractional b) => a -> b
realToFrac NominalDiffTime
ndt :: Double
         in forall r. PrintfType r => String -> r
printf String
"%6.2fs" Double
d
  let relativeTimeChunk :: Chunk
relativeTimeChunk = Colour -> Chunk -> Chunk
fore Colour
cyan forall a b. (a -> b) -> a -> b
$ Text -> Chunk
chunk forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ NominalDiffTime -> String
relativeTimeStr forall a b. (a -> b) -> a -> b
$ UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime (ZonedTime -> UTCTime
zonedTimeToUTC ZonedTime
now) (ZonedTime -> UTCTime
zonedTimeToUTC ZonedTime
loopBegin)
  TerminalCapabilities -> [Chunk] -> IO ()
putChunksLocaleWith TerminalCapabilities
terminalCapabilities forall a b. (a -> b) -> a -> b
$ Chunk
timeChunk forall a. a -> [a] -> [a]
: Chunk
" " forall a. a -> [a] -> [a]
: Chunk
relativeTimeChunk forall a. a -> [a] -> [a]
: Chunk
" " forall a. a -> [a] -> [a]
: [Chunk]
chunks forall a. [a] -> [a] -> [a]
++ [Chunk
"\n"]

putDone :: TerminalCapabilities -> ZonedTime -> IO ()
putDone :: TerminalCapabilities -> ZonedTime -> IO ()
putDone TerminalCapabilities
terminalCapabilities ZonedTime
loopBegin = TerminalCapabilities -> ZonedTime -> [Chunk] -> IO ()
putTimedChunks TerminalCapabilities
terminalCapabilities ZonedTime
loopBegin [String -> Chunk
indicatorChunk String
"done"]

indicatorChunk :: String -> Chunk
indicatorChunk :: String -> Chunk
indicatorChunk = Colour -> Chunk -> Chunk
fore Colour
cyan forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Chunk
chunk forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. PrintfType r => String -> r
printf String
"%-12s"

loopNameChunk :: String -> Chunk
loopNameChunk :: String -> Chunk
loopNameChunk = Colour -> Chunk -> Chunk
fore Colour
yellow forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Chunk
chunk forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

commandChunk :: String -> Chunk
commandChunk :: String -> Chunk
commandChunk = Colour -> Chunk -> Chunk
fore Colour
blue forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Chunk
chunk forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

startingLines :: RunSettings -> [[Chunk]]
startingLines :: RunSettings -> [[Chunk]]
startingLines RunSettings {Maybe (Path Abs Dir)
Map String String
Command
runSettingWorkingDir :: RunSettings -> Maybe (Path Abs Dir)
runSettingExtraEnv :: RunSettings -> Map String String
runSettingCommand :: RunSettings -> Command
runSettingWorkingDir :: Maybe (Path Abs Dir)
runSettingExtraEnv :: Map String String
runSettingCommand :: Command
..} =
  let RunSettings Command
_ Map String String
_ Maybe (Path Abs Dir)
_ = forall a. HasCallStack => a
undefined
   in forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ case Command
runSettingCommand of
            CommandArgs String
command ->
              [ [ String -> Chunk
indicatorChunk String
"starting",
                  Chunk
" ",
                  String -> Chunk
commandChunk String
command
                ]
              ]
            CommandScript String
script ->
              [ [ String -> Chunk
indicatorChunk String
"starting script\n",
                  Text -> Chunk
chunk forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
script
                ]
              ],
          [ [ String -> Chunk
indicatorChunk String
"working dir:",
              Chunk
" ",
              Text -> Chunk
chunk forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ Path Abs Dir -> String
fromAbsDir Path Abs Dir
workdir
            ]
            | Path Abs Dir
workdir <- forall a. Maybe a -> [a]
maybeToList Maybe (Path Abs Dir)
runSettingWorkingDir
          ],
          if forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map String String
runSettingExtraEnv
            then []
            else
              [String -> Chunk
indicatorChunk String
"extra env:"] forall a. a -> [a] -> [a]
:
              forall a b. (a -> b) -> [a] -> [b]
map
                ( \(String
k, String
v) ->
                    [ Chunk
"  ",
                      Colour -> Chunk -> Chunk
fore Colour
blue forall a b. (a -> b) -> a -> b
$ Text -> Chunk
chunk (String -> Text
T.pack String
k),
                      Chunk
": ",
                      Colour -> Chunk -> Chunk
fore Colour
blue forall a b. (a -> b) -> a -> b
$ Text -> Chunk
chunk (String -> Text
T.pack String
v)
                    ]
                )
                (forall k a. Map k a -> [(k, a)]
M.toList Map String String
runSettingExtraEnv)
        ]

exitCodeChunks :: ExitCode -> [Chunk]
exitCodeChunks :: ExitCode -> [Chunk]
exitCodeChunks ExitCode
ec =
  [ String -> Chunk
indicatorChunk String
"exited:",
    Chunk
" ",
    case ExitCode
ec of
      ExitCode
ExitSuccess ->
        Colour -> Chunk -> Chunk
fore Colour
green Chunk
"success"
      ExitFailure Int
c ->
        Colour -> Chunk -> Chunk
fore Colour
red forall a b. (a -> b) -> a -> b
$ Text -> Chunk
chunk forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ String
"failed: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
c
  ]

durationChunks :: Word64 -> [Chunk]
durationChunks :: Word64 -> [Chunk]
durationChunks Word64
nanosecs =
  let diffTime :: Double
      diffTime :: Double
diffTime = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
nanosecs forall a. Fractional a => a -> a -> a
/ Double
1_000_000_000
   in [ String -> Chunk
indicatorChunk String
"took",
        Chunk
" ",
        Text -> Chunk
chunk forall a b. (a -> b) -> a -> b
$
          String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => String -> r
printf String
"%4.2fs" Double
diffTime
      ]