{-# OPTIONS_GHC -fno-warn-orphans #-}
module Futhark.Util.Pretty
(
prettyTuple,
prettyTupleLines,
prettyString,
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,
semisep,
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)
import Prettyprinter.Render.Terminal qualified
import Prettyprinter.Render.Text qualified
import Prettyprinter.Symbols.Ascii
import System.IO (Handle, hIsTerminalDevice, 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
String -> IO ()
putStrLn 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
h = do
Doc AnsiStyle -> IO ()
putDoc Doc AnsiStyle
h
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
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. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutSmart LayoutOptions
defaultLayoutOptions
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
semisep :: [Doc a] -> Doc a
semisep :: forall a. [Doc a] -> Doc a
semisep = 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
semi
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