{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}

module HWM.Runtime.UI
  ( MonadUI (..),
    UIT,
    runUIT,
    runUI,
    putLine,
    indent,
    section,
    sectionWorkspace,
    sectionEnvironments,
    sectionConfig,
    sectionTableM,
    forTable,
    printSummary,
    statusIndicator,
    runSpinner,
  )
where

import Control.Concurrent (threadDelay)
import Control.Monad.Error.Class (MonadError)
import Control.Monad.Except (MonadError (..))
import Data.List (groupBy, maximum)
import qualified Data.Map.Strict as Map
import qualified Data.Text as T
import HWM.Core.Formatting (Color (..), Format (..), Status (..), chalk, indentBlockNum, padDots, renderSummaryStatus, subPathSign)
import HWM.Core.Result
  ( Issue (..),
    IssueDetails (..),
    ResultT (..),
    Severity (..),
  )
import Relude
import System.Console.ANSI (clearLine, setCursorColumn)

data UIContext m = UIContext
  { forall (m :: * -> *). UIContext m -> Text -> m ()
uiWriter :: Text -> m (),
    forall (m :: * -> *). UIContext m -> Int
uiIndent :: Int
  }

newtype UIT m a = UIT {forall (m :: * -> *) a. UIT m a -> ReaderT (UIContext m) m a
_unUIT :: ReaderT (UIContext m) m a}
  deriving newtype ((forall a b. (a -> b) -> UIT m a -> UIT m b)
-> (forall a b. a -> UIT m b -> UIT m a) -> Functor (UIT m)
forall a b. a -> UIT m b -> UIT m a
forall a b. (a -> b) -> UIT m a -> UIT m b
forall (m :: * -> *) a b. Functor m => a -> UIT m b -> UIT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> UIT m a -> UIT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> UIT m a -> UIT m b
fmap :: forall a b. (a -> b) -> UIT m a -> UIT m b
$c<$ :: forall (m :: * -> *) a b. Functor m => a -> UIT m b -> UIT m a
<$ :: forall a b. a -> UIT m b -> UIT m a
Functor, Functor (UIT m)
Functor (UIT m) =>
(forall a. a -> UIT m a)
-> (forall a b. UIT m (a -> b) -> UIT m a -> UIT m b)
-> (forall a b c. (a -> b -> c) -> UIT m a -> UIT m b -> UIT m c)
-> (forall a b. UIT m a -> UIT m b -> UIT m b)
-> (forall a b. UIT m a -> UIT m b -> UIT m a)
-> Applicative (UIT m)
forall a. a -> UIT m a
forall a b. UIT m a -> UIT m b -> UIT m a
forall a b. UIT m a -> UIT m b -> UIT m b
forall a b. UIT m (a -> b) -> UIT m a -> UIT m b
forall a b c. (a -> b -> c) -> UIT m a -> UIT m b -> UIT m c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (m :: * -> *). Applicative m => Functor (UIT m)
forall (m :: * -> *) a. Applicative m => a -> UIT m a
forall (m :: * -> *) a b.
Applicative m =>
UIT m a -> UIT m b -> UIT m a
forall (m :: * -> *) a b.
Applicative m =>
UIT m a -> UIT m b -> UIT m b
forall (m :: * -> *) a b.
Applicative m =>
UIT m (a -> b) -> UIT m a -> UIT m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> UIT m a -> UIT m b -> UIT m c
$cpure :: forall (m :: * -> *) a. Applicative m => a -> UIT m a
pure :: forall a. a -> UIT m a
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
UIT m (a -> b) -> UIT m a -> UIT m b
<*> :: forall a b. UIT m (a -> b) -> UIT m a -> UIT m b
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> UIT m a -> UIT m b -> UIT m c
liftA2 :: forall a b c. (a -> b -> c) -> UIT m a -> UIT m b -> UIT m c
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
UIT m a -> UIT m b -> UIT m b
*> :: forall a b. UIT m a -> UIT m b -> UIT m b
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
UIT m a -> UIT m b -> UIT m a
<* :: forall a b. UIT m a -> UIT m b -> UIT m a
Applicative, Applicative (UIT m)
Applicative (UIT m) =>
(forall a b. UIT m a -> (a -> UIT m b) -> UIT m b)
-> (forall a b. UIT m a -> UIT m b -> UIT m b)
-> (forall a. a -> UIT m a)
-> Monad (UIT m)
forall a. a -> UIT m a
forall a b. UIT m a -> UIT m b -> UIT m b
forall a b. UIT m a -> (a -> UIT m b) -> UIT m b
forall (m :: * -> *). Monad m => Applicative (UIT m)
forall (m :: * -> *) a. Monad m => a -> UIT m a
forall (m :: * -> *) a b. Monad m => UIT m a -> UIT m b -> UIT m b
forall (m :: * -> *) a b.
Monad m =>
UIT m a -> (a -> UIT m b) -> UIT m b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
UIT m a -> (a -> UIT m b) -> UIT m b
>>= :: forall a b. UIT m a -> (a -> UIT m b) -> UIT m b
$c>> :: forall (m :: * -> *) a b. Monad m => UIT m a -> UIT m b -> UIT m b
>> :: forall a b. UIT m a -> UIT m b -> UIT m b
$creturn :: forall (m :: * -> *) a. Monad m => a -> UIT m a
return :: forall a. a -> UIT m a
Monad, Monad (UIT m)
Monad (UIT m) => (forall a. IO a -> UIT m a) -> MonadIO (UIT m)
forall a. IO a -> UIT m a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
forall (m :: * -> *). MonadIO m => Monad (UIT m)
forall (m :: * -> *) a. MonadIO m => IO a -> UIT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> UIT m a
liftIO :: forall a. IO a -> UIT m a
MonadIO)

instance MonadTrans UIT where
  lift :: forall (m :: * -> *) a. Monad m => m a -> UIT m a
lift = ReaderT (UIContext m) m a -> UIT m a
forall (m :: * -> *) a. ReaderT (UIContext m) m a -> UIT m a
UIT (ReaderT (UIContext m) m a -> UIT m a)
-> (m a -> ReaderT (UIContext m) m a) -> m a -> UIT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> ReaderT (UIContext m) m a
forall (m :: * -> *) a. Monad m => m a -> ReaderT (UIContext m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

instance (MonadError err m) => MonadError err (UIT m) where
  throwError :: forall a. err -> UIT m a
throwError = ReaderT (UIContext m) m a -> UIT m a
forall (m :: * -> *) a. ReaderT (UIContext m) m a -> UIT m a
UIT (ReaderT (UIContext m) m a -> UIT m a)
-> (err -> ReaderT (UIContext m) m a) -> err -> UIT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> ReaderT (UIContext m) m a
forall (m :: * -> *) a. Monad m => m a -> ReaderT (UIContext m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ReaderT (UIContext m) m a)
-> (err -> m a) -> err -> ReaderT (UIContext m) m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. err -> m a
forall a. err -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
  catchError :: forall a. UIT m a -> (err -> UIT m a) -> UIT m a
catchError (UIT ReaderT (UIContext m) m a
action) err -> UIT m a
handler = ReaderT (UIContext m) m a -> UIT m a
forall (m :: * -> *) a. ReaderT (UIContext m) m a -> UIT m a
UIT (ReaderT (UIContext m) m a -> UIT m a)
-> ReaderT (UIContext m) m a -> UIT m a
forall a b. (a -> b) -> a -> b
$ (UIContext m -> m a) -> ReaderT (UIContext m) m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((UIContext m -> m a) -> ReaderT (UIContext m) m a)
-> (UIContext m -> m a) -> ReaderT (UIContext m) m a
forall a b. (a -> b) -> a -> b
$ \UIContext m
ctx ->
    m a -> (err -> m a) -> m a
forall a. m a -> (err -> m a) -> m a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError (ReaderT (UIContext m) m a -> UIContext m -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT (UIContext m) m a
action UIContext m
ctx) (\err
e -> ReaderT (UIContext m) m a -> UIContext m -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (UIT m a -> ReaderT (UIContext m) m a
forall (m :: * -> *) a. UIT m a -> ReaderT (UIContext m) m a
_unUIT (err -> UIT m a
handler err
e)) UIContext m
ctx)

runUIT :: (Monad m) => (Text -> m ()) -> UIT m a -> m a
runUIT :: forall (m :: * -> *) a. Monad m => (Text -> m ()) -> UIT m a -> m a
runUIT Text -> m ()
writer (UIT ReaderT (UIContext m) m a
action) =
  let ctx :: UIContext m
ctx = UIContext {uiWriter :: Text -> m ()
uiWriter = Text -> m ()
writer, uiIndent :: Int
uiIndent = Int
0}
   in ReaderT (UIContext m) m a -> UIContext m -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT (UIContext m) m a
action UIContext m
ctx

runUI :: UIT IO a -> IO a
runUI :: forall a. UIT IO a -> IO a
runUI = (Text -> IO ()) -> UIT IO a -> IO a
forall (m :: * -> *) a. Monad m => (Text -> m ()) -> UIT m a -> m a
runUIT (String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
putStr (String -> IO ()) -> (Text -> String) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
forall a. ToString a => a -> String
toString)

class (Monad m) => MonadUI m where
  uiWrite :: Text -> m ()
  uiIndentLevel :: m Int
  uiWithIndent :: (Int -> Int) -> m a -> m a

instance (Monad m) => MonadUI (UIT m) where
  uiWrite :: Text -> UIT m ()
uiWrite Text
txt = ReaderT (UIContext m) m () -> UIT m ()
forall (m :: * -> *) a. ReaderT (UIContext m) m a -> UIT m a
UIT (ReaderT (UIContext m) m () -> UIT m ())
-> ReaderT (UIContext m) m () -> UIT m ()
forall a b. (a -> b) -> a -> b
$ do
    UIContext {Text -> m ()
uiWriter :: forall (m :: * -> *). UIContext m -> Text -> m ()
uiWriter :: Text -> m ()
uiWriter} <- ReaderT (UIContext m) m (UIContext m)
forall r (m :: * -> *). MonadReader r m => m r
ask
    m () -> ReaderT (UIContext m) m ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT (UIContext m) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Text -> m ()
uiWriter Text
txt)
  uiIndentLevel :: UIT m Int
uiIndentLevel = ReaderT (UIContext m) m Int -> UIT m Int
forall (m :: * -> *) a. ReaderT (UIContext m) m a -> UIT m a
UIT (ReaderT (UIContext m) m Int -> UIT m Int)
-> ReaderT (UIContext m) m Int -> UIT m Int
forall a b. (a -> b) -> a -> b
$ (UIContext m -> Int) -> ReaderT (UIContext m) m Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks UIContext m -> Int
forall (m :: * -> *). UIContext m -> Int
uiIndent
  uiWithIndent :: forall a. (Int -> Int) -> UIT m a -> UIT m a
uiWithIndent Int -> Int
f (UIT ReaderT (UIContext m) m a
action) = ReaderT (UIContext m) m a -> UIT m a
forall (m :: * -> *) a. ReaderT (UIContext m) m a -> UIT m a
UIT (ReaderT (UIContext m) m a -> UIT m a)
-> ReaderT (UIContext m) m a -> UIT m a
forall a b. (a -> b) -> a -> b
$ (UIContext m -> UIContext m)
-> ReaderT (UIContext m) m a -> ReaderT (UIContext m) m a
forall a.
(UIContext m -> UIContext m)
-> ReaderT (UIContext m) m a -> ReaderT (UIContext m) m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local UIContext m -> UIContext m
forall {m :: * -> *}. UIContext m -> UIContext m
adjust ReaderT (UIContext m) m a
action
    where
      adjust :: UIContext m -> UIContext m
adjust UIContext m
ctx = UIContext m
ctx {uiIndent = f (uiIndent ctx)}

instance (MonadUI m) => MonadUI (ResultT m) where
  uiWrite :: Text -> ResultT m ()
uiWrite Text
txt = m () -> ResultT m ()
forall (m :: * -> *) a. Monad m => m a -> ResultT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Text -> m ()
forall (m :: * -> *). MonadUI m => Text -> m ()
uiWrite Text
txt)
  uiIndentLevel :: ResultT m Int
uiIndentLevel = m Int -> ResultT m Int
forall (m :: * -> *) a. Monad m => m a -> ResultT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Int
forall (m :: * -> *). MonadUI m => m Int
uiIndentLevel
  uiWithIndent :: forall a. (Int -> Int) -> ResultT m a -> ResultT m a
uiWithIndent Int -> Int
f (ResultT m (Result Issue a)
action) = m (Result Issue a) -> ResultT m a
forall (m :: * -> *) a. m (Result Issue a) -> ResultT m a
ResultT (m (Result Issue a) -> ResultT m a)
-> m (Result Issue a) -> ResultT m a
forall a b. (a -> b) -> a -> b
$ (Int -> Int) -> m (Result Issue a) -> m (Result Issue a)
forall a. (Int -> Int) -> m a -> m a
forall (m :: * -> *) a. MonadUI m => (Int -> Int) -> m a -> m a
uiWithIndent Int -> Int
f m (Result Issue a)
action

putLine :: (MonadUI m) => Text -> m ()
putLine :: forall (m :: * -> *). MonadUI m => Text -> m ()
putLine Text
txt = do
  Int
level <- m Int
forall (m :: * -> *). MonadUI m => m Int
uiIndentLevel
  Text -> m ()
forall (m :: * -> *). MonadUI m => Text -> m ()
uiWrite (Int -> Text -> Text
indentBlockNum Int
level (Text
txt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"))

indent :: (MonadUI m) => Int -> m a -> m a
indent :: forall (m :: * -> *) a. MonadUI m => Int -> m a -> m a
indent Int
amount = (Int -> Int) -> m a -> m a
forall a. (Int -> Int) -> m a -> m a
forall (m :: * -> *) a. MonadUI m => (Int -> Int) -> m a -> m a
uiWithIndent (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
amount)

sectionWithIcon :: (MonadUI m) => Text -> Text -> m a -> m ()
sectionWithIcon :: forall (m :: * -> *) a. MonadUI m => Text -> Text -> m a -> m ()
sectionWithIcon Text
emoji Text
title m a
action = do
  Text -> m ()
forall (m :: * -> *). MonadUI m => Text -> m ()
putLine Text
""
  Text -> m ()
forall (m :: * -> *). MonadUI m => Text -> m ()
putLine (Text
emoji Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Color -> Text -> Text
chalk Color
Bold Text
title)
  Int -> m a -> m a
forall (m :: * -> *) a. MonadUI m => Int -> m a -> m a
indent Int
1 m a
action m a -> () -> m ()
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ()

section :: (MonadUI m) => Text -> m a -> m ()
section :: forall (m :: * -> *) a. MonadUI m => Text -> m a -> m ()
section = Text -> Text -> m a -> m ()
forall (m :: * -> *) a. MonadUI m => Text -> Text -> m a -> m ()
sectionWithIcon Text
"•"

sectionWorkspace :: (MonadUI m) => m a -> m ()
sectionWorkspace :: forall (m :: * -> *) a. MonadUI m => m a -> m ()
sectionWorkspace = Text -> Text -> m a -> m ()
forall (m :: * -> *) a. MonadUI m => Text -> Text -> m a -> m ()
sectionWithIcon Text
"./" Text
"workspace"

sectionEnvironments :: (MonadUI m) => m a -> m ()
sectionEnvironments :: forall (m :: * -> *) a. MonadUI m => m a -> m ()
sectionEnvironments = Text -> m a -> m ()
forall (m :: * -> *) a. MonadUI m => Text -> m a -> m ()
section Text
"environments"

tableM :: (MonadUI m) => Int -> [(Text, m Text)] -> m ()
tableM :: forall (m :: * -> *). MonadUI m => Int -> [(Text, m Text)] -> m ()
tableM Int
minSize [(Text, m Text)]
rows = ((Text, m Text) -> m ()) -> [(Text, m Text)] -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Text, m Text) -> m ()
forall {m :: * -> *}. MonadUI m => (Text, m Text) -> m ()
formatRow [(Text, m Text)]
rows
  where
    maxLabelLen :: Int
maxLabelLen = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Int
minSize Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: ((Text, m Text) -> Int) -> [(Text, m Text)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Int
T.length (Text -> Int) -> ((Text, m Text) -> Text) -> (Text, m Text) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, m Text) -> Text
forall a b. (a, b) -> a
fst) [(Text, m Text)]
rows) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2
    formatRow :: (Text, m Text) -> m ()
formatRow (Text
label, m Text
valueM) = do
      Text
value <- m Text
valueM
      Text -> m ()
forall (m :: * -> *). MonadUI m => Text -> m ()
putLine (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
padDots Int
maxLabelLen Text
label Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
value

sectionTableM :: (MonadUI m) => Int -> Text -> [(Text, m Text)] -> m ()
sectionTableM :: forall (m :: * -> *).
MonadUI m =>
Int -> Text -> [(Text, m Text)] -> m ()
sectionTableM Int
size Text
title = Text -> m () -> m ()
forall (m :: * -> *) a. MonadUI m => Text -> m a -> m ()
section Text
title (m () -> m ())
-> ([(Text, m Text)] -> m ()) -> [(Text, m Text)] -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [(Text, m Text)] -> m ()
forall (m :: * -> *). MonadUI m => Int -> [(Text, m Text)] -> m ()
tableM Int
size

sectionConfig :: (MonadUI m) => Int -> [(Text, m Text)] -> m ()
sectionConfig :: forall (m :: * -> *). MonadUI m => Int -> [(Text, m Text)] -> m ()
sectionConfig Int
size = Text -> m () -> m ()
forall (m :: * -> *) a. MonadUI m => Text -> m a -> m ()
section Text
"config" (m () -> m ())
-> ([(Text, m Text)] -> m ()) -> [(Text, m Text)] -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [(Text, m Text)] -> m ()
forall (m :: * -> *). MonadUI m => Int -> [(Text, m Text)] -> m ()
tableM Int
size

forTable :: (MonadUI m) => Int -> [a] -> (a -> (Text, Text)) -> m ()
forTable :: forall (m :: * -> *) a.
MonadUI m =>
Int -> [a] -> (a -> (Text, Text)) -> m ()
forTable Int
minSize [a]
rows a -> (Text, Text)
f =
  Int -> [(Text, m Text)] -> m ()
forall (m :: * -> *). MonadUI m => Int -> [(Text, m Text)] -> m ()
tableM Int
minSize ((a -> (Text, m Text)) -> [a] -> [(Text, m Text)]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> m Text) -> (Text, Text) -> (Text, m Text)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Text -> m Text
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Text, Text) -> (Text, m Text))
-> (a -> (Text, Text)) -> a -> (Text, m Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (Text, Text)
f) [a]
rows)

isError :: Issue -> Bool
isError :: Issue -> Bool
isError Issue
i = Issue -> Severity
issueSeverity Issue
i Severity -> Severity -> Bool
forall a. Eq a => a -> a -> Bool
== Severity
SeverityError

renderSummaryLines :: [Issue] -> [Text]
renderSummaryLines :: [Issue] -> [Text]
renderSummaryLines [] = [Text
"", Status -> Text
renderSummaryStatus Status
Checked, Text
""]
renderSummaryLines [Issue]
issues =
  let headerLine :: Text
headerLine =
        if (Issue -> Bool) -> [Issue] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Issue -> Bool
isError [Issue]
issues
          then Status -> Text
renderSummaryStatus Status
Invalid
          else Status -> Text
renderSummaryStatus Status
Warning
      grouped :: [[Issue]]
grouped = (Issue -> Issue -> Bool) -> [Issue] -> [[Issue]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Text -> Text -> Bool) -> (Issue -> Text) -> Issue -> Issue -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Issue -> Text
issueTopic) ((Issue -> Text) -> [Issue] -> [Issue]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn Issue -> Text
issueTopic [Issue]
issues)
      renderGroup :: [Issue] -> [Text]
renderGroup [] = []
      renderGroup pkgIssues :: [Issue]
pkgIssues@(Issue {issueTopic :: Issue -> Text
issueTopic = Text
header} : [Issue]
_) =
        let l1 :: Text
l1 = Text
"  "
            step :: Text
step = Text
l1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
subPathSign Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Color -> Text -> Text
chalk Color
Dim Text
"• "
            l2 :: Text
l2 = Text
l1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"    " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
subPathSign
            headerText :: Text
headerText = Text
l1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Color -> Text -> Text
chalk Color
Dim Text
"• " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Color -> Text -> Text
chalk Color
Bold Text
header
            renderIssue :: Issue -> [Text]
renderIssue Issue {issueDetails :: Issue -> Maybe IssueDetails
issueDetails = Maybe IssueDetails
Nothing, Severity
issueSeverity :: Issue -> Severity
issueSeverity :: Severity
issueSeverity, Text
issueMessage :: Text
issueMessage :: Issue -> Text
issueMessage} =
              [Text
step Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Color -> Text -> Text
chalk (Severity -> Color
levelColor Severity
issueSeverity) Text
issueMessage]
            renderIssue Issue {issueDetails :: Issue -> Maybe IssueDetails
issueDetails = Just (GenericIssue {String
issueFile :: String
issueFile :: IssueDetails -> String
issueFile}), Severity
issueSeverity :: Issue -> Severity
issueSeverity :: Severity
issueSeverity, Text
issueMessage :: Issue -> Text
issueMessage :: Text
issueMessage} =
              [ Text
step Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Color -> Text -> Text
chalk (Severity -> Color
levelColor Severity
issueSeverity) Text
issueMessage,
                Text
l2 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Color -> Text -> Text
chalk Color
Dim (Text
"file: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. Format a => a -> Text
format String
issueFile)
              ]
            renderIssue Issue {issueDetails :: Issue -> Maybe IssueDetails
issueDetails = Just (CommandIssue {Text
issueCommand :: Text
issueCommand :: IssueDetails -> Text
issueCommand, String
issueLogFile :: String
issueLogFile :: IssueDetails -> String
issueLogFile}), Severity
issueSeverity :: Issue -> Severity
issueSeverity :: Severity
issueSeverity, Text
issueMessage :: Issue -> Text
issueMessage :: Text
issueMessage} =
              let cmd :: Text
cmd =
                    if Text -> Int
T.length Text
issueCommand Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
60
                      then Int -> Text -> Text
T.take Int
60 Text
issueCommand Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Color -> Text -> Text
chalk Color
Dim Text
"..."
                      else Text
issueCommand
               in [ Text
step Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Color -> Text -> Text
chalk (Severity -> Color
levelColor Severity
issueSeverity) (Text
issueMessage Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": ") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
cmd,
                    Text
l2 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Color -> Text -> Text
chalk Color
Dim (Text
"logs: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. Format a => a -> Text
format String
issueLogFile)
                  ]
            renderIssue Issue {issueDetails :: Issue -> Maybe IssueDetails
issueDetails = Just (DependencyIssue {[(Text, Text, Text, Text)]
issueDependencies :: [(Text, Text, Text, Text)]
issueDependencies :: IssueDetails -> [(Text, Text, Text, Text)]
issueDependencies, String
issueFile :: IssueDetails -> String
issueFile :: String
issueFile}), Severity
issueSeverity :: Issue -> Severity
issueSeverity :: Severity
issueSeverity, Text
issueMessage :: Issue -> Text
issueMessage :: Text
issueMessage} =
              let groupedDeps :: [(Text, [(Text, Text, Text)])]
groupedDeps = Map Text [(Text, Text, Text)] -> [(Text, [(Text, Text, Text)])]
forall k a. Map k a -> [(k, a)]
Map.toList (Map Text [(Text, Text, Text)] -> [(Text, [(Text, Text, Text)])])
-> Map Text [(Text, Text, Text)] -> [(Text, [(Text, Text, Text)])]
forall a b. (a -> b) -> a -> b
$ ([(Text, Text, Text)]
 -> [(Text, Text, Text)] -> [(Text, Text, Text)])
-> [(Text, [(Text, Text, Text)])] -> Map Text [(Text, Text, Text)]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith [(Text, Text, Text)]
-> [(Text, Text, Text)] -> [(Text, Text, Text)]
forall a. [a] -> [a] -> [a]
(++) [(Text
scope, [(Text
depName, Text
actual, Text
expected)]) | (Text
scope, Text
depName, Text
actual, Text
expected) <- [(Text, Text, Text, Text)]
issueDependencies]
                  depLines :: [Text]
depLines = ((Text, [(Text, Text, Text)]) -> [Text])
-> [(Text, [(Text, Text, Text)])] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Text, [(Text, Text, Text)]) -> [Text]
formatGroup [(Text, [(Text, Text, Text)])]
groupedDeps
                  formatGroup :: (Text, [(Text, Text, Text)]) -> [Text]
formatGroup (Text
scope, [(Text, Text, Text)]
deps) =
                    (Text
l2 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Color -> Text -> Text
chalk Color
Dim Text
"• " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Color -> Text -> Text
chalk Color
Dim Text
scope) Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: ((Text, Text, Text) -> Text) -> [(Text, Text, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Text, Text) -> Text
formatDepLine [(Text, Text, Text)]
deps
                  formatDepLine :: (Text, Text, Text) -> Text
formatDepLine (Text
depName, Text
actual, Text
expected) =
                    Text
l1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"        " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
subPathSign Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
depName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Color -> Text -> Text
chalk Color
Dim (Text
actual Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" → " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
expected)
               in Text
step Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Color -> Text -> Text
chalk (Severity -> Color
levelColor Severity
issueSeverity) Text
issueMessage
                    Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text
l2 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Color -> Text -> Text
chalk Color
Dim (Text
"file: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. Format a => a -> Text
format String
issueFile)
                    Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
depLines
            detailLines :: [Text]
detailLines = (Issue -> [Text]) -> [Issue] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Issue -> [Text]
renderIssue [Issue]
pkgIssues
         in Text
headerText Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
detailLines
   in [Text
"", Text
headerLine, Text
""] [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> ([Issue] -> [Text]) -> [[Issue]] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [Issue] -> [Text]
renderGroup [[Issue]]
grouped [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
""]

levelColor :: Severity -> Color
levelColor :: Severity -> Color
levelColor Severity
SeverityError = Color
Red
levelColor Severity
SeverityWarning = Color
Yellow

printSummary :: (MonadUI m) => [Issue] -> m ()
printSummary :: forall (m :: * -> *). MonadUI m => [Issue] -> m ()
printSummary = (Text -> m ()) -> [Text] -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Text -> m ()
forall (m :: * -> *). MonadUI m => Text -> m ()
putLine ([Text] -> m ()) -> ([Issue] -> [Text]) -> [Issue] -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Issue] -> [Text]
renderSummaryLines

statusIndicator :: (MonadIO m) => Int -> Text -> Text -> m ()
statusIndicator :: forall (m :: * -> *). MonadIO m => Int -> Text -> Text -> m ()
statusIndicator Int
padding Text
prefix Text
msg = do
  IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ()
clearLine
  IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
setCursorColumn Int
0
  IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> String
forall a. ToString a => a -> String
toString (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text
"  " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
padDots Int
padding Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
msg
  IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Handle -> IO ()
forall (m :: * -> *). MonadIO m => Handle -> m ()
hFlush Handle
stdout

runSpinner :: (MonadIO m) => Int -> Text -> m ()
runSpinner :: forall (m :: * -> *). MonadIO m => Int -> Text -> m ()
runSpinner Int
padding Text
prefix = [Text] -> m ()
forall {m :: * -> *}. MonadIO m => [Text] -> m ()
loop [Text
"◜", Text
"◠", Text
"◝", Text
"◞", Text
"◡", Text
"◟"]
  where
    loop :: [Text] -> m ()
loop (Text
f : [Text]
fs) = do
      Int -> Text -> Text -> m ()
forall (m :: * -> *). MonadIO m => Int -> Text -> Text -> m ()
statusIndicator Int
padding Text
prefix Text
f
      IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
threadDelay Int
200000 -- 200ms
      [Text] -> m ()
loop ([Text]
fs [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
f])
    loop [] = () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()