{-# LANGUAGE DerivingVia      #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Prettyprinter.Extras(
    PrettyShow(..)
    , Pretty(..)
    , PrettyFoldable(..)
    , Tagged(Tagged)
    ) where

import Data.Foldable (Foldable (toList))
import Data.Proxy (Proxy (..))
import Data.String (IsString (..))
import Data.Tagged
import GHC.TypeLits (KnownSymbol, symbolVal)
import Prettyprinter

-- | Newtype wrapper for deriving 'Pretty' via a 'Show' instance
newtype PrettyShow a = PrettyShow { PrettyShow a -> a
unPrettyShow :: a }

instance Show a => Pretty (PrettyShow a) where
  pretty :: PrettyShow a -> Doc ann
pretty = a -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow (a -> Doc ann) -> (PrettyShow a -> a) -> PrettyShow a -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrettyShow a -> a
forall a. PrettyShow a -> a
unPrettyShow

-- | Newtype wrapper for deriving 'Pretty' for a 'Foldable' container by
--   calling 'toList'.
newtype PrettyFoldable f a = PrettyFoldable { PrettyFoldable f a -> f a
unPrettyFoldable :: f a }

instance (Foldable f, Pretty a) => Pretty (PrettyFoldable f a) where
  pretty :: PrettyFoldable f a -> Doc ann
pretty = [a] -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ([a] -> Doc ann)
-> (PrettyFoldable f a -> [a]) -> PrettyFoldable f a -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (f a -> [a])
-> (PrettyFoldable f a -> f a) -> PrettyFoldable f a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrettyFoldable f a -> f a
forall (f :: * -> *) a. PrettyFoldable f a -> f a
unPrettyFoldable

instance (KnownSymbol a, Pretty b) => Pretty (Tagged a b) where
  pretty :: Tagged a b -> Doc ann
pretty = Tagged a b -> Doc ann
forall (a :: Symbol) b ann.
(KnownSymbol a, Pretty b) =>
Tagged a b -> Doc ann
prettyTagged

prettyTagged :: forall a b ann. (KnownSymbol a, Pretty b) => Tagged a b -> Doc ann
prettyTagged :: Tagged a b -> Doc ann
prettyTagged (Tagged b
b) = String -> Doc ann
forall a. IsString a => String -> a
fromString (Proxy a -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy a
forall k (t :: k). Proxy t
Proxy @a)) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> b -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty b
b