{-# OPTIONS_GHC -fno-warn-orphans #-}

-- | A re-export of the prettyprinting library, along with some
-- convenience functions.
module Futhark.Util.Pretty
  ( -- * Rendering to texts
    prettyTuple,
    prettyTupleLines,
    prettyString,
    prettyText,
    prettyTextOneLine,
    docText,
    docTextForHandle,

    -- * Rendering to terminal
    putDoc,
    hPutDoc,
    putDocLn,
    hPutDocLn,

    -- * Building blocks
    module Prettyprinter,
    module Prettyprinter.Symbols.Ascii,
    module Prettyprinter.Render.Terminal,
    apply,
    oneLine,
    annot,
    nestedBlock,
    textwrap,
    shorten,
    commastack,
    commasep,
    semistack,
    stack,
    parensIf,
    ppTuple',
    ppTupleLines',

    -- * Operators
    (</>),
  )
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)

-- | Print a doc with styling to the given file; stripping colors if
-- the file does not seem to support such things.
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}

-- | Like 'hPutDoc', but with a final newline.
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
""

-- | Like 'hPutDoc', but to stdout.
putDoc :: Doc AnsiStyle -> IO ()
putDoc :: Doc AnsiStyle -> IO ()
putDoc = Handle -> Doc AnsiStyle -> IO ()
hPutDoc Handle
stdout

-- | Like 'putDoc', but with a final newline.
putDocLn :: Doc AnsiStyle -> IO ()
putDocLn :: Doc AnsiStyle -> IO ()
putDocLn Doc AnsiStyle
h = do
  Doc AnsiStyle -> IO ()
putDoc Doc AnsiStyle
h
  String -> IO ()
putStrLn String
""

-- | Produce text suitable for printing on the given handle.  This
-- mostly means stripping any control characters if the handle is not
-- a terminal.
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

-- | Prettyprint a value to a 'String', appropriately wrapped.
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

-- | Prettyprint a value to a 'Text', appropriately wrapped.
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

-- | Convert a 'Doc' to text.  Thsi ignores any annotations (i.e. it
-- will be non-coloured output).
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}

-- | Prettyprint a value to a 'Text' on a single line.
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

-- | Prettyprint a list enclosed in curly braces.
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

-- | Like 'prettyTuple', but put a linebreak after every element.
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

-- | The document @'apply' ds@ separates @ds@ with commas and encloses them with
-- parentheses.
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

-- | Make sure that the given document is printed on just a single line.
oneLine :: Doc a -> Doc a
oneLine :: forall ann. Doc ann -> Doc ann
oneLine = forall ann. Doc ann -> Doc ann
group

-- | Splits the string into words and permits line breaks between all
-- of them.
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

-- | Stack and prepend a list of 'Doc's to another 'Doc', separated by
-- a linebreak.  If the list is empty, the second 'Doc' will be
-- returned without a preceding linebreak.
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])

-- | Surround the given document with enclosers and add linebreaks and
-- indents.
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]

-- | Prettyprint on a single line up to at most some appropriate
-- number of characters, with trailing ... if necessary.  Used for
-- error messages.
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

-- | Like 'commasep', but a newline after every comma.
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

-- | Separate with semicolons and newlines.
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

-- | Separate with commas.
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

-- | Separate with linebreaks.
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

-- | The document @'parensIf' p d@ encloses the document @d@ in parenthesis if
-- @p@ is @True@, and otherwise yields just @d@.
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