{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE LambdaCase #-}
{-# OPTIONS_GHC -Wno-name-shadowing #-}
module Text.PrettyPrint.Avh4.Block
(
Line,
space,
string7,
char7,
stringUtf8,
lineFromBuilder,
commentByteString,
Block,
render,
blankLine,
line,
mustBreak,
stack,
stackForce,
andThen,
indent,
prefix,
addSuffix,
joinMustBreak,
prefixOrIndent,
rowOrStack,
rowOrStackForce,
rowOrIndent,
rowOrIndentForce,
)
where
import Data.ByteString (ByteString)
import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Builder as B
import Data.List.NonEmpty (NonEmpty ((:|)))
import qualified Data.List.NonEmpty as NonEmpty
import Data.Semigroup (sconcat)
import Text.PrettyPrint.Avh4.Indent (Indent)
import qualified Text.PrettyPrint.Avh4.Indent as Indent
data Line
= Text B.Builder
| Row Line Line
| Space
| Blank
instance Semigroup Line where
Line
a <> :: Line -> Line -> Line
<> Line
b = Line -> Line -> Line
Row Line
a Line
b
char7 :: Char -> Line
char7 :: Char -> Line
char7 = Builder -> Line
Text forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Builder
B.char7
string7 :: String -> Line
string7 :: String -> Line
string7 = Builder -> Line
Text forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Builder
B.string7
stringUtf8 :: String -> Line
stringUtf8 :: String -> Line
stringUtf8 = Builder -> Line
Text forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Builder
B.stringUtf8
lineFromBuilder :: B.Builder -> Line
lineFromBuilder :: Builder -> Line
lineFromBuilder = Builder -> Line
Text
{-# INLINE mkTextByteString #-}
mkTextByteString :: ByteString -> Line
mkTextByteString :: ByteString -> Line
mkTextByteString = Builder -> Line
Text forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder
B.byteString
commentByteString :: ByteString -> Line
ByteString
bs =
if ByteString -> Bool
ByteString.null ByteString
bs
then Line
Blank
else ByteString -> Line
mkTextByteString ByteString
bs
space :: Line
space :: Line
space =
Line
Space
data Indented a
= Indented Indent a
deriving (forall a b. a -> Indented b -> Indented a
forall a b. (a -> b) -> Indented a -> Indented b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Indented b -> Indented a
$c<$ :: forall a b. a -> Indented b -> Indented a
fmap :: forall a b. (a -> b) -> Indented a -> Indented b
$cfmap :: forall a b. (a -> b) -> Indented a -> Indented b
Functor)
data Block
= SingleLine (Indented Line)
| Stack (Indented Line) (Indented Line) [Indented Line]
| MustBreak (Indented Line)
blankLine :: Block
blankLine :: Block
blankLine =
Line -> Block
line Line
Blank
line :: Line -> Block
line :: Line -> Block
line =
Indented Line -> Block
SingleLine forall b c a. (b -> c) -> (a -> b) -> a -> c
. Line -> Indented Line
mkIndentedLine
mustBreak :: Line -> Block
mustBreak :: Line -> Block
mustBreak =
Indented Line -> Block
MustBreak forall b c a. (b -> c) -> (a -> b) -> a -> c
. Line -> Indented Line
mkIndentedLine
mkIndentedLine :: Line -> Indented Line
mkIndentedLine :: Line -> Indented Line
mkIndentedLine Line
Space = forall a. Indent -> a -> Indented a
Indented (Word -> Indent
Indent.spaces Word
1) Line
Blank
mkIndentedLine (Row Line
Space Line
next) =
let (Indented Indent
i Line
rest') = Line -> Indented Line
mkIndentedLine Line
next
in forall a. Indent -> a -> Indented a
Indented (Word -> Indent
Indent.spaces Word
1 forall a. Semigroup a => a -> a -> a
<> Indent
i) Line
rest'
mkIndentedLine Line
other = forall a. Indent -> a -> Indented a
Indented forall a. Monoid a => a
mempty Line
other
stackForce :: Block -> Block -> Block
stackForce :: Block -> Block -> Block
stackForce Block
b1 Block
b2 =
let (Indented Line
line1first, [Indented Line]
line1rest) = Block -> (Indented Line, [Indented Line])
destructure Block
b1
(Indented Line
line2first, [Indented Line]
line2rest) = Block -> (Indented Line, [Indented Line])
destructure Block
b2
in case [Indented Line]
line1rest forall a. [a] -> [a] -> [a]
++ Indented Line
line2first forall a. a -> [a] -> [a]
: [Indented Line]
line2rest of
[] ->
forall a. HasCallStack => String -> a
error String
"the list will contain at least line2first"
Indented Line
first : [Indented Line]
rest ->
Indented Line -> Indented Line -> [Indented Line] -> Block
Stack Indented Line
line1first Indented Line
first [Indented Line]
rest
andThen :: [Block] -> Block -> Block
andThen :: [Block] -> Block -> Block
andThen [Block]
rest Block
first =
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Block -> Block -> Block
stackForce Block
first [Block]
rest
stack :: NonEmpty Block -> Block
stack :: NonEmpty Block -> Block
stack = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Block -> Block -> Block
stackForce
joinMustBreak :: Block -> Block -> Block
joinMustBreak :: Block -> Block -> Block
joinMustBreak Block
inner Block
eol =
case (Block
inner, Block
eol) of
(SingleLine (Indented Indent
i1 Line
inner'), SingleLine (Indented Indent
_ Line
eol')) ->
Indented Line -> Block
SingleLine forall a b. (a -> b) -> a -> b
$
forall a. Indent -> a -> Indented a
Indented Indent
i1 forall a b. (a -> b) -> a -> b
$
Line
inner' forall a. Semigroup a => a -> a -> a
<> Line
space forall a. Semigroup a => a -> a -> a
<> Line
eol'
(SingleLine (Indented Indent
i1 Line
inner'), MustBreak (Indented Indent
_ Line
eol')) ->
Indented Line -> Block
MustBreak forall a b. (a -> b) -> a -> b
$
forall a. Indent -> a -> Indented a
Indented Indent
i1 forall a b. (a -> b) -> a -> b
$
Line
inner' forall a. Semigroup a => a -> a -> a
<> Line
space forall a. Semigroup a => a -> a -> a
<> Line
eol'
(Block, Block)
_ ->
Block -> Block -> Block
stackForce Block
inner Block
eol
{-# INLINE prefixOrIndent #-}
prefixOrIndent :: Maybe Line -> Line -> Block -> Block
prefixOrIndent :: Maybe Line -> Line -> Block -> Block
prefixOrIndent Maybe Line
joiner Line
a Block
b =
let join :: Line -> Line -> Line
join Line
a Line
b =
case Maybe Line
joiner of
Maybe Line
Nothing -> Line
a forall a. Semigroup a => a -> a -> a
<> Line
b
Just Line
j -> Line
a forall a. Semigroup a => a -> a -> a
<> Line
j forall a. Semigroup a => a -> a -> a
<> Line
b
in case Block
b of
SingleLine (Indented Indent
_ Line
b') ->
Line -> Block
line forall a b. (a -> b) -> a -> b
$ Line -> Line -> Line
join Line
a Line
b'
MustBreak (Indented Indent
_ Line
b') ->
Line -> Block
mustBreak forall a b. (a -> b) -> a -> b
$ Line -> Line -> Line
join Line
a Line
b'
Block
_ ->
Block -> Block -> Block
stackForce (Line -> Block
line Line
a) (Block -> Block
indent Block
b)
mapLines :: (Indented Line -> Indented Line) -> Block -> Block
mapLines :: (Indented Line -> Indented Line) -> Block -> Block
mapLines Indented Line -> Indented Line
fn =
(Indented Line -> Indented Line)
-> (Indented Line -> Indented Line) -> Block -> Block
mapFirstLine Indented Line -> Indented Line
fn Indented Line -> Indented Line
fn
mapFirstLine :: (Indented Line -> Indented Line) -> (Indented Line -> Indented Line) -> Block -> Block
mapFirstLine :: (Indented Line -> Indented Line)
-> (Indented Line -> Indented Line) -> Block -> Block
mapFirstLine Indented Line -> Indented Line
firstFn Indented Line -> Indented Line
restFn Block
b =
case Block
b of
SingleLine Indented Line
l1 ->
Indented Line -> Block
SingleLine (Indented Line -> Indented Line
firstFn Indented Line
l1)
Stack Indented Line
l1 Indented Line
l2 [Indented Line]
ls ->
Indented Line -> Indented Line -> [Indented Line] -> Block
Stack (Indented Line -> Indented Line
firstFn Indented Line
l1) (Indented Line -> Indented Line
restFn Indented Line
l2) (forall a b. (a -> b) -> [a] -> [b]
map Indented Line -> Indented Line
restFn [Indented Line]
ls)
MustBreak Indented Line
l1 ->
Indented Line -> Block
MustBreak (Indented Line -> Indented Line
firstFn Indented Line
l1)
mapLastLine :: (Indented Line -> Indented Line) -> Block -> Block
mapLastLine :: (Indented Line -> Indented Line) -> Block -> Block
mapLastLine Indented Line -> Indented Line
lastFn = \case
SingleLine Indented Line
l1 ->
Indented Line -> Block
SingleLine (Indented Line -> Indented Line
lastFn Indented Line
l1)
Stack Indented Line
l1 Indented Line
l2 [] ->
Indented Line -> Indented Line -> [Indented Line] -> Block
Stack Indented Line
l1 (Indented Line -> Indented Line
lastFn Indented Line
l2) []
Stack Indented Line
l1 Indented Line
l2 [Indented Line]
ls ->
Indented Line -> Indented Line -> [Indented Line] -> Block
Stack Indented Line
l1 Indented Line
l2 (forall a. [a] -> [a]
init [Indented Line]
ls forall a. [a] -> [a] -> [a]
++ [Indented Line -> Indented Line
lastFn forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
last [Indented Line]
ls])
MustBreak Indented Line
l1 ->
Indented Line -> Block
MustBreak (Indented Line -> Indented Line
lastFn Indented Line
l1)
indent :: Block -> Block
indent :: Block -> Block
indent =
(Indented Line -> Indented Line) -> Block -> Block
mapLines (\(Indented Indent
i Line
l) -> forall a. Indent -> a -> Indented a
Indented (Indent
Indent.tab forall a. Semigroup a => a -> a -> a
<> Indent
i) Line
l)
{-# INLINE rowOrStack #-}
rowOrStack :: Maybe Line -> NonEmpty Block -> Block
rowOrStack :: Maybe Line -> NonEmpty Block -> Block
rowOrStack = Bool -> Maybe Line -> NonEmpty Block -> Block
rowOrStackForce Bool
False
{-# INLINE rowOrStackForce #-}
rowOrStackForce :: Bool -> Maybe Line -> NonEmpty Block -> Block
rowOrStackForce :: Bool -> Maybe Line -> NonEmpty Block -> Block
rowOrStackForce Bool
_ Maybe Line
_ (Block
single :| []) = Block
single
rowOrStackForce Bool
forceMultiline (Just Line
joiner) NonEmpty Block
blocks =
case forall (t :: * -> *).
Traversable t =>
t Block -> Either (t Block) (t Line)
allSingles NonEmpty Block
blocks of
Right NonEmpty Line
lines
| Bool -> Bool
not Bool
forceMultiline ->
Line -> Block
line forall a b. (a -> b) -> a -> b
$ forall a. Semigroup a => NonEmpty a -> a
sconcat forall a b. (a -> b) -> a -> b
$ forall a. a -> NonEmpty a -> NonEmpty a
NonEmpty.intersperse Line
joiner NonEmpty Line
lines
Either (NonEmpty Block) (NonEmpty Line)
_ ->
NonEmpty Block -> Block
stack NonEmpty Block
blocks
rowOrStackForce Bool
forceMultiline Maybe Line
Nothing NonEmpty Block
blocks =
case forall (t :: * -> *).
Traversable t =>
t Block -> Either (t Block) (t Line)
allSingles NonEmpty Block
blocks of
Right NonEmpty Line
lines
| Bool -> Bool
not Bool
forceMultiline ->
Line -> Block
line forall a b. (a -> b) -> a -> b
$ forall a. Semigroup a => NonEmpty a -> a
sconcat NonEmpty Line
lines
Either (NonEmpty Block) (NonEmpty Line)
_ ->
NonEmpty Block -> Block
stack NonEmpty Block
blocks
{-# INLINE rowOrIndent #-}
rowOrIndent :: Maybe Line -> NonEmpty Block -> Block
rowOrIndent :: Maybe Line -> NonEmpty Block -> Block
rowOrIndent = Bool -> Maybe Line -> NonEmpty Block -> Block
rowOrIndentForce Bool
False
{-# INLINE rowOrIndentForce #-}
rowOrIndentForce :: Bool -> Maybe Line -> NonEmpty Block -> Block
rowOrIndentForce :: Bool -> Maybe Line -> NonEmpty Block -> Block
rowOrIndentForce Bool
_ Maybe Line
_ (Block
single :| []) = Block
single
rowOrIndentForce Bool
forceMultiline (Just Line
joiner) blocks :: NonEmpty Block
blocks@(Block
b1 :| [Block]
rest) =
case forall (t :: * -> *).
Traversable t =>
t Block -> Either (t Block) (t Line)
allSingles NonEmpty Block
blocks of
Right NonEmpty Line
lines
| Bool -> Bool
not Bool
forceMultiline ->
Line -> Block
line forall a b. (a -> b) -> a -> b
$ forall a. Semigroup a => NonEmpty a -> a
sconcat forall a b. (a -> b) -> a -> b
$ forall a. a -> NonEmpty a -> NonEmpty a
NonEmpty.intersperse Line
joiner NonEmpty Line
lines
Either (NonEmpty Block) (NonEmpty Line)
_ ->
NonEmpty Block -> Block
stack (Block
b1 forall a. a -> [a] -> NonEmpty a
:| (Block -> Block
indent forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Block]
rest))
rowOrIndentForce Bool
forceMultiline Maybe Line
Nothing blocks :: NonEmpty Block
blocks@(Block
b1 :| [Block]
rest) =
case forall (t :: * -> *).
Traversable t =>
t Block -> Either (t Block) (t Line)
allSingles NonEmpty Block
blocks of
Right NonEmpty Line
lines
| Bool -> Bool
not Bool
forceMultiline ->
Line -> Block
line forall a b. (a -> b) -> a -> b
$ forall a. Semigroup a => NonEmpty a -> a
sconcat NonEmpty Line
lines
Either (NonEmpty Block) (NonEmpty Line)
_ ->
NonEmpty Block -> Block
stack (Block
b1 forall a. a -> [a] -> NonEmpty a
:| (Block -> Block
indent forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Block]
rest))
{-# DEPRECATED isLine "Rewrite to avoid inspecting the child blocks" #-}
isLine :: Block -> Either Block Line
isLine :: Block -> Either Block Line
isLine Block
b =
case Block
b of
SingleLine (Indented Indent
_ Line
l) ->
forall a b. b -> Either a b
Right Line
l
Block
_ ->
forall a b. a -> Either a b
Left Block
b
destructure :: Block -> (Indented Line, [Indented Line])
destructure :: Block -> (Indented Line, [Indented Line])
destructure Block
b =
case Block
b of
SingleLine Indented Line
l1 ->
(Indented Line
l1, [])
Stack Indented Line
l1 Indented Line
l2 [Indented Line]
rest ->
(Indented Line
l1, Indented Line
l2 forall a. a -> [a] -> [a]
: [Indented Line]
rest)
MustBreak Indented Line
l1 ->
(Indented Line
l1, [])
allSingles :: Traversable t => t Block -> Either (t Block) (t Line)
allSingles :: forall (t :: * -> *).
Traversable t =>
t Block -> Either (t Block) (t Line)
allSingles t Block
blocks =
case forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Block -> Either Block Line
isLine t Block
blocks of
Right t Line
lines' ->
forall a b. b -> Either a b
Right t Line
lines'
Either Block (t Line)
_ ->
forall a b. a -> Either a b
Left t Block
blocks
prefix :: Word -> Line -> Block -> Block
prefix :: Word -> Line -> Block -> Block
prefix Word
prefixLength Line
pref =
let padLineWithSpaces :: Indented a -> Indented a
padLineWithSpaces (Indented Indent
i a
l) = forall a. Indent -> a -> Indented a
Indented (Word -> Indent
Indent.spaces Word
prefixLength forall a. Semigroup a => a -> a -> a
<> Indent
i) a
l
addPrefixToLine :: Line -> Line
addPrefixToLine Line
Blank = Line -> Line
stripEnd Line
pref
addPrefixToLine Line
l = Line
pref forall a. Semigroup a => a -> a -> a
<> Line
l
in (Indented Line -> Indented Line)
-> (Indented Line -> Indented Line) -> Block -> Block
mapFirstLine (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Line -> Line
addPrefixToLine) forall {a}. Indented a -> Indented a
padLineWithSpaces
stripEnd :: Line -> Line
stripEnd :: Line -> Line
stripEnd = \case
Line
Space -> Line
Blank
Row Line
r1 Line
r2 ->
case (Line -> Line
stripEnd Line
r1, Line -> Line
stripEnd Line
r2) of
(Line
r1', Line
Blank) -> Line
r1'
(Line
Blank, Line
r2') -> Line
r2'
(Line
r1', Line
r2') -> Line -> Line -> Line
Row Line
r1' Line
r2'
Text Builder
t -> Builder -> Line
Text Builder
t
Line
Blank -> Line
Blank
addSuffix :: Line -> Block -> Block
addSuffix :: Line -> Block -> Block
addSuffix Line
suffix =
(Indented Line -> Indented Line) -> Block -> Block
mapLastLine forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Semigroup a => a -> a -> a
<> Line
suffix)
renderIndentedLine :: Indented Line -> B.Builder
renderIndentedLine :: Indented Line -> Builder
renderIndentedLine (Indented Indent
i Line
line') =
Indent -> Line -> Builder
renderLine Indent
i Line
line' forall a. Semigroup a => a -> a -> a
<> Char -> Builder
B.char7 Char
'\n'
spaces :: Int -> B.Builder
spaces :: Int -> Builder
spaces Int
i =
ByteString -> Builder
B.byteString (Int -> Word8 -> ByteString
ByteString.replicate Int
i Word8
0x20 )
renderLine :: Indent -> Line -> B.Builder
renderLine :: Indent -> Line -> Builder
renderLine Indent
i = \case
Text Builder
text ->
Int -> Builder
spaces (forall n. Num n => Indent -> n
Indent.width Indent
i) forall a. Semigroup a => a -> a -> a
<> Builder
text
Line
Space ->
Int -> Builder
spaces (Int
1 forall a. Num a => a -> a -> a
+ forall n. Num n => Indent -> n
Indent.width Indent
i)
Row Line
left Line
right ->
Indent -> Line -> Builder
renderLine Indent
i Line
left forall a. Semigroup a => a -> a -> a
<> Indent -> Line -> Builder
renderLine forall a. Monoid a => a
mempty Line
right
Line
Blank ->
forall a. Monoid a => a
mempty
render :: Block -> B.Builder
render :: Block -> Builder
render = \case
SingleLine Indented Line
line' ->
Indented Line -> Builder
renderIndentedLine Indented Line
line'
Stack Indented Line
l1 Indented Line
l2 [Indented Line]
rest ->
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Indented Line -> Builder
renderIndentedLine (Indented Line
l1 forall a. a -> [a] -> [a]
: Indented Line
l2 forall a. a -> [a] -> [a]
: [Indented Line]
rest)
MustBreak Indented Line
line' ->
Indented Line -> Builder
renderIndentedLine Indented Line
line'