-- | Darcs pretty printing library
--
-- The combinator names are taken from 'Text.PrettyPrint.HughesPJ', although
-- the behaviour of the two libraries is slightly different.
--
-- This code was made generic in the element type by Juliusz Chroboczek.
module Darcs.Util.Printer
    (
    -- * 'Doc' type and structural combinators
      Doc(Doc,unDoc)
    , empty, (<>), (<?>), (<+>), ($$), ($+$), vcat, vsep, hcat, hsep
    , minus, newline, plus, space, backslash, lparen, rparen
    , parens, sentence
    -- * Constructing 'Doc's
    , text
    , hiddenText
    , invisibleText
    , wrapText, quoted
    , formatText
    , formatWords
    , pathlist
    , userchunk, packedString
    , prefix
    , hiddenPrefix
    , insertBeforeLastline
    , prefixLines
    , invisiblePS, userchunkPS
    -- * Rendering to 'String'
    , renderString, renderStringWith
    -- * Rendering to 'ByteString'
    , renderPS, renderPSWith
    , renderPSs, renderPSsWith
    -- * Printers
    , Printers
    , Printers'(..)
    , Printer
    , simplePrinters, invisiblePrinter, simplePrinter
    -- * Printables
    , Printable(..)
    , doc
    , printable, invisiblePrintable, hiddenPrintable, userchunkPrintable
    -- * Constructing colored 'Doc's
    , Color(..)
    , blueText, redText, greenText, magentaText, cyanText
    , colorText
    , lineColor
    -- * IO, uses 'Data.ByteString.hPut' for output
    , hPutDoc,     hPutDocLn,     putDoc,     putDocLn
    , hPutDocWith, hPutDocLnWith, putDocWith, putDocLnWith
    , hPutDocCompr
    , debugDocLn
    -- * TODO: It is unclear what is unsafe about these constructors
    , unsafeText, unsafeBoth, unsafeBothText, unsafeChar
    , unsafePackedString
    ) where

import Darcs.Prelude

import Data.String ( IsString(..) )
import System.IO ( Handle, stdout )
import qualified Data.ByteString as B ( ByteString, hPut, concat )
import qualified Data.ByteString.Char8 as BC ( singleton )

import Darcs.Util.ByteString ( linesPS, decodeLocale, encodeLocale, gzWriteHandle )
import Darcs.Util.Global ( debugMessage )

-- | A 'Printable' is either a String, a packed string, or a chunk of
-- text with both representations.
data Printable = S !String
               | PS !B.ByteString
               | Both !String !B.ByteString

-- | 'Printable' representation of a space
spaceP :: Printable
spaceP :: Printable
spaceP   = String -> ByteString -> Printable
Both String
" "  (Char -> ByteString
BC.singleton Char
' ')

-- | 'Printable' representation of a newline.
newlineP :: Printable
newlineP :: Printable
newlineP = String -> Printable
S String
"\n"

-- | A 'Doc' representing a space (\" \")
space :: Doc
space :: Doc
space = String -> ByteString -> Doc
unsafeBoth String
" "  (Char -> ByteString
BC.singleton Char
' ')

-- | A 'Doc' representing a newline
newline :: Doc
newline :: Doc
newline = Char -> Doc
unsafeChar Char
'\n'

-- | A 'Doc' representing a \"-\"
minus :: Doc
minus :: Doc
minus = String -> ByteString -> Doc
unsafeBoth String
"-"  (Char -> ByteString
BC.singleton Char
'-')

-- | A 'Doc' representing a \"+\"
plus :: Doc
plus :: Doc
plus = String -> ByteString -> Doc
unsafeBoth String
"+"  (Char -> ByteString
BC.singleton Char
'+')

-- | A 'Doc' representing a \"\\\"
backslash :: Doc
backslash :: Doc
backslash = String -> ByteString -> Doc
unsafeBoth String
"\\" (Char -> ByteString
BC.singleton Char
'\\')

-- | A 'Doc' that represents @\"(\"@
lparen :: Doc
lparen :: Doc
lparen = String -> ByteString -> Doc
unsafeBoth  String
"(" (Char -> ByteString
BC.singleton Char
'(')

-- | A 'Doc' that represents @\")\"@
rparen :: Doc
rparen :: Doc
rparen = String -> ByteString -> Doc
unsafeBoth String
")" (Char -> ByteString
BC.singleton Char
')')

-- | prop> parens d = lparen <> d <> rparen
parens :: Doc -> Doc
parens :: Doc -> Doc
parens Doc
d = Doc
lparen Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
d Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
rparen

-- | Turn a 'Doc' into a sentence. This appends a ".".
sentence :: Doc -> Doc
sentence :: Doc -> Doc
sentence = (Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
".")

-- | Format a list of 'FilePath's as quoted text. It deliberately refuses to
-- use English.andClauses but rather separates the quoted strings only with a
-- space, because this makes it usable for copy and paste e.g. as arguments to
-- another shell command.
pathlist :: [FilePath] -> Doc
pathlist :: [String] -> Doc
pathlist [String]
paths = [Doc] -> Doc
hsep ((String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
quoted [String]
paths)

-- | 'putDocWith' puts a 'Doc' on stdout using the given printer.
putDocWith :: Printers -> Doc -> IO ()
putDocWith :: Printers -> Doc -> IO ()
putDocWith Printers
prs = Printers -> Handle -> Doc -> IO ()
hPutDocWith Printers
prs Handle
stdout

-- | 'putDocLnWith' puts a 'Doc', followed by a newline on stdout using
-- the given printer.
putDocLnWith :: Printers -> Doc -> IO ()
putDocLnWith :: Printers -> Doc -> IO ()
putDocLnWith Printers
prs = Printers -> Handle -> Doc -> IO ()
hPutDocLnWith Printers
prs Handle
stdout

-- | 'putDoc' puts a 'Doc' on stdout using the simple printer 'simplePrinters'.
putDoc :: Doc -> IO ()
putDoc :: Doc -> IO ()
putDoc = Handle -> Doc -> IO ()
hPutDoc Handle
stdout

-- | 'putDocLn' puts a 'Doc', followed by a newline on stdout using
-- 'simplePrinters'
putDocLn :: Doc -> IO ()
putDocLn :: Doc -> IO ()
putDocLn = Handle -> Doc -> IO ()
hPutDocLn Handle
stdout

-- | 'hputDocWith' puts a 'Doc' on the given handle using the given printer.
hPutDocWith :: Printers -> Handle -> Doc -> IO ()
hPutDocWith :: Printers -> Handle -> Doc -> IO ()
hPutDocWith Printers
prs Handle
h Doc
d = do
  Printers'
p <- Printers
prs Handle
h
  Handle -> [Printable] -> IO ()
hPrintPrintables Handle
h (Printers' -> Doc -> [Printable]
renderWith Printers'
p Doc
d)

-- | 'hputDocLnWith' puts a 'Doc', followed by a newline on the given
-- handle using the given printer.
hPutDocLnWith :: Printers -> Handle -> Doc -> IO ()
hPutDocLnWith :: Printers -> Handle -> Doc -> IO ()
hPutDocLnWith Printers
prs Handle
h Doc
d = Printers -> Handle -> Doc -> IO ()
hPutDocWith Printers
prs Handle
h (Doc
d Doc -> Doc -> Doc
<?> Doc
newline)

-- |'hputDoc' puts a 'Doc' on the given handle using 'simplePrinters'
hPutDoc :: Handle -> Doc -> IO ()
hPutDoc :: Handle -> Doc -> IO ()
hPutDoc = Printers -> Handle -> Doc -> IO ()
hPutDocWith Printers
simplePrinters

-- | 'hputDocLn' puts a 'Doc', followed by a newline on the given handle using
-- 'simplePrinters'.
hPutDocLn :: Handle -> Doc -> IO ()
hPutDocLn :: Handle -> Doc -> IO ()
hPutDocLn = Printers -> Handle -> Doc -> IO ()
hPutDocLnWith Printers
simplePrinters

-- | like 'hPutDoc' but with compress data before writing
hPutDocCompr :: Handle -> Doc -> IO ()
hPutDocCompr :: Handle -> Doc -> IO ()
hPutDocCompr Handle
h = Handle -> [ByteString] -> IO ()
gzWriteHandle Handle
h ([ByteString] -> IO ()) -> (Doc -> [ByteString]) -> Doc -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [ByteString]
renderPSs

-- | Write a 'Doc' to stderr if debugging is turned on.
debugDocLn :: Doc -> IO ()
debugDocLn :: Doc -> IO ()
debugDocLn = String -> IO ()
debugMessage (String -> IO ()) -> (Doc -> String) -> Doc -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> String
renderString

-- | @'hPrintPrintables' h@ prints a list of 'Printable's to the handle @h@
-- It uses binary output of 'ByteString's. If these not available,
-- converts according to locale.
hPrintPrintables :: Handle -> [Printable] -> IO ()
hPrintPrintables :: Handle -> [Printable] -> IO ()
hPrintPrintables Handle
h = (Printable -> IO ()) -> [Printable] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Handle -> Printable -> IO ()
hPrintPrintable Handle
h)

-- | @'hPrintPrintable' h@ prints a 'Printable' to the handle @h@.
hPrintPrintable :: Handle -> Printable -> IO ()
hPrintPrintable :: Handle -> Printable -> IO ()
hPrintPrintable Handle
h (S String
ps) = Handle -> ByteString -> IO ()
B.hPut Handle
h (String -> ByteString
encodeLocale String
ps)
hPrintPrintable Handle
h (PS ByteString
ps) = Handle -> ByteString -> IO ()
B.hPut Handle
h ByteString
ps
hPrintPrintable Handle
h (Both String
_ ByteString
ps) = Handle -> ByteString -> IO ()
B.hPut Handle
h ByteString
ps

-- | A 'Doc' is a bit of enriched text. 'Doc's are concatenated using
-- '<>' from class 'Monoid', which is right-associative.
newtype Doc = Doc { Doc -> St -> Document
unDoc :: St -> Document }

-- | Together with the language extension OverloadedStrings, this allows to
-- use string literals where a 'Doc' is expected.
instance IsString Doc where
   fromString :: String -> Doc
fromString = String -> Doc
text

-- | The State associated with a 'Doc'. Contains a set of printers for each
-- hanlde, and the current prefix of the document.
data St = St { St -> Printers'
printers :: !Printers',
               St -> [Printable] -> [Printable]
currentPrefix :: !([Printable] -> [Printable]) }
type Printers = Handle -> IO Printers'

-- | A set of printers to print different types of text to a handle.
data Printers' = Printers {Printers' -> Color -> Printer
colorP :: !(Color -> Printer),
                           Printers' -> Printer
invisibleP :: !Printer,
                           Printers' -> Printer
hiddenP :: !Printer,
                           Printers' -> Printer
userchunkP :: !Printer,
                           Printers' -> Printer
defP :: !Printer,
                           Printers' -> Color -> Doc -> Doc
lineColorT :: !(Color -> Doc -> Doc),
                           Printers' -> [Printable] -> [Printable]
lineColorS :: !([Printable] -> [Printable])
                          }
type Printer = Printable -> St -> Document

data Color = Blue | Red | Green | Cyan | Magenta

-- | 'Document' is a wrapper around '[Printable] -> [Printable]' which allows
-- to handle the special case of an empty 'Document' in a non-uniform manner.
-- The simplest 'Documents' are built from 'String's using 'text'.
data Document = Document ([Printable] -> [Printable])
              | Empty

-- | renders a 'Doc' into a 'String' with control codes for the
-- special features of the 'Doc'.
renderString :: Doc -> String
renderString :: Doc -> String
renderString = Printers' -> Doc -> String
renderStringWith Printers'
simplePrinters'

-- | renders a 'Doc' into a 'String' using a given set of printers.
-- If content is only available as 'ByteString', decode according to
-- the current locale.
renderStringWith :: Printers' -> Doc -> String
renderStringWith :: Printers' -> Doc -> String
renderStringWith Printers'
prs Doc
d = (Printable -> String) -> [Printable] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Printable -> String
toString) ([Printable] -> String) -> [Printable] -> String
forall a b. (a -> b) -> a -> b
$ Printers' -> Doc -> [Printable]
renderWith Printers'
prs Doc
d
    where toString :: Printable -> String
toString (S String
s) = String
s
          toString (PS ByteString
ps) = ByteString -> String
decodeLocale ByteString
ps
          toString (Both String
s ByteString
_) = String
s

-- | renders a 'Doc' into 'B.ByteString' with control codes for the
-- special features of the Doc. See also 'readerString'.
renderPS :: Doc -> B.ByteString
renderPS :: Doc -> ByteString
renderPS = Printers' -> Doc -> ByteString
renderPSWith Printers'
simplePrinters'

-- | renders a 'Doc' into a list of 'PackedStrings', one for each line.
renderPSs :: Doc -> [B.ByteString]
renderPSs :: Doc -> [ByteString]
renderPSs = Printers' -> Doc -> [ByteString]
renderPSsWith Printers'
simplePrinters'

-- | renders a 'Doc' into a 'B.ByteString' using a given set of printers.
renderPSWith :: Printers' -> Doc -> B.ByteString
renderPSWith :: Printers' -> Doc -> ByteString
renderPSWith Printers'
prs Doc
d = [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ Printers' -> Doc -> [ByteString]
renderPSsWith Printers'
prs Doc
d

-- | renders a 'Doc' into a list of 'PackedStrings', one for each
-- chunk of text that was added to the 'Doc', using the given set of
-- printers.
renderPSsWith :: Printers' -> Doc -> [B.ByteString]
renderPSsWith :: Printers' -> Doc -> [ByteString]
renderPSsWith Printers'
prs Doc
d = (Printable -> ByteString) -> [Printable] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map Printable -> ByteString
toPS ([Printable] -> [ByteString]) -> [Printable] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ Printers' -> Doc -> [Printable]
renderWith Printers'
prs Doc
d
    where toPS :: Printable -> ByteString
toPS (S String
s)        = String -> ByteString
encodeLocale String
s
          toPS (PS ByteString
ps)      = ByteString
ps
          toPS (Both String
_ ByteString
ps)  = ByteString
ps

-- | renders a 'Doc' into a list of 'Printables' using a set of
-- printers. Each item of the list corresponds to a string that was
-- added to the 'Doc'.
renderWith :: Printers' -> Doc -> [Printable]
renderWith :: Printers' -> Doc -> [Printable]
renderWith Printers'
ps (Doc St -> Document
d) = case St -> Document
d (Printers' -> St
initState Printers'
ps) of
                        Document
Empty -> []
                        Document [Printable] -> [Printable]
f -> [Printable] -> [Printable]
f []

initState :: Printers' -> St
initState :: Printers' -> St
initState Printers'
prs = St :: Printers' -> ([Printable] -> [Printable]) -> St
St { printers :: Printers'
printers = Printers'
prs, currentPrefix :: [Printable] -> [Printable]
currentPrefix = [Printable] -> [Printable]
forall a. a -> a
id }

prefix :: String -> Doc -> Doc
prefix :: String -> Doc -> Doc
prefix String
s (Doc St -> Document
d) = (St -> Document) -> Doc
Doc ((St -> Document) -> Doc) -> (St -> Document) -> Doc
forall a b. (a -> b) -> a -> b
$ \St
st ->
                   let p :: Printable
p = String -> Printable
S String
s
                       st' :: St
st' = St
st { currentPrefix :: [Printable] -> [Printable]
currentPrefix = St -> [Printable] -> [Printable]
currentPrefix St
st ([Printable] -> [Printable])
-> ([Printable] -> [Printable]) -> [Printable] -> [Printable]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Printable
pPrintable -> [Printable] -> [Printable]
forall a. a -> [a] -> [a]
:) } in
                   case St -> Document
d St
st' of
                     Document [Printable] -> [Printable]
d'' -> ([Printable] -> [Printable]) -> Document
Document (([Printable] -> [Printable]) -> Document)
-> ([Printable] -> [Printable]) -> Document
forall a b. (a -> b) -> a -> b
$ (Printable
pPrintable -> [Printable] -> [Printable]
forall a. a -> [a] -> [a]
:) ([Printable] -> [Printable])
-> ([Printable] -> [Printable]) -> [Printable] -> [Printable]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Printable] -> [Printable]
d''
                     Document
Empty -> Document
Empty

-- TODO try to find another way to do this, it's rather a violation
-- of the Doc abstraction
prefixLines :: Doc -> Doc -> Doc
prefixLines :: Doc -> Doc -> Doc
prefixLines Doc
prefixer Doc
prefixee =
  [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Doc -> Doc) -> [Doc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Doc
prefixer Doc -> Doc -> Doc
<+>) ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ (ByteString -> Doc) -> [ByteString] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> Doc
packedString ([ByteString] -> [Doc]) -> [ByteString] -> [Doc]
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
linesPS (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall a b. (a -> b) -> a -> b
$ Doc -> ByteString
renderPS Doc
prefixee

-- TODO try to find another way to do this, it's rather a violation
-- of the Doc abstraction
insertBeforeLastline :: Doc -> Doc -> Doc
insertBeforeLastline :: Doc -> Doc -> Doc
insertBeforeLastline Doc
a Doc
b =
  case [Doc] -> [Doc]
forall a. [a] -> [a]
reverse ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ (ByteString -> Doc) -> [ByteString] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> Doc
packedString ([ByteString] -> [Doc]) -> [ByteString] -> [Doc]
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
linesPS (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall a b. (a -> b) -> a -> b
$ Doc -> ByteString
renderPS Doc
a of
    (Doc
ll:[Doc]
ls) -> [Doc] -> Doc
vcat ([Doc] -> [Doc]
forall a. [a] -> [a]
reverse [Doc]
ls) Doc -> Doc -> Doc
$$ Doc
b Doc -> Doc -> Doc
$$ Doc
ll
    [] ->
      String -> Doc
forall a. HasCallStack => String -> a
error String
"empty Doc given as first argument of Printer.insert_before_last_line"

lineColor :: Color -> Doc -> Doc
lineColor :: Color -> Doc -> Doc
lineColor Color
c Doc
d = (St -> Document) -> Doc
Doc ((St -> Document) -> Doc) -> (St -> Document) -> Doc
forall a b. (a -> b) -> a -> b
$ \St
st -> case Printers' -> Color -> Doc -> Doc
lineColorT (St -> Printers'
printers St
st) Color
c Doc
d of
                             Doc St -> Document
d' -> St -> Document
d' St
st

hiddenPrefix :: String -> Doc -> Doc
hiddenPrefix :: String -> Doc -> Doc
hiddenPrefix String
s (Doc St -> Document
d) =
    (St -> Document) -> Doc
Doc ((St -> Document) -> Doc) -> (St -> Document) -> Doc
forall a b. (a -> b) -> a -> b
$ \St
st -> let pr :: Printers'
pr = St -> Printers'
printers St
st
                     p :: Printable
p = String -> Printable
S (Printers' -> Doc -> String
renderStringWith Printers'
pr (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$ String -> Doc
hiddenText String
s)
                     st' :: St
st' = St
st { currentPrefix :: [Printable] -> [Printable]
currentPrefix = St -> [Printable] -> [Printable]
currentPrefix St
st ([Printable] -> [Printable])
-> ([Printable] -> [Printable]) -> [Printable] -> [Printable]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Printable
pPrintable -> [Printable] -> [Printable]
forall a. a -> [a] -> [a]
:) }
                 in case St -> Document
d St
st' of
                      Document [Printable] -> [Printable]
d'' -> ([Printable] -> [Printable]) -> Document
Document (([Printable] -> [Printable]) -> Document)
-> ([Printable] -> [Printable]) -> Document
forall a b. (a -> b) -> a -> b
$ (Printable
pPrintable -> [Printable] -> [Printable]
forall a. a -> [a] -> [a]
:) ([Printable] -> [Printable])
-> ([Printable] -> [Printable]) -> [Printable] -> [Printable]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Printable] -> [Printable]
d''
                      Document
Empty -> Document
Empty

-- | 'unsafeBoth' builds a Doc from a 'String' and a 'B.ByteString' representing
-- the same text, but does not check that they do.
unsafeBoth :: String -> B.ByteString -> Doc
unsafeBoth :: String -> ByteString -> Doc
unsafeBoth String
s ByteString
ps = (St -> Document) -> Doc
Doc ((St -> Document) -> Doc) -> (St -> Document) -> Doc
forall a b. (a -> b) -> a -> b
$ Printer
simplePrinter (String -> ByteString -> Printable
Both String
s ByteString
ps)

-- | 'unsafeBothText' builds a 'Doc' from a 'String'. The string is stored in the
-- Doc as both a String and a 'B.ByteString'.
unsafeBothText :: String -> Doc
unsafeBothText :: String -> Doc
unsafeBothText String
s = (St -> Document) -> Doc
Doc ((St -> Document) -> Doc) -> (St -> Document) -> Doc
forall a b. (a -> b) -> a -> b
$ Printer
simplePrinter (String -> ByteString -> Printable
Both String
s (String -> ByteString
encodeLocale String
s))

-- | 'packedString' builds a 'Doc' from a 'B.ByteString' using 'printable'
packedString :: B.ByteString -> Doc
packedString :: ByteString -> Doc
packedString = Printable -> Doc
printable (Printable -> Doc)
-> (ByteString -> Printable) -> ByteString -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Printable
PS

-- | 'unsafePackedString' builds a 'Doc' from a 'B.ByteString' using 'simplePrinter'
unsafePackedString :: B.ByteString -> Doc
unsafePackedString :: ByteString -> Doc
unsafePackedString = (St -> Document) -> Doc
Doc ((St -> Document) -> Doc)
-> (ByteString -> St -> Document) -> ByteString -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Printer
simplePrinter Printer
-> (ByteString -> Printable) -> ByteString -> St -> Document
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Printable
PS

-- | 'invisiblePS' creates a 'Doc' with invisible text from a 'B.ByteString'
invisiblePS :: B.ByteString -> Doc
invisiblePS :: ByteString -> Doc
invisiblePS = Printable -> Doc
invisiblePrintable (Printable -> Doc)
-> (ByteString -> Printable) -> ByteString -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Printable
PS

-- | 'userchunkPS' creates a 'Doc' representing a user chunk from a 'B.ByteString'.
--
-- Rrrright. And what, please is that supposed to mean?
userchunkPS :: B.ByteString -> Doc
userchunkPS :: ByteString -> Doc
userchunkPS = Printable -> Doc
userchunkPrintable (Printable -> Doc)
-> (ByteString -> Printable) -> ByteString -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Printable
PS

-- | 'unsafeChar' creates a Doc containing just one character.
unsafeChar :: Char -> Doc
unsafeChar :: Char -> Doc
unsafeChar = String -> Doc
unsafeText (String -> Doc) -> (Char -> String) -> Char -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> String -> String
forall a. a -> [a] -> [a]
:String
"")

-- | 'text' creates a 'Doc' from a @String@, using 'printable'.
text :: String -> Doc
text :: String -> Doc
text = Printable -> Doc
printable (Printable -> Doc) -> (String -> Printable) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Printable
S

-- | 'unsafeText' creates a 'Doc' from a 'String', using 'simplePrinter' directly
unsafeText :: String -> Doc
unsafeText :: String -> Doc
unsafeText = (St -> Document) -> Doc
Doc ((St -> Document) -> Doc)
-> (String -> St -> Document) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Printer
simplePrinter Printer -> (String -> Printable) -> String -> St -> Document
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Printable
S

-- | 'invisibleText' creates a 'Doc' containing invisible text from a @String@
invisibleText :: String -> Doc
invisibleText :: String -> Doc
invisibleText = Printable -> Doc
invisiblePrintable (Printable -> Doc) -> (String -> Printable) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Printable
S

-- | 'hiddenText' creates a 'Doc' containing hidden text from a @String@
hiddenText :: String -> Doc
hiddenText :: String -> Doc
hiddenText = Printable -> Doc
hiddenPrintable (Printable -> Doc) -> (String -> Printable) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Printable
S

-- | 'userchunk' creates a 'Doc' containing a user chunk from a @String@
userchunk :: String -> Doc
userchunk :: String -> Doc
userchunk = Printable -> Doc
userchunkPrintable (Printable -> Doc) -> (String -> Printable) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Printable
S

blueText, redText, greenText, magentaText, cyanText :: String -> Doc
blueText :: String -> Doc
blueText = Color -> String -> Doc
colorText Color
Blue
redText :: String -> Doc
redText = Color -> String -> Doc
colorText Color
Red
greenText :: String -> Doc
greenText = Color -> String -> Doc
colorText Color
Green
magentaText :: String -> Doc
magentaText = Color -> String -> Doc
colorText Color
Magenta
cyanText :: String -> Doc
cyanText = Color -> String -> Doc
colorText Color
Cyan

-- | 'colorText' creates a 'Doc' containing colored text from a @String@
colorText :: Color -> String -> Doc
colorText :: Color -> String -> Doc
colorText Color
c = Color -> Printable -> Doc
mkColorPrintable Color
c (Printable -> Doc) -> (String -> Printable) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Printable
S

-- | @'wrapText' n s@ is a 'Doc' representing @s@ line-wrapped at 'n' characters
wrapText :: Int -> String -> Doc
wrapText :: Int -> String -> Doc
wrapText Int
n String
s =
    [Doc] -> Doc
vcat ([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]
forall a. [a] -> [a]
reverse ([String] -> Doc) -> [String] -> Doc
forall a b. (a -> b) -> a -> b
$ ([String] -> String -> [String])
-> [String] -> [String] -> [String]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl [String] -> String -> [String]
add_to_line [] (String -> [String]
words String
s)
  where add_to_line :: [String] -> String -> [String]
add_to_line [] String
a = [String
a]
        add_to_line (String
"":[String]
d) String
a = String
aString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
d
        add_to_line (String
l:[String]
ls) String
new | String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
new Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
n = String
newString -> [String] -> [String]
forall a. a -> [a] -> [a]
:String
lString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
ls
        add_to_line (String
l:[String]
ls) String
new = (String
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
new)String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
ls

-- | Given a list of 'String's representing the words of a paragraph, format
-- the paragraphs using 'wrapText' and separate them with an empty line.
formatText :: Int -> [String] -> Doc
formatText :: Int -> [String] -> Doc
formatText Int
w = [Doc] -> Doc
vsep ([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 (Int -> String -> Doc
wrapText Int
w)

-- | A variant of 'wrapText' that takes a list of strings as input.
-- Useful when @{-# LANGUAGE CPP #-}@ makes it impossible to use multiline
-- string literals.
formatWords :: [String] -> Doc
formatWords :: [String] -> Doc
formatWords = Int -> String -> Doc
wrapText Int
80 (String -> Doc) -> ([String] -> String) -> [String] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unwords

-- | Creates a 'Doc' from any 'Printable'.
printable :: Printable -> Doc
printable :: Printable -> Doc
printable Printable
x = (St -> Document) -> Doc
Doc ((St -> Document) -> Doc) -> (St -> Document) -> Doc
forall a b. (a -> b) -> a -> b
$ \St
st -> Printers' -> Printer
defP (St -> Printers'
printers St
st) Printable
x St
st

mkColorPrintable :: Color -> Printable -> Doc
mkColorPrintable :: Color -> Printable -> Doc
mkColorPrintable Color
c Printable
x = (St -> Document) -> Doc
Doc ((St -> Document) -> Doc) -> (St -> Document) -> Doc
forall a b. (a -> b) -> a -> b
$ \St
st -> Printers' -> Color -> Printer
colorP (St -> Printers'
printers St
st) Color
c Printable
x St
st

-- | Creates an invisible 'Doc' from any 'Printable'.
invisiblePrintable :: Printable -> Doc
invisiblePrintable :: Printable -> Doc
invisiblePrintable Printable
x = (St -> Document) -> Doc
Doc ((St -> Document) -> Doc) -> (St -> Document) -> Doc
forall a b. (a -> b) -> a -> b
$ \St
st -> Printers' -> Printer
invisibleP (St -> Printers'
printers St
st) Printable
x St
st

-- | Creates a hidden 'Doc' from any 'Printable'.
hiddenPrintable :: Printable -> Doc
hiddenPrintable :: Printable -> Doc
hiddenPrintable Printable
x = (St -> Document) -> Doc
Doc ((St -> Document) -> Doc) -> (St -> Document) -> Doc
forall a b. (a -> b) -> a -> b
$ \St
st -> Printers' -> Printer
hiddenP (St -> Printers'
printers St
st) Printable
x St
st

-- | Creates... WTF is a userchunk???
userchunkPrintable :: Printable -> Doc
userchunkPrintable :: Printable -> Doc
userchunkPrintable Printable
x = (St -> Document) -> Doc
Doc ((St -> Document) -> Doc) -> (St -> Document) -> Doc
forall a b. (a -> b) -> a -> b
$ \St
st -> Printers' -> Printer
userchunkP (St -> Printers'
printers St
st) Printable
x St
st

-- | 'simplePrinters' is a 'Printers' which uses the set 'simplePriners\'' on any
-- handle.
simplePrinters :: Printers
simplePrinters :: Printers
simplePrinters Handle
_ = Printers' -> IO Printers'
forall (m :: * -> *) a. Monad m => a -> m a
return Printers'
simplePrinters'

-- | A set of default printers suitable for any handle. Does not use color.
simplePrinters' :: Printers'
simplePrinters' :: Printers'
simplePrinters'  = Printers :: (Color -> Printer)
-> Printer
-> Printer
-> Printer
-> Printer
-> (Color -> Doc -> Doc)
-> ([Printable] -> [Printable])
-> Printers'
Printers { colorP :: Color -> Printer
colorP = Printer -> Color -> Printer
forall a b. a -> b -> a
const Printer
simplePrinter,
                              invisibleP :: Printer
invisibleP = Printer
simplePrinter,
                              hiddenP :: Printer
hiddenP = Printer
invisiblePrinter,
                              userchunkP :: Printer
userchunkP = Printer
simplePrinter,
                              defP :: Printer
defP = Printer
simplePrinter,
                              lineColorT :: Color -> Doc -> Doc
lineColorT = (Doc -> Doc) -> Color -> Doc -> Doc
forall a b. a -> b -> a
const Doc -> Doc
forall a. a -> a
id,
                              lineColorS :: [Printable] -> [Printable]
lineColorS = [Printable] -> [Printable]
forall a. a -> a
id
                            }

-- | 'simplePrinter' is the simplest 'Printer': it just concatenates together
-- the pieces of the 'Doc'
simplePrinter :: Printer
simplePrinter :: Printer
simplePrinter Printable
x = Doc -> St -> Document
unDoc (Doc -> St -> Document) -> Doc -> St -> Document
forall a b. (a -> b) -> a -> b
$ ([Printable] -> [Printable]) -> Doc
doc (\[Printable]
s -> Printable
xPrintable -> [Printable] -> [Printable]
forall a. a -> [a] -> [a]
:[Printable]
s)

-- | 'invisiblePrinter' is the 'Printer' for hidden text. It just replaces
-- the document with 'empty'.  It's useful to have a printer that doesn't
-- actually do anything because this allows you to have tunable policies,
-- for example, only printing some text if it's to the terminal, but not
-- if it's to a file or vice-versa.
invisiblePrinter :: Printer
invisiblePrinter :: Printer
invisiblePrinter Printable
_ = Doc -> St -> Document
unDoc Doc
empty

infixr 6 `append`
infixr 6 <+>
infixr 5 $+$
infixr 5 $$

-- | The empty 'Doc'
empty :: Doc
empty :: Doc
empty = (St -> Document) -> Doc
Doc ((St -> Document) -> Doc) -> (St -> Document) -> Doc
forall a b. (a -> b) -> a -> b
$ Document -> St -> Document
forall a b. a -> b -> a
const Document
Empty

doc :: ([Printable] -> [Printable]) -> Doc
doc :: ([Printable] -> [Printable]) -> Doc
doc [Printable] -> [Printable]
f = (St -> Document) -> Doc
Doc ((St -> Document) -> Doc) -> (St -> Document) -> Doc
forall a b. (a -> b) -> a -> b
$ Document -> St -> Document
forall a b. a -> b -> a
const (Document -> St -> Document) -> Document -> St -> Document
forall a b. (a -> b) -> a -> b
$ ([Printable] -> [Printable]) -> Document
Document [Printable] -> [Printable]
f

instance Semigroup Doc where
  <> :: Doc -> Doc -> Doc
(<>) = Doc -> Doc -> Doc
append

-- | 'mappend' ('<>') is concatenation, 'mempty' is the 'empty' 'Doc'
instance Monoid Doc where
  mempty :: Doc
mempty = Doc
empty
  mappend :: Doc -> Doc -> Doc
mappend = Doc -> Doc -> Doc
append

-- | Concatenation of two 'Doc's
append :: Doc -> Doc -> Doc
Doc St -> Document
a append :: Doc -> Doc -> Doc
`append` Doc St -> Document
b =
   (St -> Document) -> Doc
Doc ((St -> Document) -> Doc) -> (St -> Document) -> Doc
forall a b. (a -> b) -> a -> b
$ \St
st -> case St -> Document
a St
st of
                Document
Empty -> St -> Document
b St
st
                Document [Printable] -> [Printable]
af ->
                    ([Printable] -> [Printable]) -> Document
Document (\[Printable]
s -> [Printable] -> [Printable]
af ([Printable] -> [Printable]) -> [Printable] -> [Printable]
forall a b. (a -> b) -> a -> b
$ case St -> Document
b St
st of
                                         Document
Empty -> [Printable]
s
                                         Document [Printable] -> [Printable]
bf -> [Printable] -> [Printable]
bf [Printable]
s)

-- | @a '<?>' b@ is @a '<>' b@ if @a@ is not empty, else empty
(<?>) :: Doc -> Doc -> Doc
Doc St -> Document
a <?> :: Doc -> Doc -> Doc
<?> Doc St -> Document
b =
    (St -> Document) -> Doc
Doc ((St -> Document) -> Doc) -> (St -> Document) -> Doc
forall a b. (a -> b) -> a -> b
$ \St
st -> case St -> Document
a St
st of
                 Document
Empty -> Document
Empty
                 Document [Printable] -> [Printable]
af -> ([Printable] -> [Printable]) -> Document
Document (\[Printable]
s -> [Printable] -> [Printable]
af ([Printable] -> [Printable]) -> [Printable] -> [Printable]
forall a b. (a -> b) -> a -> b
$ case St -> Document
b St
st of
                                                     Document
Empty -> [Printable]
s
                                                     Document [Printable] -> [Printable]
bf -> [Printable] -> [Printable]
bf [Printable]
s)

-- | @a '<+>' b@ is @a@ followed by @b@ with a space in between if both are non-empty
(<+>) :: Doc -> Doc -> Doc
Doc St -> Document
a <+> :: Doc -> Doc -> Doc
<+> Doc St -> Document
b =
    (St -> Document) -> Doc
Doc ((St -> Document) -> Doc) -> (St -> Document) -> Doc
forall a b. (a -> b) -> a -> b
$ \St
st -> case St -> Document
a St
st of
                 Document
Empty -> St -> Document
b St
st
                 Document [Printable] -> [Printable]
af -> ([Printable] -> [Printable]) -> Document
Document (\[Printable]
s -> [Printable] -> [Printable]
af ([Printable] -> [Printable]) -> [Printable] -> [Printable]
forall a b. (a -> b) -> a -> b
$ case St -> Document
b St
st of
                                                     Document
Empty -> [Printable]
s
                                                     Document [Printable] -> [Printable]
bf ->
                                                         Printable
spacePPrintable -> [Printable] -> [Printable]
forall a. a -> [a] -> [a]
:[Printable] -> [Printable]
bf [Printable]
s)

-- | @a '$$' b@ is @a@ above @b@
($$) :: Doc -> Doc -> Doc
Doc St -> Document
a $$ :: Doc -> Doc -> Doc
$$ Doc St -> Document
b =
   (St -> Document) -> Doc
Doc ((St -> Document) -> Doc) -> (St -> Document) -> Doc
forall a b. (a -> b) -> a -> b
$ \St
st -> case St -> Document
a St
st of
                Document
Empty -> St -> Document
b St
st
                Document [Printable] -> [Printable]
af ->
                    ([Printable] -> [Printable]) -> Document
Document (\[Printable]
s -> [Printable] -> [Printable]
af ([Printable] -> [Printable]) -> [Printable] -> [Printable]
forall a b. (a -> b) -> a -> b
$ case St -> Document
b St
st of
                                         Document
Empty -> [Printable]
s
                                         Document [Printable] -> [Printable]
bf -> [Printable] -> [Printable]
sf (Printable
newlinePPrintable -> [Printable] -> [Printable]
forall a. a -> [a] -> [a]
:[Printable] -> [Printable]
pf ([Printable] -> [Printable]
bf [Printable]
s)))
                        where pf :: [Printable] -> [Printable]
pf = St -> [Printable] -> [Printable]
currentPrefix St
st
                              sf :: [Printable] -> [Printable]
sf = Printers' -> [Printable] -> [Printable]
lineColorS (Printers' -> [Printable] -> [Printable])
-> Printers' -> [Printable] -> [Printable]
forall a b. (a -> b) -> a -> b
$ St -> Printers'
printers St
st

-- | @a '$+$' b@ is @a@ above @b@ with an empty line in between if both are non-empty
($+$) :: Doc -> Doc -> Doc
Doc St -> Document
a $+$ :: Doc -> Doc -> Doc
$+$ Doc St -> Document
b =
   (St -> Document) -> Doc
Doc ((St -> Document) -> Doc) -> (St -> Document) -> Doc
forall a b. (a -> b) -> a -> b
$ \St
st -> case St -> Document
a St
st of
                Document
Empty -> St -> Document
b St
st
                Document [Printable] -> [Printable]
af ->
                    ([Printable] -> [Printable]) -> Document
Document (\[Printable]
s -> [Printable] -> [Printable]
af ([Printable] -> [Printable]) -> [Printable] -> [Printable]
forall a b. (a -> b) -> a -> b
$ case St -> Document
b St
st of
                                         Document
Empty -> [Printable]
s
                                         Document [Printable] -> [Printable]
bf -> [Printable] -> [Printable]
sf (Printable
newlinePPrintable -> [Printable] -> [Printable]
forall a. a -> [a] -> [a]
:Printable
newlinePPrintable -> [Printable] -> [Printable]
forall a. a -> [a] -> [a]
:[Printable] -> [Printable]
pf ([Printable] -> [Printable]
bf [Printable]
s)))
                        where pf :: [Printable] -> [Printable]
pf = St -> [Printable] -> [Printable]
currentPrefix St
st
                              sf :: [Printable] -> [Printable]
sf = Printers' -> [Printable] -> [Printable]
lineColorS (Printers' -> [Printable] -> [Printable])
-> Printers' -> [Printable] -> [Printable]
forall a b. (a -> b) -> a -> b
$ St -> Printers'
printers St
st

-- | Pile 'Doc's vertically
vcat :: [Doc] -> Doc
vcat :: [Doc] -> Doc
vcat = (Doc -> Doc -> Doc) -> Doc -> [Doc] -> Doc
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Doc -> Doc -> Doc
($$) Doc
empty

-- | Pile 'Doc's vertically, with a blank line in between
vsep :: [Doc] -> Doc
vsep :: [Doc] -> Doc
vsep = (Doc -> Doc -> Doc) -> Doc -> [Doc] -> Doc
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Doc -> Doc -> Doc
($+$) Doc
empty

-- | Concatenate 'Doc's horizontally
hcat :: [Doc] -> Doc
hcat :: [Doc] -> Doc
hcat = [Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat

-- | Concatenate 'Doc's horizontally with a space as separator
hsep :: [Doc] -> Doc
hsep :: [Doc] -> Doc
hsep = (Doc -> Doc -> Doc) -> Doc -> [Doc] -> Doc
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Doc -> Doc -> Doc
(<+>) Doc
empty

-- | Quote a string for screen output
quoted :: String -> Doc
quoted :: String -> Doc
quoted String
s = String -> Doc
text String
"\"" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text (String -> String
escape String
s) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"\""
  where
    escape :: String -> String
escape String
"" = String
""
    escape (Char
c:String
cs) = if Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'\\', Char
'"']
                       then Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
escape String
cs
                       else Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
escape String
cs