{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_HADDOCK prune, not-home #-}
module Core.Text.Utilities (
Render (..),
render,
renderNoAnsi,
indefinite,
oxford,
breakRope,
breakWords,
breakLines,
breakPieces,
isNewline,
wrap,
calculatePositionEnd,
underline,
leftPadWith,
rightPadWith,
quote,
intoPieces,
intoChunks,
byteChunk,
intoDocA,
module Core.Text.Colour,
bold,
) where
import Core.Text.Breaking
import Core.Text.Bytes
import Core.Text.Colour
import Core.Text.Parsing
import Core.Text.Rope
import Data.Bits (Bits (..))
import qualified Data.ByteString as B (ByteString, length, splitAt, unpack)
import Data.Char (intToDigit)
import qualified Data.FingerTree as F (ViewL (..), viewl, (<|))
import Data.Kind (Type)
import qualified Data.List as List (dropWhileEnd, foldl', splitAt)
import qualified Data.Text as T
import qualified Data.Text.Short as S (
ShortText,
replicate,
singleton,
toText,
uncons,
)
import Data.Word (Word8)
import Language.Haskell.TH (litE, stringL)
import Language.Haskell.TH.Quote (QuasiQuoter (QuasiQuoter))
import Prettyprinter (
Doc,
LayoutOptions (LayoutOptions),
PageWidth (AvailablePerLine),
Pretty (..),
SimpleDocStream (..),
annotate,
emptyDoc,
flatAlt,
group,
hsep,
layoutPretty,
pretty,
reAnnotateS,
softline',
unAnnotateS,
vcat,
)
import Prettyprinter.Render.Text (renderLazy)
class Render α where
type Token α :: Type
colourize :: Token α -> AnsiColour
highlight :: α -> Doc (Token α)
intoDocA :: α -> Doc (Token α)
intoDocA :: α -> Doc (Token α)
intoDocA = [Char] -> α -> Doc (Token α)
forall a. HasCallStack => [Char] -> a
error [Char]
"Nothing should be invoking this method directly."
{-# DEPRECATED intoDocA "method'intoDocA' has been renamed 'highlight'; implement that instead." #-}
bold :: AnsiColour -> AnsiColour
bold :: AnsiColour -> AnsiColour
bold = AnsiColour -> AnsiColour
boldColour
{-# DEPRECATED bold "Import Core.Text.Colour and use 'boldColour' instead" #-}
instance Render Rope where
type Token Rope = ()
colourize :: Token Rope -> AnsiColour
colourize = AnsiColour -> () -> AnsiColour
forall a b. a -> b -> a
const AnsiColour
forall a. Monoid a => a
mempty
highlight :: Rope -> Doc (Token Rope)
highlight = (ShortText -> Doc () -> Doc ())
-> Doc () -> FingerTree Width ShortText -> Doc ()
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ShortText -> Doc () -> Doc ()
f Doc ()
forall ann. Doc ann
emptyDoc (FingerTree Width ShortText -> Doc ())
-> (Rope -> FingerTree Width ShortText) -> Rope -> Doc ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rope -> FingerTree Width ShortText
unRope
where
f :: S.ShortText -> Doc () -> Doc ()
f :: ShortText -> Doc () -> Doc ()
f ShortText
piece Doc ()
built = Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
(<>) (Text -> Doc ()
forall a ann. Pretty a => a -> Doc ann
pretty (ShortText -> Text
S.toText ShortText
piece)) Doc ()
built
instance Render Char where
type Token Char = ()
colourize :: Token Char -> AnsiColour
colourize = AnsiColour -> () -> AnsiColour
forall a b. a -> b -> a
const AnsiColour
forall a. Monoid a => a
mempty
highlight :: Char -> Doc (Token Char)
highlight Char
c = Char -> Doc ()
forall a ann. Pretty a => a -> Doc ann
pretty Char
c
instance (Render a) => Render [a] where
type Token [a] = Token a
colourize :: Token [a] -> AnsiColour
colourize = Render a => Token a -> AnsiColour
forall α. Render α => Token α -> AnsiColour
colourize @a
highlight :: [a] -> Doc (Token [a])
highlight = [Doc (Token a)] -> Doc (Token a)
forall a. Monoid a => [a] -> a
mconcat ([Doc (Token a)] -> Doc (Token a))
-> ([a] -> [Doc (Token a)]) -> [a] -> Doc (Token a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Doc (Token a)) -> [a] -> [Doc (Token a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Doc (Token a)
forall α. Render α => α -> Doc (Token α)
highlight
instance Render String where
type Token String = Token Char
colourize :: Token [Char] -> AnsiColour
colourize = Render Char => Token Char -> AnsiColour
forall α. Render α => Token α -> AnsiColour
colourize @Char
highlight :: [Char] -> Doc (Token [Char])
highlight = [Doc ()] -> Doc ()
forall a. Monoid a => [a] -> a
mconcat ([Doc ()] -> Doc ()) -> ([Char] -> [Doc ()]) -> [Char] -> Doc ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Doc ()) -> [Char] -> [Doc ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Doc ()
forall α. Render α => α -> Doc (Token α)
highlight
instance Render T.Text where
type Token T.Text = ()
colourize :: Token Text -> AnsiColour
colourize = AnsiColour -> () -> AnsiColour
forall a b. a -> b -> a
const AnsiColour
forall a. Monoid a => a
mempty
highlight :: Text -> Doc (Token Text)
highlight Text
t = Text -> Doc ()
forall a ann. Pretty a => a -> Doc ann
pretty Text
t
instance Render Bytes where
type Token Bytes = ()
colourize :: Token Bytes -> AnsiColour
colourize = AnsiColour -> () -> AnsiColour
forall a b. a -> b -> a
const AnsiColour
brightGreen
highlight :: Bytes -> Doc (Token Bytes)
highlight = Bytes -> Doc ()
Bytes -> Doc (Token Bytes)
prettyBytes
prettyBytes :: Bytes -> Doc ()
prettyBytes :: Bytes -> Doc ()
prettyBytes =
() -> Doc () -> Doc ()
forall ann. ann -> Doc ann -> Doc ann
annotate () (Doc () -> Doc ()) -> (Bytes -> Doc ()) -> Bytes -> Doc ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc ()] -> Doc ()
forall ann. [Doc ann] -> Doc ann
vcat ([Doc ()] -> Doc ()) -> (Bytes -> [Doc ()]) -> Bytes -> Doc ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc ()] -> [Doc ()]
forall ann. [Doc ann] -> [Doc ann]
twoWords
([Doc ()] -> [Doc ()]) -> (Bytes -> [Doc ()]) -> Bytes -> [Doc ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Doc ()) -> [ByteString] -> [Doc ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Doc ()
forall ann. ByteString -> Doc ann
wordToHex
([ByteString] -> [Doc ()])
-> (Bytes -> [ByteString]) -> Bytes -> [Doc ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
byteChunk
(ByteString -> [ByteString])
-> (Bytes -> ByteString) -> Bytes -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> ByteString
unBytes
twoWords :: [Doc ann] -> [Doc ann]
twoWords :: [Doc ann] -> [Doc ann]
twoWords [Doc ann]
ds = [Doc ann] -> [Doc ann]
forall ann. [Doc ann] -> [Doc ann]
go [Doc ann]
ds
where
go :: [Doc ann] -> [Doc ann]
go [] = []
go [Doc ann
x] = [Doc ann
forall ann. Doc ann
softline' Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
x]
go [Doc ann]
xs =
let (Doc ann
one : Doc ann
two : [], [Doc ann]
remainder) = Int -> [Doc ann] -> ([Doc ann], [Doc ann])
forall a. Int -> [a] -> ([a], [a])
List.splitAt Int
2 [Doc ann]
xs
in Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
group (Doc ann
one Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
spacer Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
two) Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: [Doc ann] -> [Doc ann]
go [Doc ann]
remainder
spacer :: Doc ann
spacer = Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
flatAlt Doc ann
forall ann. Doc ann
softline' Doc ann
" "
byteChunk :: B.ByteString -> [B.ByteString]
byteChunk :: ByteString -> [ByteString]
byteChunk = [ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse ([ByteString] -> [ByteString])
-> (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString -> [ByteString]
go []
where
go :: [ByteString] -> ByteString -> [ByteString]
go [ByteString]
acc ByteString
blob =
let (ByteString
eight, ByteString
remainder) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt Int
8 ByteString
blob
in if ByteString -> Int
B.length ByteString
remainder Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
then ByteString
eight ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
acc
else [ByteString] -> ByteString -> [ByteString]
go (ByteString
eight ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
acc) ByteString
remainder
wordToHex :: B.ByteString -> Doc ann
wordToHex :: ByteString -> Doc ann
wordToHex ByteString
eight =
let ws :: [Word8]
ws = ByteString -> [Word8]
B.unpack ByteString
eight
ds :: [Doc ann]
ds = (Word8 -> Doc ann) -> [Word8] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word8 -> Doc ann
forall ann. Word8 -> Doc ann
byteToHex [Word8]
ws
in [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep [Doc ann]
ds
byteToHex :: Word8 -> Doc ann
byteToHex :: Word8 -> Doc ann
byteToHex Word8
c = Char -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Char
hi Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Char -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Char
low
where
!low :: Char
low = Word8 -> Char
byteToDigit (Word8 -> Char) -> Word8 -> Char
forall a b. (a -> b) -> a -> b
$ Word8
c Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0xf
!hi :: Char
hi = Word8 -> Char
byteToDigit (Word8 -> Char) -> Word8 -> Char
forall a b. (a -> b) -> a -> b
$ (Word8
c Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0xf0) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
4
byteToDigit :: Word8 -> Char
byteToDigit :: Word8 -> Char
byteToDigit = Int -> Char
intToDigit (Int -> Char) -> (Word8 -> Int) -> Word8 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
render :: Render α => Int -> α -> Rope
render :: Int -> α -> Rope
render Int
columns (α
thing :: α) =
let options :: LayoutOptions
options = PageWidth -> LayoutOptions
LayoutOptions (Int -> Double -> PageWidth
AvailablePerLine (Int
columns Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Double
1.0)
in [AnsiColour] -> SimpleDocStream AnsiColour -> Rope
go [] (SimpleDocStream AnsiColour -> Rope)
-> (α -> SimpleDocStream AnsiColour) -> α -> Rope
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Token α -> AnsiColour)
-> SimpleDocStream (Token α) -> SimpleDocStream AnsiColour
forall ann ann'.
(ann -> ann') -> SimpleDocStream ann -> SimpleDocStream ann'
reAnnotateS (Render α => Token α -> AnsiColour
forall α. Render α => Token α -> AnsiColour
colourize @α)
(SimpleDocStream (Token α) -> SimpleDocStream AnsiColour)
-> (α -> SimpleDocStream (Token α))
-> α
-> SimpleDocStream AnsiColour
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayoutOptions -> Doc (Token α) -> SimpleDocStream (Token α)
forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutPretty LayoutOptions
options
(Doc (Token α) -> SimpleDocStream (Token α))
-> (α -> Doc (Token α)) -> α -> SimpleDocStream (Token α)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. α -> Doc (Token α)
forall α. Render α => α -> Doc (Token α)
highlight
(α -> Rope) -> α -> Rope
forall a b. (a -> b) -> a -> b
$ α
thing
where
go :: [AnsiColour] -> SimpleDocStream AnsiColour -> Rope
go :: [AnsiColour] -> SimpleDocStream AnsiColour -> Rope
go [AnsiColour]
as SimpleDocStream AnsiColour
x = case SimpleDocStream AnsiColour
x of
SimpleDocStream AnsiColour
SFail -> [Char] -> Rope
forall a. HasCallStack => [Char] -> a
error [Char]
"Unhandled SFail"
SimpleDocStream AnsiColour
SEmpty -> Rope
emptyRope
SChar Char
c SimpleDocStream AnsiColour
xs ->
Char -> Rope
singletonRope Char
c Rope -> Rope -> Rope
forall a. Semigroup a => a -> a -> a
<> [AnsiColour] -> SimpleDocStream AnsiColour -> Rope
go [AnsiColour]
as SimpleDocStream AnsiColour
xs
SText Int
_ Text
t SimpleDocStream AnsiColour
xs ->
Text -> Rope
forall α. Textual α => α -> Rope
intoRope Text
t Rope -> Rope -> Rope
forall a. Semigroup a => a -> a -> a
<> [AnsiColour] -> SimpleDocStream AnsiColour -> Rope
go [AnsiColour]
as SimpleDocStream AnsiColour
xs
SLine Int
len SimpleDocStream AnsiColour
xs ->
Char -> Rope
singletonRope Char
'\n'
Rope -> Rope -> Rope
forall a. Semigroup a => a -> a -> a
<> Int -> Char -> Rope
replicateChar Int
len Char
' '
Rope -> Rope -> Rope
forall a. Semigroup a => a -> a -> a
<> [AnsiColour] -> SimpleDocStream AnsiColour -> Rope
go [AnsiColour]
as SimpleDocStream AnsiColour
xs
SAnnPush AnsiColour
a SimpleDocStream AnsiColour
xs ->
Rope -> Rope
forall α. Textual α => α -> Rope
intoRope (AnsiColour -> Rope
convert AnsiColour
a) Rope -> Rope -> Rope
forall a. Semigroup a => a -> a -> a
<> [AnsiColour] -> SimpleDocStream AnsiColour -> Rope
go (AnsiColour
a AnsiColour -> [AnsiColour] -> [AnsiColour]
forall a. a -> [a] -> [a]
: [AnsiColour]
as) SimpleDocStream AnsiColour
xs
SAnnPop SimpleDocStream AnsiColour
xs ->
case [AnsiColour]
as of
[] -> [Char] -> Rope
forall a. HasCallStack => [Char] -> a
error [Char]
"Popped an empty stack"
(AnsiColour
_ : [AnsiColour]
as') -> case [AnsiColour]
as' of
[] -> Rope
reset Rope -> Rope -> Rope
forall a. Semigroup a => a -> a -> a
<> [AnsiColour] -> SimpleDocStream AnsiColour -> Rope
go [] SimpleDocStream AnsiColour
xs
(AnsiColour
a : [AnsiColour]
_) -> AnsiColour -> Rope
convert AnsiColour
a Rope -> Rope -> Rope
forall a. Semigroup a => a -> a -> a
<> [AnsiColour] -> SimpleDocStream AnsiColour -> Rope
go [AnsiColour]
as' SimpleDocStream AnsiColour
xs
convert :: AnsiColour -> Rope
convert :: AnsiColour -> Rope
convert = AnsiColour -> Rope
intoEscapes
reset :: Rope
reset :: Rope
reset = AnsiColour -> Rope
intoEscapes AnsiColour
resetColour
renderNoAnsi :: Render α => Int -> α -> Rope
renderNoAnsi :: Int -> α -> Rope
renderNoAnsi Int
columns (α
thing :: α) =
let options :: LayoutOptions
options = PageWidth -> LayoutOptions
LayoutOptions (Int -> Double -> PageWidth
AvailablePerLine (Int
columns Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Double
1.0)
in Text -> Rope
forall α. Textual α => α -> Rope
intoRope (Text -> Rope) -> (α -> Text) -> α -> Rope
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleDocStream Any -> Text
forall ann. SimpleDocStream ann -> Text
renderLazy (SimpleDocStream Any -> Text)
-> (α -> SimpleDocStream Any) -> α -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleDocStream (Token α) -> SimpleDocStream Any
forall ann xxx. SimpleDocStream ann -> SimpleDocStream xxx
unAnnotateS
(SimpleDocStream (Token α) -> SimpleDocStream Any)
-> (α -> SimpleDocStream (Token α)) -> α -> SimpleDocStream Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayoutOptions -> Doc (Token α) -> SimpleDocStream (Token α)
forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutPretty LayoutOptions
options
(Doc (Token α) -> SimpleDocStream (Token α))
-> (α -> Doc (Token α)) -> α -> SimpleDocStream (Token α)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. α -> Doc (Token α)
forall α. Render α => α -> Doc (Token α)
highlight
(α -> Rope) -> α -> Rope
forall a b. (a -> b) -> a -> b
$ α
thing
indefinite :: Rope -> Rope
indefinite :: Rope -> Rope
indefinite Rope
text =
let x :: FingerTree Width ShortText
x = Rope -> FingerTree Width ShortText
unRope Rope
text
in case FingerTree Width ShortText -> ViewL (FingerTree Width) ShortText
forall v a.
Measured v a =>
FingerTree v a -> ViewL (FingerTree v) a
F.viewl FingerTree Width ShortText
x of
ViewL (FingerTree Width) ShortText
F.EmptyL -> Rope
text
ShortText
piece F.:< FingerTree Width ShortText
_ -> case ShortText -> Maybe (Char, ShortText)
S.uncons ShortText
piece of
Maybe (Char, ShortText)
Nothing -> Rope
text
Just (Char
c, ShortText
_) ->
if Char
c Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'A', Char
'E', Char
'I', Char
'O', Char
'U', Char
'a', Char
'e', Char
'i', Char
'o', Char
'u']
then FingerTree Width ShortText -> Rope
forall α. Textual α => α -> Rope
intoRope (ShortText
"an " ShortText
-> FingerTree Width ShortText -> FingerTree Width ShortText
forall v a. Measured v a => a -> FingerTree v a -> FingerTree v a
F.<| FingerTree Width ShortText
x)
else FingerTree Width ShortText -> Rope
forall α. Textual α => α -> Rope
intoRope (ShortText
"a " ShortText
-> FingerTree Width ShortText -> FingerTree Width ShortText
forall v a. Measured v a => a -> FingerTree v a -> FingerTree v a
F.<| FingerTree Width ShortText
x)
oxford :: [Rope] -> Rope
oxford :: [Rope] -> Rope
oxford [] = Rope
emptyRope
oxford (Rope
first : []) = Rope
first
oxford (Rope
first : Rope
second : []) = Rope
first Rope -> Rope -> Rope
forall a. Semigroup a => a -> a -> a
<> Rope
" and " Rope -> Rope -> Rope
forall a. Semigroup a => a -> a -> a
<> Rope
second
oxford (Rope
first : [Rope]
remainder) = Rope
first Rope -> Rope -> Rope
forall a. Semigroup a => a -> a -> a
<> [Rope] -> Rope
series [Rope]
remainder
where
series :: [Rope] -> Rope
series [] = Rope
emptyRope
series (Rope
item : []) = Rope
", and " Rope -> Rope -> Rope
forall a. Semigroup a => a -> a -> a
<> Rope
item
series (Rope
item : [Rope]
items) = Rope
", " Rope -> Rope -> Rope
forall a. Semigroup a => a -> a -> a
<> Rope
item Rope -> Rope -> Rope
forall a. Semigroup a => a -> a -> a
<> [Rope] -> Rope
series [Rope]
items
wrap :: Int -> Rope -> Rope
wrap :: Int -> Rope -> Rope
wrap Int
margin Rope
text =
let built :: Rope
built = Int -> [Rope] -> Rope
wrapHelper Int
margin (Rope -> [Rope]
breakWords Rope
text)
in Rope
built
wrapHelper :: Int -> [Rope] -> Rope
wrapHelper :: Int -> [Rope] -> Rope
wrapHelper Int
_ [] = Rope
""
wrapHelper Int
_ [Rope
x] = Rope
x
wrapHelper Int
margin (Rope
x : [Rope]
xs) =
(Int, Rope) -> Rope
forall a b. (a, b) -> b
snd ((Int, Rope) -> Rope) -> (Int, Rope) -> Rope
forall a b. (a -> b) -> a -> b
$ ((Int, Rope) -> Rope -> (Int, Rope))
-> (Int, Rope) -> [Rope] -> (Int, Rope)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' (Int -> (Int, Rope) -> Rope -> (Int, Rope)
wrapLine Int
margin) (Rope -> Int
widthRope Rope
x, Rope
x) [Rope]
xs
wrapLine :: Int -> (Int, Rope) -> Rope -> (Int, Rope)
wrapLine :: Int -> (Int, Rope) -> Rope -> (Int, Rope)
wrapLine Int
margin (Int
pos, Rope
builder) Rope
word =
let wide :: Int
wide = Rope -> Int
widthRope Rope
word
wide' :: Int
wide' = Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
wide Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
in if Int
wide' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
margin
then (Int
wide, Rope
builder Rope -> Rope -> Rope
forall a. Semigroup a => a -> a -> a
<> Rope
"\n" Rope -> Rope -> Rope
forall a. Semigroup a => a -> a -> a
<> Rope
word)
else (Int
wide', Rope
builder Rope -> Rope -> Rope
forall a. Semigroup a => a -> a -> a
<> Rope
" " Rope -> Rope -> Rope
forall a. Semigroup a => a -> a -> a
<> Rope
word)
underline :: Char -> Rope -> Rope
underline :: Char -> Rope -> Rope
underline Char
level Rope
text =
let title :: Text
title = Rope -> Text
forall α. Textual α => Rope -> α
fromRope Rope
text
line :: Text
line = (Char -> Char) -> Text -> Text
T.map (\Char
_ -> Char
level) Text
title
in Text -> Rope
forall α. Textual α => α -> Rope
intoRope Text
line
leftPadWith :: Char -> Int -> Rope -> Rope
leftPadWith :: Char -> Int -> Rope -> Rope
leftPadWith Char
c Int
digits Rope
text =
ShortText -> Rope
forall α. Textual α => α -> Rope
intoRope ShortText
pad Rope -> Rope -> Rope
forall a. Semigroup a => a -> a -> a
<> Rope
text
where
pad :: ShortText
pad = Int -> ShortText -> ShortText
S.replicate Int
len (Char -> ShortText
S.singleton Char
c)
len :: Int
len = Int
digits Int -> Int -> Int
forall a. Num a => a -> a -> a
- Rope -> Int
widthRope Rope
text
rightPadWith :: Char -> Int -> Rope -> Rope
rightPadWith :: Char -> Int -> Rope -> Rope
rightPadWith Char
c Int
digits Rope
text =
Rope
text Rope -> Rope -> Rope
forall a. Semigroup a => a -> a -> a
<> ShortText -> Rope
forall α. Textual α => α -> Rope
intoRope ShortText
pad
where
pad :: ShortText
pad = Int -> ShortText -> ShortText
S.replicate Int
len (Char -> ShortText
S.singleton Char
c)
len :: Int
len = Int
digits Int -> Int -> Int
forall a. Num a => a -> a -> a
- Rope -> Int
widthRope Rope
text
quote :: QuasiQuoter
quote :: QuasiQuoter
quote =
([Char] -> Q Exp)
-> ([Char] -> Q Pat)
-> ([Char] -> Q Type)
-> ([Char] -> Q [Dec])
-> QuasiQuoter
QuasiQuoter
(Lit -> Q Exp
litE (Lit -> Q Exp) -> ([Char] -> Lit) -> [Char] -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Lit
stringL ([Char] -> Lit) -> ([Char] -> [Char]) -> [Char] -> Lit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
trim)
([Char] -> [Char] -> Q Pat
forall a. HasCallStack => [Char] -> a
error [Char]
"Cannot use [quote| ... |] in a pattern")
([Char] -> [Char] -> Q Type
forall a. HasCallStack => [Char] -> a
error [Char]
"Cannot use [quote| ... |] as a type")
([Char] -> [Char] -> Q [Dec]
forall a. HasCallStack => [Char] -> a
error [Char]
"Cannot use [quote| ... |] for a declaration")
where
trim :: String -> String
trim :: [Char] -> [Char]
trim = [Char] -> [Char]
bot ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
top
top :: [Char] -> [Char]
top [] = []
top (Char
'\n' : [Char]
cs) = [Char]
cs
top [Char]
str = [Char]
str
bot :: [Char] -> [Char]
bot = (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
List.dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ')