{-# OPTIONS_GHC -fno-warn-orphans #-}
module Futhark.Util.Pretty
(
prettyTuple,
prettyTupleLines,
prettyString,
prettyStringOneLine,
prettyText,
prettyTextOneLine,
docText,
docTextForHandle,
putDoc,
hPutDoc,
putDocLn,
hPutDocLn,
module Prettyprinter,
module Prettyprinter.Symbols.Ascii,
module Prettyprinter.Render.Terminal,
apply,
oneLine,
annot,
nestedBlock,
textwrap,
shorten,
commastack,
commasep,
semistack,
stack,
parensIf,
ppTuple',
ppTupleLines',
(</>),
)
where
import Data.Text (Text)
import Data.Text qualified as T
import Numeric.Half
import Prettyprinter
import Prettyprinter.Render.Terminal (AnsiStyle, Color (..), bgColor, bgColorDull, bold, color, colorDull, italicized, underlined)
import Prettyprinter.Render.Terminal qualified
import Prettyprinter.Render.Text qualified
import Prettyprinter.Symbols.Ascii
import System.IO (Handle, hIsTerminalDevice, hPutStrLn, stdout)
hPutDoc :: Handle -> Doc AnsiStyle -> IO ()
hPutDoc :: Handle -> Doc AnsiStyle -> IO ()
hPutDoc Handle
h Doc AnsiStyle
d = do
Bool
colours <- Handle -> IO Bool
hIsTerminalDevice Handle
h
if Bool
colours
then Handle -> SimpleDocStream AnsiStyle -> IO ()
Prettyprinter.Render.Terminal.renderIO Handle
h (forall {ann}. Doc ann -> SimpleDocStream ann
layouter Doc AnsiStyle
d)
else forall ann. Handle -> Doc ann -> IO ()
Prettyprinter.Render.Text.hPutDoc Handle
h Doc AnsiStyle
d
where
layouter :: Doc ann -> SimpleDocStream ann
layouter =
forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutSmart LayoutOptions
defaultLayoutOptions {layoutPageWidth :: PageWidth
layoutPageWidth = PageWidth
Unbounded}
hPutDocLn :: Handle -> Doc AnsiStyle -> IO ()
hPutDocLn :: Handle -> Doc AnsiStyle -> IO ()
hPutDocLn Handle
h Doc AnsiStyle
d = do
Handle -> Doc AnsiStyle -> IO ()
hPutDoc Handle
h Doc AnsiStyle
d
Handle -> String -> IO ()
hPutStrLn Handle
h String
""
putDoc :: Doc AnsiStyle -> IO ()
putDoc :: Doc AnsiStyle -> IO ()
putDoc = Handle -> Doc AnsiStyle -> IO ()
hPutDoc Handle
stdout
putDocLn :: Doc AnsiStyle -> IO ()
putDocLn :: Doc AnsiStyle -> IO ()
putDocLn Doc AnsiStyle
d = do
Doc AnsiStyle -> IO ()
putDoc Doc AnsiStyle
d
String -> IO ()
putStrLn String
""
docTextForHandle :: Handle -> Doc AnsiStyle -> IO T.Text
docTextForHandle :: Handle -> Doc AnsiStyle -> IO Text
docTextForHandle Handle
h Doc AnsiStyle
d = do
Bool
colours <- Handle -> IO Bool
hIsTerminalDevice Handle
h
let sds :: SimpleDocStream AnsiStyle
sds = forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutSmart LayoutOptions
defaultLayoutOptions Doc AnsiStyle
d
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
if Bool
colours
then SimpleDocStream AnsiStyle -> Text
Prettyprinter.Render.Terminal.renderStrict SimpleDocStream AnsiStyle
sds
else forall ann. SimpleDocStream ann -> Text
Prettyprinter.Render.Text.renderStrict SimpleDocStream AnsiStyle
sds
prettyString :: (Pretty a) => a -> String
prettyString :: forall a. Pretty a => a -> String
prettyString = Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> Text
prettyText
prettyStringOneLine :: (Pretty a) => a -> String
prettyStringOneLine :: forall a. Pretty a => a -> String
prettyStringOneLine = Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> Text
prettyTextOneLine
prettyText :: (Pretty a) => a -> Text
prettyText :: forall a. Pretty a => a -> Text
prettyText = forall a. Doc a -> Text
docText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. Pretty a => a -> Doc ann
pretty
docText :: Doc a -> T.Text
docText :: forall a. Doc a -> Text
docText = forall ann. SimpleDocStream ann -> Text
Prettyprinter.Render.Text.renderStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {ann}. Doc ann -> SimpleDocStream ann
layouter
where
layouter :: Doc ann -> SimpleDocStream ann
layouter =
forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutSmart LayoutOptions
defaultLayoutOptions {layoutPageWidth :: PageWidth
layoutPageWidth = PageWidth
Unbounded}
prettyTextOneLine :: (Pretty a) => a -> Text
prettyTextOneLine :: forall a. Pretty a => a -> Text
prettyTextOneLine = forall ann. SimpleDocStream ann -> Text
Prettyprinter.Render.Text.renderStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutSmart LayoutOptions
oneLineLayout forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann. Doc ann -> Doc ann
group forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. Pretty a => a -> Doc ann
pretty
where
oneLineLayout :: LayoutOptions
oneLineLayout = LayoutOptions
defaultLayoutOptions {layoutPageWidth :: PageWidth
layoutPageWidth = PageWidth
Unbounded}
ppTuple' :: [Doc a] -> Doc a
ppTuple' :: forall a. [Doc a] -> Doc a
ppTuple' [Doc a]
ets = forall ann. Doc ann -> Doc ann
braces forall a b. (a -> b) -> a -> b
$ forall a. [Doc a] -> Doc a
commasep forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall ann. Doc ann -> Doc ann
align [Doc a]
ets
ppTupleLines' :: [Doc a] -> Doc a
ppTupleLines' :: forall a. [Doc a] -> Doc a
ppTupleLines' [Doc a]
ets = forall ann. Doc ann -> Doc ann
braces forall a b. (a -> b) -> a -> b
$ forall a. [Doc a] -> Doc a
commastack forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall ann. Doc ann -> Doc ann
align [Doc a]
ets
prettyTuple :: (Pretty a) => [a] -> Text
prettyTuple :: forall a. Pretty a => [a] -> Text
prettyTuple = forall a. Doc a -> Text
docText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Doc a] -> Doc a
ppTuple' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty
prettyTupleLines :: (Pretty a) => [a] -> Text
prettyTupleLines :: forall a. Pretty a => [a] -> Text
prettyTupleLines = forall a. Doc a -> Text
docText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Doc a] -> Doc a
ppTupleLines' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty
apply :: [Doc a] -> Doc a
apply :: forall a. [Doc a] -> Doc a
apply = forall ann. Doc ann -> Doc ann
parens forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann. Doc ann -> Doc ann
align forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Doc a] -> Doc a
commasep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall ann. Doc ann -> Doc ann
align
oneLine :: Doc a -> Doc a
oneLine :: forall ann. Doc ann -> Doc ann
oneLine = forall ann. Doc ann -> Doc ann
group
textwrap :: T.Text -> Doc a
textwrap :: forall a. Text -> Doc a
textwrap = forall a. [Doc a] -> Doc a
fillSep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.words
annot :: [Doc a] -> Doc a -> Doc a
annot :: forall a. [Doc a] -> Doc a -> Doc a
annot [] Doc a
s = Doc a
s
annot [Doc a]
l Doc a
s = forall a. [Doc a] -> Doc a
vsep ([Doc a]
l forall a. [a] -> [a] -> [a]
++ [Doc a
s])
nestedBlock :: Doc a -> Doc a -> Doc a -> Doc a
nestedBlock :: forall a. Doc a -> Doc a -> Doc a -> Doc a
nestedBlock Doc a
pre Doc a
post Doc a
body = forall a. [Doc a] -> Doc a
vsep [Doc a
pre, forall ann. Int -> Doc ann -> Doc ann
indent Int
2 Doc a
body, Doc a
post]
shorten :: Doc a -> Doc b
shorten :: forall a b. Doc a -> Doc b
shorten Doc a
a
| Text -> Int
T.length Text
s forall a. Ord a => a -> a -> Bool
> Int
70 = forall a ann. Pretty a => a -> Doc ann
pretty (Int -> Text -> Text
T.take Int
70 Text
s) forall a. Semigroup a => a -> a -> a
<> Doc b
"..."
| Bool
otherwise = forall a ann. Pretty a => a -> Doc ann
pretty Text
s
where
s :: Text
s = forall ann. SimpleDocStream ann -> Text
Prettyprinter.Render.Text.renderStrict forall a b. (a -> b) -> a -> b
$ forall ann1 ann2. Doc ann1 -> SimpleDocStream ann2
layoutCompact Doc a
a
commastack :: [Doc a] -> Doc a
commastack :: forall a. [Doc a] -> Doc a
commastack = forall ann. Doc ann -> Doc ann
align forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Doc a] -> Doc a
vsep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate forall ann. Doc ann
comma
semistack :: [Doc a] -> Doc a
semistack :: forall a. [Doc a] -> Doc a
semistack = forall ann. Doc ann -> Doc ann
align forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Doc a] -> Doc a
vsep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate forall ann. Doc ann
semi
commasep :: [Doc a] -> Doc a
commasep :: forall a. [Doc a] -> Doc a
commasep = forall a. [Doc a] -> Doc a
hsep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate forall ann. Doc ann
comma
stack :: [Doc a] -> Doc a
stack :: forall a. [Doc a] -> Doc a
stack = forall ann. Doc ann -> Doc ann
align forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate forall ann. Doc ann
line
parensIf :: Bool -> Doc a -> Doc a
parensIf :: forall a. Bool -> Doc a -> Doc a
parensIf Bool
True Doc a
doc = forall ann. Doc ann -> Doc ann
parens Doc a
doc
parensIf Bool
False Doc a
doc = Doc a
doc
instance Pretty Half where
pretty :: forall ann. Half -> Doc ann
pretty = forall a ann. Show a => a -> Doc ann
viaShow
(</>) :: Doc a -> Doc a -> Doc a
Doc a
a </> :: forall a. Doc a -> Doc a -> Doc a
</> Doc a
b = Doc a
a forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
line forall a. Semigroup a => a -> a -> a
<> Doc a
b