{-# 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 { forall a. PrettyShow a -> a
unPrettyShow :: a }

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

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

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

instance (KnownSymbol a, Pretty b) => Pretty (Tagged a b) where
  pretty :: forall ann. Tagged a b -> Doc ann
pretty = 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 :: forall (a :: Symbol) b ann.
(KnownSymbol a, Pretty b) =>
Tagged a b -> Doc ann
prettyTagged (Tagged b
b) = forall a. IsString a => String -> a
fromString (forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
Proxy @a)) forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty b
b