-- | A constructor we can wrap around values to avoid any built in
-- Pretty instance - for example, instance Pretty [a].
--
--  * display is now prettyShow
--  * display' is now prettyText
--  * ppDisplay is now ppShow
--  * ppDisplay' is now ppText
{-# LANGUAGE DeriveFunctor, FlexibleContexts, FlexibleInstances, OverloadedStrings, TypeSynonymInstances #-}
module Debian.Pretty
    ( PP(PP, unPP)
    , prettyText
    , ppPrint
    , ppShow
    , ppText
    -- * Re-export
    , prettyShow
    ) where

import Data.Text (Text, unpack, pack)
import Text.PrettyPrint.HughesPJClass (Doc, text, empty)
import Distribution.Pretty (Pretty(pretty), prettyShow)

-- | This type is wrapped around values before we pretty print them so
-- we can write our own Pretty instances for common types without
-- polluting the name space of clients of this package with instances
-- they don't want.
newtype PP a = PP {PP a -> a
unPP :: a} deriving (a -> PP b -> PP a
(a -> b) -> PP a -> PP b
(forall a b. (a -> b) -> PP a -> PP b)
-> (forall a b. a -> PP b -> PP a) -> Functor PP
forall a b. a -> PP b -> PP a
forall a b. (a -> b) -> PP a -> PP b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> PP b -> PP a
$c<$ :: forall a b. a -> PP b -> PP a
fmap :: (a -> b) -> PP a -> PP b
$cfmap :: forall a b. (a -> b) -> PP a -> PP b
Functor)

instance Pretty (PP Text) where
    pretty :: PP Text -> Doc
pretty = String -> Doc
text (String -> Doc) -> (PP Text -> String) -> PP Text -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack (Text -> String) -> (PP Text -> Text) -> PP Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PP Text -> Text
forall a. PP a -> a
unPP

instance Pretty (PP String) where
    pretty :: PP String -> Doc
pretty = String -> Doc
text (String -> Doc) -> (PP String -> String) -> PP String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PP String -> String
forall a. PP a -> a
unPP

instance Pretty (PP a) => Pretty (PP (Maybe a)) where
    pretty :: PP (Maybe a) -> Doc
pretty = Doc -> (a -> Doc) -> Maybe a -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty a -> Doc
forall a. Pretty (PP a) => a -> Doc
ppPrint (Maybe a -> Doc)
-> (PP (Maybe a) -> Maybe a) -> PP (Maybe a) -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PP (Maybe a) -> Maybe a
forall a. PP a -> a
unPP

prettyText :: Pretty a => a -> Text
prettyText :: a -> Text
prettyText = String -> Text
pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Pretty a => a -> String
prettyShow

ppPrint :: Pretty (PP a) => a -> Doc
ppPrint :: a -> Doc
ppPrint = PP a -> Doc
forall a. Pretty a => a -> Doc
pretty (PP a -> Doc) -> (a -> PP a) -> a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> PP a
forall a. a -> PP a
PP

ppShow :: Pretty (PP a) => a -> String
ppShow :: a -> String
ppShow = PP a -> String
forall a. Pretty a => a -> String
prettyShow (PP a -> String) -> (a -> PP a) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> PP a
forall a. a -> PP a
PP

ppText :: Pretty (PP a) => a -> Text
ppText :: a -> Text
ppText = String -> Text
pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PP a -> String
forall a. Pretty a => a -> String
prettyShow (PP a -> String) -> (a -> PP a) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> PP a
forall a. a -> PP a
PP