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

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

import Brick
import Brick.Widgets.Border
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
import UnliftIO.Exception


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

instance ToBrickWidget Status where
  toBrickWidget :: forall n. Status -> Reader CustomExceptionFormatters (Widget n)
toBrickWidget (NotStarted {}) = Widget n -> ReaderT CustomExceptionFormatters Identity (Widget n)
forall a. a -> ReaderT CustomExceptionFormatters Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Widget n -> ReaderT CustomExceptionFormatters Identity (Widget n))
-> Widget n
-> ReaderT CustomExceptionFormatters Identity (Widget n)
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
strWrap String
"Not started."
  toBrickWidget (Running {UTCTime
statusStartTime :: UTCTime
statusStartTime :: Status -> UTCTime
statusStartTime}) = Widget n -> ReaderT CustomExceptionFormatters Identity (Widget n)
forall a. a -> ReaderT CustomExceptionFormatters Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Widget n -> ReaderT CustomExceptionFormatters Identity (Widget n))
-> Widget n
-> ReaderT CustomExceptionFormatters Identity (Widget n)
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
strWrap [i|Started at #{statusStartTime}.|]
  toBrickWidget (Done UTCTime
startTime Maybe UTCTime
setupFinishTime Maybe UTCTime
teardownStartTime UTCTime
endTime Result
Success) = Widget n -> ReaderT CustomExceptionFormatters Identity (Widget n)
forall a. a -> ReaderT CustomExceptionFormatters Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Widget n -> ReaderT CustomExceptionFormatters Identity (Widget n))
-> Widget n
-> ReaderT CustomExceptionFormatters Identity (Widget n)
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
strWrap ([i|Succeeded in #{showTimeDiff startTime endTime}.#{setupTeardownInfo}|])
    where
      Maybe Text
setupInfo :: Maybe T.Text = (\NominalDiffTime
t -> [i|Setup: #{formatNominalDiffTime t}.|]) (NominalDiffTime -> Text) -> Maybe NominalDiffTime -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((UTCTime -> UTCTime -> NominalDiffTime)
-> UTCTime -> UTCTime -> NominalDiffTime
forall a b c. (a -> b -> c) -> b -> a -> c
flip UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
startTime (UTCTime -> NominalDiffTime)
-> Maybe UTCTime -> Maybe NominalDiffTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe UTCTime
setupFinishTime)
      Maybe Text
teardownInfo :: Maybe T.Text = (\NominalDiffTime
t -> [i|Teardown: #{formatNominalDiffTime t}.|]) (NominalDiffTime -> Text) -> Maybe NominalDiffTime -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
endTime (UTCTime -> NominalDiffTime)
-> Maybe UTCTime -> Maybe NominalDiffTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe UTCTime
teardownStartTime)
      setupTeardownInfo :: Text
setupTeardownInfo = case [Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
catMaybes [Maybe Text
setupInfo, Maybe Text
teardownInfo] of
        [] -> Text
""
        [Text]
xs -> Text
" (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
" " [Text]
xs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
  toBrickWidget (Done {statusResult :: Status -> Result
statusResult=(Failure FailureReason
failureReason)}) = FailureReason
-> ReaderT CustomExceptionFormatters Identity (Widget n)
forall n.
FailureReason -> Reader CustomExceptionFormatters (Widget n)
forall a n.
ToBrickWidget a =>
a -> Reader CustomExceptionFormatters (Widget n)
toBrickWidget FailureReason
failureReason
  toBrickWidget (Done {statusResult :: Status -> Result
statusResult=Result
DryRun}) = Widget n -> ReaderT CustomExceptionFormatters Identity (Widget n)
forall a. a -> ReaderT CustomExceptionFormatters Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Widget n -> ReaderT CustomExceptionFormatters Identity (Widget n))
-> Widget n
-> ReaderT CustomExceptionFormatters Identity (Widget n)
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
strWrap String
"Not started due to dry run."
  toBrickWidget (Done {statusResult :: Status -> Result
statusResult=Result
Cancelled}) = Widget n -> ReaderT CustomExceptionFormatters Identity (Widget n)
forall a. a -> ReaderT CustomExceptionFormatters Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Widget n -> ReaderT CustomExceptionFormatters Identity (Widget n))
-> Widget n
-> ReaderT CustomExceptionFormatters Identity (Widget n)
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
strWrap String
"Cancelled."

showTimeDiff :: UTCTime -> UTCTime -> String
showTimeDiff :: UTCTime -> UTCTime -> String
showTimeDiff UTCTime
startTime UTCTime
endTime = NominalDiffTime -> String
formatNominalDiffTime (UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
endTime UTCTime
startTime)

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 (s -> Maybe Value
forall a. Show a => a -> Maybe Value
P.reify s
x1, s -> Maybe Value
forall a. Show a => a -> Maybe Value
P.reify s
x2) of
      (Just Value
v1, Just Value
v2) -> (, ) (Widget n -> Widget n -> (Widget n, Widget n))
-> Reader CustomExceptionFormatters (Widget n)
-> ReaderT
     CustomExceptionFormatters
     Identity
     (Widget n -> (Widget n, Widget n))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Reader CustomExceptionFormatters (Widget n)
forall n. Value -> Reader CustomExceptionFormatters (Widget n)
forall a n.
ToBrickWidget a =>
a -> Reader CustomExceptionFormatters (Widget n)
toBrickWidget Value
v1 ReaderT
  CustomExceptionFormatters
  Identity
  (Widget n -> (Widget n, Widget n))
-> Reader CustomExceptionFormatters (Widget n)
-> ReaderT CustomExceptionFormatters Identity (Widget n, Widget n)
forall a b.
ReaderT CustomExceptionFormatters Identity (a -> b)
-> ReaderT CustomExceptionFormatters Identity a
-> ReaderT CustomExceptionFormatters Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Reader CustomExceptionFormatters (Widget n)
forall n. Value -> Reader CustomExceptionFormatters (Widget n)
forall a n.
ToBrickWidget a =>
a -> Reader CustomExceptionFormatters (Widget n)
toBrickWidget Value
v2
      (Maybe Value, Maybe Value)
_ -> (Widget n, Widget n)
-> ReaderT CustomExceptionFormatters Identity (Widget n, Widget n)
forall a. a -> ReaderT CustomExceptionFormatters Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Widget n
forall n. String -> Widget n
str (s -> String
forall a. Show a => a -> String
show s
x1), String -> Widget n
forall n. String -> Widget n
str (s -> String
forall a. Show a => a -> String
show s
x2))

    Widget n -> Reader CustomExceptionFormatters (Widget n)
forall a. a -> ReaderT CustomExceptionFormatters Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Widget n -> Reader CustomExceptionFormatters (Widget n))
-> Widget n -> Reader CustomExceptionFormatters (Widget n)
forall a b. (a -> b) -> a -> b
$ [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
hBox [
      Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
hLimitPercent Int
50 (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
        Widget n -> Widget n
forall n. Widget n -> Widget n
border (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
          Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
padAll Int
1 (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
            (Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padBottom (Int -> Padding
Pad Int
1) (AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
expectedAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
str String
"Expected:"))
            Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<=>
            Widget n
widget1
      , Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padLeft (Int -> Padding
Pad Int
1) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
          Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
hLimitPercent Int
50 (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
            Widget n -> Widget n
forall n. Widget n -> Widget n
border (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
              Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
padAll Int
1 (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
                (Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padBottom (Int -> Padding
Pad Int
1) (AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
sawAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
str String
"Saw:"))
                Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<=>
                Widget n
widget2
      ]
  toBrickWidget (DidNotExpectButGot Maybe CallStack
_ ShowEqBox
x) = String -> Widget n -> Widget n
forall n. String -> Widget n -> Widget n
boxWithTitle String
"Did not expect:" (Widget n -> Widget n)
-> Reader CustomExceptionFormatters (Widget n)
-> Reader CustomExceptionFormatters (Widget n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ShowEqBox -> Reader CustomExceptionFormatters (Widget n)
forall a n.
Show a =>
a -> Reader CustomExceptionFormatters (Widget n)
reifyWidget ShowEqBox
x)
  toBrickWidget (Pending Maybe CallStack
_ Maybe String
maybeMessage) = Widget n -> Reader CustomExceptionFormatters (Widget n)
forall a. a -> ReaderT CustomExceptionFormatters Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Widget n -> Reader CustomExceptionFormatters (Widget n))
-> Widget n -> Reader CustomExceptionFormatters (Widget n)
forall a b. (a -> b) -> a -> b
$ case Maybe String
maybeMessage of
    Maybe String
Nothing -> AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
pendingAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
str String
"Pending"
    Just String
msg -> [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
hBox [AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
pendingAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
str String
"Pending"
                     , String -> Widget n
forall n. String -> Widget n
str (String
": " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
msg)]
  toBrickWidget (Reason Maybe CallStack
_ String
msg) = Widget n -> Reader CustomExceptionFormatters (Widget n)
forall a. a -> ReaderT CustomExceptionFormatters Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Widget n -> Reader CustomExceptionFormatters (Widget n))
-> Widget n -> Reader CustomExceptionFormatters (Widget n)
forall a b. (a -> b) -> a -> b
$ String -> Widget n -> Widget n
forall n. String -> Widget n -> Widget n
boxWithTitle String
"Failure reason:" (String -> Widget n
forall n. String -> Widget n
strWrap String
msg)
  toBrickWidget (RawImage Maybe CallStack
_ String
_ Image
image) = Widget n -> Reader CustomExceptionFormatters (Widget n)
forall a. a -> ReaderT CustomExceptionFormatters Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Widget n -> Reader CustomExceptionFormatters (Widget n))
-> Widget n -> Reader CustomExceptionFormatters (Widget n)
forall a b. (a -> b) -> a -> b
$ String -> Widget n -> Widget n
forall n. String -> Widget n -> Widget n
boxWithTitle String
"Failure reason:" (Image -> Widget n
forall n. Image -> Widget n
raw Image
image)
  toBrickWidget (ChildrenFailed Maybe CallStack
_ Int
n) = Widget n -> Reader CustomExceptionFormatters (Widget n)
forall a. a -> ReaderT CustomExceptionFormatters Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Widget n -> Reader CustomExceptionFormatters (Widget n))
-> Widget n -> Reader CustomExceptionFormatters (Widget n)
forall a b. (a -> b) -> a -> b
$ String -> Widget n -> Widget n
forall n. String -> Widget n -> Widget n
boxWithTitle [i|Reason: #{n} #{if n == 1 then ("child" :: String) else "children"} failed|] (String -> Widget n
forall n. String -> Widget n
strWrap String
"")
  toBrickWidget (GotException Maybe CallStack
_ Maybe String
maybeMessage e :: SomeExceptionWithEq
e@(SomeExceptionWithEq SomeException
baseException)) = case SomeException -> Maybe FailureReason
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
baseException of
    Just (FailureReason
fr :: FailureReason) -> String -> Widget n -> Widget n
forall n. String -> Widget n -> Widget n
boxWithTitle String
heading (Widget n -> Widget n)
-> Reader CustomExceptionFormatters (Widget n)
-> Reader CustomExceptionFormatters (Widget n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FailureReason -> Reader CustomExceptionFormatters (Widget n)
forall n.
FailureReason -> Reader CustomExceptionFormatters (Widget n)
forall a n.
ToBrickWidget a =>
a -> Reader CustomExceptionFormatters (Widget n)
toBrickWidget FailureReason
fr)
    Maybe FailureReason
Nothing -> do
      CustomExceptionFormatters
customExceptionFormatters <- ReaderT
  CustomExceptionFormatters Identity CustomExceptionFormatters
forall r (m :: * -> *). MonadReader r m => m r
ask
      case [CustomTUIException] -> Maybe CustomTUIException
forall a. [a] -> Maybe a
headMay ([CustomTUIException] -> Maybe CustomTUIException)
-> [CustomTUIException] -> Maybe CustomTUIException
forall a b. (a -> b) -> a -> b
$ [Maybe CustomTUIException] -> [CustomTUIException]
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
_) -> Widget n -> Reader CustomExceptionFormatters (Widget n)
forall a. a -> ReaderT CustomExceptionFormatters Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Widget n -> Reader CustomExceptionFormatters (Widget n))
-> Widget n -> Reader CustomExceptionFormatters (Widget n)
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
strWrap (String -> Widget n) -> String -> Widget n
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
msg
        Just (CustomTUIExceptionBrick forall n. Widget n
widget) -> Widget n -> Reader CustomExceptionFormatters (Widget n)
forall a. a -> ReaderT CustomExceptionFormatters Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Widget n -> Reader CustomExceptionFormatters (Widget n))
-> Widget n -> Reader CustomExceptionFormatters (Widget n)
forall a b. (a -> b) -> a -> b
$ String -> Widget n -> Widget n
forall n. String -> Widget n -> Widget n
boxWithTitle String
heading Widget n
forall n. Widget n
widget
        Maybe CustomTUIException
Nothing -> String -> Widget n -> Widget n
forall n. String -> Widget n -> Widget n
boxWithTitle String
heading (Widget n -> Widget n)
-> Reader CustomExceptionFormatters (Widget n)
-> Reader CustomExceptionFormatters (Widget n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SomeExceptionWithEq -> Reader CustomExceptionFormatters (Widget n)
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) = String -> Widget n -> Widget n
forall n. String -> Widget n -> Widget n
boxWithTitle String
heading (Widget n -> Widget n)
-> Reader CustomExceptionFormatters (Widget n)
-> Reader CustomExceptionFormatters (Widget n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SomeAsyncExceptionWithEq
-> Reader CustomExceptionFormatters (Widget n)
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 SomeException -> Maybe FailureReason
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
baseException of
    Just (FailureReason
fr :: FailureReason) -> String -> Widget n -> Widget n
forall n. String -> Widget n -> Widget n
boxWithTitle String
"Get context exception:" (Widget n -> Widget n)
-> Reader CustomExceptionFormatters (Widget n)
-> Reader CustomExceptionFormatters (Widget n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FailureReason -> Reader CustomExceptionFormatters (Widget n)
forall n.
FailureReason -> Reader CustomExceptionFormatters (Widget n)
forall a n.
ToBrickWidget a =>
a -> Reader CustomExceptionFormatters (Widget n)
toBrickWidget FailureReason
fr)
    Maybe FailureReason
_ -> String -> Widget n -> Widget n
forall n. String -> Widget n -> Widget n
boxWithTitle String
"Get context exception:" (Widget n -> Widget n)
-> Reader CustomExceptionFormatters (Widget n)
-> Reader CustomExceptionFormatters (Widget n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SomeExceptionWithEq -> Reader CustomExceptionFormatters (Widget n)
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 = [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
hBox [
  Widget n -> Widget n
forall n. Widget n -> Widget n
border (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
    Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
padAll Int
1 (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
      (Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padBottom (Int -> Padding
Pad Int
1) (AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
expectedAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
strWrap String
heading))
      Widget n -> Widget n -> Widget n
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 a -> Maybe Value
forall a. Show a => a -> Maybe Value
P.reify a
x of
  Just Value
v -> Value -> Reader CustomExceptionFormatters (Widget n)
forall n. Value -> Reader CustomExceptionFormatters (Widget n)
forall a n.
ToBrickWidget a =>
a -> Reader CustomExceptionFormatters (Widget n)
toBrickWidget Value
v
  Maybe Value
_ -> Widget n -> Reader CustomExceptionFormatters (Widget n)
forall a. a -> ReaderT CustomExceptionFormatters Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Widget n -> Reader CustomExceptionFormatters (Widget n))
-> Widget n -> Reader CustomExceptionFormatters (Widget n)
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
strWrap (a -> String
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) = Widget n -> ReaderT CustomExceptionFormatters Identity (Widget n)
forall a. a -> ReaderT CustomExceptionFormatters Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Widget n -> ReaderT CustomExceptionFormatters Identity (Widget n))
-> Widget n
-> ReaderT CustomExceptionFormatters Identity (Widget n)
forall a b. (a -> b) -> a -> b
$ AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
integerAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
strWrap String
s
  toBrickWidget (Float String
s) = Widget n -> ReaderT CustomExceptionFormatters Identity (Widget n)
forall a. a -> ReaderT CustomExceptionFormatters Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Widget n -> ReaderT CustomExceptionFormatters Identity (Widget n))
-> Widget n
-> ReaderT CustomExceptionFormatters Identity (Widget n)
forall a b. (a -> b) -> a -> b
$ AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
floatAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
strWrap String
s
  toBrickWidget (Char String
s) = Widget n -> ReaderT CustomExceptionFormatters Identity (Widget n)
forall a. a -> ReaderT CustomExceptionFormatters Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Widget n -> ReaderT CustomExceptionFormatters Identity (Widget n))
-> Widget n
-> ReaderT CustomExceptionFormatters Identity (Widget n)
forall a b. (a -> b) -> a -> b
$ AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
charAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
strWrap String
s
  toBrickWidget (String String
s) = Widget n -> ReaderT CustomExceptionFormatters Identity (Widget n)
forall a. a -> ReaderT CustomExceptionFormatters Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Widget n -> ReaderT CustomExceptionFormatters Identity (Widget n))
-> Widget n
-> ReaderT CustomExceptionFormatters Identity (Widget n)
forall a b. (a -> b) -> a -> b
$ AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
stringAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
strWrap String
s
#if MIN_VERSION_pretty_show(1,10,0)
  toBrickWidget (Date String
s) = Widget n -> ReaderT CustomExceptionFormatters Identity (Widget n)
forall a. a -> ReaderT CustomExceptionFormatters Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Widget n -> ReaderT CustomExceptionFormatters Identity (Widget n))
-> Widget n
-> ReaderT CustomExceptionFormatters Identity (Widget n)
forall a b. (a -> b) -> a -> b
$ AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
dateAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
strWrap String
s
  toBrickWidget (Time String
s) = Widget n -> ReaderT CustomExceptionFormatters Identity (Widget n)
forall a. a -> ReaderT CustomExceptionFormatters Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Widget n -> ReaderT CustomExceptionFormatters Identity (Widget n))
-> Widget n
-> ReaderT CustomExceptionFormatters Identity (Widget n)
forall a b. (a -> b) -> a -> b
$ AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
timeAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
strWrap String
s
  toBrickWidget (Quote String
s) = Widget n -> ReaderT CustomExceptionFormatters Identity (Widget n)
forall a. a -> ReaderT CustomExceptionFormatters Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Widget n -> ReaderT CustomExceptionFormatters Identity (Widget n))
-> Widget n
-> ReaderT CustomExceptionFormatters Identity (Widget n)
forall a b. (a -> b) -> a -> b
$ AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
quoteAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
strWrap String
s
#endif
  toBrickWidget (Ratio Value
v1 Value
v2) = do
    Widget n
w1 <- Value -> ReaderT CustomExceptionFormatters Identity (Widget n)
forall n. Value -> Reader CustomExceptionFormatters (Widget n)
forall a n.
ToBrickWidget a =>
a -> Reader CustomExceptionFormatters (Widget n)
toBrickWidget Value
v1
    Widget n
w2 <- Value -> ReaderT CustomExceptionFormatters Identity (Widget n)
forall n. Value -> Reader CustomExceptionFormatters (Widget n)
forall a n.
ToBrickWidget a =>
a -> Reader CustomExceptionFormatters (Widget n)
toBrickWidget Value
v2
    Widget n -> ReaderT CustomExceptionFormatters Identity (Widget n)
forall a. a -> ReaderT CustomExceptionFormatters Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Widget n -> ReaderT CustomExceptionFormatters Identity (Widget n))
-> Widget n
-> ReaderT CustomExceptionFormatters Identity (Widget n)
forall a b. (a -> b) -> a -> b
$ [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
hBox [Widget n
w1, AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
slashAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
str String
"/", Widget n
w2]
  toBrickWidget (Neg Value
v) = do
    Widget n
w <- Value -> ReaderT CustomExceptionFormatters Identity (Widget n)
forall n. Value -> Reader CustomExceptionFormatters (Widget n)
forall a n.
ToBrickWidget a =>
a -> Reader CustomExceptionFormatters (Widget n)
toBrickWidget Value
v
    Widget n -> ReaderT CustomExceptionFormatters Identity (Widget n)
forall a. a -> ReaderT CustomExceptionFormatters Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Widget n -> ReaderT CustomExceptionFormatters Identity (Widget n))
-> Widget n
-> ReaderT CustomExceptionFormatters Identity (Widget n)
forall a b. (a -> b) -> a -> b
$ [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
hBox [AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
negAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
str String
"-", Widget n
w]
  toBrickWidget (List [Value]
vs) = do
    [Widget n]
listRows <- [Value] -> Reader CustomExceptionFormatters [Widget n]
forall n. [Value] -> Reader CustomExceptionFormatters [Widget n]
abbreviateList [Value]
vs
    Widget n -> ReaderT CustomExceptionFormatters Identity (Widget n)
forall a. a -> ReaderT CustomExceptionFormatters Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Widget n -> ReaderT CustomExceptionFormatters Identity (Widget n))
-> Widget n
-> ReaderT CustomExceptionFormatters Identity (Widget n)
forall a b. (a -> b) -> a -> b
$ [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
vBox ((AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
listBracketAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
str String
"[")
                   Widget n -> [Widget n] -> [Widget n]
forall a. a -> [a] -> [a]
: ((Widget n -> Widget n) -> [Widget n] -> [Widget n]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padLeft (Int -> Padding
Pad Int
4)) [Widget n]
listRows)
                   [Widget n] -> [Widget n] -> [Widget n]
forall a. Semigroup a => a -> a -> a
<> [AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
listBracketAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
str String
"]"])
  toBrickWidget (Tuple [Value]
vs) = do
    [Widget n]
tupleRows <- [Value] -> Reader CustomExceptionFormatters [Widget n]
forall n. [Value] -> Reader CustomExceptionFormatters [Widget n]
abbreviateList [Value]
vs
    Widget n -> ReaderT CustomExceptionFormatters Identity (Widget n)
forall a. a -> ReaderT CustomExceptionFormatters Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Widget n -> ReaderT CustomExceptionFormatters Identity (Widget n))
-> Widget n
-> ReaderT CustomExceptionFormatters Identity (Widget n)
forall a b. (a -> b) -> a -> b
$ [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
vBox ((AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
tupleBracketAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
str String
"(")
                   Widget n -> [Widget n] -> [Widget n]
forall a. a -> [a] -> [a]
: ((Widget n -> Widget n) -> [Widget n] -> [Widget n]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padLeft (Int -> Padding
Pad Int
4)) [Widget n]
tupleRows)
                   [Widget n] -> [Widget n] -> [Widget n]
forall a. Semigroup a => a -> a -> a
<> [AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
tupleBracketAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
str String
")"])
  toBrickWidget (Rec String
recordName [(String, Value)]
tuples) = do
    [Widget n]
recordRows <- ((String, Value)
 -> ReaderT CustomExceptionFormatters Identity (Widget n))
-> [(String, Value)] -> Reader CustomExceptionFormatters [Widget n]
forall (m :: * -> *) a n.
Monad m =>
(a -> m (Widget n)) -> [a] -> m [Widget n]
abbreviateList' (String, Value)
-> ReaderT CustomExceptionFormatters Identity (Widget n)
forall {a} {n}.
ToBrickWidget a =>
(String, a)
-> ReaderT CustomExceptionFormatters Identity (Widget n)
tupleToWidget [(String, Value)]
tuples
    Widget n -> ReaderT CustomExceptionFormatters Identity (Widget n)
forall a. a -> ReaderT CustomExceptionFormatters Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Widget n -> ReaderT CustomExceptionFormatters Identity (Widget n))
-> Widget n
-> ReaderT CustomExceptionFormatters Identity (Widget n)
forall a b. (a -> b) -> a -> b
$ [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
vBox ([Widget n] -> Widget n
forall n. [Widget n] -> Widget n
hBox [AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
recordNameAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
str String
recordName, AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
braceAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
str String
" {"]
                        Widget n -> [Widget n] -> [Widget n]
forall a. a -> [a] -> [a]
: ((Widget n -> Widget n) -> [Widget n] -> [Widget n]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padLeft (Int -> Padding
Pad Int
4)) [Widget n]
recordRows)
                        [Widget n] -> [Widget n] -> [Widget n]
forall a. Semigroup a => a -> a -> a
<> [AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
braceAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
str String
"}"])
    where
      tupleToWidget :: (String, a)
-> ReaderT CustomExceptionFormatters Identity (Widget n)
tupleToWidget (String
name, a
v) = a -> ReaderT CustomExceptionFormatters Identity (Widget n)
forall n. a -> Reader CustomExceptionFormatters (Widget n)
forall a n.
ToBrickWidget a =>
a -> Reader CustomExceptionFormatters (Widget n)
toBrickWidget a
v ReaderT CustomExceptionFormatters Identity (Widget n)
-> (Widget n
    -> ReaderT CustomExceptionFormatters Identity (Widget n))
-> ReaderT CustomExceptionFormatters Identity (Widget n)
forall a b.
ReaderT CustomExceptionFormatters Identity a
-> (a -> ReaderT CustomExceptionFormatters Identity b)
-> ReaderT CustomExceptionFormatters Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Widget n
w -> Widget n -> ReaderT CustomExceptionFormatters Identity (Widget n)
forall a. a -> ReaderT CustomExceptionFormatters Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Widget n -> ReaderT CustomExceptionFormatters Identity (Widget n))
-> Widget n
-> ReaderT CustomExceptionFormatters Identity (Widget n)
forall a b. (a -> b) -> a -> b
$ [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
hBox [
        AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
fieldNameAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
str String
name
        , String -> Widget n
forall n. String -> Widget n
str String
" = "
        , Widget n
w
        ]
  toBrickWidget (Con String
conName [Value]
vs) = do
   [Widget n]
constructorRows <- [Value] -> Reader CustomExceptionFormatters [Widget n]
forall n. [Value] -> Reader CustomExceptionFormatters [Widget n]
abbreviateList [Value]
vs
   Widget n -> ReaderT CustomExceptionFormatters Identity (Widget n)
forall a. a -> ReaderT CustomExceptionFormatters Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Widget n -> ReaderT CustomExceptionFormatters Identity (Widget n))
-> Widget n
-> ReaderT CustomExceptionFormatters Identity (Widget n)
forall a b. (a -> b) -> a -> b
$ [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
vBox ((AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
constructorNameAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
str String
conName)
                  Widget n -> [Widget n] -> [Widget n]
forall a. a -> [a] -> [a]
: ((Widget n -> Widget n) -> [Widget n] -> [Widget n]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Padding -> Widget n -> Widget n
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 <- ((String, Value)
 -> ReaderT CustomExceptionFormatters Identity (Widget n))
-> [(String, Value)] -> Reader CustomExceptionFormatters [Widget n]
forall (m :: * -> *) a n.
Monad m =>
(a -> m (Widget n)) -> [a] -> m [Widget n]
abbreviateList' (String, Value)
-> ReaderT CustomExceptionFormatters Identity (Widget n)
forall {a} {n}.
ToBrickWidget a =>
(String, a)
-> ReaderT CustomExceptionFormatters Identity (Widget n)
tupleToWidget [(String, Value)]
tuples
    Widget n
op <- Value -> ReaderT CustomExceptionFormatters Identity (Widget n)
forall n. Value -> Reader CustomExceptionFormatters (Widget n)
forall a n.
ToBrickWidget a =>
a -> Reader CustomExceptionFormatters (Widget n)
toBrickWidget Value
opValue
    Widget n -> ReaderT CustomExceptionFormatters Identity (Widget n)
forall a. a -> ReaderT CustomExceptionFormatters Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Widget n -> ReaderT CustomExceptionFormatters Identity (Widget n))
-> Widget n
-> ReaderT CustomExceptionFormatters Identity (Widget n)
forall a b. (a -> b) -> a -> b
$ [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
vBox ([Widget n] -> [[Widget n]] -> [Widget n]
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) = a -> ReaderT CustomExceptionFormatters Identity (Widget n)
forall n. a -> Reader CustomExceptionFormatters (Widget n)
forall a n.
ToBrickWidget a =>
a -> Reader CustomExceptionFormatters (Widget n)
toBrickWidget a
v ReaderT CustomExceptionFormatters Identity (Widget n)
-> (Widget n
    -> ReaderT CustomExceptionFormatters Identity (Widget n))
-> ReaderT CustomExceptionFormatters Identity (Widget n)
forall a b.
ReaderT CustomExceptionFormatters Identity a
-> (a -> ReaderT CustomExceptionFormatters Identity b)
-> ReaderT CustomExceptionFormatters Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Widget n
w -> Widget n -> ReaderT CustomExceptionFormatters Identity (Widget n)
forall a. a -> ReaderT CustomExceptionFormatters Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Widget n -> ReaderT CustomExceptionFormatters Identity (Widget n))
-> Widget n
-> ReaderT CustomExceptionFormatters Identity (Widget n)
forall a b. (a -> b) -> a -> b
$ [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
hBox [
        AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
fieldNameAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
str String
name
        , String -> Widget n
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 = (Value -> ReaderT CustomExceptionFormatters Identity (Widget n))
-> [Value] -> ReaderT CustomExceptionFormatters Identity [Widget n]
forall (m :: * -> *) a n.
Monad m =>
(a -> m (Widget n)) -> [a] -> m [Widget n]
abbreviateList' Value -> ReaderT CustomExceptionFormatters Identity (Widget n)
forall n. Value -> Reader CustomExceptionFormatters (Widget n)
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 | [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
vs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
10 = (a -> m (Widget n)) -> [a] -> m [Widget n]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM a -> m (Widget n)
f [a]
vs
abbreviateList' a -> m (Widget n)
f [a]
vs = do
  [Widget n]
initial <- (a -> m (Widget n)) -> [a] -> m [Widget n]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM a -> m (Widget n)
f (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
L.take Int
3 [a]
vs)
  [Widget n]
final <- (a -> m (Widget n)) -> [a] -> m [Widget n]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM a -> m (Widget n)
f (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
takeEnd Int
3 [a]
vs)
  [Widget n] -> m [Widget n]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Widget n] -> m [Widget n]) -> [Widget n] -> m [Widget n]
forall a b. (a -> b) -> a -> b
$ [Widget n]
initial [Widget n] -> [Widget n] -> [Widget n]
forall a. Semigroup a => a -> a -> a
<> [AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
ellipsesAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
str String
"..."] [Widget n] -> [Widget n] -> [Widget n]
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 = [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
vBox ([Widget n] -> Widget n)
-> ReaderT CustomExceptionFormatters Identity [Widget n]
-> ReaderT CustomExceptionFormatters Identity (Widget n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (((String, SrcLoc)
 -> ReaderT CustomExceptionFormatters Identity (Widget n))
-> [(String, SrcLoc)]
-> ReaderT CustomExceptionFormatters Identity [Widget n]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (String, SrcLoc)
-> ReaderT CustomExceptionFormatters Identity (Widget n)
forall {a} {n}.
ToBrickWidget a =>
(String, a)
-> ReaderT CustomExceptionFormatters Identity (Widget n)
renderLine ([(String, SrcLoc)]
 -> ReaderT CustomExceptionFormatters Identity [Widget n])
-> [(String, SrcLoc)]
-> ReaderT CustomExceptionFormatters Identity [Widget n]
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) = a -> ReaderT CustomExceptionFormatters Identity (Widget n)
forall n. a -> Reader CustomExceptionFormatters (Widget n)
forall a n.
ToBrickWidget a =>
a -> Reader CustomExceptionFormatters (Widget n)
toBrickWidget a
srcLoc ReaderT CustomExceptionFormatters Identity (Widget n)
-> (Widget n
    -> ReaderT CustomExceptionFormatters Identity (Widget n))
-> ReaderT CustomExceptionFormatters Identity (Widget n)
forall a b.
ReaderT CustomExceptionFormatters Identity a
-> (a -> ReaderT CustomExceptionFormatters Identity b)
-> ReaderT CustomExceptionFormatters Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Widget n
w -> Widget n -> ReaderT CustomExceptionFormatters Identity (Widget n)
forall a. a -> ReaderT CustomExceptionFormatters Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Widget n -> ReaderT CustomExceptionFormatters Identity (Widget n))
-> Widget n
-> ReaderT CustomExceptionFormatters Identity (Widget n)
forall a b. (a -> b) -> a -> b
$ [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
hBox [
        AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
logFunctionAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
str String
f
        , String -> Widget n
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
srcLocPackage :: String
srcLocModule :: String
srcLocFile :: String
srcLocStartLine :: Int
srcLocStartCol :: Int
srcLocEndLine :: Int
srcLocEndCol :: Int
srcLocPackage :: SrcLoc -> String
srcLocModule :: SrcLoc -> String
srcLocFile :: SrcLoc -> String
srcLocStartLine :: SrcLoc -> Int
srcLocStartCol :: SrcLoc -> Int
srcLocEndLine :: SrcLoc -> Int
srcLocEndCol :: SrcLoc -> Int
..}) = Widget n -> ReaderT CustomExceptionFormatters Identity (Widget n)
forall a. a -> ReaderT CustomExceptionFormatters Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Widget n -> ReaderT CustomExceptionFormatters Identity (Widget n))
-> Widget n
-> ReaderT CustomExceptionFormatters Identity (Widget n)
forall a b. (a -> b) -> a -> b
$ [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
hBox [
    AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
logFilenameAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
str String
srcLocFile
    , String -> Widget n
forall n. String -> Widget n
str String
":"
    , AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
logLineAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
str (String -> Widget n) -> String -> Widget n
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
srcLocStartLine
    , String -> Widget n
forall n. String -> Widget n
str String
":"
    , AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
logChAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
str (String -> Widget n) -> String -> Widget n
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
srcLocStartCol
    , String -> Widget n
forall n. String -> Widget n
str String
" in "
    , AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
logPackageAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
str String
srcLocPackage
    , String -> Widget n
forall n. String -> Widget n
str String
":"
    , String -> Widget n
forall n. String -> Widget n
str String
srcLocModule
    ]

-- * Util

takeEnd :: Int -> [a] -> [a]
takeEnd :: forall a. Int -> [a] -> [a]
takeEnd Int
j [a]
xs = [a] -> [a] -> [a]
forall {a} {a}. [a] -> [a] -> [a]
f [a]
xs (Int -> [a] -> [a]
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