{-# LANGUAGE CPP #-}
{-# LANGUAGE MultiWayIf #-}

module Test.Sandwich.Formatters.TerminalUI.Draw.ToBrickWidget where

import Brick
import Brick.Widgets.Border
import Control.Exception.Safe
import Control.Monad.Reader
import qualified Data.List as L
import Data.Maybe
import Data.String.Interpolate
import qualified Data.Text as T
import Data.Time.Clock
import GHC.Stack
import Safe
import Test.Sandwich.Formatters.Common.Util
import Test.Sandwich.Formatters.TerminalUI.AttrMap
import Test.Sandwich.Formatters.TerminalUI.Types
import Test.Sandwich.Types.RunTree
import Test.Sandwich.Types.Spec
import Text.Show.Pretty as P


class ToBrickWidget a where
  toBrickWidget :: a -> Reader CustomExceptionFormatters (Widget n)

instance ToBrickWidget Status where
  toBrickWidget :: forall n. Status -> Reader CustomExceptionFormatters (Widget n)
toBrickWidget (NotStarted {}) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
strWrap String
"Not started"
  toBrickWidget (Running {UTCTime
statusStartTime :: Status -> UTCTime
statusStartTime :: UTCTime
statusStartTime}) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
strWrap [i|Started at #{statusStartTime}|]
  toBrickWidget (Done UTCTime
startTime UTCTime
endTime Result
Success) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
strWrap [i|Succeeded in #{formatNominalDiffTime (diffUTCTime endTime startTime)}|]
  toBrickWidget (Done {statusResult :: Status -> Result
statusResult=(Failure FailureReason
failureReason)}) = forall a n.
ToBrickWidget a =>
a -> Reader CustomExceptionFormatters (Widget n)
toBrickWidget FailureReason
failureReason
  toBrickWidget (Done {statusResult :: Status -> Result
statusResult=Result
DryRun}) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
strWrap String
"Not started due to dry run"
  toBrickWidget (Done {statusResult :: Status -> Result
statusResult=Result
Cancelled}) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
strWrap String
"Cancelled"

instance ToBrickWidget FailureReason where
  toBrickWidget :: forall n.
FailureReason -> Reader CustomExceptionFormatters (Widget n)
toBrickWidget (ExpectedButGot Maybe CallStack
_ (SEB s
x1) (SEB s
x2)) = do
    (Widget n
widget1, Widget n
widget2) <- case (forall a. Show a => a -> Maybe Value
P.reify s
x1, forall a. Show a => a -> Maybe Value
P.reify s
x2) of
      (Just Value
v1, Just Value
v2) -> (, ) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a n.
ToBrickWidget a =>
a -> Reader CustomExceptionFormatters (Widget n)
toBrickWidget Value
v1 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a n.
ToBrickWidget a =>
a -> Reader CustomExceptionFormatters (Widget n)
toBrickWidget Value
v2
      (Maybe Value, Maybe Value)
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall n. String -> Widget n
str (forall a. Show a => a -> String
show s
x1), forall n. String -> Widget n
str (forall a. Show a => a -> String
show s
x2))

    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall n. [Widget n] -> Widget n
hBox [
      forall n. Int -> Widget n -> Widget n
hLimitPercent Int
50 forall a b. (a -> b) -> a -> b
$
        forall n. Widget n -> Widget n
border forall a b. (a -> b) -> a -> b
$
          forall n. Int -> Widget n -> Widget n
padAll Int
1 forall a b. (a -> b) -> a -> b
$
            (forall n. Padding -> Widget n -> Widget n
padBottom (Int -> Padding
Pad Int
1) (forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
expectedAttr forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str String
"Expected:"))
            forall n. Widget n -> Widget n -> Widget n
<=>
            Widget n
widget1
      , forall n. Padding -> Widget n -> Widget n
padLeft (Int -> Padding
Pad Int
1) forall a b. (a -> b) -> a -> b
$
          forall n. Int -> Widget n -> Widget n
hLimitPercent Int
50 forall a b. (a -> b) -> a -> b
$
            forall n. Widget n -> Widget n
border forall a b. (a -> b) -> a -> b
$
              forall n. Int -> Widget n -> Widget n
padAll Int
1 forall a b. (a -> b) -> a -> b
$
                (forall n. Padding -> Widget n -> Widget n
padBottom (Int -> Padding
Pad Int
1) (forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
sawAttr forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str String
"Saw:"))
                forall n. Widget n -> Widget n -> Widget n
<=>
                Widget n
widget2
      ]
  toBrickWidget (DidNotExpectButGot Maybe CallStack
_ ShowEqBox
x) = forall n. String -> Widget n -> Widget n
boxWithTitle String
"Did not expect:" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a n.
Show a =>
a -> Reader CustomExceptionFormatters (Widget n)
reifyWidget ShowEqBox
x)
  toBrickWidget (Pending Maybe CallStack
_ Maybe String
maybeMessage) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Maybe String
maybeMessage of
    Maybe String
Nothing -> forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
pendingAttr forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str String
"Pending"
    Just String
msg -> forall n. [Widget n] -> Widget n
hBox [forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
pendingAttr forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str String
"Pending"
                     , forall n. String -> Widget n
str (String
": " forall a. Semigroup a => a -> a -> a
<> String
msg)]
  toBrickWidget (Reason Maybe CallStack
_ String
msg) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n -> Widget n
boxWithTitle String
"Failure reason:" (forall n. String -> Widget n
strWrap String
msg)
  toBrickWidget (RawImage Maybe CallStack
_ String
_ Image
image) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n -> Widget n
boxWithTitle String
"Failure reason:" (forall n. Image -> Widget n
raw Image
image)
  toBrickWidget (ChildrenFailed Maybe CallStack
_ Int
n) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n -> Widget n
boxWithTitle [i|Reason: #{n} #{if n == 1 then ("child" :: String) else "children"} failed|] (forall n. String -> Widget n
strWrap String
"")
  toBrickWidget (GotException Maybe CallStack
_ Maybe String
maybeMessage e :: SomeExceptionWithEq
e@(SomeExceptionWithEq SomeException
baseException)) = case forall e. Exception e => SomeException -> Maybe e
fromException SomeException
baseException of
    Just (FailureReason
fr :: FailureReason) -> forall n. String -> Widget n -> Widget n
boxWithTitle String
heading forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a n.
ToBrickWidget a =>
a -> Reader CustomExceptionFormatters (Widget n)
toBrickWidget FailureReason
fr)
    Maybe FailureReason
Nothing -> do
      CustomExceptionFormatters
customExceptionFormatters <- forall r (m :: * -> *). MonadReader r m => m r
ask
      case forall a. [a] -> Maybe a
headMay forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes [SomeException -> Maybe CustomTUIException
x SomeException
baseException | SomeException -> Maybe CustomTUIException
x <- CustomExceptionFormatters
customExceptionFormatters] of
        Just (CustomTUIExceptionMessageAndCallStack Text
msg Maybe CallStack
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
strWrap forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
msg
        Just (CustomTUIExceptionBrick forall n. Widget n
widget) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n -> Widget n
boxWithTitle String
heading forall n. Widget n
widget
        Maybe CustomTUIException
Nothing -> forall n. String -> Widget n -> Widget n
boxWithTitle String
heading forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a n.
Show a =>
a -> Reader CustomExceptionFormatters (Widget n)
reifyWidget SomeExceptionWithEq
e)
    where heading :: String
heading = case Maybe String
maybeMessage of
            Maybe String
Nothing -> String
"Got exception: "
            Just String
msg -> [i|Got exception (#{msg}):|]
  toBrickWidget (GotAsyncException Maybe CallStack
_ Maybe String
maybeMessage SomeAsyncExceptionWithEq
e) = forall n. String -> Widget n -> Widget n
boxWithTitle String
heading forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a n.
Show a =>
a -> Reader CustomExceptionFormatters (Widget n)
reifyWidget SomeAsyncExceptionWithEq
e)
    where heading :: String
heading = case Maybe String
maybeMessage of
            Maybe String
Nothing -> String
"Got async exception: "
            Just String
msg -> [i|Got async exception (#{msg}):|]
  toBrickWidget (GetContextException Maybe CallStack
_ e :: SomeExceptionWithEq
e@(SomeExceptionWithEq SomeException
baseException)) = case forall e. Exception e => SomeException -> Maybe e
fromException SomeException
baseException of
    Just (FailureReason
fr :: FailureReason) -> forall n. String -> Widget n -> Widget n
boxWithTitle String
"Get context exception:" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a n.
ToBrickWidget a =>
a -> Reader CustomExceptionFormatters (Widget n)
toBrickWidget FailureReason
fr)
    Maybe FailureReason
_ -> forall n. String -> Widget n -> Widget n
boxWithTitle String
"Get context exception:" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a n.
Show a =>
a -> Reader CustomExceptionFormatters (Widget n)
reifyWidget SomeExceptionWithEq
e)


boxWithTitle :: String -> Widget n -> Widget n
boxWithTitle :: forall n. String -> Widget n -> Widget n
boxWithTitle String
heading Widget n
inside = forall n. [Widget n] -> Widget n
hBox [
  forall n. Widget n -> Widget n
border forall a b. (a -> b) -> a -> b
$
    forall n. Int -> Widget n -> Widget n
padAll Int
1 forall a b. (a -> b) -> a -> b
$
      (forall n. Padding -> Widget n -> Widget n
padBottom (Int -> Padding
Pad Int
1) (forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
expectedAttr forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
strWrap String
heading))
      forall n. Widget n -> Widget n -> Widget n
<=>
      Widget n
inside
  ]

reifyWidget :: Show a => a -> Reader CustomExceptionFormatters (Widget n)
reifyWidget :: forall a n.
Show a =>
a -> Reader CustomExceptionFormatters (Widget n)
reifyWidget a
x = case forall a. Show a => a -> Maybe Value
P.reify a
x of
  Just Value
v -> forall a n.
ToBrickWidget a =>
a -> Reader CustomExceptionFormatters (Widget n)
toBrickWidget Value
v
  Maybe Value
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
strWrap (forall a. Show a => a -> String
show a
x)

instance ToBrickWidget P.Value where
  toBrickWidget :: forall n. Value -> Reader CustomExceptionFormatters (Widget n)
toBrickWidget (Integer String
s) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
integerAttr forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
strWrap String
s
  toBrickWidget (Float String
s) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
floatAttr forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
strWrap String
s
  toBrickWidget (Char String
s) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
charAttr forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
strWrap String
s
  toBrickWidget (String String
s) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
stringAttr forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
strWrap String
s
#if MIN_VERSION_pretty_show(1,10,0)
  toBrickWidget (Date String
s) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
dateAttr forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
strWrap String
s
  toBrickWidget (Time String
s) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
timeAttr forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
strWrap String
s
  toBrickWidget (Quote String
s) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
quoteAttr forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
strWrap String
s
#endif
  toBrickWidget (Ratio Value
v1 Value
v2) = do
    Widget n
w1 <- forall a n.
ToBrickWidget a =>
a -> Reader CustomExceptionFormatters (Widget n)
toBrickWidget Value
v1
    Widget n
w2 <- forall a n.
ToBrickWidget a =>
a -> Reader CustomExceptionFormatters (Widget n)
toBrickWidget Value
v2
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall n. [Widget n] -> Widget n
hBox [Widget n
w1, forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
slashAttr forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str String
"/", Widget n
w2]
  toBrickWidget (Neg Value
v) = do
    Widget n
w <- forall a n.
ToBrickWidget a =>
a -> Reader CustomExceptionFormatters (Widget n)
toBrickWidget Value
v
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall n. [Widget n] -> Widget n
hBox [forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
negAttr forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str String
"-", Widget n
w]
  toBrickWidget (List [Value]
vs) = do
    [Widget n]
listRows <- forall n. [Value] -> Reader CustomExceptionFormatters [Widget n]
abbreviateList [Value]
vs
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall n. [Widget n] -> Widget n
vBox ((forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
listBracketAttr forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str String
"[")
                   forall a. a -> [a] -> [a]
: (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall n. Padding -> Widget n -> Widget n
padLeft (Int -> Padding
Pad Int
4)) [Widget n]
listRows)
                   forall a. Semigroup a => a -> a -> a
<> [forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
listBracketAttr forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str String
"]"])
  toBrickWidget (Tuple [Value]
vs) = do
    [Widget n]
tupleRows <- forall n. [Value] -> Reader CustomExceptionFormatters [Widget n]
abbreviateList [Value]
vs
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall n. [Widget n] -> Widget n
vBox ((forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
tupleBracketAttr forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str String
"(")
                   forall a. a -> [a] -> [a]
: (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall n. Padding -> Widget n -> Widget n
padLeft (Int -> Padding
Pad Int
4)) [Widget n]
tupleRows)
                   forall a. Semigroup a => a -> a -> a
<> [forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
tupleBracketAttr forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str String
")"])
  toBrickWidget (Rec String
recordName [(String, Value)]
tuples) = do
    [Widget n]
recordRows <- forall (m :: * -> *) a n.
Monad m =>
(a -> m (Widget n)) -> [a] -> m [Widget n]
abbreviateList' forall {a} {n}.
ToBrickWidget a =>
(String, a)
-> ReaderT CustomExceptionFormatters Identity (Widget n)
tupleToWidget [(String, Value)]
tuples
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall n. [Widget n] -> Widget n
vBox (forall n. [Widget n] -> Widget n
hBox [forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
recordNameAttr forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str String
recordName, forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
braceAttr forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str String
" {"]
                        forall a. a -> [a] -> [a]
: (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall n. Padding -> Widget n -> Widget n
padLeft (Int -> Padding
Pad Int
4)) [Widget n]
recordRows)
                        forall a. Semigroup a => a -> a -> a
<> [forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
braceAttr forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str String
"}"])
    where
      tupleToWidget :: (String, a)
-> ReaderT CustomExceptionFormatters Identity (Widget n)
tupleToWidget (String
name, a
v) = forall a n.
ToBrickWidget a =>
a -> Reader CustomExceptionFormatters (Widget n)
toBrickWidget a
v forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Widget n
w -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall n. [Widget n] -> Widget n
hBox [
        forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
fieldNameAttr forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str String
name
        , forall n. String -> Widget n
str String
" = "
        , Widget n
w
        ]
  toBrickWidget (Con String
conName [Value]
vs) = do
   [Widget n]
constructorRows <- forall n. [Value] -> Reader CustomExceptionFormatters [Widget n]
abbreviateList [Value]
vs
   forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall n. [Widget n] -> Widget n
vBox ((forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
constructorNameAttr forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str String
conName)
                  forall a. a -> [a] -> [a]
: (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall n. Padding -> Widget n -> Widget n
padLeft (Int -> Padding
Pad Int
4)) [Widget n]
constructorRows))
  toBrickWidget (InfixCons Value
opValue [(String, Value)]
tuples) = do
    [Widget n]
rows <- forall (m :: * -> *) a n.
Monad m =>
(a -> m (Widget n)) -> [a] -> m [Widget n]
abbreviateList' forall {a} {n}.
ToBrickWidget a =>
(String, a)
-> ReaderT CustomExceptionFormatters Identity (Widget n)
tupleToWidget [(String, Value)]
tuples
    Widget n
op <- forall a n.
ToBrickWidget a =>
a -> Reader CustomExceptionFormatters (Widget n)
toBrickWidget Value
opValue
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall n. [Widget n] -> Widget n
vBox (forall a. [a] -> [[a]] -> [a]
L.intercalate [Widget n
op] [[Widget n
x] | Widget n
x <- [Widget n]
rows])
    where
      tupleToWidget :: (String, a)
-> ReaderT CustomExceptionFormatters Identity (Widget n)
tupleToWidget (String
name, a
v) = forall a n.
ToBrickWidget a =>
a -> Reader CustomExceptionFormatters (Widget n)
toBrickWidget a
v forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Widget n
w -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall n. [Widget n] -> Widget n
hBox [
        forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
fieldNameAttr forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str String
name
        , forall n. String -> Widget n
str String
" = "
        , Widget n
w
        ]

abbreviateList :: [Value] -> Reader CustomExceptionFormatters [Widget n]
abbreviateList :: forall n. [Value] -> Reader CustomExceptionFormatters [Widget n]
abbreviateList = forall (m :: * -> *) a n.
Monad m =>
(a -> m (Widget n)) -> [a] -> m [Widget n]
abbreviateList' forall a n.
ToBrickWidget a =>
a -> Reader CustomExceptionFormatters (Widget n)
toBrickWidget

abbreviateList' :: (Monad m) => (a -> m (Widget n)) -> [a] -> m [Widget n]
abbreviateList' :: forall (m :: * -> *) a n.
Monad m =>
(a -> m (Widget n)) -> [a] -> m [Widget n]
abbreviateList' a -> m (Widget n)
f [a]
vs | forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
vs forall a. Ord a => a -> a -> Bool
< Int
10 = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM a -> m (Widget n)
f [a]
vs
abbreviateList' a -> m (Widget n)
f [a]
vs = do
  [Widget n]
initial <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM a -> m (Widget n)
f (forall a. Int -> [a] -> [a]
L.take Int
3 [a]
vs)
  [Widget n]
final <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM a -> m (Widget n)
f (forall a. Int -> [a] -> [a]
takeEnd Int
3 [a]
vs)
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Widget n]
initial forall a. Semigroup a => a -> a -> a
<> [forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
ellipsesAttr forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str String
"..."] forall a. Semigroup a => a -> a -> a
<> [Widget n]
final

instance ToBrickWidget CallStack where
  toBrickWidget :: forall n. CallStack -> Reader CustomExceptionFormatters (Widget n)
toBrickWidget CallStack
cs = forall n. [Widget n] -> Widget n
vBox forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall {a} {n}.
ToBrickWidget a =>
(String, a)
-> ReaderT CustomExceptionFormatters Identity (Widget n)
renderLine forall a b. (a -> b) -> a -> b
$ CallStack -> [(String, SrcLoc)]
getCallStack CallStack
cs)
    where
      renderLine :: (String, a)
-> ReaderT CustomExceptionFormatters Identity (Widget n)
renderLine (String
f, a
srcLoc) = forall a n.
ToBrickWidget a =>
a -> Reader CustomExceptionFormatters (Widget n)
toBrickWidget a
srcLoc forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Widget n
w -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall n. [Widget n] -> Widget n
hBox [
        forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
logFunctionAttr forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str String
f
        , forall n. String -> Widget n
str String
" called at "
        , Widget n
w
        ]

instance ToBrickWidget SrcLoc where
  toBrickWidget :: forall n. SrcLoc -> Reader CustomExceptionFormatters (Widget n)
toBrickWidget (SrcLoc {Int
String
srcLocEndCol :: SrcLoc -> Int
srcLocEndLine :: SrcLoc -> Int
srcLocFile :: SrcLoc -> String
srcLocModule :: SrcLoc -> String
srcLocPackage :: SrcLoc -> String
srcLocStartCol :: SrcLoc -> Int
srcLocStartLine :: SrcLoc -> Int
srcLocEndCol :: Int
srcLocEndLine :: Int
srcLocStartCol :: Int
srcLocStartLine :: Int
srcLocFile :: String
srcLocModule :: String
srcLocPackage :: String
..}) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall n. [Widget n] -> Widget n
hBox [
    forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
logFilenameAttr forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str String
srcLocFile
    , forall n. String -> Widget n
str String
":"
    , forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
logLineAttr forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Int
srcLocStartLine
    , forall n. String -> Widget n
str String
":"
    , forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
logChAttr forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Int
srcLocStartCol
    , forall n. String -> Widget n
str String
" in "
    , forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
logPackageAttr forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str String
srcLocPackage
    , forall n. String -> Widget n
str String
":"
    , forall n. String -> Widget n
str String
srcLocModule
    ]

-- * Util

takeEnd :: Int -> [a] -> [a]
takeEnd :: forall a. Int -> [a] -> [a]
takeEnd Int
j [a]
xs = forall {a} {a}. [a] -> [a] -> [a]
f [a]
xs (forall a. Int -> [a] -> [a]
drop Int
j [a]
xs)
  where f :: [a] -> [a] -> [a]
f (a
_:[a]
zs) (a
_:[a]
ys) = [a] -> [a] -> [a]
f [a]
zs [a]
ys
        f [a]
zs [a]
_ = [a]
zs