-- | Pretty printing Block

{-# LANGUAGE OverloadedStrings #-}

module Blockfrost.Pretty.Block
  ( prettyBlock
  , prettyBlock'
  ) where

import Blockfrost.Lens
import Blockfrost.Pretty.Ada
import Blockfrost.Pretty.Config
import Blockfrost.Pretty.POSIXTime
import Blockfrost.Pretty.Shared
import Blockfrost.Types
import Control.Lens
import Data.Default
import Data.Maybe

import Prettyprinter
import Prettyprinter.Render.Terminal

instance Pretty Block where
  pretty :: Block -> Doc ann
pretty = Doc AnsiStyle -> Doc ann
forall ann xxx. Doc ann -> Doc xxx
unAnnotate (Doc AnsiStyle -> Doc ann)
-> (Block -> Doc AnsiStyle) -> Block -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> Doc AnsiStyle
prettyBlock

-- | Pretty print `Block` with custom `PrettyConfig`
prettyBlock' :: PrettyConfig -> Block -> Doc AnsiStyle
prettyBlock' :: PrettyConfig -> Block -> Doc AnsiStyle
prettyBlock' PrettyConfig
cfg Block
b = [Doc AnsiStyle] -> Doc AnsiStyle
forall ann. [Doc ann] -> Doc ann
vcat ([Doc AnsiStyle] -> Doc AnsiStyle)
-> [Doc AnsiStyle] -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$
  [ AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
color Color
Yellow) (Doc AnsiStyle
"block" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> BlockHash -> Doc AnsiStyle
prettyBlockHash (Block
b Block -> Getting BlockHash Block BlockHash -> BlockHash
forall s a. s -> Getting a s a -> a
^. Getting BlockHash Block BlockHash
forall s a. HasHash s a => Lens' s a
hash))
  , Doc AnsiStyle
"Date:" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> POSIXTime -> Doc AnsiStyle
prettyTime (Block
b Block -> Getting POSIXTime Block POSIXTime -> POSIXTime
forall s a. s -> Getting a s a -> a
^. Getting POSIXTime Block POSIXTime
forall s a. HasTime s a => Lens' s a
time)
  ]
  [Doc AnsiStyle] -> [Doc AnsiStyle] -> [Doc AnsiStyle]
forall a. [a] -> [a] -> [a]
++
  ([Maybe (Doc AnsiStyle)] -> [Doc AnsiStyle]
forall a. [Maybe a] -> [a]
catMaybes
    [
      (Doc AnsiStyle
"Height:"Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+>) (Doc AnsiStyle -> Doc AnsiStyle)
-> (Integer -> Doc AnsiStyle) -> Integer -> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty (Integer -> Doc AnsiStyle)
-> Maybe Integer -> Maybe (Doc AnsiStyle)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Block
b Block
-> Getting (Maybe Integer) Block (Maybe Integer) -> Maybe Integer
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Integer) Block (Maybe Integer)
forall s a. HasHeight s a => Lens' s a
height
    , (Doc AnsiStyle
"Slot:"Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+>) (Doc AnsiStyle -> Doc AnsiStyle)
-> (Slot -> Doc AnsiStyle) -> Slot -> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Slot -> Doc AnsiStyle
prettySlot (Slot -> Doc AnsiStyle) -> Maybe Slot -> Maybe (Doc AnsiStyle)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Block
b Block -> Getting (Maybe Slot) Block (Maybe Slot) -> Maybe Slot
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Slot) Block (Maybe Slot)
forall s a. HasSlot s a => Lens' s a
slot
    , (Doc AnsiStyle
"Epoch:"Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+>) (Doc AnsiStyle -> Doc AnsiStyle)
-> (Epoch -> Doc AnsiStyle) -> Epoch -> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Epoch -> Doc AnsiStyle
prettyEpoch (Epoch -> Doc AnsiStyle) -> Maybe Epoch -> Maybe (Doc AnsiStyle)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Block
b Block -> Getting (Maybe Epoch) Block (Maybe Epoch) -> Maybe Epoch
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Epoch) Block (Maybe Epoch)
forall s a. HasEpoch s a => Lens' s a
epoch
    , (Doc AnsiStyle
"Slot within the epoch:"Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+>) (Doc AnsiStyle -> Doc AnsiStyle)
-> (Integer -> Doc AnsiStyle) -> Integer -> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty (Integer -> Doc AnsiStyle)
-> Maybe Integer -> Maybe (Doc AnsiStyle)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Block
b Block
-> Getting (Maybe Integer) Block (Maybe Integer) -> Maybe Integer
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Integer) Block (Maybe Integer)
forall s a. HasEpochSlot s a => Lens' s a
epochSlot
    , (Doc AnsiStyle
"Fees:" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+>) (Doc AnsiStyle -> Doc AnsiStyle)
-> (Discrete' "ADA" '(1000000, 1) -> Doc AnsiStyle)
-> Discrete' "ADA" '(1000000, 1)
-> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrettyConfig -> Lovelaces -> Doc AnsiStyle
prettyLovelacesDoc' PrettyConfig
cfg (Discrete' "ADA" '(1000000, 1) -> Doc AnsiStyle)
-> Maybe (Discrete' "ADA" '(1000000, 1)) -> Maybe (Doc AnsiStyle)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Block
b Block
-> Getting
     (Maybe (Discrete' "ADA" '(1000000, 1)))
     Block
     (Maybe (Discrete' "ADA" '(1000000, 1)))
-> Maybe (Discrete' "ADA" '(1000000, 1))
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (Discrete' "ADA" '(1000000, 1)))
  Block
  (Maybe (Discrete' "ADA" '(1000000, 1)))
forall s a. HasFees s a => Lens' s a
fees
    , (Doc AnsiStyle
"Output:" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+>) (Doc AnsiStyle -> Doc AnsiStyle)
-> (Discrete' "ADA" '(1000000, 1) -> Doc AnsiStyle)
-> Discrete' "ADA" '(1000000, 1)
-> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrettyConfig -> Lovelaces -> Doc AnsiStyle
prettyLovelacesDoc' PrettyConfig
cfg (Discrete' "ADA" '(1000000, 1) -> Doc AnsiStyle)
-> Maybe (Discrete' "ADA" '(1000000, 1)) -> Maybe (Doc AnsiStyle)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Block
b Block
-> Getting
     (Maybe (Discrete' "ADA" '(1000000, 1)))
     Block
     (Maybe (Discrete' "ADA" '(1000000, 1)))
-> Maybe (Discrete' "ADA" '(1000000, 1))
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (Discrete' "ADA" '(1000000, 1)))
  Block
  (Maybe (Discrete' "ADA" '(1000000, 1)))
forall s a. HasOutput s a => Lens' s a
output
    ]
  )
  [Doc AnsiStyle] -> [Doc AnsiStyle] -> [Doc AnsiStyle]
forall a. [a] -> [a] -> [a]
++
  [ Doc AnsiStyle
"Size:" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Integer -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty (Block
b Block -> Getting Integer Block Integer -> Integer
forall s a. s -> Getting a s a -> a
^. Getting Integer Block Integer
forall s a. HasSize s a => Lens' s a
size)
  , Doc AnsiStyle
"TxCount:" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Integer -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty (Block
b Block -> Getting Integer Block Integer -> Integer
forall s a. s -> Getting a s a -> a
^. Getting Integer Block Integer
forall s a. HasTxCount s a => Lens' s a
txCount)
  , Doc AnsiStyle
"Confirmations:" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Integer -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty (Block
b Block -> Getting Integer Block Integer -> Integer
forall s a. s -> Getting a s a -> a
^. Getting Integer Block Integer
forall s a. HasConfirmations s a => Lens' s a
confirmations)
  , Int -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Int -> Doc ann -> Doc ann
indent Int
4 (Doc AnsiStyle -> Doc AnsiStyle) -> Doc AnsiStyle -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ [Doc AnsiStyle] -> Doc AnsiStyle
forall ann. [Doc ann] -> Doc ann
vsep ([Doc AnsiStyle] -> Doc AnsiStyle)
-> [Doc AnsiStyle] -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ [Maybe (Doc AnsiStyle)] -> [Doc AnsiStyle]
forall a. [Maybe a] -> [a]
catMaybes
    [ (Doc AnsiStyle
"VRF:" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ) (Doc AnsiStyle -> Doc AnsiStyle)
-> (Text -> Doc AnsiStyle) -> Text -> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty (Text -> Doc AnsiStyle) -> Maybe Text -> Maybe (Doc AnsiStyle)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Block
b Block -> Getting (Maybe Text) Block (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Text) Block (Maybe Text)
forall s a. HasBlockVrf s a => Lens' s a
blockVrf
    , (Doc AnsiStyle
"Previous block:" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ) (Doc AnsiStyle -> Doc AnsiStyle)
-> (BlockHash -> Doc AnsiStyle) -> BlockHash -> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockHash -> Doc AnsiStyle
prettyBlockHash (BlockHash -> Doc AnsiStyle)
-> Maybe BlockHash -> Maybe (Doc AnsiStyle)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Block
b Block
-> Getting (Maybe BlockHash) Block (Maybe BlockHash)
-> Maybe BlockHash
forall s a. s -> Getting a s a -> a
^. Getting (Maybe BlockHash) Block (Maybe BlockHash)
forall s a. HasPreviousBlock s a => Lens' s a
previousBlock
    , (Doc AnsiStyle
"Next block:" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ) (Doc AnsiStyle -> Doc AnsiStyle)
-> (BlockHash -> Doc AnsiStyle) -> BlockHash -> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockHash -> Doc AnsiStyle
prettyBlockHash (BlockHash -> Doc AnsiStyle)
-> Maybe BlockHash -> Maybe (Doc AnsiStyle)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Block
b Block
-> Getting (Maybe BlockHash) Block (Maybe BlockHash)
-> Maybe BlockHash
forall s a. s -> Getting a s a -> a
^. Getting (Maybe BlockHash) Block (Maybe BlockHash)
forall s a. HasNextBlock s a => Lens' s a
nextBlock
    ]
  ]

-- | Pretty print `Block` using default `PrettyConfig`
prettyBlock :: Block -> Doc AnsiStyle
prettyBlock :: Block -> Doc AnsiStyle
prettyBlock = PrettyConfig -> Block -> Doc AnsiStyle
prettyBlock' PrettyConfig
forall a. Default a => a
def