-- | Pretty POSIXTime

{-# LANGUAGE TypeSynonymInstances #-}

module Blockfrost.Pretty.POSIXTime
  where

import Data.Time
import Data.Time.Clock.POSIX
import Prettyprinter
import Prettyprinter.Render.Terminal

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

-- | Pretty print `POSIXTime` as UTC time
prettyTime :: POSIXTime -> Doc AnsiStyle
prettyTime :: POSIXTime -> Doc AnsiStyle
prettyTime POSIXTime
pt =
  let
    ut :: UTCTime
ut = POSIXTime -> UTCTime
posixSecondsToUTCTime POSIXTime
pt
    ymd :: String
ymd = TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%F" UTCTime
ut
    hms :: String
hms = TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%X" UTCTime
ut
  in
    AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
color Color
Green) (String -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty String
ymd)
    Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+>
    AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
color Color
Blue) (String -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty String
hms)
    Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+>
    String -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty String
"UTC"