module Darcs.Util.Printer
(
Doc(Doc,unDoc)
, empty, (<>), (<?>), (<+>), ($$), ($+$), vcat, vsep, hcat, hsep
, minus, newline, plus, space, backslash, lparen, rparen
, parens, sentence
, text
, hiddenText
, invisibleText
, wrapText, quoted
, formatText
, formatWords
, pathlist
, userchunk, packedString
, prefix
, hiddenPrefix
, insertBeforeLastline
, prefixLines
, invisiblePS, userchunkPS
, renderString, renderStringWith
, renderPS, renderPSWith
, renderPSs, renderPSsWith
, Printers
, Printers'(..)
, Printer
, simplePrinters, invisiblePrinter, simplePrinter
, Printable(..)
, doc
, printable, invisiblePrintable, hiddenPrintable, userchunkPrintable
, Color(..)
, blueText, redText, greenText, magentaText, cyanText
, colorText
, lineColor
, hPutDoc, hPutDocLn, putDoc, putDocLn
, hPutDocWith, hPutDocLnWith, putDocWith, putDocLnWith
, hPutDocCompr
, debugDocLn
, 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 )
data Printable = S !String
| PS !B.ByteString
| Both !String !B.ByteString
spaceP :: Printable
spaceP :: Printable
spaceP = String -> ByteString -> Printable
Both String
" " (Char -> ByteString
BC.singleton Char
' ')
newlineP :: Printable
newlineP :: Printable
newlineP = String -> Printable
S String
"\n"
space :: Doc
space :: Doc
space = String -> ByteString -> Doc
unsafeBoth String
" " (Char -> ByteString
BC.singleton Char
' ')
newline :: Doc
newline :: Doc
newline = Char -> Doc
unsafeChar Char
'\n'
minus :: Doc
minus :: Doc
minus = String -> ByteString -> Doc
unsafeBoth String
"-" (Char -> ByteString
BC.singleton Char
'-')
plus :: Doc
plus :: Doc
plus = String -> ByteString -> Doc
unsafeBoth String
"+" (Char -> ByteString
BC.singleton Char
'+')
backslash :: Doc
backslash :: Doc
backslash = String -> ByteString -> Doc
unsafeBoth String
"\\" (Char -> ByteString
BC.singleton Char
'\\')
lparen :: Doc
lparen :: Doc
lparen = String -> ByteString -> Doc
unsafeBoth String
"(" (Char -> ByteString
BC.singleton Char
'(')
rparen :: Doc
rparen :: Doc
rparen = String -> ByteString -> Doc
unsafeBoth String
")" (Char -> ByteString
BC.singleton Char
')')
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
sentence :: Doc -> Doc
sentence :: Doc -> Doc
sentence = (Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
".")
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 :: Printers -> Doc -> IO ()
putDocWith :: Printers -> Doc -> IO ()
putDocWith Printers
prs = Printers -> Handle -> Doc -> IO ()
hPutDocWith Printers
prs Handle
stdout
putDocLnWith :: Printers -> Doc -> IO ()
putDocLnWith :: Printers -> Doc -> IO ()
putDocLnWith Printers
prs = Printers -> Handle -> Doc -> IO ()
hPutDocLnWith Printers
prs Handle
stdout
putDoc :: Doc -> IO ()
putDoc :: Doc -> IO ()
putDoc = Handle -> Doc -> IO ()
hPutDoc Handle
stdout
putDocLn :: Doc -> IO ()
putDocLn :: Doc -> IO ()
putDocLn = Handle -> Doc -> IO ()
hPutDocLn Handle
stdout
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 :: 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 :: Handle -> Doc -> IO ()
hPutDoc :: Handle -> Doc -> IO ()
hPutDoc = Printers -> Handle -> Doc -> IO ()
hPutDocWith Printers
simplePrinters
hPutDocLn :: Handle -> Doc -> IO ()
hPutDocLn :: Handle -> Doc -> IO ()
hPutDocLn = Printers -> Handle -> Doc -> IO ()
hPutDocLnWith Printers
simplePrinters
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
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 :: 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 :: 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
newtype Doc = Doc { Doc -> St -> Document
unDoc :: St -> Document }
instance IsString Doc where
fromString :: String -> Doc
fromString = String -> Doc
text
data St = St { St -> Printers'
printers :: !Printers',
St -> [Printable] -> [Printable]
currentPrefix :: !([Printable] -> [Printable]) }
type Printers = Handle -> IO Printers'
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
data Document = Document ([Printable] -> [Printable])
| Empty
renderString :: Doc -> String
renderString :: Doc -> String
renderString = Printers' -> Doc -> String
renderStringWith Printers'
simplePrinters'
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
renderPS :: Doc -> B.ByteString
renderPS :: Doc -> ByteString
renderPS = Printers' -> Doc -> ByteString
renderPSWith Printers'
simplePrinters'
renderPSs :: Doc -> [B.ByteString]
renderPSs :: Doc -> [ByteString]
renderPSs = Printers' -> Doc -> [ByteString]
renderPSsWith Printers'
simplePrinters'
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
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
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 :: 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 = currentPrefix st . (p:) } 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
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
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 = currentPrefix st . (p:) }
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 :: 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 :: 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 :: 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 :: 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 :: 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 :: 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 :: 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 :: 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 :: 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 :: 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 :: 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 :: 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 :: 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 :: 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 b a. (b -> a -> b) -> b -> [a] -> b
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 a. [a] -> 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 a. [a] -> 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
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)
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
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
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
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
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 :: Printers
simplePrinters :: Printers
simplePrinters Handle
_ = Printers' -> IO Printers'
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Printers'
simplePrinters'
simplePrinters' :: Printers'
simplePrinters' :: Printers'
simplePrinters' = 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 :: 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 :: Printer
invisiblePrinter :: Printer
invisiblePrinter Printable
_ = Doc -> St -> Document
unDoc Doc
empty
infixr 6 `append`
infixr 6 <+>
infixr 5 $+$
infixr 5 $$
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
instance Monoid Doc where
mempty :: Doc
mempty = Doc
empty
mappend :: Doc -> Doc -> Doc
mappend = Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
(<>)
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)
(<?>) :: 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)
(<+>) :: 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)
($$) :: 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
($+$) :: 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
vcat :: [Doc] -> Doc
vcat :: [Doc] -> Doc
vcat = (Doc -> Doc -> Doc) -> Doc -> [Doc] -> Doc
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Doc -> Doc -> Doc
($$) Doc
empty
vsep :: [Doc] -> Doc
vsep :: [Doc] -> Doc
vsep = (Doc -> Doc -> Doc) -> Doc -> [Doc] -> Doc
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Doc -> Doc -> Doc
($+$) Doc
empty
hcat :: [Doc] -> Doc
hcat :: [Doc] -> Doc
hcat = [Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat
hsep :: [Doc] -> Doc
hsep :: [Doc] -> Doc
hsep = (Doc -> Doc -> Doc) -> Doc -> [Doc] -> Doc
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Doc -> Doc -> Doc
(<+>) Doc
empty
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 a. Eq a => a -> [a] -> 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