{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UnicodeSyntax #-}

module Imm.Pretty (module Imm.Pretty, module X) where

-- {{{ Imports
import qualified Data.Text as Text
import Data.Time
import Data.Tree
import Data.XML.Types as XML
import Prettyprinter (list)
import Prettyprinter as X hiding (list, width)
import Prettyprinter.Render.Terminal
import Prettyprinter.Render.Terminal as X (AnsiStyle)
import qualified Prettyprinter.Render.Terminal as Pretty
import Refined
import Text.Atom.Types as Atom
import Text.RSS.Types as RSS
import URI.ByteString

-- }}}

-- | Newtype wrapper to prettyprint a key uniquely identifying an object
newtype PrettyKey a = PrettyKey a

prettyKey ∷ Pretty (PrettyKey a) ⇒ a → Doc b
prettyKey :: forall a b. Pretty (PrettyKey a) => a -> Doc b
prettyKey = PrettyKey a -> Doc b
forall a ann. Pretty a => a -> Doc ann
forall ann. PrettyKey a -> Doc ann
pretty (PrettyKey a -> Doc b) -> (a -> PrettyKey a) -> a -> Doc b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> PrettyKey a
forall a. a -> PrettyKey a
PrettyKey

-- | Newtype wrapper to prettyprint a user-friendly name referring to an object
newtype PrettyName a = PrettyName a

prettyName ∷ Pretty (PrettyName a) ⇒ a → Doc b
prettyName :: forall a b. Pretty (PrettyName a) => a -> Doc b
prettyName = PrettyName a -> Doc b
forall a ann. Pretty a => a -> Doc ann
forall ann. PrettyName a -> Doc ann
pretty (PrettyName a -> Doc b) -> (a -> PrettyName a) -> a -> Doc b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> PrettyName a
forall a. a -> PrettyName a
PrettyName

-- | Newtype wrapper to prettyprint a short description of an object
newtype PrettyShort a = PrettyShort a

prettyShort ∷ Pretty (PrettyShort a) ⇒ a → Doc b
prettyShort :: forall a b. Pretty (PrettyShort a) => a -> Doc b
prettyShort = PrettyShort a -> Doc b
forall a ann. Pretty a => a -> Doc ann
forall ann. PrettyShort a -> Doc ann
pretty (PrettyShort a -> Doc b) -> (a -> PrettyShort a) -> a -> Doc b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> PrettyShort a
forall a. a -> PrettyShort a
PrettyShort

-- | Infix operator for 'line'
(<++>) ∷ Doc a → Doc a → Doc a
Doc a
x <++> :: forall a. Doc a -> Doc a -> Doc a
<++> Doc a
y = Doc a
x Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
forall ann. Doc ann
line Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
y

prettyTree ∷ Pretty a ⇒ Tree a → Doc b
prettyTree :: forall a b. Pretty a => Tree a -> Doc b
prettyTree (Node a
n [Tree a]
s) = a -> Doc b
forall ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
n Doc b -> Doc b -> Doc b
forall a. Doc a -> Doc a -> Doc a
<++> Int -> Doc b -> Doc b
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 ([Doc b] -> Doc b
forall ann. [Doc ann] -> Doc ann
vsep ([Doc b] -> Doc b) -> [Doc b] -> Doc b
forall a b. (a -> b) -> a -> b
$ Tree a -> Doc b
forall a b. Pretty a => Tree a -> Doc b
prettyTree (Tree a -> Doc b) -> [Tree a] -> [Doc b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Tree a]
s)

prettyTime ∷ UTCTime → Doc a
prettyTime :: forall a. UTCTime -> Doc a
prettyTime = String -> Doc a
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (String -> Doc a) -> (UTCTime -> String) -> UTCTime -> Doc a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%F %T"

prettyPerson ∷ AtomPerson → Doc a
prettyPerson :: forall a. AtomPerson -> Doc a
prettyPerson AtomPerson
p = Text -> Doc a
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Refined (Not Null) Text -> Text
forall {k} (p :: k) x. Refined p x -> x
unrefine (Refined (Not Null) Text -> Text)
-> Refined (Not Null) Text -> Text
forall a b. (a -> b) -> a -> b
$ AtomPerson -> Refined (Not Null) Text
personName AtomPerson
p) Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
forall ann. Doc ann
email
 where
  email :: Doc ann
email =
    if Text -> Bool
Text.null (Text -> Bool) -> Text -> Bool
forall a b. (a -> b) -> a -> b
$ AtomPerson -> Text
personEmail AtomPerson
p
      then Doc ann
forall a. Monoid a => a
mempty
      else Doc ann
forall ann. Doc ann
space Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
angles (Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Text -> Doc ann) -> Text -> Doc ann
forall a b. (a -> b) -> a -> b
$ AtomPerson -> Text
personEmail AtomPerson
p)

prettyLink ∷ AtomLink → Doc a
prettyLink :: forall a. AtomLink -> Doc a
prettyLink AtomLink
l = (forall a. URIRef a -> Doc a) -> AtomURI -> Doc a
forall b. (forall a. URIRef a -> b) -> AtomURI -> b
withAtomURI URIRef a -> Doc a
forall a. URIRef a -> Doc a
forall a b. URIRef a -> Doc b
prettyURI (AtomURI -> Doc a) -> AtomURI -> Doc a
forall a b. (a -> b) -> a -> b
$ AtomLink -> AtomURI
linkHref AtomLink
l

prettyAtomText ∷ AtomText → Doc a
prettyAtomText :: forall a. AtomText -> Doc a
prettyAtomText (AtomPlainText TextType
_ Text
t) = Text -> Doc a
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
t
prettyAtomText (AtomXHTMLText Element
element) = Element -> Doc a
forall a. Element -> Doc a
prettyElement Element
element

prettyElement ∷ Element → Doc a
prettyElement :: forall a. Element -> Doc a
prettyElement (Element Name
_ [(Name, [Content])]
_ [Node]
nodes) = [Doc a] -> Doc a
forall a. Monoid a => [a] -> a
mconcat ([Doc a] -> Doc a) -> [Doc a] -> Doc a
forall a b. (a -> b) -> a -> b
$ (Node -> Doc a) -> [Node] -> [Doc a]
forall a b. (a -> b) -> [a] -> [b]
map Node -> Doc a
forall a. Node -> Doc a
prettyNode [Node]
nodes

prettyNode ∷ Node → Doc a
prettyNode :: forall a. Node -> Doc a
prettyNode (NodeElement Element
element) = Element -> Doc a
forall a. Element -> Doc a
prettyElement Element
element
prettyNode (NodeContent Content
content) = Content -> Doc a
forall a. Content -> Doc a
prettyContent Content
content
prettyNode Node
_ = Doc a
forall a. Monoid a => a
mempty

prettyContent ∷ Content → Doc a
prettyContent :: forall a. Content -> Doc a
prettyContent (ContentText Text
t) = Text -> Doc a
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
t
prettyContent (ContentEntity Text
"lt") = Doc a
"<"
prettyContent (ContentEntity Text
"gt") = Doc a
">"
prettyContent Content
_ = Doc a
"?"

prettyEntry ∷ AtomEntry → Doc a
prettyEntry :: forall a. AtomEntry -> Doc a
prettyEntry AtomEntry
e =
  Doc a
"Entry:"
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> AtomText -> Doc a
forall a. AtomText -> Doc a
prettyAtomText (AtomEntry -> AtomText
entryTitle AtomEntry
e)
      Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<++> Int -> Doc a -> Doc a
forall ann. Int -> Doc ann -> Doc ann
indent
        Int
4
        ( Doc a
"By"
            Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Doc a
forall ann. Doc ann
equals
            Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
list (AtomPerson -> Doc a
forall a. AtomPerson -> Doc a
prettyPerson (AtomPerson -> Doc a) -> [AtomPerson] -> [Doc a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AtomEntry -> [AtomPerson]
entryAuthors AtomEntry
e)
              Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<++> Doc a
"Updated"
            Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Doc a
forall ann. Doc ann
equals
            Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> UTCTime -> Doc a
forall a. UTCTime -> Doc a
prettyTime (AtomEntry -> UTCTime
entryUpdated AtomEntry
e)
              Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<++> Doc a
"Links"
            Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Doc a
forall ann. Doc ann
equals
            Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> [Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
list (AtomLink -> Doc a
forall a. AtomLink -> Doc a
prettyLink (AtomLink -> Doc a) -> [AtomLink] -> [Doc a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AtomEntry -> [AtomLink]
entryLinks AtomEntry
e)
            -- , "   Item Body:   " ++ (Imm.Mail.getItemContent item),
        )

prettyItem ∷ RssItem e → Doc a
prettyItem :: forall e a. RssItem e -> Doc a
prettyItem RssItem e
i =
  Doc a
"Item:"
    Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Text -> Doc a
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (RssItem e -> Text
forall extensions. RssItem extensions -> Text
itemTitle RssItem e
i)
      Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<++> Int -> Doc a -> Doc a
forall ann. Int -> Doc ann -> Doc ann
indent
        Int
4
        ( Doc a
"By"
            Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Doc a
forall ann. Doc ann
equals
            Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Text -> Doc a
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (RssItem e -> Text
forall extensions. RssItem extensions -> Text
itemAuthor RssItem e
i)
              Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<++> Doc a
"Updated"
            Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Doc a
forall ann. Doc ann
equals
            Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Doc a -> (UTCTime -> Doc a) -> Maybe UTCTime -> Doc a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc a
"<empty>" UTCTime -> Doc a
forall a. UTCTime -> Doc a
prettyTime (RssItem e -> Maybe UTCTime
forall extensions. RssItem extensions -> Maybe UTCTime
itemPubDate RssItem e
i)
              Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<++> Doc a
"Link"
            Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Doc a
forall ann. Doc ann
equals
            Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a
<+> Doc a -> (RssURI -> Doc a) -> Maybe RssURI -> Doc a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc a
"<empty>" ((forall a. URIRef a -> Doc a) -> RssURI -> Doc a
forall b. (forall a. URIRef a -> b) -> RssURI -> b
withRssURI URIRef a -> Doc a
forall a. URIRef a -> Doc a
forall a b. URIRef a -> Doc b
prettyURI) (RssItem e -> Maybe RssURI
forall extensions. RssItem extensions -> Maybe RssURI
itemLink RssItem e
i)
        )

prettyURI ∷ URIRef a → Doc b
prettyURI :: forall a b. URIRef a -> Doc b
prettyURI URIRef a
uri = forall a ann. Pretty a => a -> Doc ann
pretty @Text (Text -> Doc b) -> Text -> Doc b
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ URIRef a -> ByteString
forall a. URIRef a -> ByteString
serializeURIRef' URIRef a
uri

prettyGuid ∷ RssGuid → Doc a
prettyGuid :: forall a. RssGuid -> Doc a
prettyGuid (GuidText Text
t) = Text -> Doc a
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
t
prettyGuid (GuidUri (RssURI URIRef a
u)) = URIRef a -> Doc a
forall a b. URIRef a -> Doc b
prettyURI URIRef a
u

prettyAtomContent ∷ AtomContent → Doc a
prettyAtomContent :: forall a. AtomContent -> Doc a
prettyAtomContent (AtomContentInlineText TextType
_ Text
t) = Text -> Doc a
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
t
prettyAtomContent (AtomContentInlineXHTML Element
element) = Element -> Doc a
forall a. Element -> Doc a
prettyElement Element
element
prettyAtomContent (AtomContentInlineOther Text
_ Text
t) = Text -> Doc a
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
t
prettyAtomContent (AtomContentOutOfLine Text
_ AtomURI
u) = (forall a. URIRef a -> Doc a) -> AtomURI -> Doc a
forall b. (forall a. URIRef a -> b) -> AtomURI -> b
withAtomURI URIRef a -> Doc a
forall a. URIRef a -> Doc a
forall a b. URIRef a -> Doc b
prettyURI AtomURI
u

magenta ∷ Doc AnsiStyle → Doc AnsiStyle
magenta :: Doc AnsiStyle -> Doc AnsiStyle
magenta = AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate (AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle)
-> AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ Color -> AnsiStyle
color Color
Magenta

yellow ∷ Doc AnsiStyle → Doc AnsiStyle
yellow :: Doc AnsiStyle -> Doc AnsiStyle
yellow = AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate (AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle)
-> AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ Color -> AnsiStyle
color Color
Yellow

red ∷ Doc AnsiStyle → Doc AnsiStyle
red :: Doc AnsiStyle -> Doc AnsiStyle
red = AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate (AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle)
-> AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ Color -> AnsiStyle
color Color
Red

green ∷ Doc AnsiStyle → Doc AnsiStyle
green :: Doc AnsiStyle -> Doc AnsiStyle
green = AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate (AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle)
-> AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ Color -> AnsiStyle
color Color
Green

cyan ∷ Doc AnsiStyle → Doc AnsiStyle
cyan :: Doc AnsiStyle -> Doc AnsiStyle
cyan = AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate (AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle)
-> AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ Color -> AnsiStyle
color Color
Cyan

bold ∷ Doc AnsiStyle → Doc AnsiStyle
bold :: Doc AnsiStyle -> Doc AnsiStyle
bold = AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate AnsiStyle
Pretty.bold