module System.Process.Quick.Pretty
  ( Pretty (..)
  , (&!)
  , escArg
  , tab
  , printDoc
  , apNe
  , module PP
  ) where

import Control.Exception.Safe
import GHC.ResponseFile (escapeArgs)
import Relude
import Text.PrettyPrint as PP hiding (hsep, (<>), empty, isEmpty)
import Text.PrettyPrint qualified as PP


class Pretty a where
  default doc :: Show a => a -> Doc
  doc = String -> Doc
text (String -> Doc) -> (a -> String) -> a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall b a. (Show a, IsString b) => a -> b
show
  doc :: a -> Doc

  hsep :: [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 :: [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 #-}

instance Pretty Doc where
  doc :: Doc -> Doc
doc = Doc -> Doc
forall a. a -> a
id
  {-# INLINE doc #-}
instance Pretty String where
  doc :: String -> Doc
doc = String -> Doc
text
  {-# INLINE doc #-}
instance Pretty IOException
instance Pretty Int
instance Pretty Integer
instance Pretty [String]


printDoc :: MonadIO m => Doc -> m ()
printDoc :: forall (m :: * -> *). MonadIO m => Doc -> m ()
printDoc = String -> m ()
forall (m :: * -> *). MonadIO m => String -> m ()
putStrLn (String -> m ()) -> (Doc -> String) -> Doc -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> String
render

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 &!

escArg :: String -> String
escArg :: String -> String
escArg = String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
escapeArgs ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure