{-# OPTIONS_GHC -Wno-orphans #-}
module Data.Git.Phoenix.Pretty
  ( doc
  , hsep
  , vsep
  , (&!)
  , ($$)
  , tab
  , printDoc
  , apNe
  , module PP
  ) where

import Data.Time ( NominalDiffTime )
import Control.Exception ( IOException )
import Relude
import Text.PrettyPrint.Leijen.Text as PP hiding
  ( (<$>), bool, group, hsep, vsep, empty, isEmpty, (</>) )
import Text.PrettyPrint.Leijen.Text qualified as PP

infixr 5 $$
($$) :: Doc -> Doc -> Doc
$$ :: Doc -> Doc -> Doc
($$) = Doc -> Doc -> Doc
(<$$>)

doc :: Pretty a => a -> Doc
doc :: forall a. Pretty a => a -> Doc
doc = a -> Doc
forall a. Pretty a => a -> Doc
pretty

hsep :: Pretty a => [a] -> Doc
hsep :: forall a. Pretty a => [a] -> Doc
hsep = [Doc] -> Doc
PP.hsep ([Doc] -> Doc) -> ([a] -> [Doc]) -> [a] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Doc
forall a. Pretty a => a -> Doc
doc
{-# INLINE hsep #-}

vsep :: Pretty a => [a] -> Doc
vsep :: forall a. Pretty a => [a] -> Doc
vsep = [Doc] -> Doc
vcat ([Doc] -> Doc) -> ([a] -> [Doc]) -> [a] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Doc
forall a. Pretty a => a -> Doc
doc
{-# INLINE vsep #-}

printDoc :: (MonadIO m, Pretty a) => a -> m ()
printDoc :: forall (m :: * -> *) a. (MonadIO m, Pretty a) => a -> m ()
printDoc a
x = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Doc -> IO ()
putDoc (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ a -> Doc
forall a. Pretty a => a -> Doc
pretty a
x)

tab :: Pretty a => a -> Doc
tab :: forall a. Pretty a => a -> Doc
tab = Int -> Doc -> Doc
nest Int
2 (Doc -> Doc) -> (a -> Doc) -> a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Doc
forall a. Pretty a => a -> Doc
doc

class IsEmpty a where
  isEmpty :: a -> Bool

instance IsEmpty [a] where
  isEmpty :: [a] -> Bool
isEmpty = [a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null

apNe :: (IsEmpty a, Pretty a) => a -> (Doc -> Doc) -> Doc
apNe :: forall a. (IsEmpty a, Pretty a) => a -> (Doc -> Doc) -> Doc
apNe a
d Doc -> Doc
f
  | a -> Bool
forall a. IsEmpty a => a -> Bool
isEmpty a
d = Doc
d'
  | Bool
otherwise = Doc -> Doc
f Doc
d'
  where
    d' :: Doc
d' = a -> Doc
forall a. Pretty a => a -> Doc
doc a
d

(&!) :: (IsEmpty a, Pretty a) => a -> (Doc -> Doc) -> Doc
&! :: forall a. (IsEmpty a, Pretty a) => a -> (Doc -> Doc) -> Doc
(&!) = a -> (Doc -> Doc) -> Doc
forall a. (IsEmpty a, Pretty a) => a -> (Doc -> Doc) -> Doc
apNe

infixl 7 &!

instance Pretty IOException where
  pretty :: IOException -> Doc
pretty = Text -> Doc
text (Text -> Doc) -> (IOException -> Text) -> IOException -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOException -> Text
forall b a. (Show a, IsString b) => a -> b
show

instance Pretty a => Pretty (Set a) where
  pretty :: Set a -> Doc
pretty Set a
x = Doc
"{" Doc -> Doc -> Doc
<+> [a] -> Doc
forall a. Pretty a => [a] -> Doc
hsep (Set a -> [a]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set a
x) Doc -> Doc -> Doc
<+> Doc
"}"

instance Pretty NominalDiffTime where
  pretty :: NominalDiffTime -> Doc
pretty = Text -> Doc
text (Text -> Doc)
-> (NominalDiffTime -> Text) -> NominalDiffTime -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NominalDiffTime -> Text
forall b a. (Show a, IsString b) => a -> b
show