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

-- | A re-export of the prettyprinting library, along with some convenience functions.
module Futhark.Util.Pretty
  ( module Text.PrettyPrint.Mainland,
    module Text.PrettyPrint.Mainland.Class,
    pretty,
    prettyDoc,
    prettyTuple,
    prettyText,
    prettyTextOneLine,
    prettyOneLine,
    apply,
    oneLine,
    annot,
    nestedBlock,
    textwrap,
    shorten,
  )
where

import Data.Text (Text)
import qualified Data.Text.Lazy as LT
import Text.PrettyPrint.Mainland hiding (pretty)
import qualified Text.PrettyPrint.Mainland as PP
import Text.PrettyPrint.Mainland.Class

-- | Prettyprint a value, wrapped to 80 characters.
pretty :: Pretty a => a -> String
pretty :: a -> String
pretty = Int -> Doc -> String
PP.pretty Int
80 (Doc -> String) -> (a -> Doc) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Doc
forall a. Pretty a => a -> Doc
ppr

-- | Prettyprint a value to a 'Text', wrapped to 80 characters.
prettyText :: Pretty a => a -> Text
prettyText :: a -> Text
prettyText = Text -> Text
LT.toStrict (Text -> Text) -> (a -> Text) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc -> Text
PP.prettyLazyText Int
80 (Doc -> Text) -> (a -> Doc) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Doc
forall a. Pretty a => a -> Doc
ppr

-- | Prettyprint a value to a 'Text' without any width restriction.
prettyTextOneLine :: Pretty a => a -> Text
prettyTextOneLine :: a -> Text
prettyTextOneLine = Text -> Text
LT.toStrict (Text -> Text) -> (a -> Text) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc -> Text
PP.prettyLazyText Int
80 (Doc -> Text) -> (a -> Doc) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
oneLine (Doc -> Doc) -> (a -> Doc) -> a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Doc
forall a. Pretty a => a -> Doc
ppr

-- | Prettyprint a value without any width restriction.
prettyOneLine :: Pretty a => a -> String
prettyOneLine :: a -> String
prettyOneLine = ((String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
"") ((String -> String) -> String)
-> (a -> String -> String) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RDoc -> String -> String
displayS (RDoc -> String -> String) -> (a -> RDoc) -> a -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> RDoc
renderCompact (Doc -> RDoc) -> (a -> Doc) -> a -> RDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
oneLine (Doc -> Doc) -> (a -> Doc) -> a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Doc
forall a. Pretty a => a -> Doc
ppr

-- | Re-export of 'PP.pretty'.
prettyDoc :: Int -> Doc -> String
prettyDoc :: Int -> Doc -> String
prettyDoc = Int -> Doc -> String
PP.pretty

ppTuple' :: Pretty a => [a] -> Doc
ppTuple' :: [a] -> Doc
ppTuple' [a]
ets = Doc -> Doc
braces (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
commasep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc
forall a. Pretty a => a -> Doc
ppr [a]
ets

-- | Prettyprint a list enclosed in curly braces.
prettyTuple :: Pretty a => [a] -> String
prettyTuple :: [a] -> String
prettyTuple = Int -> Doc -> String
PP.pretty Int
80 (Doc -> String) -> ([a] -> Doc) -> [a] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Doc
forall a. Pretty a => [a] -> Doc
ppTuple'

-- | The document @'apply' ds@ separates @ds@ with commas and encloses them with
-- parentheses.
apply :: [Doc] -> Doc
apply :: [Doc] -> Doc
apply = Doc -> Doc
parens (Doc -> Doc) -> ([Doc] -> Doc) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
commasep ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc -> Doc) -> [Doc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Doc -> Doc
align

-- | Make sure that the given document is printed on just a single line.
oneLine :: PP.Doc -> PP.Doc
oneLine :: Doc -> Doc
oneLine Doc
s = String -> Doc
PP.text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ RDoc -> String -> String
PP.displayS (Doc -> RDoc
PP.renderCompact Doc
s) String
""

-- | Like 'text', but splits the string into words and permits line breaks between all of them.
textwrap :: String -> Doc
textwrap :: String -> Doc
textwrap = (Doc -> Doc -> Doc) -> [Doc] -> Doc
folddoc Doc -> Doc -> Doc
(<+/>) ([Doc] -> Doc) -> (String -> [Doc]) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
text ([String] -> [Doc]) -> (String -> [String]) -> String -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
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] -> Doc -> Doc
annot :: [Doc] -> Doc -> Doc
annot [] Doc
s = Doc
s
annot [Doc]
l Doc
s = [Doc] -> Doc
stack [Doc]
l Doc -> Doc -> Doc
</> Doc
s

-- | Surround the given document with enclosers and add linebreaks and
-- indents.
nestedBlock :: String -> String -> Doc -> Doc
nestedBlock :: String -> String -> Doc -> Doc
nestedBlock String
pre String
post Doc
body =
  String -> Doc
text String
pre
    Doc -> Doc -> Doc
</> Int -> Doc -> Doc
PP.indent Int
2 Doc
body
    Doc -> Doc -> Doc
</> String -> Doc
text String
post

-- | Prettyprint on a single line up to at most some appropriate
-- number of characters, with trailing ... if necessary.  Used for
-- error messages.
shorten :: Pretty a => a -> Doc
shorten :: a -> Doc
shorten a
a
  | String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
70 = String -> Doc
text (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
70 String
s) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"..."
  | Bool
otherwise = String -> Doc
text String
s
  where
    s :: String
s = a -> String
forall a. Pretty a => a -> String
pretty a
a