{-# 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 (Chunk -> Chunk) -> Chunk -> Chunk forall a b. (a -> b) -> a -> b $ Text -> Chunk chunk (Text -> Chunk) -> Text -> Chunk forall a b. (a -> b) -> a -> b $ String -> Text T.pack (String -> Text) -> String -> Text forall a b. (a -> b) -> a -> b $ TimeLocale -> String -> ZonedTime -> String 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 = NominalDiffTime -> Double forall a b. (Real a, Fractional b) => a -> b realToFrac NominalDiffTime ndt :: Double in String -> Double -> String forall r. PrintfType r => String -> r printf String "%6.2fs" Double d let relativeTimeChunk :: Chunk relativeTimeChunk = Colour -> Chunk -> Chunk fore Colour cyan (Chunk -> Chunk) -> Chunk -> Chunk forall a b. (a -> b) -> a -> b $ Text -> Chunk chunk (Text -> Chunk) -> Text -> Chunk forall a b. (a -> b) -> a -> b $ String -> Text T.pack (String -> Text) -> String -> Text forall a b. (a -> b) -> a -> b $ NominalDiffTime -> String relativeTimeStr (NominalDiffTime -> String) -> NominalDiffTime -> String 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 ([Chunk] -> IO ()) -> [Chunk] -> IO () forall a b. (a -> b) -> a -> b $ Chunk timeChunk Chunk -> [Chunk] -> [Chunk] forall a. a -> [a] -> [a] : Chunk " " Chunk -> [Chunk] -> [Chunk] forall a. a -> [a] -> [a] : Chunk relativeTimeChunk Chunk -> [Chunk] -> [Chunk] forall a. a -> [a] -> [a] : Chunk " " Chunk -> [Chunk] -> [Chunk] forall a. a -> [a] -> [a] : [Chunk] chunks [Chunk] -> [Chunk] -> [Chunk] 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 (Chunk -> Chunk) -> (String -> Chunk) -> String -> Chunk forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> Chunk chunk (Text -> Chunk) -> (String -> Text) -> String -> Chunk forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> Text T.pack (String -> Text) -> (String -> String) -> String -> Text forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> String -> String forall r. PrintfType r => String -> r printf String "%-12s" loopNameChunk :: String -> Chunk loopNameChunk :: String -> Chunk loopNameChunk = Colour -> Chunk -> Chunk fore Colour yellow (Chunk -> Chunk) -> (String -> Chunk) -> String -> Chunk forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> Chunk chunk (Text -> Chunk) -> (String -> Text) -> String -> 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 (Chunk -> Chunk) -> (String -> Chunk) -> String -> Chunk forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> Chunk chunk (Text -> Chunk) -> (String -> Text) -> String -> 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 runSettingCommand :: Command runSettingExtraEnv :: Map String String runSettingWorkingDir :: Maybe (Path Abs Dir) runSettingCommand :: RunSettings -> Command runSettingExtraEnv :: RunSettings -> Map String String runSettingWorkingDir :: RunSettings -> Maybe (Path Abs Dir) ..} = let RunSettings Command _ Map String String _ Maybe (Path Abs Dir) _ = RunSettings forall a. HasCallStack => a undefined in [[[Chunk]]] -> [[Chunk]] forall (t :: * -> *) a. Foldable t => t [a] -> [a] concat [ case Command runSettingCommand of CommandScript String script -> [ [ String -> Chunk indicatorChunk String "starting script\n", Text -> Chunk chunk (Text -> Chunk) -> Text -> Chunk forall a b. (a -> b) -> a -> b $ String -> Text T.pack String script ] ], [ [ String -> Chunk indicatorChunk String "working dir:", Chunk " ", Text -> Chunk chunk (Text -> Chunk) -> Text -> Chunk forall a b. (a -> b) -> a -> b $ String -> Text T.pack (String -> Text) -> String -> Text forall a b. (a -> b) -> a -> b $ Path Abs Dir -> String fromAbsDir Path Abs Dir workdir ] | Path Abs Dir workdir <- Maybe (Path Abs Dir) -> [Path Abs Dir] forall a. Maybe a -> [a] maybeToList Maybe (Path Abs Dir) runSettingWorkingDir ], if Map String String -> Bool forall a. Map String a -> Bool forall (t :: * -> *) a. Foldable t => t a -> Bool null Map String String runSettingExtraEnv then [] else [String -> Chunk indicatorChunk String "extra env:"] [Chunk] -> [[Chunk]] -> [[Chunk]] forall a. a -> [a] -> [a] : ((String, String) -> [Chunk]) -> [(String, String)] -> [[Chunk]] forall a b. (a -> b) -> [a] -> [b] map ( \(String k, String v) -> [ Chunk " ", Colour -> Chunk -> Chunk fore Colour blue (Chunk -> Chunk) -> Chunk -> Chunk forall a b. (a -> b) -> a -> b $ Text -> Chunk chunk (String -> Text T.pack String k), Chunk ": ", Colour -> Chunk -> Chunk fore Colour blue (Chunk -> Chunk) -> Chunk -> Chunk forall a b. (a -> b) -> a -> b $ Text -> Chunk chunk (String -> Text T.pack String v) ] ) (Map String String -> [(String, String)] 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 (Chunk -> Chunk) -> Chunk -> Chunk forall a b. (a -> b) -> a -> b $ Text -> Chunk chunk (Text -> Chunk) -> Text -> Chunk forall a b. (a -> b) -> a -> b $ String -> Text T.pack (String -> Text) -> String -> Text forall a b. (a -> b) -> a -> b $ String "failed: " String -> String -> String forall a. Semigroup a => a -> a -> a <> Int -> String forall a. Show a => a -> String show Int c ] durationChunks :: Word64 -> [Chunk] durationChunks :: Word64 -> [Chunk] durationChunks Word64 nanosecs = let diffTime :: Double diffTime :: Double diffTime = Word64 -> Double forall a b. (Integral a, Num b) => a -> b fromIntegral Word64 nanosecs Double -> Double -> Double forall a. Fractional a => a -> a -> a / Double 1_000_000_000 in [ String -> Chunk indicatorChunk String "took", Chunk " ", Text -> Chunk chunk (Text -> Chunk) -> Text -> Chunk forall a b. (a -> b) -> a -> b $ String -> Text T.pack (String -> Text) -> String -> Text forall a b. (a -> b) -> a -> b $ String -> Double -> String forall r. PrintfType r => String -> r printf String "%4.2fs" Double diffTime ]