{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}

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

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


class ToBrickWidget a where
  toBrickWidget :: a -> Widget n

instance ToBrickWidget Status where
  toBrickWidget :: Status -> Widget n
toBrickWidget (NotStarted {}) = String -> Widget n
forall n. String -> Widget n
strWrap String
"Not started"
  toBrickWidget (Running {UTCTime
statusStartTime :: Status -> UTCTime
statusStartTime :: UTCTime
statusStartTime}) = String -> Widget n
forall n. String -> Widget n
strWrap [i|Started at #{statusStartTime}|]
  toBrickWidget (Done UTCTime
startTime UTCTime
endTime Result
Success) = String -> Widget n
forall n. String -> Widget n
strWrap [i|Succeeded in #{formatNominalDiffTime (diffUTCTime endTime startTime)}|]
  toBrickWidget (Done {statusResult :: Status -> Result
statusResult=(Failure FailureReason
failureReason)}) = FailureReason -> Widget n
forall a n. ToBrickWidget a => a -> Widget n
toBrickWidget FailureReason
failureReason

instance ToBrickWidget FailureReason where
  toBrickWidget :: FailureReason -> Widget n
toBrickWidget (ExpectedButGot Maybe CallStack
_ (SEB s
x1) (SEB s
x2)) = [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
forall 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
forall n. Widget n
widget2
    ]
    where
      (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) -> (Value -> Widget n
forall a n. ToBrickWidget a => a -> Widget n
toBrickWidget Value
v1, Value -> Widget n
forall a n. ToBrickWidget a => a -> Widget n
toBrickWidget Value
v2)
        (Maybe Value, Maybe Value)
_ -> (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))
  toBrickWidget (DidNotExpectButGot Maybe CallStack
_ ShowEqBox
x) = String -> Widget n -> Widget n
forall n. String -> Widget n -> Widget n
boxWithTitle String
"Did not expect:" (ShowEqBox -> Widget n
forall a n. Show a => a -> Widget n
reifyWidget ShowEqBox
x)
  toBrickWidget (Pending Maybe CallStack
_ Maybe String
maybeMessage) = 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) = 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 (ChildrenFailed Maybe CallStack
_ Int
n) = 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 (FailureReason -> Widget n
forall a n. ToBrickWidget a => a -> Widget n
toBrickWidget FailureReason
fr)
    Maybe FailureReason
_ -> String -> Widget n -> Widget n
forall n. String -> Widget n -> Widget n
boxWithTitle String
heading (SomeExceptionWithEq -> Widget n
forall a n. Show a => a -> 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 (SomeAsyncExceptionWithEq -> Widget n
forall a n. Show a => a -> 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:" (FailureReason -> Widget n
forall a n. ToBrickWidget a => a -> Widget n
toBrickWidget FailureReason
fr)
    Maybe FailureReason
_ -> String -> Widget n -> Widget n
forall n. String -> Widget n -> Widget n
boxWithTitle String
"Get context exception:" (SomeExceptionWithEq -> Widget n
forall a n. Show a => a -> Widget n
reifyWidget SomeExceptionWithEq
e)


boxWithTitle :: String -> Widget n -> Widget n
boxWithTitle :: 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 :: a -> 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 -> Widget n
forall a n. ToBrickWidget a => a -> Widget n
toBrickWidget Value
v
  Maybe Value
_ -> 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 :: Value -> Widget n
toBrickWidget (Integer String
s) = 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) = 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) = 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) = 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) = 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) = 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) = 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) = [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
hBox [Value -> Widget n
forall a n. ToBrickWidget a => a -> Widget n
toBrickWidget Value
v1, 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
"/", Value -> Widget n
forall a n. ToBrickWidget a => a -> Widget n
toBrickWidget Value
v2]
  toBrickWidget (Neg Value
v) = [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
"-"
                               , Value -> Widget n
forall a n. ToBrickWidget a => a -> Widget n
toBrickWidget Value
v]
  toBrickWidget (List [Value]
vs) = [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 (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]
forall n. [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
"]"])
    where listRows :: [Widget n]
listRows
            | [Value] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Value]
vs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
10 = (Value -> Widget n) -> [Value] -> [Widget n]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> Widget n
forall a n. ToBrickWidget a => a -> Widget n
toBrickWidget [Value]
vs
            | Bool
otherwise = ((Value -> Widget n) -> [Value] -> [Widget n]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> Widget n
forall a n. ToBrickWidget a => a -> Widget n
toBrickWidget (Int -> [Value] -> [Value]
forall a. Int -> [a] -> [a]
L.take Int
3 [Value]
vs))
                          [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
<> ((Value -> Widget n) -> [Value] -> [Widget n]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> Widget n
forall a n. ToBrickWidget a => a -> Widget n
toBrickWidget (Int -> [Value] -> [Value]
forall a. Int -> [a] -> [a]
takeEnd Int
3 [Value]
vs))
  toBrickWidget (Tuple [Value]
vs) = [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 (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]
forall n. [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
")"])
    where tupleRows :: [Widget n]
tupleRows
            | [Value] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Value]
vs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
10 = (Value -> Widget n) -> [Value] -> [Widget n]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> Widget n
forall a n. ToBrickWidget a => a -> Widget n
toBrickWidget [Value]
vs
            | Bool
otherwise = ((Value -> Widget n) -> [Value] -> [Widget n]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> Widget n
forall a n. ToBrickWidget a => a -> Widget n
toBrickWidget (Int -> [Value] -> [Value]
forall a. Int -> [a] -> [a]
L.take Int
3 [Value]
vs))
                          [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
<> ((Value -> Widget n) -> [Value] -> [Widget n]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> Widget n
forall a n. ToBrickWidget a => a -> Widget n
toBrickWidget (Int -> [Value] -> [Value]
forall a. Int -> [a] -> [a]
takeEnd Int
3 [Value]
vs))
  toBrickWidget (Rec String
recordName [(String, Value)]
tuples) = [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 (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]
forall n. [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 recordRows :: [Widget n]
recordRows
            | [(String, Value)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(String, Value)]
tuples Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
10 = ((String, Value) -> Widget n) -> [(String, Value)] -> [Widget n]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String, Value) -> Widget n
forall a n. ToBrickWidget a => (String, a) -> Widget n
tupleToWidget [(String, Value)]
tuples
            | Bool
otherwise = (((String, Value) -> Widget n) -> [(String, Value)] -> [Widget n]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String, Value) -> Widget n
forall a n. ToBrickWidget a => (String, a) -> Widget n
tupleToWidget (Int -> [(String, Value)] -> [(String, Value)]
forall a. Int -> [a] -> [a]
L.take Int
3 [(String, Value)]
tuples))
                          [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
<> (((String, Value) -> Widget n) -> [(String, Value)] -> [Widget n]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String, Value) -> Widget n
forall a n. ToBrickWidget a => (String, a) -> Widget n
tupleToWidget (Int -> [(String, Value)] -> [(String, Value)]
forall a. Int -> [a] -> [a]
takeEnd Int
3 [(String, Value)]
tuples))

          tupleToWidget :: (String, a) -> Widget n
tupleToWidget (String
name, a
v) = [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
" = "
                                         , a -> Widget n
forall a n. ToBrickWidget a => a -> Widget n
toBrickWidget a
v]
  toBrickWidget (Con String
conName [Value]
vs) = [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 (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]
forall n. [Widget n]
constructorRows))
    where constructorRows :: [Widget n]
constructorRows
            | [Value] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Value]
vs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
10 = (Value -> Widget n) -> [Value] -> [Widget n]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> Widget n
forall a n. ToBrickWidget a => a -> Widget n
toBrickWidget [Value]
vs
            | Bool
otherwise = ((Value -> Widget n) -> [Value] -> [Widget n]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> Widget n
forall a n. ToBrickWidget a => a -> Widget n
toBrickWidget (Int -> [Value] -> [Value]
forall a. Int -> [a] -> [a]
L.take Int
3 [Value]
vs))
                          [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
<> ((Value -> Widget n) -> [Value] -> [Widget n]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> Widget n
forall a n. ToBrickWidget a => a -> Widget n
toBrickWidget (Int -> [Value] -> [Value]
forall a. Int -> [a] -> [a]
takeEnd Int
3 [Value]
vs))

  toBrickWidget (InfixCons Value
opValue [(String, Value)]
tuples) = [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
vBox ([Widget n] -> [[Widget n]] -> [Widget n]
forall a. [a] -> [[a]] -> [a]
L.intercalate [Value -> Widget n
forall a n. ToBrickWidget a => a -> Widget n
toBrickWidget Value
opValue] [[Widget n
x] | Widget n
x <- [Widget n]
forall n. [Widget n]
rows])
    where rows :: [Widget n]
rows
            | [(String, Value)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(String, Value)]
tuples Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
10 = ((String, Value) -> Widget n) -> [(String, Value)] -> [Widget n]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String, Value) -> Widget n
forall a n. ToBrickWidget a => (String, a) -> Widget n
tupleToWidget [(String, Value)]
tuples
            | Bool
otherwise = (((String, Value) -> Widget n) -> [(String, Value)] -> [Widget n]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String, Value) -> Widget n
forall a n. ToBrickWidget a => (String, a) -> Widget n
tupleToWidget (Int -> [(String, Value)] -> [(String, Value)]
forall a. Int -> [a] -> [a]
L.take Int
3 [(String, Value)]
tuples))
                          [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
<> (((String, Value) -> Widget n) -> [(String, Value)] -> [Widget n]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String, Value) -> Widget n
forall a n. ToBrickWidget a => (String, a) -> Widget n
tupleToWidget (Int -> [(String, Value)] -> [(String, Value)]
forall a. Int -> [a] -> [a]
takeEnd Int
3 [(String, Value)]
tuples))

          tupleToWidget :: (String, a) -> Widget n
tupleToWidget (String
name, a
v) = [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
" = "
                                         , a -> Widget n
forall a n. ToBrickWidget a => a -> Widget n
toBrickWidget a
v]

instance ToBrickWidget CallStack where
  toBrickWidget :: CallStack -> Widget n
toBrickWidget CallStack
cs = [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
vBox (((String, SrcLoc) -> Widget n) -> [(String, SrcLoc)] -> [Widget n]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String, SrcLoc) -> Widget n
forall a n. ToBrickWidget a => (String, a) -> Widget n
renderLine ([(String, SrcLoc)] -> [Widget n])
-> [(String, SrcLoc)] -> [Widget n]
forall a b. (a -> b) -> a -> b
$ CallStack -> [(String, SrcLoc)]
getCallStack CallStack
cs)
    where
      renderLine :: (String, a) -> Widget n
renderLine (String
f, a
srcLoc) = [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 "
        , a -> Widget n
forall a n. ToBrickWidget a => a -> Widget n
toBrickWidget a
srcLoc
        ]

instance ToBrickWidget SrcLoc where
  toBrickWidget :: SrcLoc -> Widget n
toBrickWidget (SrcLoc {Int
String
srcLocPackage :: SrcLoc -> String
srcLocModule :: SrcLoc -> String
srcLocFile :: SrcLoc -> String
srcLocStartLine :: SrcLoc -> Int
srcLocStartCol :: SrcLoc -> Int
srcLocEndLine :: SrcLoc -> Int
srcLocEndCol :: SrcLoc -> Int
srcLocEndCol :: Int
srcLocEndLine :: Int
srcLocStartCol :: Int
srcLocStartLine :: Int
srcLocFile :: String
srcLocModule :: String
srcLocPackage :: String
..}) = [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 :: 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