{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module Util.Format (
Doc, shortForm, text, string
, (</>), (<+/>), (<//>), (<+>)
, newline, unlines, paragraphs, wrap, wrapWords
, withIndent, indent, indent_, indentLine
, Width, render, renderFlat
, simplify, denest
#ifdef TESTING
, module Util.Format
#endif
) where
import Prelude hiding (unlines)
import qualified Data.Char.WCWidth as WCWidth
import qualified Data.List as List
import qualified Data.String as String
import qualified Data.Text as Text
import Data.Text (Text)
import qualified Data.Text.Lazy as Lazy
import qualified Data.Text.Lazy.Builder as Builder
import qualified Util.Num as Num
import qualified Util.Seq as Seq
data Doc =
Text !Text
| Doc :+ Doc
| ShortForm Doc Doc
| Indent !Indent
| Break !BreakType
deriving (Doc -> Doc -> Bool
(Doc -> Doc -> Bool) -> (Doc -> Doc -> Bool) -> Eq Doc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Doc -> Doc -> Bool
$c/= :: Doc -> Doc -> Bool
== :: Doc -> Doc -> Bool
$c== :: Doc -> Doc -> Bool
Eq, Width -> Doc -> ShowS
[Doc] -> ShowS
Doc -> String
(Width -> Doc -> ShowS)
-> (Doc -> String) -> ([Doc] -> ShowS) -> Show Doc
forall a.
(Width -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Doc] -> ShowS
$cshowList :: [Doc] -> ShowS
show :: Doc -> String
$cshow :: Doc -> String
showsPrec :: Width -> Doc -> ShowS
$cshowsPrec :: Width -> Doc -> ShowS
Show)
infixr :+
type Indent = Int
instance Semigroup Doc where <> :: Doc -> Doc -> Doc
(<>) = Doc -> Doc -> Doc
(:+)
instance Monoid Doc where
mempty :: Doc
mempty = Text -> Doc
Text Text
forall a. Monoid a => a
mempty
mappend :: Doc -> Doc -> Doc
mappend = Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
(<>)
instance String.IsString Doc where
fromString :: String -> Doc
fromString = Text -> Doc
text (Text -> Doc) -> (String -> Text) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. IsString a => String -> a
String.fromString
shortForm :: Doc -> Doc -> Doc
shortForm :: Doc -> Doc -> Doc
shortForm = Doc -> Doc -> Doc
ShortForm
text :: Text -> Doc
text :: Text -> Doc
text Text
t = case Text -> [Doc]
make Text
t of
[] -> Doc
forall a. Monoid a => a
mempty
[Doc]
ts -> (Doc -> Doc -> Doc) -> [Doc] -> Doc
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Doc -> Doc -> Doc
(:+) ([Doc] -> [Doc]
merge [Doc]
ts)
where
merge :: [Doc] -> [Doc]
merge [] = []
merge [Doc]
breaks = case (Doc -> Maybe Width) -> [Doc] -> ([Width], [Doc])
forall a b. (a -> Maybe b) -> [a] -> ([b], [a])
Seq.span_while Doc -> Maybe Width
isHard [Doc]
breaks of
([], []) -> []
([], Doc
x : [Doc]
xs) -> Doc
x Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: [Doc] -> [Doc]
merge [Doc]
xs
([Width]
hs, [Doc]
rest) -> BreakType -> Doc
Break (Width -> BreakType
Hard ([Width] -> Width
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
Num.sum [Width]
hs)) Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: [Doc] -> [Doc]
merge [Doc]
rest
isHard :: Doc -> Maybe Width
isHard (Break (Hard Width
n)) = Width -> Maybe Width
forall a. a -> Maybe a
Just Width
n
isHard Doc
_ = Maybe Width
forall a. Maybe a
Nothing
make :: Text -> [Doc]
make = (Doc -> Bool) -> [Doc] -> [Doc]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Doc -> Bool) -> Doc -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Bool
isEmpty) ([Doc] -> [Doc]) -> (Text -> [Doc]) -> Text -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
List.intersperse (Width -> Doc
newline Width
1) ([Doc] -> [Doc]) -> (Text -> [Doc]) -> Text -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Doc) -> [Text] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Doc
Text
([Text] -> [Doc]) -> (Text -> [Text]) -> Text -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> [Text]
Text.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'\n')
string :: String -> Doc
string :: String -> Doc
string = Text -> Doc
text (Text -> Doc) -> (String -> Text) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack
isEmpty :: Doc -> Bool
isEmpty :: Doc -> Bool
isEmpty (Text Text
t) = Text -> Bool
Text.null Text
t
isEmpty Doc
_ = Bool
False
data BreakType = NoSpace | Space | Hard !Int deriving (BreakType -> BreakType -> Bool
(BreakType -> BreakType -> Bool)
-> (BreakType -> BreakType -> Bool) -> Eq BreakType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BreakType -> BreakType -> Bool
$c/= :: BreakType -> BreakType -> Bool
== :: BreakType -> BreakType -> Bool
$c== :: BreakType -> BreakType -> Bool
Eq, Eq BreakType
Eq BreakType
-> (BreakType -> BreakType -> Ordering)
-> (BreakType -> BreakType -> Bool)
-> (BreakType -> BreakType -> Bool)
-> (BreakType -> BreakType -> Bool)
-> (BreakType -> BreakType -> Bool)
-> (BreakType -> BreakType -> BreakType)
-> (BreakType -> BreakType -> BreakType)
-> Ord BreakType
BreakType -> BreakType -> Bool
BreakType -> BreakType -> Ordering
BreakType -> BreakType -> BreakType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BreakType -> BreakType -> BreakType
$cmin :: BreakType -> BreakType -> BreakType
max :: BreakType -> BreakType -> BreakType
$cmax :: BreakType -> BreakType -> BreakType
>= :: BreakType -> BreakType -> Bool
$c>= :: BreakType -> BreakType -> Bool
> :: BreakType -> BreakType -> Bool
$c> :: BreakType -> BreakType -> Bool
<= :: BreakType -> BreakType -> Bool
$c<= :: BreakType -> BreakType -> Bool
< :: BreakType -> BreakType -> Bool
$c< :: BreakType -> BreakType -> Bool
compare :: BreakType -> BreakType -> Ordering
$ccompare :: BreakType -> BreakType -> Ordering
Ord, Width -> BreakType -> ShowS
[BreakType] -> ShowS
BreakType -> String
(Width -> BreakType -> ShowS)
-> (BreakType -> String)
-> ([BreakType] -> ShowS)
-> Show BreakType
forall a.
(Width -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BreakType] -> ShowS
$cshowList :: [BreakType] -> ShowS
show :: BreakType -> String
$cshow :: BreakType -> String
showsPrec :: Width -> BreakType -> ShowS
$cshowsPrec :: Width -> BreakType -> ShowS
Show)
instance Semigroup BreakType where <> :: BreakType -> BreakType -> BreakType
(<>) = BreakType -> BreakType -> BreakType
forall a. Ord a => a -> a -> a
max
instance Monoid BreakType where
mempty :: BreakType
mempty = BreakType
NoSpace
mappend :: BreakType -> BreakType -> BreakType
mappend = BreakType -> BreakType -> BreakType
forall a. Semigroup a => a -> a -> a
(<>)
(</>) :: Doc -> Doc -> Doc
Doc
d1 </> :: Doc -> Doc -> Doc
</> Doc
d2 = Doc
d1 Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> BreakType -> Doc
Break BreakType
NoSpace Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
d2
infixr 5 </>
(<+/>) :: Doc -> Doc -> Doc
Doc
d1 <+/> :: Doc -> Doc -> Doc
<+/> Doc
d2 = Doc
d1 Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> BreakType -> Doc
Break BreakType
Space Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
d2
infixr 5 <+/>
(<//>) :: Doc -> Doc -> Doc
Doc
d1 <//> :: Doc -> Doc -> Doc
<//> Doc
d2 = Doc
d1 Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Width -> Doc
newline Width
1 Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
d2
infixr 4 <//>
withIndent :: Doc -> Doc
withIndent :: Doc -> Doc
withIndent Doc
doc = Width -> Doc
Indent Width
1 Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
doc Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Width -> Doc
Indent (-Width
1)
indentBreak :: BreakType -> Doc -> Doc
indentBreak :: BreakType -> Doc -> Doc
indentBreak BreakType
break Doc
doc = Width -> Doc
Indent Width
1 Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> BreakType -> Doc
Break BreakType
break Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
doc Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Width -> Doc
Indent (-Width
1)
indent :: Doc -> Doc
indent :: Doc -> Doc
indent = BreakType -> Doc -> Doc
indentBreak BreakType
NoSpace
indent_ :: Doc -> Doc
indent_ :: Doc -> Doc
indent_ = BreakType -> Doc -> Doc
indentBreak BreakType
Space
indentLine :: Doc -> Doc
indentLine :: Doc -> Doc
indentLine = BreakType -> Doc -> Doc
indentBreak (Width -> BreakType
Hard Width
1)
(<+>) :: Doc -> Doc -> Doc
Doc
d1 <+> :: Doc -> Doc -> Doc
<+> Doc
d2 = Doc
d1 Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Doc
Text Text
" " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
d2
infixr 6 <+>
newline :: Int -> Doc
newline :: Width -> Doc
newline Width
n = BreakType -> Doc
Break (Width -> BreakType
Hard Width
n)
unlines :: [Doc] -> Doc
unlines :: [Doc] -> Doc
unlines [] = Doc
forall a. Monoid a => a
mempty
unlines [Doc]
docs = [Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat (Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
List.intersperse (Width -> Doc
newline Width
1) [Doc]
docs) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Width -> Doc
newline Width
1
paragraphs :: [Doc] -> Doc
paragraphs :: [Doc] -> Doc
paragraphs [] = Doc
forall a. Monoid a => a
mempty
paragraphs [Doc]
docs = [Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat (Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
List.intersperse (Width -> Doc
newline Width
2) [Doc]
docs) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Width -> Doc
newline Width
1
wrapWords :: [Doc] -> Doc
wrapWords :: [Doc] -> Doc
wrapWords (Doc
d:[Doc]
ds) = (Doc -> Doc -> Doc) -> Doc -> [Doc] -> Doc
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' Doc -> Doc -> Doc
(<+/>) Doc
d [Doc]
ds
wrapWords [] = Doc
forall a. Monoid a => a
mempty
wrap :: [Doc] -> Doc
wrap :: [Doc] -> Doc
wrap (Doc
d:[Doc]
ds) = (Doc -> Doc -> Doc) -> Doc -> [Doc] -> Doc
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' Doc -> Doc -> Doc
(</>) Doc
d [Doc]
ds
wrap [] = Doc
forall a. Monoid a => a
mempty
type Width = Int
data State = State {
State -> B
stateCollect :: !B
, State -> [Section]
stateSubs :: ![Section]
, State -> [Section]
stateSections :: ![Section]
, State -> Width
stateIndent :: !Indent
, State -> Width
statePreviousIndent :: !Indent
, State -> Width
stateBreakIndent :: !Indent
} deriving (Width -> State -> ShowS
[State] -> ShowS
State -> String
(Width -> State -> ShowS)
-> (State -> String) -> ([State] -> ShowS) -> Show State
forall a.
(Width -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [State] -> ShowS
$cshowList :: [State] -> ShowS
show :: State -> String
$cshow :: State -> String
showsPrec :: Width -> State -> ShowS
$cshowsPrec :: Width -> State -> ShowS
Show)
data Section = Section {
Section -> Width
sectionStartIndent :: !Indent
, Section -> Width
sectionEndIndent :: !Indent
, Section -> B
sectionB :: !B
, Section -> [Section]
sectionSubs :: ![Section]
, Section -> BreakType
sectionBreak :: !BreakType
} deriving (Width -> Section -> ShowS
[Section] -> ShowS
Section -> String
(Width -> Section -> ShowS)
-> (Section -> String) -> ([Section] -> ShowS) -> Show Section
forall a.
(Width -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Section] -> ShowS
$cshowList :: [Section] -> ShowS
show :: Section -> String
$cshow :: Section -> String
showsPrec :: Width -> Section -> ShowS
$cshowsPrec :: Width -> Section -> ShowS
Show)
sectionBuilder :: Section -> Builder.Builder
sectionBuilder :: Section -> Builder
sectionBuilder = B -> Builder
bBuilder (B -> Builder) -> (Section -> B) -> Section -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Section -> B
sectionB
flatten :: Doc -> [Section]
flatten :: Doc -> [Section]
flatten = [Section] -> [Section]
postprocSections ([Section] -> [Section]) -> (Doc -> [Section]) -> Doc -> [Section]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> [Section]
stateSections (State -> [Section]) -> (Doc -> State) -> Doc -> [Section]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> State
flush (State -> State) -> (Doc -> State) -> Doc -> State
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc -> State -> State) -> State -> Doc -> State
forall a b c. (a -> b -> c) -> b -> a -> c
flip Doc -> State -> State
go State
initialState
where
initialState :: State
initialState = State
{ stateCollect :: B
stateCollect = B
forall a. Monoid a => a
mempty
, stateSubs :: [Section]
stateSubs = []
, stateSections :: [Section]
stateSections = []
, stateIndent :: Width
stateIndent = Width
0
, stateBreakIndent :: Width
stateBreakIndent = Width
0
, statePreviousIndent :: Width
statePreviousIndent = Width
0
}
go :: Doc -> State -> State
go Doc
doc State
state = case Doc
doc of
Text Text
t -> State
state { stateCollect :: B
stateCollect = State -> B
stateCollect State
state B -> B -> B
forall a. Semigroup a => a -> a -> a
<> Text -> B
bFromText Text
t }
Doc
d1 :+ Doc
d2 -> Doc -> State -> State
go Doc
d2 (Doc -> State -> State
go Doc
d1 State
state)
ShortForm Doc
short Doc
long -> State
state
{ stateCollect :: B
stateCollect =
State -> B
stateCollect State
state B -> B -> B
forall a. Semigroup a => a -> a -> a
<> [Section] -> B
renderSectionsB (Doc -> [Section]
flatten Doc
short)
, stateSubs :: [Section]
stateSubs = State -> [Section]
stateSections State
sub
}
where
sub :: State
sub = BreakType -> State -> State
addSection (Width -> BreakType
Hard Width
0) (State -> State) -> State -> State
forall a b. (a -> b) -> a -> b
$ Doc -> State -> State
go Doc
long State
subState
where
subState :: State
subState = State
initialState
{ stateCollect :: B
stateCollect = State -> B
stateCollect State
state
, stateIndent :: Width
stateIndent = State -> Width
stateIndent State
state
, statePreviousIndent :: Width
statePreviousIndent = State -> Width
statePreviousIndent State
state
, stateBreakIndent :: Width
stateBreakIndent = State -> Width
stateBreakIndent State
state
}
Indent Width
n -> State
state
{ stateIndent :: Width
stateIndent = State -> Width
stateIndent State
state Width -> Width -> Width
forall a. Num a => a -> a -> a
+ Width
n
, statePreviousIndent :: Width
statePreviousIndent = State -> Width
stateIndent State
state
}
Break BreakType
break -> BreakType -> State -> State
addSection BreakType
break State
state
addSection :: BreakType -> State -> State
addSection BreakType
break State
state = State
state
{ stateCollect :: B
stateCollect = B
forall a. Monoid a => a
mempty
, stateSubs :: [Section]
stateSubs = []
, stateSections :: [Section]
stateSections = (Section -> [Section] -> [Section]
forall a. a -> [a] -> [a]
: State -> [Section]
stateSections State
state) (Section -> [Section]) -> Section -> [Section]
forall a b. (a -> b) -> a -> b
$ Section
{ sectionStartIndent :: Width
sectionStartIndent = State -> Width
stateBreakIndent State
state
, sectionEndIndent :: Width
sectionEndIndent = State -> Width
statePreviousIndent State
state
, sectionB :: B
sectionB = State -> B
stateCollect State
state
, sectionSubs :: [Section]
sectionSubs = [Section] -> [Section]
replaceBreaks ([Section] -> [Section]) -> [Section] -> [Section]
forall a b. (a -> b) -> a -> b
$ State -> [Section]
stateSubs State
state
, sectionBreak :: BreakType
sectionBreak = BreakType
break
}
, stateBreakIndent :: Width
stateBreakIndent = State -> Width
stateIndent State
state
, statePreviousIndent :: Width
statePreviousIndent = State -> Width
stateIndent State
state
}
where
replaceBreaks :: [Section] -> [Section]
replaceBreaks [] = []
replaceBreaks (Section
sub:[Section]
subs) = Section
sub
{ sectionBreak :: BreakType
sectionBreak = BreakType
break
, sectionSubs :: [Section]
sectionSubs = [Section] -> [Section]
replaceBreaks ([Section] -> [Section]) -> [Section] -> [Section]
forall a b. (a -> b) -> a -> b
$ Section -> [Section]
sectionSubs Section
sub
} Section -> [Section] -> [Section]
forall a. a -> [a] -> [a]
: [Section]
subs
flush :: State -> State
flush State
state
| Bool -> Bool
not (B -> Bool
bNull (State -> B
stateCollect State
state)) = BreakType -> State -> State
addSection (Width -> BreakType
Hard Width
1) State
state
| Section
final : [Section]
sections <- State -> [Section]
stateSections State
state = State
state
{ stateSections :: [Section]
stateSections = Section
final { sectionBreak :: BreakType
sectionBreak = Width -> BreakType
Hard Width
1 } Section -> [Section] -> [Section]
forall a. a -> [a] -> [a]
: [Section]
sections }
| Bool
otherwise = State
state
postprocSections :: [Section] -> [Section]
postprocSections :: [Section] -> [Section]
postprocSections = (Section -> Section) -> [Section] -> [Section]
forall a b. (a -> b) -> [a] -> [b]
map Section -> Section
subs ([Section] -> [Section])
-> ([Section] -> [Section]) -> [Section] -> [Section]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Section] -> [Section]
mergeBreaks ([Section] -> [Section])
-> ([Section] -> [Section]) -> [Section] -> [Section]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Section] -> [Section]
forall a. [a] -> [a]
reverse
where
subs :: Section -> Section
subs Section
section
| [Section] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Section -> [Section]
sectionSubs Section
section) = Section
section
| Bool
otherwise = Section
section
{ sectionSubs :: [Section]
sectionSubs = [Section] -> [Section]
postprocSections ([Section] -> [Section]) -> [Section] -> [Section]
forall a b. (a -> b) -> a -> b
$ Section -> [Section]
sectionSubs Section
section }
mergeBreaks :: [Section] -> [Section]
mergeBreaks :: [Section] -> [Section]
mergeBreaks [] = []
mergeBreaks (Section
section : [Section]
sections) = case (Section -> Bool) -> [Section] -> ([Section], [Section])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Section -> Bool
empty [Section]
sections of
([], [Section]
_) -> Section
section Section -> [Section] -> [Section]
forall a. a -> [a] -> [a]
: [Section] -> [Section]
mergeBreaks [Section]
sections
([Section]
nulls, [Section]
rest) -> Section
section { sectionBreak :: BreakType
sectionBreak = BreakType
break } Section -> [Section] -> [Section]
forall a. a -> [a] -> [a]
: [Section] -> [Section]
mergeBreaks [Section]
rest
where break :: BreakType
break = Section -> BreakType
sectionBreak Section
section BreakType -> BreakType -> BreakType
forall a. Semigroup a => a -> a -> a
<> [BreakType] -> BreakType
forall a. Monoid a => [a] -> a
mconcat ((Section -> BreakType) -> [Section] -> [BreakType]
forall a b. (a -> b) -> [a] -> [b]
map Section -> BreakType
sectionBreak [Section]
nulls)
where empty :: Section -> Bool
empty Section
section = B -> Bool
bNull (Section -> B
sectionB Section
section)
render :: Text -> Width -> Doc -> Lazy.Text
render :: Text -> Width -> Doc -> Text
render Text
indent Width
width = Text -> Width -> [Section] -> Text
renderText Text
indent Width
width ([Section] -> Text) -> (Doc -> [Section]) -> Doc -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Section]
flatten
renderFlat :: Doc -> Lazy.Text
renderFlat :: Doc -> Text
renderFlat = [Section] -> Text
renderTextFlat ([Section] -> Text) -> (Doc -> [Section]) -> Doc -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Section]
flatten
renderText :: Text -> Width -> [Section] -> Lazy.Text
renderText :: Text -> Width -> [Section] -> Text
renderText Text
indentS Width
maxWidth = Builder -> Text
Builder.toLazyText (Builder -> Text) -> ([Section] -> Builder) -> [Section] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Section] -> Builder -> Builder)
-> Builder -> [Section] -> Builder
forall a b c. (a -> b -> c) -> b -> a -> c
flip [Section] -> Builder -> Builder
renderLine Builder
forall a. Monoid a => a
mempty
where
renderLine :: [Section] -> Builder -> Builder
renderLine [] Builder
out = Builder
out
renderLine (Section Width
indent Width
_ B
b [Section]
subs BreakType
_ : [Section]
sections) Builder
out
| Bool -> Bool
not ([Section] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Section]
subs) Bool -> Bool -> Bool
&& Width
indent Width -> Width -> Width
forall a. Num a => a -> a -> a
* Text -> Width
textWidth Text
indentS Width -> Width -> Width
forall a. Num a => a -> a -> a
+ B -> Width
bWidth B
b Width -> Width -> Bool
forall a. Ord a => a -> a -> Bool
> Width
maxWidth =
[Section] -> Builder -> Builder
renderLine ([Section]
subs [Section] -> [Section] -> [Section]
forall a. [a] -> [a] -> [a]
++ [Section]
sections) Builder
out
renderLine allSections :: [Section]
allSections@(Section
section1 : [Section]
_) Builder
out =
Builder
out Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> case Width -> Width -> [Section] -> (Text, Bool, [Section], [Section])
spanLine (Text -> Width
textWidth Text
indentS) Width
maxWidth [Section]
allSections of
(Text
_, Bool
_, [], []) -> Builder
forall a. Monoid a => a
mempty
(Text
_, Bool
_, [], Section
section : [Section]
sections) ->
[Section] -> Builder -> Builder
renderLine [Section]
sections (Builder -> Builder
emitLine (Section -> Builder
sectionBuilder Section
section))
(Text
_, Bool
False, [Section]
line, [Section]
rest) ->
[Section] -> Builder -> Builder
renderLine [Section]
rest (Builder -> Builder
emitLine ([Section] -> Builder
renderSections [Section]
line))
(Text
_, Bool
True, [Section]
line, [Section]
rest) -> case [Section] -> ([Section], [Section])
findBreak [Section]
line of
([], []) -> Builder
forall a. Monoid a => a
mempty
([], Section
section : [Section]
sections) -> [Section] -> Builder -> Builder
renderLine ([Section]
sections [Section] -> [Section] -> [Section]
forall a. [a] -> [a] -> [a]
++ [Section]
rest)
(Builder -> Builder
emitLine (Section -> Builder
sectionBuilder Section
section))
([Section]
line, [Section]
rest2) ->
[Section] -> Builder -> Builder
renderLine ([Section]
rest2 [Section] -> [Section] -> [Section]
forall a. [a] -> [a] -> [a]
++ [Section]
rest) (Builder -> Builder
emitLine ([Section] -> Builder
renderSections [Section]
line))
where
indent :: Width
indent = Section -> Width
sectionStartIndent Section
section1
emitLine :: Builder -> Builder
emitLine Builder
b = Builder
indentB Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
b Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
nl
where
indentB :: Builder
indentB = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ Width -> Builder -> [Builder]
forall a. Width -> a -> [a]
replicate Width
indent Builder
indent1
nl :: Builder
nl = Char -> Builder
Builder.singleton Char
'\n'
indent1 :: Builder
indent1 = Text -> Builder
Builder.fromText Text
indentS
renderTextFlat :: [Section] -> Lazy.Text
renderTextFlat :: [Section] -> Text
renderTextFlat = Builder -> Text
Builder.toLazyText (Builder -> Text) -> ([Section] -> Builder) -> [Section] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Section] -> Builder
renderSections
renderSectionsB :: [Section] -> B
renderSectionsB :: [Section] -> B
renderSectionsB [Section]
sections =
[B] -> B
forall a. Monoid a => [a] -> a
mconcat ([B] -> B) -> [B] -> B
forall a b. (a -> b) -> a -> b
$ [B] -> [B] -> [B]
forall a. [a] -> [a] -> [a]
interleave ((Section -> B) -> [Section] -> [B]
forall a b. (a -> b) -> [a] -> [b]
map Section -> B
sectionB [Section]
sections) [B]
spaces
where
spaces :: [B]
spaces = (Section -> B) -> [Section] -> [B]
forall a b. (a -> b) -> [a] -> [b]
map (BreakType -> B
toSpace (BreakType -> B) -> (Section -> BreakType) -> Section -> B
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Section -> BreakType
sectionBreak) [Section]
sections
toSpace :: BreakType -> B
toSpace BreakType
Space = Builder -> Width -> B
B (Char -> Builder
Builder.singleton Char
' ') Width
1
toSpace BreakType
_ = Builder -> Width -> B
B Builder
forall a. Monoid a => a
mempty Width
0
renderSections :: [Section] -> Builder.Builder
renderSections :: [Section] -> Builder
renderSections = B -> Builder
bBuilder (B -> Builder) -> ([Section] -> B) -> [Section] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Section] -> B
renderSectionsB
spanLine :: Width -> Width -> [Section]
-> (Text, Bool, [Section], [Section])
spanLine :: Width -> Width -> [Section] -> (Text, Bool, [Section], [Section])
spanLine Width
_ Width
_ [] = (Text
"out of sections", Bool
False, [], [])
spanLine Width
indentWidth Width
maxWidth sections :: [Section]
sections@(Section
section1 : [Section]
_) =
Width -> [Section] -> (Text, Bool, [Section], [Section])
go (Width
indentWidth Width -> Width -> Width
forall a. Num a => a -> a -> a
* Width
indent) [Section]
sections
where
indent :: Width
indent = Section -> Width
sectionStartIndent Section
section1
go :: Width -> [Section] -> (Text, Bool, [Section], [Section])
go Width
_ [] = (Text
"out of sections", Bool
False, [], [])
go Width
col (Section
section : [Section]
sections)
| Section -> Width
sectionStartIndent Section
section Width -> Width -> Bool
forall a. Ord a => a -> a -> Bool
< Width
indent =
( Text
"indent decreased: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Width -> Text
forall a. Show a => a -> Text
showt (Section -> Width
sectionStartIndent Section
section)
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" < " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Width -> Text
forall a. Show a => a -> Text
showt Width
indent
, Bool
False, [], Section
section Section -> [Section] -> [Section]
forall a. a -> [a] -> [a]
: [Section]
sections
)
| Width
col Width -> Width -> Width
forall a. Num a => a -> a -> a
+ Width
width Width -> Width -> Bool
forall a. Ord a => a -> a -> Bool
> Width
maxWidth =
( Text
"too wide: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Width -> Text
forall a. Show a => a -> Text
showt Width
col Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" + "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Width -> Text
forall a. Show a => a -> Text
showt Width
width Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" > " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Width -> Text
forall a. Show a => a -> Text
showt Width
maxWidth
, Bool
True, [Section
section], [Section]
sections
)
| Hard Width
n <- Section -> BreakType
sectionBreak Section
section, Width
n Width -> Width -> Bool
forall a. Ord a => a -> a -> Bool
> Width
0 =
( Text
"hard break"
, Bool
False, [Section
section]
, if Width
n Width -> Width -> Bool
forall a. Ord a => a -> a -> Bool
> Width
1 then BreakType -> Section -> Section
strip (Width -> BreakType
Hard (Width
nWidth -> Width -> Width
forall a. Num a => a -> a -> a
-Width
1)) Section
section Section -> [Section] -> [Section]
forall a. a -> [a] -> [a]
: [Section]
sections else [Section]
sections
)
| Bool
otherwise =
let (Text
msg, Bool
break, [Section]
pre, [Section]
post) = Width -> [Section] -> (Text, Bool, [Section], [Section])
go (Width
col Width -> Width -> Width
forall a. Num a => a -> a -> a
+ Width
space Width -> Width -> Width
forall a. Num a => a -> a -> a
+ Width
width) [Section]
sections
in (Text
msg, Bool
break, Section
section Section -> [Section] -> [Section]
forall a. a -> [a] -> [a]
: [Section]
pre, [Section]
post)
where
space :: Width
space = if Section -> BreakType
sectionBreak Section
section BreakType -> BreakType -> Bool
forall a. Eq a => a -> a -> Bool
== BreakType
Space then Width
1 else Width
0
width :: Width
width = B -> Width
bWidth (Section -> B
sectionB Section
section)
strip :: BreakType -> Section -> Section
strip BreakType
break Section
section = Section
{ sectionStartIndent :: Width
sectionStartIndent = Section -> Width
sectionStartIndent Section
section
, sectionEndIndent :: Width
sectionEndIndent = Section -> Width
sectionEndIndent Section
section
, sectionB :: B
sectionB = B
forall a. Monoid a => a
mempty
, sectionSubs :: [Section]
sectionSubs = []
, sectionBreak :: BreakType
sectionBreak = BreakType
break
}
findBreak :: [Section] -> ([Section], [Section])
findBreak :: [Section] -> ([Section], [Section])
findBreak [Section]
sections = case Maybe (Width, Width)
lowest of
Maybe (Width, Width)
Nothing -> ([], [])
Just (Width
i, Width
_) -> Width -> [Section] -> ([Section], [Section])
forall a. Width -> [a] -> ([a], [a])
splitAt Width
i [Section]
sections
where lowest :: Maybe (Width, Width)
lowest = ((Width, Width) -> Width)
-> [(Width, Width)] -> Maybe (Width, Width)
forall k a. Ord k => (a -> k) -> [a] -> Maybe a
lastMinimumOn (Width, Width) -> Width
forall a b. (a, b) -> b
snd ([(Width, Width)] -> Maybe (Width, Width))
-> [(Width, Width)] -> Maybe (Width, Width)
forall a b. (a -> b) -> a -> b
$ [Width] -> [Width] -> [(Width, Width)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Width
0..] ((Section -> Width) -> [Section] -> [Width]
forall a b. (a -> b) -> [a] -> [b]
map Section -> Width
sectionEndIndent [Section]
sections)
showt :: Show a => a -> Text
showt :: forall a. Show a => a -> Text
showt = String -> Text
Text.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show
data B = B {
B -> Builder
bBuilder :: !Builder.Builder
, B -> Width
bWidth :: !Width
}
instance Show B where
show :: B -> String
show (B Builder
b Width
_) = Builder -> String
forall a. Show a => a -> String
show Builder
b
instance Semigroup B where
B Builder
b1 Width
len1 <> :: B -> B -> B
<> B Builder
b2 Width
len2 = Builder -> Width -> B
B (Builder
b1Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>Builder
b2) (Width
len1Width -> Width -> Width
forall a. Num a => a -> a -> a
+Width
len2)
instance Monoid B where
mempty :: B
mempty = Builder -> Width -> B
B Builder
forall a. Monoid a => a
mempty Width
0
mappend :: B -> B -> B
mappend = B -> B -> B
forall a. Semigroup a => a -> a -> a
(<>)
mconcat :: [B] -> B
mconcat [] = B
forall a. Monoid a => a
mempty
mconcat [B]
bs = Builder -> Width -> B
B ([Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [Builder]
builders) ([Width] -> Width
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
Num.sum [Width]
lens)
where ([Builder]
builders, [Width]
lens) = [(Builder, Width)] -> ([Builder], [Width])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Builder
b, Width
len) | B Builder
b Width
len <- [B]
bs, Width
len Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
/= Width
0]
bFromText :: Text -> B
bFromText :: Text -> B
bFromText Text
text = Builder -> Width -> B
B (Text -> Builder
Builder.fromText Text
text) (Text -> Width
textWidth Text
text)
textWidth :: Text -> Width
textWidth :: Text -> Width
textWidth = (Width -> Char -> Width) -> Width -> Text -> Width
forall a. (a -> Char -> a) -> a -> Text -> a
Text.foldl' (\Width
n Char
c -> Width
n Width -> Width -> Width
forall a. Num a => a -> a -> a
+ Char -> Width
WCWidth.wcwidth Char
c) Width
0
bNull :: B -> Bool
bNull :: B -> Bool
bNull = (Width -> Width -> Bool
forall a. Eq a => a -> a -> Bool
==Width
0) (Width -> Bool) -> (B -> Width) -> B -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. B -> Width
bWidth
simplify :: Doc -> Doc
simplify :: Doc -> Doc
simplify Doc
doc = case Doc
doc of
Text Text
t1 :+ Doc
d1 -> case Doc -> Doc
simplify Doc
d1 of
Text Text
t2 :+ Doc
d2 -> Text -> Doc
Text (Text
t1Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
t2) Doc -> Doc -> Doc
:+ Doc
d2
Text Text
t2 -> Text -> Doc
Text (Text
t1Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
t2)
Doc
doc -> Text -> Doc
Text Text
t1 Doc -> Doc -> Doc
:+ Doc
doc
Doc
d1 :+ Doc
d2 -> case (Doc -> Doc
simplify Doc
d1, Doc -> Doc
simplify Doc
d2) of
(Text Text
t1, Text Text
t2) -> Text -> Doc
Text (Text
t1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t2)
(Doc
d1, Doc
d2) -> Doc
d1 Doc -> Doc -> Doc
:+ Doc
d2
ShortForm Doc
d1 Doc
d2 ->
Doc -> Doc -> Doc
ShortForm (Text -> Doc
Text (Text -> Text
Lazy.toStrict (Doc -> Text
renderFlat Doc
d1))) (Doc -> Doc
simplify Doc
d2)
Doc
_ -> Doc
doc
denest :: Doc -> Text
denest :: Doc -> Text
denest Doc
doc = case Doc
doc of
Doc
d1 :+ Doc
d2 -> Doc -> Text
denest Doc
d1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Doc -> Text
denest Doc
d2
Text Text
t -> Text -> Text
forall a. Show a => a -> Text
showt Text
t
Indent Width
n -> if Width
n Width -> Width -> Bool
forall a. Ord a => a -> a -> Bool
> Width
0 then Text
"^" else Text
"v"
Break BreakType
b -> case BreakType
b of
BreakType
NoSpace -> Text
"/"
BreakType
Space -> Text
"/+"
Hard Width
_ -> Text
"//"
ShortForm Doc
_ Doc
doc -> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Doc -> Text
denest Doc
doc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
lastMinimumOn :: Ord k => (a -> k) -> [a] -> Maybe a
lastMinimumOn :: forall k a. Ord k => (a -> k) -> [a] -> Maybe a
lastMinimumOn a -> k
_ [] = Maybe a
forall a. Maybe a
Nothing
lastMinimumOn a -> k
key [a]
xs = a -> Maybe a
forall a. a -> Maybe a
Just ((a -> a -> a) -> [a] -> a
forall a. (a -> a -> a) -> [a] -> a
List.foldl1' a -> a -> a
f [a]
xs)
where f :: a -> a -> a
f a
low a
x = if a -> k
key a
x k -> k -> Bool
forall a. Ord a => a -> a -> Bool
<= a -> k
key a
low then a
x else a
low
interleave :: [a] -> [a] -> [a]
interleave :: forall a. [a] -> [a] -> [a]
interleave [a
x] [a]
_ = [a
x]
interleave (a
x:[a]
xs) (a
y:[a]
ys) = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
interleave [a]
xs [a]
ys
interleave [a]
xs [a]
_ = [a]
xs