{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleInstances #-}
-- Module      : Verismith.Verilog2005.LibPretty
-- Description : Pretty printer library with intuitive display algorithm.
-- Copyright   : (c) 2023 Quentin Corradi
-- License     : GPL-3
-- Maintainer  : q [dot] corradi22 [at] imperial [dot] ac [dot] uk
-- Stability   : experimental
-- Portability : POSIX
{-# LANGUAGE OverloadedLists #-}

module Verismith.Verilog2005.LibPretty
  ( Doc,
    nullDoc,
    raw,
    alt,
    viaShow,
    lparen,
    rparen,
    lbrace,
    rbrace,
    lbracket,
    rbracket,
    langle,
    rangle,
    comma,
    colon,
    dot,
    equals,
    semi,
    squote,
    space,
    indent,
    hardline,
    newline,
    softline,
    softspace,
    encl,
    (<+>),
    (<#>),
    (<->),
    (<=>),
    (</>),
    mkopt,
    (<?+>),
    (<?#>),
    (<?=>),
    (<?/>),
    trailoptcat,
    nest,
    group,
    ng,
    block,
    layout,
  )
where

import Control.Applicative (liftA2)
import Data.Bits
import qualified Data.ByteString as SB
import Data.ByteString.Builder
import Data.ByteString.Internal (isSpaceWord8, w2c)
import qualified Data.ByteString.Lazy as LB
import Data.Char
import Data.Foldable
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NE
import Data.Maybe (fromMaybe)
import Data.Semigroup
import Data.String
import Verismith.Utils hiding (comma)

infixr 6 <+>

infixr 6 <#>

infixr 6 <->

infixr 6 <=>

infixr 6 </>

infixr 6 <?+>

infixr 6 <?#>

infixr 6 <?=>

infixr 6 <?/>

-- Consider adding a constructor to keep first and last line in constant time reach
data Doc' w
  = Lines w (Doc' w) (Doc' w)
  | Line Word (Line w)

data Line w
  = Concat w (Line w) (Line w)
  | Token SB.ByteString
  | Group w (Line w)
  | Nest w (Line w)
  | Alt SB.ByteString (Doc' w)

type Doc = Doc' ()

type DocLength w = (Ord w, Semigroup w, Enum w)

emptyLine :: Line w
emptyLine :: forall w. Line w
emptyLine = ByteString -> Line w
forall w. ByteString -> Line w
Token ByteString
""

emptyDoc :: Doc' w
emptyDoc :: forall w. Doc' w
emptyDoc = Word -> Line w -> Doc' w
forall w. Word -> Line w -> Doc' w
Line Word
0 Line w
forall w. Line w
emptyLine

nullLine :: Line w -> Bool
nullLine :: forall w. Line w -> Bool
nullLine Line w
l = case Line w
l of
  Concat w
_ Line w
a Line w
b -> Line w -> Bool
forall w. Line w -> Bool
nullLine Line w
a Bool -> Bool -> Bool
&& Line w -> Bool
forall w. Line w -> Bool
nullLine Line w
b
  Token ByteString
t -> ByteString -> Bool
SB.null ByteString
t
  Alt ByteString
t Doc' w
d -> ByteString -> Bool
SB.null ByteString
t Bool -> Bool -> Bool
&& Doc' w -> Bool
forall w. Doc' w -> Bool
nullDoc Doc' w
d
  Group w
_ Line w
l -> Line w -> Bool
forall w. Line w -> Bool
nullLine Line w
l
  Nest w
_ Line w
l -> Line w -> Bool
forall w. Line w -> Bool
nullLine Line w
l

nullDoc :: Doc' w -> Bool
nullDoc :: forall w. Doc' w -> Bool
nullDoc Doc' w
d = case Doc' w
d of
  Lines w
_ Doc' w
_ Doc' w
_ -> Bool
False
  Line Word
i Line w
l -> Word
i Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0 Bool -> Bool -> Bool
&& Line w -> Bool
forall w. Line w -> Bool
nullLine Line w
l

linelength :: (Semigroup w, Enum w) => Word -> Line w -> w
linelength :: forall w. (Semigroup w, Enum w) => Word -> Line w -> w
linelength Word
i Line w
l = Int -> w
forall a. Enum a => Int -> a
toEnum (Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Word -> Int
forall a. Enum a => a -> Int
fromEnum Word
i) w -> w -> w
forall a. Semigroup a => a -> a -> a
<> Line w -> w
forall w. Enum w => Line w -> w
maxLengthLine Line w
l

maxLengthLine :: Enum w => Line w -> w
maxLengthLine :: forall w. Enum w => Line w -> w
maxLengthLine Line w
l = case Line w
l of
  Concat w
w Line w
_ Line w
_ -> w
w
  Token ByteString
t -> Int -> w
forall a. Enum a => Int -> a
toEnum (Int -> w) -> Int -> w
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
SB.length ByteString
t
  Alt ByteString
t Doc' w
_ -> Int -> w
forall a. Enum a => Int -> a
toEnum (Int -> w) -> Int -> w
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
SB.length ByteString
t
  Group w
w Line w
_ -> w
w
  Nest w
w Line w
_ -> w
w

maxLengthDoc :: (Semigroup w, Enum w) => Doc' w -> w
maxLengthDoc :: forall w. (Semigroup w, Enum w) => Doc' w -> w
maxLengthDoc Doc' w
d = case Doc' w
d of
  Lines w
w Doc' w
_ Doc' w
_ -> w
w
  Line Word
i Line w
l -> Word -> Line w -> w
forall w. (Semigroup w, Enum w) => Word -> Line w -> w
linelength Word
i Line w
l

instance (Semigroup w, Enum w) => Semigroup (Line w) where
  <> :: Line w -> Line w -> Line w
(<>) Line w
a Line w
b =
    if Line w -> Bool
forall w. Line w -> Bool
nullLine Line w
a
      then Line w
b
      else
        if Line w -> Bool
forall w. Line w -> Bool
nullLine Line w
b
          then Line w
a
          else case (Line w
a, Line w
b) of
            (Group w
wa Line w
da, Group w
wb Line w
db) -> w -> Line w -> Line w
forall w. w -> Line w -> Line w
Group (w
wa w -> w -> w
forall a. Semigroup a => a -> a -> a
<> w
wb) (Line w
da Line w -> Line w -> Line w
forall a. Semigroup a => a -> a -> a
<> Line w
db)
            (Line w
_, Line w
_) -> w -> Line w -> Line w -> Line w
forall w. w -> Line w -> Line w -> Line w
Concat (Line w -> w
forall w. Enum w => Line w -> w
maxLengthLine Line w
a w -> w -> w
forall a. Semigroup a => a -> a -> a
<> Line w -> w
forall w. Enum w => Line w -> w
maxLengthLine Line w
b) Line w
a Line w
b

instance (Semigroup w, Enum w) => Monoid (Line w) where
  mempty :: Line w
mempty = Line w
forall w. Line w
emptyLine

instance IsString (Line w) where
  fromString :: String -> Line w
fromString = ByteString -> Line w
forall w. ByteString -> Line w
Token (ByteString -> Line w)
-> (String -> ByteString) -> String -> Line w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
forall a. IsString a => String -> a
fromString

(<#>) :: DocLength w => Doc' w -> Doc' w -> Doc' w
<#> :: forall w. DocLength w => Doc' w -> Doc' w -> Doc' w
(<#>) Doc' w
a Doc' w
b = w -> Doc' w -> Doc' w -> Doc' w
forall w. w -> Doc' w -> Doc' w -> Doc' w
Lines (w -> w -> w
forall a. Ord a => a -> a -> a
max (Doc' w -> w
forall w. (Semigroup w, Enum w) => Doc' w -> w
maxLengthDoc Doc' w
a) (Doc' w -> w
forall w. (Semigroup w, Enum w) => Doc' w -> w
maxLengthDoc Doc' w
b)) Doc' w
a Doc' w
b

extractFirstLine :: DocLength w => Doc' w -> Doc' w -> (Word, Line w, Doc' w)
extractFirstLine :: forall w. DocLength w => Doc' w -> Doc' w -> (Word, Line w, Doc' w)
extractFirstLine Doc' w
a Doc' w
b = case Doc' w
a of
  Line Word
i Line w
l -> (Word
i, Line w
l, Doc' w
b)
  Lines w
_ Doc' w
l Doc' w
a -> Doc' w -> Doc' w -> (Word, Line w, Doc' w)
forall w. DocLength w => Doc' w -> Doc' w -> (Word, Line w, Doc' w)
extractFirstLine Doc' w
l (Doc' w -> (Word, Line w, Doc' w))
-> Doc' w -> (Word, Line w, Doc' w)
forall a b. (a -> b) -> a -> b
$ Doc' w
a Doc' w -> Doc' w -> Doc' w
forall w. DocLength w => Doc' w -> Doc' w -> Doc' w
<#> Doc' w
b

extractLastLine :: DocLength w => Doc' w -> Doc' w -> (Doc' w, Word, Line w)
extractLastLine :: forall w. DocLength w => Doc' w -> Doc' w -> (Doc' w, Word, Line w)
extractLastLine Doc' w
a Doc' w
b = case Doc' w
b of
  Line Word
i Line w
l -> (Doc' w
a, Word
i, Line w
l)
  Lines w
_ Doc' w
b Doc' w
l -> Doc' w -> Doc' w -> (Doc' w, Word, Line w)
forall w. DocLength w => Doc' w -> Doc' w -> (Doc' w, Word, Line w)
extractLastLine (Doc' w
a Doc' w -> Doc' w -> Doc' w
forall w. DocLength w => Doc' w -> Doc' w -> Doc' w
<#> Doc' w
b) Doc' w
l

instance DocLength w => Semigroup (Doc' w) where
  <> :: Doc' w -> Doc' w -> Doc' w
(<>) Doc' w
a Doc' w
b = case (Doc' w
a, Doc' w
b) of
    (Line Word
ia Line w
la, Line Word
ib Line w
lb) -> Word -> Line w -> Word -> Line w -> Doc' w
forall {w}.
(Semigroup w, Enum w) =>
Word -> Line w -> Word -> Line w -> Doc' w
catline Word
ia Line w
la Word
ib Line w
lb
    (Line Word
il Line w
l, Lines w
_ Doc' w
a Doc' w
b) -> let (Word
ic, Line w
c, Doc' w
r) = Doc' w -> Doc' w -> (Word, Line w, Doc' w)
forall w. DocLength w => Doc' w -> Doc' w -> (Word, Line w, Doc' w)
extractFirstLine Doc' w
a Doc' w
b in Word -> Line w -> Word -> Line w -> Doc' w
forall {w}.
(Semigroup w, Enum w) =>
Word -> Line w -> Word -> Line w -> Doc' w
catline Word
il Line w
l Word
ic Line w
c Doc' w -> Doc' w -> Doc' w
forall w. DocLength w => Doc' w -> Doc' w -> Doc' w
<#> Doc' w
r
    (Lines w
w Doc' w
a Doc' w
b, Line Word
ir Line w
r) -> let (Doc' w
l, Word
ic, Line w
c) = Doc' w -> Doc' w -> (Doc' w, Word, Line w)
forall w. DocLength w => Doc' w -> Doc' w -> (Doc' w, Word, Line w)
extractLastLine Doc' w
a Doc' w
b in Doc' w
l Doc' w -> Doc' w -> Doc' w
forall w. DocLength w => Doc' w -> Doc' w -> Doc' w
<#> Word -> Line w -> Word -> Line w -> Doc' w
forall {w}.
(Semigroup w, Enum w) =>
Word -> Line w -> Word -> Line w -> Doc' w
catline Word
ic Line w
c Word
ir Line w
r
    (Lines w
_ Doc' w
a Doc' w
b, Lines w
_ Doc' w
c Doc' w
d) ->
      let (Doc' w
ll, Word
il, Line w
lr) = Doc' w -> Doc' w -> (Doc' w, Word, Line w)
forall w. DocLength w => Doc' w -> Doc' w -> (Doc' w, Word, Line w)
extractLastLine Doc' w
a Doc' w
b
          (Word
ir, Line w
rl, Doc' w
rr) = Doc' w -> Doc' w -> (Word, Line w, Doc' w)
forall w. DocLength w => Doc' w -> Doc' w -> (Word, Line w, Doc' w)
extractFirstLine Doc' w
c Doc' w
d
       in Doc' w
ll Doc' w -> Doc' w -> Doc' w
forall w. DocLength w => Doc' w -> Doc' w -> Doc' w
<#> Word -> Line w -> Word -> Line w -> Doc' w
forall {w}.
(Semigroup w, Enum w) =>
Word -> Line w -> Word -> Line w -> Doc' w
catline Word
il Line w
lr Word
ir Line w
rl Doc' w -> Doc' w -> Doc' w
forall w. DocLength w => Doc' w -> Doc' w -> Doc' w
<#> Doc' w
rr
    where
      catline :: Word -> Line w -> Word -> Line w -> Doc' w
catline Word
ia Line w
la Word
ib Line w
lb = if Line w -> Bool
forall w. Line w -> Bool
nullLine Line w
la then Word -> Line w -> Doc' w
forall w. Word -> Line w -> Doc' w
Line (Word
ia Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
ib) Line w
lb else Word -> Line w -> Doc' w
forall w. Word -> Line w -> Doc' w
Line Word
ia (Line w
la Line w -> Line w -> Line w
forall a. Semigroup a => a -> a -> a
<> Line w
lb)

instance DocLength w => Monoid (Doc' w) where
  mempty :: Doc' w
mempty = Doc' w
forall w. Doc' w
emptyDoc

instance DocLength w => IsString (Doc' w) where
  fromString :: String -> Doc' w
fromString String
s =
    Doc' w
-> (NonEmpty (NonEmpty Char) -> Doc' w)
-> [NonEmpty Char]
-> Doc' w
forall b a. b -> (NonEmpty a -> b) -> [a] -> b
nonEmpty
      Doc' w
forall a. Monoid a => a
mempty
      ( (NonEmpty Char -> Doc' w)
-> (NonEmpty Char -> Doc' w -> Doc' w)
-> NonEmpty (NonEmpty Char)
-> Doc' w
forall a b. (a -> b) -> (a -> b -> b) -> NonEmpty a -> b
foldrMap1 NonEmpty Char -> Doc' w
forall {w}. NonEmpty Char -> Doc' w
f (Doc' w -> Doc' w -> Doc' w
forall w. DocLength w => Doc' w -> Doc' w -> Doc' w
(<#>) (Doc' w -> Doc' w -> Doc' w)
-> (NonEmpty Char -> Doc' w) -> NonEmpty Char -> Doc' w -> Doc' w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Char -> Doc' w
forall {w}. NonEmpty Char -> Doc' w
f)
          (NonEmpty (NonEmpty Char) -> Doc' w)
-> (NonEmpty (NonEmpty Char) -> NonEmpty (NonEmpty Char))
-> NonEmpty (NonEmpty Char)
-> Doc' w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \((Char
h :| String
l) :| [NonEmpty Char]
t) -> if Char
h Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' then [Char
Item (NonEmpty Char)
h] NonEmpty Char -> [NonEmpty Char] -> NonEmpty (NonEmpty Char)
forall a. a -> [a] -> NonEmpty a
:| (Char
h Char -> String -> NonEmpty Char
forall a. a -> [a] -> NonEmpty a
:| String
l) NonEmpty Char -> [NonEmpty Char] -> [NonEmpty Char]
forall a. a -> [a] -> [a]
: [NonEmpty Char]
t else (Char
'\n' Char -> String -> NonEmpty Char
forall a. a -> [a] -> NonEmpty a
:| Char
h Char -> String -> String
forall a. a -> [a] -> [a]
: String
l) NonEmpty Char -> [NonEmpty Char] -> NonEmpty (NonEmpty Char)
forall a. a -> [a] -> NonEmpty a
:| [NonEmpty Char]
t
      )
      ([NonEmpty Char] -> Doc' w) -> [NonEmpty Char] -> Doc' w
forall a b. (a -> b) -> a -> b
$ (Char -> Char -> Bool) -> String -> [NonEmpty Char]
forall (f :: * -> *) a.
Foldable f =>
(a -> a -> Bool) -> f a -> [NonEmpty a]
NE.groupBy ((Char -> Bool) -> Char -> Char -> Bool
forall a b. a -> b -> a
const (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n')) String
s
    where
      f :: NonEmpty Char -> Doc' w
f NonEmpty Char
s =
        ( \(String
a, String
b) ->
            Word -> Line w -> Doc' w
forall w. Word -> Line w -> Doc' w
Line (Word -> Word -> Word
forall a. Integral a => a -> a -> a
div ((Word -> Char -> Word) -> Word -> String -> Word
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Word
b Char
c -> Word
1 Word -> Word -> Word
forall a. Num a => a -> a -> a
+ if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t' then Word
b Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. Word
3 else Word
b) Word
0 String
a) Word
4) (Line w -> Doc' w) -> Line w -> Doc' w
forall a b. (a -> b) -> a -> b
$ String -> Line w
forall a. IsString a => String -> a
fromString String
b
        )
          ((String, String) -> Doc' w) -> (String, String) -> Doc' w
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isSpace (String -> (String, String)) -> String -> (String, String)
forall a b. (a -> b) -> a -> b
$ NonEmpty Char -> String
forall a. NonEmpty a -> [a]
NE.tail NonEmpty Char
s

raw :: SB.ByteString -> Doc' w
raw :: forall w. ByteString -> Doc' w
raw = Word -> Line w -> Doc' w
forall w. Word -> Line w -> Doc' w
Line Word
0 (Line w -> Doc' w)
-> (ByteString -> Line w) -> ByteString -> Doc' w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Line w
forall w. ByteString -> Line w
Token

alt :: SB.ByteString -> Doc' w -> Doc' w
alt :: forall w. ByteString -> Doc' w -> Doc' w
alt ByteString
a Doc' w
b = Word -> Line w -> Doc' w
forall w. Word -> Line w -> Doc' w
Line Word
0 (Line w -> Doc' w) -> Line w -> Doc' w
forall a b. (a -> b) -> a -> b
$ ByteString -> Doc' w -> Line w
forall w. ByteString -> Doc' w -> Line w
Alt ByteString
a Doc' w
b

viaShow :: Show a => a -> Doc' w
viaShow :: forall a w. Show a => a -> Doc' w
viaShow = ByteString -> Doc' w
forall w. ByteString -> Doc' w
raw (ByteString -> Doc' w) -> (a -> ByteString) -> a -> Doc' w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
forall a. IsString a => String -> a
fromString (String -> ByteString) -> (a -> String) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

lparen :: Doc' w
lparen :: forall w. Doc' w
lparen = ByteString -> Doc' w
forall w. ByteString -> Doc' w
raw ByteString
"("

rparen :: Doc' w
rparen :: forall w. Doc' w
rparen = ByteString -> Doc' w
forall w. ByteString -> Doc' w
raw ByteString
")"

lbrace :: Doc' w
lbrace :: forall w. Doc' w
lbrace = ByteString -> Doc' w
forall w. ByteString -> Doc' w
raw ByteString
"{"

rbrace :: Doc' w
rbrace :: forall w. Doc' w
rbrace = ByteString -> Doc' w
forall w. ByteString -> Doc' w
raw ByteString
"}"

lbracket :: Doc' w
lbracket :: forall w. Doc' w
lbracket = ByteString -> Doc' w
forall w. ByteString -> Doc' w
raw ByteString
"["

rbracket :: Doc' w
rbracket :: forall w. Doc' w
rbracket = ByteString -> Doc' w
forall w. ByteString -> Doc' w
raw ByteString
"]"

langle :: Doc' w
langle :: forall w. Doc' w
langle = ByteString -> Doc' w
forall w. ByteString -> Doc' w
raw ByteString
"<"

rangle :: Doc' w
rangle :: forall w. Doc' w
rangle = ByteString -> Doc' w
forall w. ByteString -> Doc' w
raw ByteString
">"

comma :: Doc' w
comma :: forall w. Doc' w
comma = ByteString -> Doc' w
forall w. ByteString -> Doc' w
raw ByteString
","

colon :: Doc' w
colon :: forall w. Doc' w
colon = ByteString -> Doc' w
forall w. ByteString -> Doc' w
raw ByteString
":"

dot :: Doc' w
dot :: forall w. Doc' w
dot = ByteString -> Doc' w
forall w. ByteString -> Doc' w
raw ByteString
"."

equals :: Doc' w
equals :: forall w. Doc' w
equals = ByteString -> Doc' w
forall w. ByteString -> Doc' w
raw ByteString
"="

semi :: Doc' w
semi :: forall w. Doc' w
semi = ByteString -> Doc' w
forall w. ByteString -> Doc' w
raw ByteString
";"

squote :: Doc' w
squote :: forall w. Doc' w
squote = ByteString -> Doc' w
forall w. ByteString -> Doc' w
raw ByteString
"'"

space :: Doc' w
space :: forall w. Doc' w
space = ByteString -> Doc' w
forall w. ByteString -> Doc' w
raw ByteString
" "

hardline :: Enum w => Doc' w
hardline :: forall w. Enum w => Doc' w
hardline = w -> Doc' w -> Doc' w -> Doc' w
forall w. w -> Doc' w -> Doc' w -> Doc' w
Lines (Int -> w
forall a. Enum a => Int -> a
toEnum Int
0) Doc' w
forall w. Doc' w
emptyDoc Doc' w
forall w. Doc' w
emptyDoc

newline :: Enum w => Doc' w
newline :: forall w. Enum w => Doc' w
newline = ByteString -> Doc' w -> Doc' w
forall w. ByteString -> Doc' w -> Doc' w
alt ByteString
" " Doc' w
forall w. Enum w => Doc' w
hardline

softline :: Enum w => Doc' w
softline :: forall w. Enum w => Doc' w
softline = ByteString -> Doc' w -> Doc' w
forall w. ByteString -> Doc' w -> Doc' w
alt ByteString
"" Doc' w
forall w. Enum w => Doc' w
hardline

softspace :: Doc' w
softspace :: forall w. Doc' w
softspace = ByteString -> Doc' w -> Doc' w
forall w. ByteString -> Doc' w -> Doc' w
alt ByteString
"" (Doc' w -> Doc' w) -> Doc' w -> Doc' w
forall a b. (a -> b) -> a -> b
$ ByteString -> Doc' w
forall w. ByteString -> Doc' w
raw ByteString
" "

appendWith :: DocLength w => Line w -> Doc' w -> Doc' w -> Doc' w
appendWith :: forall w. DocLength w => Line w -> Doc' w -> Doc' w -> Doc' w
appendWith Line w
l Doc' w
a Doc' w
b = case (Doc' w
a, Doc' w
b) of
  (Line Word
ia Line w
la, Line Word
ib Line w
lb) -> Word -> Line w -> Doc' w
forall w. Word -> Line w -> Doc' w
Line Word
ia (Line w -> Doc' w) -> Line w -> Doc' w
forall a b. (a -> b) -> a -> b
$ Line w
la Line w -> Line w -> Line w
forall a. Semigroup a => a -> a -> a
<> Line w
l Line w -> Line w -> Line w
forall a. Semigroup a => a -> a -> a
<> Line w
lb
  (Line Word
i Line w
ll, Lines w
_ Doc' w
a Doc' w
b) -> let (Word
_, Line w
c, Doc' w
r) = Doc' w -> Doc' w -> (Word, Line w, Doc' w)
forall w. DocLength w => Doc' w -> Doc' w -> (Word, Line w, Doc' w)
extractFirstLine Doc' w
a Doc' w
b in Word -> Line w -> Doc' w
forall w. Word -> Line w -> Doc' w
Line Word
i (Line w
ll Line w -> Line w -> Line w
forall a. Semigroup a => a -> a -> a
<> Line w
l Line w -> Line w -> Line w
forall a. Semigroup a => a -> a -> a
<> Line w
c) Doc' w -> Doc' w -> Doc' w
forall w. DocLength w => Doc' w -> Doc' w -> Doc' w
<#> Doc' w
r
  (Lines w
_ Doc' w
a Doc' w
b, Line Word
_ Line w
r) -> let (Doc' w
ll, Word
i, Line w
c) = Doc' w -> Doc' w -> (Doc' w, Word, Line w)
forall w. DocLength w => Doc' w -> Doc' w -> (Doc' w, Word, Line w)
extractLastLine Doc' w
a Doc' w
b in Doc' w
ll Doc' w -> Doc' w -> Doc' w
forall w. DocLength w => Doc' w -> Doc' w -> Doc' w
<#> Word -> Line w -> Doc' w
forall w. Word -> Line w -> Doc' w
Line Word
i (Line w
c Line w -> Line w -> Line w
forall a. Semigroup a => a -> a -> a
<> Line w
l Line w -> Line w -> Line w
forall a. Semigroup a => a -> a -> a
<> Line w
r)
  (Lines w
_ Doc' w
a Doc' w
b, Lines w
_ Doc' w
c Doc' w
d) ->
    let (Doc' w
ll, Word
i, Line w
lr) = Doc' w -> Doc' w -> (Doc' w, Word, Line w)
forall w. DocLength w => Doc' w -> Doc' w -> (Doc' w, Word, Line w)
extractLastLine Doc' w
a Doc' w
b
        (Word
_, Line w
rl, Doc' w
rr) = Doc' w -> Doc' w -> (Word, Line w, Doc' w)
forall w. DocLength w => Doc' w -> Doc' w -> (Word, Line w, Doc' w)
extractFirstLine Doc' w
c Doc' w
d
     in Doc' w
ll Doc' w -> Doc' w -> Doc' w
forall w. DocLength w => Doc' w -> Doc' w -> Doc' w
<#> Word -> Line w -> Doc' w
forall w. Word -> Line w -> Doc' w
Line Word
i (Line w
lr Line w -> Line w -> Line w
forall a. Semigroup a => a -> a -> a
<> Line w
l Line w -> Line w -> Line w
forall a. Semigroup a => a -> a -> a
<> Line w
rl) Doc' w -> Doc' w -> Doc' w
forall w. DocLength w => Doc' w -> Doc' w -> Doc' w
<#> Doc' w
rr

(<+>) :: DocLength w => Doc' w -> Doc' w -> Doc' w
<+> :: forall w. DocLength w => Doc' w -> Doc' w -> Doc' w
(<+>) = Line w -> Doc' w -> Doc' w -> Doc' w
forall w. DocLength w => Line w -> Doc' w -> Doc' w -> Doc' w
appendWith Line w
" "

(<->) :: DocLength w => Doc' w -> Doc' w -> Doc' w
<-> :: forall w. DocLength w => Doc' w -> Doc' w -> Doc' w
(<->) = Line w -> Doc' w -> Doc' w -> Doc' w
forall w. DocLength w => Line w -> Doc' w -> Doc' w -> Doc' w
appendWith (Line w -> Doc' w -> Doc' w -> Doc' w)
-> Line w -> Doc' w -> Doc' w -> Doc' w
forall a b. (a -> b) -> a -> b
$ ByteString -> Doc' w -> Line w
forall w. ByteString -> Doc' w -> Line w
Alt ByteString
"" (Doc' w -> Line w) -> Doc' w -> Line w
forall a b. (a -> b) -> a -> b
$ ByteString -> Doc' w
forall w. ByteString -> Doc' w
raw ByteString
" "

(<=>) :: DocLength w => Doc' w -> Doc' w -> Doc' w
<=> :: forall w. DocLength w => Doc' w -> Doc' w -> Doc' w
(<=>) = Line w -> Doc' w -> Doc' w -> Doc' w
forall w. DocLength w => Line w -> Doc' w -> Doc' w -> Doc' w
appendWith (Line w -> Doc' w -> Doc' w -> Doc' w)
-> Line w -> Doc' w -> Doc' w -> Doc' w
forall a b. (a -> b) -> a -> b
$ ByteString -> Doc' w -> Line w
forall w. ByteString -> Doc' w -> Line w
Alt ByteString
" " Doc' w
forall w. Enum w => Doc' w
hardline

(</>) :: DocLength w => Doc' w -> Doc' w -> Doc' w
</> :: forall w. DocLength w => Doc' w -> Doc' w -> Doc' w
(</>) = Line w -> Doc' w -> Doc' w -> Doc' w
forall w. DocLength w => Line w -> Doc' w -> Doc' w -> Doc' w
appendWith (Line w -> Doc' w -> Doc' w -> Doc' w)
-> Line w -> Doc' w -> Doc' w -> Doc' w
forall a b. (a -> b) -> a -> b
$ ByteString -> Doc' w -> Line w
forall w. ByteString -> Doc' w -> Line w
Alt ByteString
"" Doc' w
forall w. Enum w => Doc' w
hardline

mkopt :: (Doc' w -> Doc' w -> Doc' w) -> Doc' w -> Doc' w -> Doc' w
mkopt :: forall w.
(Doc' w -> Doc' w -> Doc' w) -> Doc' w -> Doc' w -> Doc' w
mkopt Doc' w -> Doc' w -> Doc' w
f Doc' w
a Doc' w
b = if Doc' w -> Bool
forall w. Doc' w -> Bool
nullDoc Doc' w
a then Doc' w
b else if Doc' w -> Bool
forall w. Doc' w -> Bool
nullDoc Doc' w
b then Doc' w
a else Doc' w -> Doc' w -> Doc' w
f Doc' w
a Doc' w
b

(<?+>) :: DocLength w => Doc' w -> Doc' w -> Doc' w
<?+> :: forall w. DocLength w => Doc' w -> Doc' w -> Doc' w
(<?+>) = (Doc' w -> Doc' w -> Doc' w) -> Doc' w -> Doc' w -> Doc' w
forall w.
(Doc' w -> Doc' w -> Doc' w) -> Doc' w -> Doc' w -> Doc' w
mkopt Doc' w -> Doc' w -> Doc' w
forall w. DocLength w => Doc' w -> Doc' w -> Doc' w
(<+>)

(<?#>) :: DocLength w => Doc' w -> Doc' w -> Doc' w
<?#> :: forall w. DocLength w => Doc' w -> Doc' w -> Doc' w
(<?#>) = (Doc' w -> Doc' w -> Doc' w) -> Doc' w -> Doc' w -> Doc' w
forall w.
(Doc' w -> Doc' w -> Doc' w) -> Doc' w -> Doc' w -> Doc' w
mkopt Doc' w -> Doc' w -> Doc' w
forall w. DocLength w => Doc' w -> Doc' w -> Doc' w
(<#>)

(<?=>) :: DocLength w => Doc' w -> Doc' w -> Doc' w
<?=> :: forall w. DocLength w => Doc' w -> Doc' w -> Doc' w
(<?=>) = (Doc' w -> Doc' w -> Doc' w) -> Doc' w -> Doc' w -> Doc' w
forall w.
(Doc' w -> Doc' w -> Doc' w) -> Doc' w -> Doc' w -> Doc' w
mkopt Doc' w -> Doc' w -> Doc' w
forall w. DocLength w => Doc' w -> Doc' w -> Doc' w
(<=>)

(<?/>) :: DocLength w => Doc' w -> Doc' w -> Doc' w
<?/> :: forall w. DocLength w => Doc' w -> Doc' w -> Doc' w
(<?/>) = (Doc' w -> Doc' w -> Doc' w) -> Doc' w -> Doc' w -> Doc' w
forall w.
(Doc' w -> Doc' w -> Doc' w) -> Doc' w -> Doc' w -> Doc' w
mkopt Doc' w -> Doc' w -> Doc' w
forall w. DocLength w => Doc' w -> Doc' w -> Doc' w
(</>)

trailoptcat :: Foldable f => (Doc' w -> Doc' w -> Doc' w) -> f (Doc' w) -> Doc' w
trailoptcat :: forall (f :: * -> *) w.
Foldable f =>
(Doc' w -> Doc' w -> Doc' w) -> f (Doc' w) -> Doc' w
trailoptcat Doc' w -> Doc' w -> Doc' w
f =
  Doc' w -> Maybe (Doc' w) -> Doc' w
forall a. a -> Maybe a -> a
fromMaybe Doc' w
forall w. Doc' w
emptyDoc
    (Maybe (Doc' w) -> Doc' w)
-> (f (Doc' w) -> Maybe (Doc' w)) -> f (Doc' w) -> Doc' w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc' w -> Maybe (Doc' w) -> Maybe (Doc' w))
-> Maybe (Doc' w) -> f (Doc' w) -> Maybe (Doc' w)
forall a b. (a -> b -> b) -> b -> f a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Doc' w
a -> Maybe (Doc' w)
-> (Doc' w -> Maybe (Doc' w)) -> Maybe (Doc' w) -> Maybe (Doc' w)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (if Doc' w -> Bool
forall w. Doc' w -> Bool
nullDoc Doc' w
a then Maybe (Doc' w)
forall a. Maybe a
Nothing else Doc' w -> Maybe (Doc' w)
forall a. a -> Maybe a
Just Doc' w
a) ((Doc' w -> Maybe (Doc' w)) -> Maybe (Doc' w) -> Maybe (Doc' w))
-> (Doc' w -> Maybe (Doc' w)) -> Maybe (Doc' w) -> Maybe (Doc' w)
forall a b. (a -> b) -> a -> b
$ Doc' w -> Maybe (Doc' w)
forall a. a -> Maybe a
Just (Doc' w -> Maybe (Doc' w))
-> (Doc' w -> Doc' w) -> Doc' w -> Maybe (Doc' w)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc' w -> Doc' w -> Doc' w
f Doc' w
a) Maybe (Doc' w)
forall a. Maybe a
Nothing

foldDoc :: (Word -> Line w -> a) -> (a -> a -> a) -> Doc' w -> a
foldDoc :: forall w a. (Word -> Line w -> a) -> (a -> a -> a) -> Doc' w -> a
foldDoc Word -> Line w -> a
f a -> a -> a
g Doc' w
d = case Doc' w
d of Lines w
_ Doc' w
a Doc' w
b -> a -> a -> a
g ((Word -> Line w -> a) -> (a -> a -> a) -> Doc' w -> a
forall w a. (Word -> Line w -> a) -> (a -> a -> a) -> Doc' w -> a
foldDoc Word -> Line w -> a
f a -> a -> a
g Doc' w
a) ((Word -> Line w -> a) -> (a -> a -> a) -> Doc' w -> a
forall w a. (Word -> Line w -> a) -> (a -> a -> a) -> Doc' w -> a
foldDoc Word -> Line w -> a
f a -> a -> a
g Doc' w
b); Line Word
i Line w
l -> Word -> Line w -> a
f Word
i Line w
l

mapDoc :: DocLength w => (Word -> Line v -> Doc' w) -> Doc' v -> Doc' w
mapDoc :: forall w v.
DocLength w =>
(Word -> Line v -> Doc' w) -> Doc' v -> Doc' w
mapDoc Word -> Line v -> Doc' w
f = (Word -> Line v -> Doc' w)
-> (Doc' w -> Doc' w -> Doc' w) -> Doc' v -> Doc' w
forall w a. (Word -> Line w -> a) -> (a -> a -> a) -> Doc' w -> a
foldDoc Word -> Line v -> Doc' w
f Doc' w -> Doc' w -> Doc' w
forall w. DocLength w => Doc' w -> Doc' w -> Doc' w
(<#>)

foldLine ::
  (SB.ByteString -> a) ->
  (SB.ByteString -> Doc' w -> a) ->
  (a -> a) ->
  (a -> a) ->
  (a -> a -> a) ->
  Line w ->
  a
foldLine :: forall a w.
(ByteString -> a)
-> (ByteString -> Doc' w -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a -> a)
-> Line w
-> a
foldLine ByteString -> a
f ByteString -> Doc' w -> a
g a -> a
h a -> a
i a -> a -> a
j Line w
l = case Line w
l of
  Token ByteString
s -> ByteString -> a
f ByteString
s
  Alt ByteString
s Doc' w
d -> ByteString -> Doc' w -> a
g ByteString
s Doc' w
d
  Group w
_ Line w
l -> a -> a
h (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ (ByteString -> a)
-> (ByteString -> Doc' w -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a -> a)
-> Line w
-> a
forall a w.
(ByteString -> a)
-> (ByteString -> Doc' w -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a -> a)
-> Line w
-> a
foldLine ByteString -> a
f ByteString -> Doc' w -> a
g a -> a
h a -> a
i a -> a -> a
j Line w
l
  Nest w
_ Line w
l -> a -> a
i (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ (ByteString -> a)
-> (ByteString -> Doc' w -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a -> a)
-> Line w
-> a
forall a w.
(ByteString -> a)
-> (ByteString -> Doc' w -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a -> a)
-> Line w
-> a
foldLine ByteString -> a
f ByteString -> Doc' w -> a
g a -> a
h a -> a
i a -> a -> a
j Line w
l
  Concat w
_ Line w
a Line w
b -> a -> a -> a
j ((ByteString -> a)
-> (ByteString -> Doc' w -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a -> a)
-> Line w
-> a
forall a w.
(ByteString -> a)
-> (ByteString -> Doc' w -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a -> a)
-> Line w
-> a
foldLine ByteString -> a
f ByteString -> Doc' w -> a
g a -> a
h a -> a
i a -> a -> a
j Line w
a) ((ByteString -> a)
-> (ByteString -> Doc' w -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a -> a)
-> Line w
-> a
forall a w.
(ByteString -> a)
-> (ByteString -> Doc' w -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a -> a)
-> Line w
-> a
foldLine ByteString -> a
f ByteString -> Doc' w -> a
g a -> a
h a -> a
i a -> a -> a
j Line w
b)

group :: DocLength w => Doc' w -> Doc' w
group :: forall w. DocLength w => Doc' w -> Doc' w
group Doc' w
d = case Doc' w
d of
  Line Word
i Line w
l -> Word -> Line w -> Doc' w
forall w. Word -> Line w -> Doc' w
Line Word
i (Line w -> Doc' w) -> Line w -> Doc' w
forall a b. (a -> b) -> a -> b
$ Line w -> Line w
forall {w}. Enum w => Line w -> Line w
mk Line w
l
  Lines w
w Doc' w
a Doc' w
b -> let (Word
il, Line w
l, Doc' w
r) = Doc' w -> Doc' w -> (Word, Line w, Doc' w)
forall w. DocLength w => Doc' w -> Doc' w -> (Word, Line w, Doc' w)
extractFirstLine Doc' w
a Doc' w
b in w -> Doc' w -> Doc' w -> Doc' w
forall w. w -> Doc' w -> Doc' w -> Doc' w
Lines w
w (Word -> Line w -> Doc' w
forall w. Word -> Line w -> Doc' w
Line Word
il (Line w -> Doc' w) -> Line w -> Doc' w
forall a b. (a -> b) -> a -> b
$ Line w -> Line w
forall {w}. Enum w => Line w -> Line w
mk Line w
l) Doc' w
r
  where
    mk :: Line w -> Line w
mk Line w
l = w -> Line w -> Line w
forall w. w -> Line w -> Line w
Group (Line w -> w
forall w. Enum w => Line w -> w
maxLengthLine Line w
l) Line w
l

indent :: DocLength w => Word -> Doc' w -> Doc' w
indent :: forall w. DocLength w => Word -> Doc' w -> Doc' w
indent Word
i = (Word -> Line w -> Doc' w) -> Doc' w -> Doc' w
forall w v.
DocLength w =>
(Word -> Line v -> Doc' w) -> Doc' v -> Doc' w
mapDoc ((Word -> Line w -> Doc' w) -> Doc' w -> Doc' w)
-> (Word -> Line w -> Doc' w) -> Doc' w -> Doc' w
forall a b. (a -> b) -> a -> b
$ Word -> Line w -> Doc' w
forall w. Word -> Line w -> Doc' w
Line (Word -> Line w -> Doc' w)
-> (Word -> Word) -> Word -> Line w -> Doc' w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word
i Word -> Word -> Word
forall a. Num a => a -> a -> a
+)

nest :: DocLength w => Doc' w -> Doc' w
nest :: forall w. DocLength w => Doc' w -> Doc' w
nest Doc' w
d = case Doc' w
d of
  Line Word
i Line w
l -> Word -> Line w -> Doc' w
forall w. Word -> Line w -> Doc' w
Line Word
i (Line w -> Doc' w) -> Line w -> Doc' w
forall a b. (a -> b) -> a -> b
$ Line w -> Line w
forall {w}. Enum w => Line w -> Line w
mk Line w
l
  Lines w
_ Doc' w
a Doc' w
b -> let (Word
il, Line w
l, Doc' w
r) = Doc' w -> Doc' w -> (Word, Line w, Doc' w)
forall w. DocLength w => Doc' w -> Doc' w -> (Word, Line w, Doc' w)
extractFirstLine Doc' w
a Doc' w
b in Word -> Line w -> Doc' w
forall w. Word -> Line w -> Doc' w
Line Word
il (Line w -> Line w
forall {w}. Enum w => Line w -> Line w
mk Line w
l) Doc' w -> Doc' w -> Doc' w
forall w. DocLength w => Doc' w -> Doc' w -> Doc' w
<#> Word -> Doc' w -> Doc' w
forall w. DocLength w => Word -> Doc' w -> Doc' w
indent Word
1 Doc' w
r
  where
    mk :: Line w -> Line w
mk Line w
l = w -> Line w -> Line w
forall w. w -> Line w -> Line w
Nest (Line w -> w
forall w. Enum w => Line w -> w
maxLengthLine Line w
l) Line w
l

ng :: DocLength w => Doc' w -> Doc' w
ng :: forall w. DocLength w => Doc' w -> Doc' w
ng Doc' w
d = case Doc' w
d of
  Line Word
i Line w
l -> Word -> Line w -> Doc' w
forall w. Word -> Line w -> Doc' w
Line Word
i (Line w -> Doc' w) -> Line w -> Doc' w
forall a b. (a -> b) -> a -> b
$ Line w -> Line w
forall {w}. Enum w => Line w -> Line w
mk Line w
l
  Lines w
_ Doc' w
a Doc' w
b -> let (Word
il, Line w
l, Doc' w
r) = Doc' w -> Doc' w -> (Word, Line w, Doc' w)
forall w. DocLength w => Doc' w -> Doc' w -> (Word, Line w, Doc' w)
extractFirstLine Doc' w
a Doc' w
b in Word -> Line w -> Doc' w
forall w. Word -> Line w -> Doc' w
Line Word
il (Line w -> Line w
forall {w}. Enum w => Line w -> Line w
mk Line w
l) Doc' w -> Doc' w -> Doc' w
forall w. DocLength w => Doc' w -> Doc' w -> Doc' w
<#> Word -> Doc' w -> Doc' w
forall w. DocLength w => Word -> Doc' w -> Doc' w
indent Word
1 Doc' w
r
  where
    mk :: Line w -> Line w
mk Line w
l = let w :: w
w = Line w -> w
forall w. Enum w => Line w -> w
maxLengthLine Line w
l in w -> Line w -> Line w
forall w. w -> Line w -> Line w
Group w
w (Line w -> Line w) -> Line w -> Line w
forall a b. (a -> b) -> a -> b
$ w -> Line w -> Line w
forall w. w -> Line w -> Line w
Nest w
w Line w
l

block :: DocLength w => Doc' w -> Doc' w -> Doc' w -> Doc' w
block :: forall w. DocLength w => Doc' w -> Doc' w -> Doc' w -> Doc' w
block Doc' w
l Doc' w
r Doc' w
x = Doc' w
l Doc' w -> Doc' w -> Doc' w
forall w. DocLength w => Doc' w -> Doc' w -> Doc' w
<#> Word -> Doc' w -> Doc' w
forall w. DocLength w => Word -> Doc' w -> Doc' w
indent Word
1 Doc' w
x Doc' w -> Doc' w -> Doc' w
forall w. DocLength w => Doc' w -> Doc' w -> Doc' w
<#> Doc' w
r

encl :: DocLength w => Doc' w -> Doc' w -> Doc' w -> Doc' w
encl :: forall w. DocLength w => Doc' w -> Doc' w -> Doc' w -> Doc' w
encl Doc' w
l Doc' w
r Doc' w
x = Doc' w -> Doc' w
forall w. DocLength w => Doc' w -> Doc' w
group (Doc' w -> Doc' w) -> Doc' w -> Doc' w
forall a b. (a -> b) -> a -> b
$ Doc' w
l Doc' w -> Doc' w -> Doc' w
forall w. DocLength w => Doc' w -> Doc' w -> Doc' w
<-> Doc' w
x Doc' w -> Doc' w -> Doc' w
forall a. Semigroup a => a -> a -> a
<> Doc' w
r

instance Enum w => Enum (Sum w) where
  toEnum :: Int -> Sum w
toEnum = w -> Sum w
forall a. a -> Sum a
Sum (w -> Sum w) -> (Int -> w) -> Int -> Sum w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> w
forall a. Enum a => Int -> a
toEnum
  fromEnum :: Sum w -> Int
fromEnum (Sum w
w) = w -> Int
forall a. Enum a => a -> Int
fromEnum w
w
  succ :: Sum w -> Sum w
succ (Sum w
w) = w -> Sum w
forall a. a -> Sum a
Sum (w -> Sum w) -> w -> Sum w
forall a b. (a -> b) -> a -> b
$ w -> w
forall a. Enum a => a -> a
succ w
w
  pred :: Sum w -> Sum w
pred (Sum w
w) = w -> Sum w
forall a. a -> Sum a
Sum (w -> Sum w) -> w -> Sum w
forall a b. (a -> b) -> a -> b
$ w -> w
forall a. Enum a => a -> a
pred w
w

flatten :: Doc' w -> Builder
flatten :: forall w. Doc' w -> Builder
flatten =
  (Word -> Line w -> Builder)
-> (Builder -> Builder -> Builder) -> Doc' w -> Builder
forall w a. (Word -> Line w -> a) -> (a -> a -> a) -> Doc' w -> a
foldDoc
    ( \Word
i Line w
l ->
        String -> Builder
string8 (Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Word -> Int
forall a. Enum a => a -> Int
fromEnum Word
i) Char
'\t')
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (ByteString -> Builder)
-> (ByteString -> Doc' w -> Builder)
-> (Builder -> Builder)
-> (Builder -> Builder)
-> (Builder -> Builder -> Builder)
-> Line w
-> Builder
forall a w.
(ByteString -> a)
-> (ByteString -> Doc' w -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a -> a)
-> Line w
-> a
foldLine ByteString -> Builder
byteString (Builder -> Doc' w -> Builder
forall a b. a -> b -> a
const (Builder -> Doc' w -> Builder)
-> (ByteString -> Builder) -> ByteString -> Doc' w -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder
byteString) Builder -> Builder
forall a. a -> a
id Builder -> Builder
forall a. a -> a
id Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
(<>) Line w
l
    )
    (\Builder
a Builder
b -> Builder
a Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\n" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
b)

-- | Add max line length data to the doc
preprocess :: DocLength w => Doc' v -> (Any, Doc' w)
preprocess :: forall w v. DocLength w => Doc' v -> (Any, Doc' w)
preprocess =
  (Word -> Line v -> (Any, Doc' w))
-> ((Any, Doc' w) -> (Any, Doc' w) -> (Any, Doc' w))
-> Doc' v
-> (Any, Doc' w)
forall w a. (Word -> Line w -> a) -> (a -> a -> a) -> Doc' w -> a
foldDoc
    ( \Word
i ->
        (Line w -> Doc' w) -> (Any, Line w) -> (Any, Doc' w)
forall a b. (a -> b) -> (Any, a) -> (Any, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Word -> Line w -> Doc' w
forall w. Word -> Line w -> Doc' w
Line Word
i)
          ((Any, Line w) -> (Any, Doc' w))
-> (Line v -> (Any, Line w)) -> Line v -> (Any, Doc' w)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> (Any, Line w))
-> (ByteString -> Doc' v -> (Any, Line w))
-> ((Any, Line w) -> (Any, Line w))
-> ((Any, Line w) -> (Any, Line w))
-> ((Any, Line w) -> (Any, Line w) -> (Any, Line w))
-> Line v
-> (Any, Line w)
forall a w.
(ByteString -> a)
-> (ByteString -> Doc' w -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a -> a)
-> Line w
-> a
foldLine
            (Line w -> (Any, Line w)
forall a. a -> (Any, a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Line w -> (Any, Line w))
-> (ByteString -> Line w) -> ByteString -> (Any, Line w)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Line w
forall w. ByteString -> Line w
Token)
            (\ByteString
s Doc' v
d -> (Bool -> Any
Any Bool
True, ByteString -> Doc' w -> Line w
forall w. ByteString -> Doc' w -> Line w
Alt ByteString
s (Doc' w -> Line w) -> Doc' w -> Line w
forall a b. (a -> b) -> a -> b
$ (Any, Doc' w) -> Doc' w
forall a b. (a, b) -> b
snd ((Any, Doc' w) -> Doc' w) -> (Any, Doc' w) -> Doc' w
forall a b. (a -> b) -> a -> b
$ Doc' v -> (Any, Doc' w)
forall w v. DocLength w => Doc' v -> (Any, Doc' w)
preprocess Doc' v
d))
            (\(Any
b, Line w
l) -> (Any
b, if Any -> Bool
getAny Any
b then w -> Line w -> Line w
forall w. w -> Line w -> Line w
Group (Line w -> w
forall w. Enum w => Line w -> w
maxLengthLine Line w
l) Line w
l else Line w
l))
            (\(Any
b, Line w
l) -> (Any
b, if Any -> Bool
getAny Any
b then w -> Line w -> Line w
forall w. w -> Line w -> Line w
Nest (Line w -> w
forall w. Enum w => Line w -> w
maxLengthLine Line w
l) Line w
l else Line w
l))
            ((Line w -> Line w -> Line w)
-> (Any, Line w) -> (Any, Line w) -> (Any, Line w)
forall a b c. (a -> b -> c) -> (Any, a) -> (Any, b) -> (Any, c)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 ((Line w -> Line w -> Line w)
 -> (Any, Line w) -> (Any, Line w) -> (Any, Line w))
-> (Line w -> Line w -> Line w)
-> (Any, Line w)
-> (Any, Line w)
-> (Any, Line w)
forall a b. (a -> b) -> a -> b
$ \Line w
a Line w
b -> w -> Line w -> Line w -> Line w
forall w. w -> Line w -> Line w -> Line w
Concat (Line w -> w
forall w. Enum w => Line w -> w
maxLengthLine Line w
a w -> w -> w
forall a. Semigroup a => a -> a -> a
<> Line w -> w
forall w. Enum w => Line w -> w
maxLengthLine Line w
b) Line w
a Line w
b)
    )
    (((Any, Doc' w) -> (Any, Doc' w) -> (Any, Doc' w))
 -> Doc' v -> (Any, Doc' w))
-> ((Any, Doc' w) -> (Any, Doc' w) -> (Any, Doc' w))
-> Doc' v
-> (Any, Doc' w)
forall a b. (a -> b) -> a -> b
$ (Doc' w -> Doc' w -> Doc' w)
-> (Any, Doc' w) -> (Any, Doc' w) -> (Any, Doc' w)
forall a b c. (a -> b -> c) -> (Any, a) -> (Any, b) -> (Any, c)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Doc' w -> Doc' w -> Doc' w
forall w. DocLength w => Doc' w -> Doc' w -> Doc' w
(<#>)

breakLine :: DocLength w => Word -> Line w -> (Any, Doc' w)
breakLine :: forall w. DocLength w => Word -> Line w -> (Any, Doc' w)
breakLine Word
i Line w
l = case Line w
l of
  Concat w
_ Line w
a Line w
b -> Doc' w -> Doc' w -> Doc' w
forall a. Semigroup a => a -> a -> a
(<>) (Doc' w -> Doc' w -> Doc' w)
-> (Any, Doc' w) -> (Any, Doc' w -> Doc' w)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word -> Line w -> (Any, Doc' w)
forall w. DocLength w => Word -> Line w -> (Any, Doc' w)
breakLine Word
i Line w
a (Any, Doc' w -> Doc' w) -> (Any, Doc' w) -> (Any, Doc' w)
forall a b. (Any, a -> b) -> (Any, a) -> (Any, b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Word -> Line w -> (Any, Doc' w)
forall w. DocLength w => Word -> Line w -> (Any, Doc' w)
breakLine Word
i Line w
b
  Token ByteString
s -> Doc' w -> (Any, Doc' w)
forall a. a -> (Any, a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc' w -> (Any, Doc' w)) -> Doc' w -> (Any, Doc' w)
forall a b. (a -> b) -> a -> b
$ Word -> Line w -> Doc' w
forall w. Word -> Line w -> Doc' w
Line Word
i (Line w -> Doc' w) -> Line w -> Doc' w
forall a b. (a -> b) -> a -> b
$ ByteString -> Line w
forall w. ByteString -> Line w
Token ByteString
s
  Alt ByteString
_ Doc' w
d -> (Bool -> Any
Any Bool
True, Doc' w
d)
  Group w
_ Line w
l -> (Bool -> Any
Any Bool
True, Word -> Line w -> Doc' w
forall w. Word -> Line w -> Doc' w
Line Word
i Line w
l)
  Nest w
_ Line w
l -> let (Any
b, Doc' w
d) = Word -> Line w -> (Any, Doc' w)
forall w. DocLength w => Word -> Line w -> (Any, Doc' w)
breakLine Word
i Line w
l in (Any
b, if Any -> Bool
getAny Any
b then Doc' w -> Doc' w
forall w. DocLength w => Doc' w -> Doc' w
nest Doc' w
d else Doc' w
d)

breakDoc :: DocLength w => w -> Doc' w -> Doc' w
breakDoc :: forall w. DocLength w => w -> Doc' w -> Doc' w
breakDoc w
w Doc' w
d = case Doc' w
d of
  Line Word
i Line w
l | w
w w -> w -> Bool
forall a. Ord a => a -> a -> Bool
< Word -> Line w -> w
forall w. (Semigroup w, Enum w) => Word -> Line w -> w
linelength Word
i Line w
l Bool -> Bool -> Bool
&& Int -> w
forall a. Enum a => Int -> a
toEnum (Int
4Int -> Int -> Int
forall a. Num a => a -> a -> a
*(Word -> Int
forall a. Enum a => a -> Int
fromEnum Word
i)) w -> w -> Bool
forall a. Ord a => a -> a -> Bool
< w
w ->
    let (Any Bool
b, Doc' w
d) = Word -> Line w -> (Any, Doc' w)
forall w. DocLength w => Word -> Line w -> (Any, Doc' w)
breakLine Word
i Line w
l in if Bool
b then w -> Doc' w -> Doc' w
forall w. DocLength w => w -> Doc' w -> Doc' w
breakDoc w
w Doc' w
d else Doc' w
d
  Lines w
w' Doc' w
a Doc' w
b | w
w w -> w -> Bool
forall a. Ord a => a -> a -> Bool
< w
w' -> w -> Doc' w -> Doc' w
forall w. DocLength w => w -> Doc' w -> Doc' w
breakDoc w
w Doc' w
a Doc' w -> Doc' w -> Doc' w
forall w. DocLength w => Doc' w -> Doc' w -> Doc' w
<#> w -> Doc' w -> Doc' w
forall w. DocLength w => w -> Doc' w -> Doc' w
breakDoc w
w Doc' w
b
  Doc' w
_ -> Doc' w
d

layout :: Maybe Word -> Doc' w -> LB.ByteString
layout :: forall w. Maybe Word -> Doc' w -> ByteString
layout Maybe Word
w Doc' w
d =
  Builder -> ByteString
toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$
    Builder -> (Word -> Builder) -> Maybe Word -> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
      (Doc' w -> Builder
forall w. Doc' w -> Builder
flatten Doc' w
d)
      ( \Word
w ->
          let (Any Bool
b, Doc' (Sum Word)
d') = Doc' w -> (Any, Doc' (Sum Word))
forall w v. DocLength w => Doc' v -> (Any, Doc' w)
preprocess Doc' w
d
           in Doc' (Sum Word) -> Builder
forall w. Doc' w -> Builder
flatten (Doc' (Sum Word) -> Builder) -> Doc' (Sum Word) -> Builder
forall a b. (a -> b) -> a -> b
$ if Bool
b Bool -> Bool -> Bool
&& Word -> Sum Word
forall a. a -> Sum a
Sum Word
w Sum Word -> Sum Word -> Bool
forall a. Ord a => a -> a -> Bool
< Doc' (Sum Word) -> Sum Word
forall w. (Semigroup w, Enum w) => Doc' w -> w
maxLengthDoc Doc' (Sum Word)
d' then Sum Word -> Doc' (Sum Word) -> Doc' (Sum Word)
forall w. DocLength w => w -> Doc' w -> Doc' w
breakDoc (Word -> Sum Word
forall a. a -> Sum a
Sum Word
w) Doc' (Sum Word)
d' else Doc' (Sum Word)
d'
      )
      Maybe Word
w