module FP.Pretty.Instances where

import FP.Prelude
import FP.Pretty.Pretty
import FP.Pretty.Deriving

instance Pretty Doc where 
  pretty = id

instance Pretty 𝔹 where pretty = ppCon ∘ 𝕤 ∘ show
instance Pretty 𝕀 where pretty = ppLit ∘ 𝕤 ∘ show
instance Pretty ℤ where pretty = ppLit ∘ 𝕤 ∘ show
instance Pretty ℕ where pretty = ppLit ∘ 𝕤 ∘ show
instance Pretty ℕᵀ where 
  pretty NInfinity = ppLit "∞"
  pretty (NFinite n) = pretty n
instance Pretty ℂ where pretty = ppLit ∘ 𝕤 ∘ show
instance Pretty 𝕊 where pretty = ppLit ∘ 𝕤 ∘ show
instance Pretty 𝔻  where pretty = ppLit ∘ 𝕤 ∘ show
instance Pretty () where pretty = ppCon ∘ 𝕤 ∘ show

instance (Pretty a, Pretty b) ⇒ Pretty (a, b) where
  pretty (a, b) = ppCollection "(" ")" "," [pretty a, pretty b]
instance (Pretty a, Pretty b, Pretty c) ⇒ Pretty (a, b, c) where
  pretty (a, b, c) = ppCollection "(" ")" "," [pretty a, pretty b, pretty c]

instance (Pretty a) ⇒ Pretty (Stream a) where pretty xs = ppApp (ppText "stream") [pretty $ list xs]
instance (Pretty a) ⇒ Pretty [a] where pretty = ppCollection "[" "]" "," ∘ map pretty
instance (Pretty a) ⇒ Pretty (𝒫 a) where pretty = ppCollection "{" "}"  "," ∘ map pretty ∘ list
instance (Pretty a,Ord a) ⇒ Pretty (𝒫ᵇ a) where pretty = pretty ∘ concretizeSet
instance (Pretty k,Pretty v) ⇒ Pretty (k ⇰ v) where pretty = ppRecord "↦" ∘ map (mapPair pretty pretty) ∘ list
instance (Pretty k,Pretty v,Ord k,Monoid v) ⇒ Pretty (k ⇰♭⧺ v) where pretty = pretty ∘ concretizeDictAppend
instance (Pretty k,Pretty v,Ord k,JoinLattice v) ⇒ Pretty (k ⇰♭⊔ v) where pretty = pretty ∘ concretizeDictJoin

instance (Pretty a) ⇒ Pretty (AddBot a) where
  pretty Bot = ppCon "⊥"
  pretty (AddBot x) = pretty x

instance (Pretty a) ⇒ Pretty (AddTop a) where
  pretty Top = ppCon "⊤"
  pretty (AddTop x) = pretty x

instance (Functorial Pretty f) ⇒ Pretty (Fixed f) where
  pretty (Fixed f) =
    with (functorial ∷ W (Pretty (f (Fixed f)))) $
    pretty f

makePrettySum ''Maybe
makePrettySum ''Either

makePrettyUnion ''ID