{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE LambdaCase #-}
{-# OPTIONS_GHC -Wno-name-shadowing #-}

module Text.PrettyPrint.Avh4.Block
  ( -- * Line
    Line,
    space,
    string7,
    char7,
    stringUtf8,
    lineFromBuilder,
    commentByteString,

    -- * Block
    Block,

    -- ** convert to
    render,

    -- ** create
    blankLine,
    line,
    mustBreak,

    -- ** combine
    stack,
    indent,
    prefix,
    addSuffix,
    prefixOrIndent,
    rowOrStack,
    rowOrStackForce,
    rowOrIndent,
    rowOrIndentForce,
    spaceSeparatedOrStack,
    spaceSeparatedOrStackForce,
    spaceSeparatedOrIndent,
    spaceSeparatedOrIndentForce,

    -- *** deprecated
    stackForce,
    andThen,
    joinMustBreak,
  )
where

import Control.Applicative (Applicative (..))
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

-- | A `Line` is ALWAYS just one single line of text,
-- and can always be combined horizontally with other `Line`s.
--
-- - `Space` is a single horizontal space,
-- - `Blank` is a line with no content.
-- - `Text` brings any text into the data structure. (Uses `ByteString.Builder` for the possibility of optimal performance)
-- - `Row` joins multiple elements onto one line.
data Line
  = Text B.Builder
  | Row Line Line
  | Space
  | Blank
  deriving (Int -> Line -> ShowS
[Line] -> ShowS
Line -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Line] -> ShowS
$cshowList :: [Line] -> ShowS
show :: Line -> String
$cshow :: Line -> String
showsPrec :: Int -> Line -> ShowS
$cshowsPrec :: Int -> Line -> ShowS
Show)

instance Semigroup Line where
  Line
a <> :: Line -> Line -> Line
<> Line
b = Line -> Line -> Line
Row Line
a Line
b

-- | Creates a @Line@ from the given @Char@.
-- You must guarantee that the given character is a valid 7-bit ASCII character,
-- and is not a space character (use `space` instead).
char7 :: Char -> Line
char7 :: Char -> Line
char7 = Builder -> Line
Text forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Builder
B.char7

-- | Creates a @Line@ from the given @String@.
-- You must guarantee that all characters in the @String@ are valid 7-bit ASCII characters,
-- and that the string does not start or end with spaces (use `space` instead).
string7 :: String -> Line
string7 :: String -> Line
string7 = Builder -> Line
Text forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Builder
B.string7

-- | If you know the String only contains ASCII characters, then use `string7` instead for better performance.
stringUtf8 :: String -> Line
stringUtf8 :: String -> Line
stringUtf8 = Builder -> Line
Text forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Builder
B.stringUtf8

-- | You must guarantee that the content of the Builder does not contain newlines and does not start with whitespace.
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
commentByteString :: ByteString -> Line
commentByteString ByteString
bs =
  if ByteString -> Bool
ByteString.null ByteString
bs
    then Line
Blank
    else ByteString -> Line
mkTextByteString ByteString
bs

-- | A @Line@ containing a single space.  You **must** use this to create
-- space characters if the spaces will ever be at the start or end of a line that is joined in the context of indentation changes.
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, Int -> Indented a -> ShowS
forall a. Show a => Int -> Indented a -> ShowS
forall a. Show a => [Indented a] -> ShowS
forall a. Show a => Indented a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Indented a] -> ShowS
$cshowList :: forall a. Show a => [Indented a] -> ShowS
show :: Indented a -> String
$cshow :: forall a. Show a => Indented a -> String
showsPrec :: Int -> Indented a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Indented a -> ShowS
Show)

-- | `Block` contains Lines (at least one; it can't be empty).
--
-- Block either:
--
--  - can appear in the middle of a line
--      (Stack someLine [], thus can be joined without problems), or
--  - has to appear on its own
--      (Stack someLine moreLines OR MustBreak someLine).
--
-- Types of Blocks:
--
-- - `SingleLine` is a single line, and the indentation level for the line.
-- - `MustBreak` is a single line (and its indentation level)) that cannot have anything joined to its right side.
--  Notably, it is used for `--` comments.
-- - `Stack` contains two or more lines, and the indentation level for each.
--
-- Sometimes (see `prefix`) the first line of Stack
--  gets different treatment than the other lines.
data Block
  = SingleLine RequiredLineBreaks (Indented Line)
  | Stack (Indented Line) (NonEmpty (Indented Line))
  deriving (Int -> Block -> ShowS
[Block] -> ShowS
Block -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Block] -> ShowS
$cshowList :: [Block] -> ShowS
show :: Block -> String
$cshow :: Block -> String
showsPrec :: Int -> Block -> ShowS
$cshowsPrec :: Int -> Block -> ShowS
Show)

data RequiredLineBreaks
  = MustBreakAtEnd
  | NoRequiredBreaks
  deriving (Int -> RequiredLineBreaks -> ShowS
[RequiredLineBreaks] -> ShowS
RequiredLineBreaks -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RequiredLineBreaks] -> ShowS
$cshowList :: [RequiredLineBreaks] -> ShowS
show :: RequiredLineBreaks -> String
$cshow :: RequiredLineBreaks -> String
showsPrec :: Int -> RequiredLineBreaks -> ShowS
$cshowsPrec :: Int -> RequiredLineBreaks -> ShowS
Show, RequiredLineBreaks -> RequiredLineBreaks -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RequiredLineBreaks -> RequiredLineBreaks -> Bool
$c/= :: RequiredLineBreaks -> RequiredLineBreaks -> Bool
== :: RequiredLineBreaks -> RequiredLineBreaks -> Bool
$c== :: RequiredLineBreaks -> RequiredLineBreaks -> Bool
Eq)

-- | A blank line (taking up one vertical space), with no text content.
blankLine :: Block
blankLine :: Block
blankLine =
  Line -> Block
line Line
Blank

-- | Promote a @Line@ into a @Block@.
line :: Line -> Block
line :: Line -> Block
line =
  RequiredLineBreaks -> Indented Line -> Block
SingleLine RequiredLineBreaks
NoRequiredBreaks forall b c a. (b -> c) -> (a -> b) -> a -> c
. Line -> Indented Line
mkIndentedLine

-- | Promote a @Line@ into a @Block@ that will always have a newline at the end of it,
-- meaning that this @Line@ will never have another @Line@ joined to its right side.
mustBreak :: Line -> Block
mustBreak :: Line -> Block
mustBreak =
  RequiredLineBreaks -> Indented Line -> Block
SingleLine RequiredLineBreaks
MustBreakAtEnd 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

-- | A binary version of `stack`.
{-# DEPRECATED stackForce "Use `stack` instead." #-}
stackForce :: Block -> Block -> Block
stackForce :: Block -> Block -> Block
stackForce Block
b1 Block
b2 =
  let (Indented Line
line1first :| [Indented Line]
line1rest) = Block -> NonEmpty (Indented Line)
toLines Block
b1
   in Indented Line -> NonEmpty (Indented Line) -> Block
Stack
        Indented Line
line1first
        ([Indented Line]
line1rest forall a. [a] -> NonEmpty a -> NonEmpty a
`NonEmpty.prependList` Block -> NonEmpty (Indented Line)
toLines Block
b2)
  where
    toLines :: Block -> NonEmpty (Indented Line)
    toLines :: Block -> NonEmpty (Indented Line)
toLines Block
b =
      case Block
b of
        SingleLine RequiredLineBreaks
_ Indented Line
l1 ->
          -- We lose information about RequiredLineBreaks, but that's okay
          -- since the result will always be a multiline stack,
          -- which will never join with a single line
          forall (f :: * -> *) a. Applicative f => a -> f a
pure Indented Line
l1
        Stack Indented Line
l1 NonEmpty (Indented Line)
rest ->
          forall a. a -> NonEmpty a -> NonEmpty a
NonEmpty.cons Indented Line
l1 NonEmpty (Indented Line)
rest

-- | An alternate style for `stack`.
--
-- @a & andThen [b, c]@ is the same as @stack [a, b, c]@
{-# DEPRECATED andThen "Use `stack` instead." #-}
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

-- | A vertical stack of @Block@s.  The left edges of all the @Block@s will be aligned.
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

{-# DEPRECATED joinMustBreak "The normal rowOr* functions should handle this automatically now.  Use `rowOrStack (Just space)` instead." #-}
joinMustBreak :: Block -> Block -> Block
joinMustBreak :: Block -> Block -> Block
joinMustBreak Block
inner Block
eol =
  case (Block
inner, Block
eol) of
    (SingleLine RequiredLineBreaks
NoRequiredBreaks (Indented Indent
i1 Line
inner'), SingleLine RequiredLineBreaks
NoRequiredBreaks (Indented Indent
_ Line
eol')) ->
      RequiredLineBreaks -> Indented Line -> Block
SingleLine RequiredLineBreaks
NoRequiredBreaks 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 RequiredLineBreaks
NoRequiredBreaks (Indented Indent
i1 Line
inner'), SingleLine RequiredLineBreaks
MustBreakAtEnd (Indented Indent
_ Line
eol')) ->
      RequiredLineBreaks -> Indented Line -> Block
SingleLine RequiredLineBreaks
MustBreakAtEnd 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 RequiredLineBreaks
breaks (Indented Indent
_ Line
b') ->
          RequiredLineBreaks -> Indented Line -> Block
SingleLine RequiredLineBreaks
breaks forall a b. (a -> b) -> a -> b
$ Line -> Indented Line
mkIndentedLine 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 RequiredLineBreaks
breaks Indented Line
l1 ->
      RequiredLineBreaks -> Indented Line -> Block
SingleLine RequiredLineBreaks
breaks (Indented Line -> Indented Line
firstFn Indented Line
l1)
    Stack Indented Line
l1 NonEmpty (Indented Line)
ls ->
      Indented Line -> NonEmpty (Indented Line) -> Block
Stack (Indented Line -> Indented Line
firstFn Indented Line
l1) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Indented Line -> Indented Line
restFn NonEmpty (Indented Line)
ls)

mapLastLine :: (Indented Line -> Indented Line) -> Block -> Block
mapLastLine :: (Indented Line -> Indented Line) -> Block -> Block
mapLastLine Indented Line -> Indented Line
lastFn = \case
  SingleLine RequiredLineBreaks
breaks Indented Line
l1 ->
    RequiredLineBreaks -> Indented Line -> Block
SingleLine RequiredLineBreaks
breaks (Indented Line -> Indented Line
lastFn Indented Line
l1)
  Stack Indented Line
l1 NonEmpty (Indented Line)
ls ->
    Indented Line -> NonEmpty (Indented Line) -> Block
Stack Indented Line
l1 (forall a. NonEmpty a -> [a]
NonEmpty.init NonEmpty (Indented Line)
ls forall a. [a] -> NonEmpty a -> NonEmpty a
`NonEmpty.prependList` forall (f :: * -> *) a. Applicative f => a -> f a
pure (Indented Line -> Indented Line
lastFn forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> a
NonEmpty.last NonEmpty (Indented Line)
ls))

-- | Makes a new @Block@ with the contents of the input @Block@ indented by one additional level.
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)

-- | This is the same as `rowOrStackForce` @False@.
{-# INLINE rowOrStack #-}
rowOrStack :: Maybe Line -> NonEmpty Block -> Block
rowOrStack :: Maybe Line -> NonEmpty Block -> Block
rowOrStack = Bool -> Maybe Line -> NonEmpty Block -> Block
rowOrStackForce Bool
False

-- | If all given @Block@s are single-line and the @Bool@ is @False@,
-- then makes a new single-line @Block@, with the @Maybe Line@ interspersed.
-- Otherwise, makes a vertical `stack` of the given @Block@s.
{-# 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 Maybe Line
joiner NonEmpty Block
blocks =
  case forall (t :: * -> *).
Traversable t =>
t Block -> Either (t Block) (t Line, Bool)
allSingles NonEmpty Block
blocks of
    Right (NonEmpty Line
lines, Bool
isMustBreak)
      | Bool -> Bool
not Bool
forceMultiline ->
          Line -> Block
mkLine forall a b. (a -> b) -> a -> b
$ NonEmpty Line -> Line
join NonEmpty Line
lines
      where
        mkLine :: Line -> Block
mkLine = if Bool
isMustBreak then Line -> Block
mustBreak else Line -> Block
line
        join :: NonEmpty Line -> Line
join = case Maybe Line
joiner of
          Maybe Line
Nothing -> forall a. Semigroup a => NonEmpty a -> a
sconcat
          Just Line
j -> forall a. Semigroup a => NonEmpty a -> a
sconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> NonEmpty a -> NonEmpty a
NonEmpty.intersperse Line
j
    Either (NonEmpty Block) (NonEmpty Line, Bool)
_ ->
      NonEmpty Block -> Block
stack NonEmpty Block
blocks

-- | Same as `rowOrIndentForce` @False@.
{-# INLINE rowOrIndent #-}
rowOrIndent :: Maybe Line -> NonEmpty Block -> Block
rowOrIndent :: Maybe Line -> NonEmpty Block -> Block
rowOrIndent = Bool -> Maybe Line -> NonEmpty Block -> Block
rowOrIndentForce Bool
False

-- | This is the same as `rowOrStackForce`, but all non-first lines in
-- the resulting block are indented one additional level.
{-# 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 Maybe Line
joiner blocks :: NonEmpty Block
blocks@(Block
b1 :| [Block]
rest) =
  case forall (t :: * -> *).
Traversable t =>
t Block -> Either (t Block) (t Line, Bool)
allSingles NonEmpty Block
blocks of
    Right (NonEmpty Line
lines, Bool
isMustBreak)
      | Bool -> Bool
not Bool
forceMultiline ->
          Line -> Block
mkLine forall a b. (a -> b) -> a -> b
$ NonEmpty Line -> Line
join NonEmpty Line
lines
      where
        mkLine :: Line -> Block
mkLine = if Bool
isMustBreak then Line -> Block
mustBreak else Line -> Block
line
        join :: NonEmpty Line -> Line
join = case Maybe Line
joiner of
          Maybe Line
Nothing -> forall a. Semigroup a => NonEmpty a -> a
sconcat
          Just Line
j -> forall a. Semigroup a => NonEmpty a -> a
sconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> NonEmpty a -> NonEmpty a
NonEmpty.intersperse Line
j
    Either (NonEmpty Block) (NonEmpty Line, Bool)
_ ->
      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))

data AllSingles a
  = Failed
  | Single (Maybe RequiredLineBreaks) a
  deriving (Int -> AllSingles a -> ShowS
forall a. Show a => Int -> AllSingles a -> ShowS
forall a. Show a => [AllSingles a] -> ShowS
forall a. Show a => AllSingles a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AllSingles a] -> ShowS
$cshowList :: forall a. Show a => [AllSingles a] -> ShowS
show :: AllSingles a -> String
$cshow :: forall a. Show a => AllSingles a -> String
showsPrec :: Int -> AllSingles a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> AllSingles a -> ShowS
Show, forall a b. a -> AllSingles b -> AllSingles a
forall a b. (a -> b) -> AllSingles a -> AllSingles 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 -> AllSingles b -> AllSingles a
$c<$ :: forall a b. a -> AllSingles b -> AllSingles a
fmap :: forall a b. (a -> b) -> AllSingles a -> AllSingles b
$cfmap :: forall a b. (a -> b) -> AllSingles a -> AllSingles b
Functor, AllSingles a -> AllSingles a -> Bool
forall a. Eq a => AllSingles a -> AllSingles a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AllSingles a -> AllSingles a -> Bool
$c/= :: forall a. Eq a => AllSingles a -> AllSingles a -> Bool
== :: AllSingles a -> AllSingles a -> Bool
$c== :: forall a. Eq a => AllSingles a -> AllSingles a -> Bool
Eq)

instance Applicative AllSingles where
  pure :: forall a. a -> AllSingles a
pure = forall a. Maybe RequiredLineBreaks -> a -> AllSingles a
Single forall a. Maybe a
Nothing
  liftA2 :: forall a b c.
(a -> b -> c) -> AllSingles a -> AllSingles b -> AllSingles c
liftA2 a -> b -> c
f (Single Maybe RequiredLineBreaks
m1 a
a) (Single Maybe RequiredLineBreaks
m2 b
b) =
    case (Maybe RequiredLineBreaks
m1, Maybe RequiredLineBreaks
m2) of
      (Just RequiredLineBreaks
MustBreakAtEnd, Maybe RequiredLineBreaks
Nothing) -> forall a. Maybe RequiredLineBreaks -> a -> AllSingles a
Single (forall a. a -> Maybe a
Just RequiredLineBreaks
MustBreakAtEnd) (a -> b -> c
f a
a b
b)
      (Just RequiredLineBreaks
MustBreakAtEnd, Just RequiredLineBreaks
_) -> forall a. AllSingles a
Failed
      (Maybe RequiredLineBreaks
m, Maybe RequiredLineBreaks
Nothing) -> forall a. Maybe RequiredLineBreaks -> a -> AllSingles a
Single Maybe RequiredLineBreaks
m (a -> b -> c
f a
a b
b)
      (Maybe RequiredLineBreaks
_, Maybe RequiredLineBreaks
m) -> forall a. Maybe RequiredLineBreaks -> a -> AllSingles a
Single Maybe RequiredLineBreaks
m (a -> b -> c
f a
a b
b)
  liftA2 a -> b -> c
_ AllSingles a
Failed AllSingles b
_ = forall a. AllSingles a
Failed
  liftA2 a -> b -> c
_ AllSingles a
_ AllSingles b
Failed = forall a. AllSingles a
Failed

allSingles :: Traversable t => t Block -> Either (t Block) (t Line, Bool)
allSingles :: forall (t :: * -> *).
Traversable t =>
t Block -> Either (t Block) (t Line, Bool)
allSingles t Block
blocks =
  case forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Block -> AllSingles Line
allSingles' t Block
blocks of
    Single (Just RequiredLineBreaks
MustBreakAtEnd) t Line
lines -> forall a b. b -> Either a b
Right (t Line
lines, Bool
True)
    Single (Just RequiredLineBreaks
NoRequiredBreaks) t Line
lines -> forall a b. b -> Either a b
Right (t Line
lines, Bool
False)
    AllSingles (t Line)
_ -> forall a b. a -> Either a b
Left t Block
blocks
  where
    allSingles' :: Block -> AllSingles Line
    allSingles' :: Block -> AllSingles Line
allSingles' = \case
      SingleLine RequiredLineBreaks
breaks (Indented Indent
_ Line
l) -> forall a. Maybe RequiredLineBreaks -> a -> AllSingles a
Single (forall a. a -> Maybe a
Just RequiredLineBreaks
breaks) Line
l
      Block
_ -> forall a. AllSingles a
Failed

-- | A convenience alias for `rowOrStack (Just space)`.
spaceSeparatedOrStack :: NonEmpty Block -> Block
spaceSeparatedOrStack :: NonEmpty Block -> Block
spaceSeparatedOrStack = Maybe Line -> NonEmpty Block -> Block
rowOrStack (forall a. a -> Maybe a
Just Line
space)

-- | A convenience alias for `rowOrStackForce (Just space)`.
spaceSeparatedOrStackForce :: Bool -> NonEmpty Block -> Block
spaceSeparatedOrStackForce :: Bool -> NonEmpty Block -> Block
spaceSeparatedOrStackForce Bool
force = Bool -> Maybe Line -> NonEmpty Block -> Block
rowOrStackForce Bool
force (forall a. a -> Maybe a
Just Line
space)

-- | A convenience alias for `rowOrIndentForce (Just space)`.
spaceSeparatedOrIndent :: NonEmpty Block -> Block
spaceSeparatedOrIndent :: NonEmpty Block -> Block
spaceSeparatedOrIndent = Maybe Line -> NonEmpty Block -> Block
rowOrIndent (forall a. a -> Maybe a
Just Line
space)

-- | A convenience alias for `rowOrIndentForce (Just space)`.
spaceSeparatedOrIndentForce :: Bool -> NonEmpty Block -> Block
spaceSeparatedOrIndentForce :: Bool -> NonEmpty Block -> Block
spaceSeparatedOrIndentForce Bool
force = Bool -> Maybe Line -> NonEmpty Block -> Block
rowOrIndentForce Bool
force (forall a. a -> Maybe a
Just Line
space)

-- | Adds the prefix to the first line,
-- and pads the other lines with spaces of the given length.
-- You are responsible for making sure that the given length is the actual length of the content of the given @Line@.
--
-- NOTE: An exceptional case that we haven't really designed for is if the first line of the input Block is indented.
--
-- EXAMPLE:
--
-- @
-- abcde
-- xyz
-- ----->
-- myPrefix abcde
--         xyz
-- @
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
r2 of
      Line
Blank -> Line -> Line
stripEnd Line
r1
      Line
r2' -> Line -> Line -> Line
Row Line
r1 Line
r2'
  Text Builder
t -> Builder -> Line
Text Builder
t
  Line
Blank -> Line
Blank

-- | Adds the given suffix to then end of the last line of the @Block@.
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
stripEnd 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 {- space -})

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

-- | Converts a @Block@ into a `Data.ByteString.Builder.Builder`.
--
-- You can then write to a file with `Data.ByteString.Builder.writeFile`,
-- or convert to @Text@ with @Data.Text.Encoding.decodeUtf8@ . `Data.ByteString.Builder.toLazyByteString`
render :: Block -> B.Builder
render :: Block -> Builder
render = \case
  SingleLine RequiredLineBreaks
_ Indented Line
line' ->
    Indented Line -> Builder
renderIndentedLine Indented Line
line'
  Stack Indented Line
l1 NonEmpty (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]
: forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty (Indented Line)
rest)