{-# LANGUAGE CPP #-}
module Agda.Utils.Pretty
( module Agda.Utils.Pretty
, module Text.PrettyPrint
) where
import Data.Int ( Int32 )
import Data.Data (Data(..))
import qualified Data.Map as Map
#if __GLASGOW_HASKELL__ < 800
import qualified Data.Semigroup as S
#endif
import qualified Text.PrettyPrint as P
import Text.PrettyPrint hiding (TextDetails(Str), empty)
import Agda.Utils.NonemptyList
#include "undefined.h"
import Agda.Utils.Impossible
#if __GLASGOW_HASKELL__ < 800
instance S.Semigroup Doc where
(<>) = (<>)
#endif
class Pretty a where
pretty :: a -> Doc
prettyPrec :: Int -> a -> Doc
prettyList :: [a] -> Doc
pretty = prettyPrec 0
prettyPrec = const pretty
prettyList = brackets . prettyList_
prettyShow :: Pretty a => a -> String
prettyShow = render . pretty
instance Pretty Bool where pretty = text . show
instance Pretty Int where pretty = text . show
instance Pretty Int32 where pretty = text . show
instance Pretty Integer where pretty = text . show
instance Pretty Char where
pretty c = text [c]
prettyList = text
instance Pretty Doc where
pretty = id
instance Pretty () where
pretty _ = P.empty
instance Pretty a => Pretty (Maybe a) where
prettyPrec p Nothing = "Nothing"
prettyPrec p (Just x) = mparens (p > 0) $ "Just" <+> prettyPrec 10 x
instance Pretty a => Pretty [a] where
pretty = prettyList
instance Pretty a => Pretty (NonemptyList a) where
pretty = prettyList . toList
pwords :: String -> [Doc]
pwords = map text . words
fwords :: String -> Doc
fwords = fsep . pwords
prettyList_ :: Pretty a => [a] -> Doc
prettyList_ = fsep . punctuate comma . map pretty
mparens :: Bool -> Doc -> Doc
mparens True = parens
mparens False = id
align :: Int -> [(String, Doc)] -> Doc
align max rows =
vcat $ map (\(s, d) -> text s $$ nest (maxLen + 1) d) $ rows
where maxLen = maximum $ 0 : filter (< max) (map (length . fst) rows)
multiLineText :: String -> Doc
multiLineText = vcat . map text . lines
instance Data Doc where
gunfold _ _ _ = __IMPOSSIBLE__
toConstr = __IMPOSSIBLE__
dataTypeOf = __IMPOSSIBLE__
infixl 6 <?>
(<?>) :: Doc -> Doc -> Doc
a <?> b = hang a 2 b
pshow :: Show a => a -> Doc
pshow = text . show