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