-- | Pretty shared types

{-# LANGUAGE OverloadedStrings #-}

module Blockfrost.Pretty.Shared
  ( prettyBlockHash
  , prettyEpoch
  , prettySlot
  ) where

import Blockfrost.Types
import Prettyprinter
import Prettyprinter.Render.Terminal

-- | Pretty print `BlockHash`
prettyBlockHash :: BlockHash -> Doc AnsiStyle
prettyBlockHash :: BlockHash -> Doc AnsiStyle
prettyBlockHash (BlockHash Text
bh) =
  AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
color Color
Yellow) (Doc AnsiStyle
"#" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty Text
bh)

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

-- | Pretty print `Slot`
prettySlot :: Slot -> Doc AnsiStyle
prettySlot :: Slot -> Doc AnsiStyle
prettySlot =
  AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
color Color
Cyan) (Doc AnsiStyle -> Doc AnsiStyle)
-> (Slot -> Doc AnsiStyle) -> Slot -> 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)
-> (Slot -> Integer) -> Slot -> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Slot -> Integer
unSlot

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

-- | Pretty print `Epoch`
prettyEpoch :: Epoch -> Doc AnsiStyle
prettyEpoch :: Epoch -> Doc AnsiStyle
prettyEpoch =
  AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
color Color
Green) (Doc AnsiStyle -> Doc AnsiStyle)
-> (Epoch -> Doc AnsiStyle) -> Epoch -> 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)
-> (Epoch -> Integer) -> Epoch -> Doc AnsiStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Epoch -> Integer
unEpoch

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