dynamic-pp 0.1.0 → 0.2.0

raw patch · 2 files changed

+280/−222 lines, 2 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• dynamic-pp.cabal +3/−1
• src/Text/Format.hs +277/−221

@@ -1,6 +1,6 @@ Name:                   dynamic-pp Category:               Text-Version:                0.1.0+Version:                0.2.0 License:                BSD3 License-File:           LICENSE Author:                 Eric McCorkle@@ -22,6 +22,8 @@   .   This library also provides two simpler rendering engines for uses where the full optimal layout engine is not   necessary.  These engines are much simpler and consume fewer resources.+  .+  NOTE: This library is still in development.  It may contain bugs, performance issues, and the interface may change. Build-type:             Simple Cabal-version:          >= 1.16 

@@ -53,6 +53,7 @@        empty,        line,        linebreak,+       hardline,        softline,        softbreak, @@ -139,6 +140,7 @@        -- *** Derived        (<>),        (<+>),+       (<!>),        (<$>),        (<$$>),        (</>),@@ -173,10 +175,12 @@  import Blaze.ByteString.Builder import Blaze.ByteString.Builder.Char.Utf8+import Control.Arrow((***)) import Control.Monad import Data.Hashable-import Data.HashMap.Strict(HashMap)-import Data.List(intersperse, minimumBy)+import Data.HashSet(HashSet)+--import Data.HashMap.Strict(HashMap)+import Data.List(intersperse, minimumBy, sort) import Data.Maybe import Data.Monoid hiding ((<>)) import Data.Word@@ -189,10 +193,20 @@ import qualified Data.ByteString.Lazy as Lazy import qualified Data.ByteString.Lazy.Char8 as Lazy.Char8 import qualified Data.ByteString.Lazy.UTF8 as Lazy.UTF8-import qualified Data.HashMap.Strict as HashMap+--import qualified Data.HashMap.Strict as HashMap+import qualified Data.HashSet as HashSet  -- | Datatype representing a formatted document. +data LineKind =+    -- | Unerasable linebreak+    Hard+    -- | Linebreak replaced with nothing+  | Soft+    -- | Linebreak replaced with a space+  | Break+    deriving (Ord, Eq, Enum)+ -- Docs are organized into a tree structure whose nodes dictate the -- formatting of the generated text.  These are rendered by the -- various rendering engines into a Builder (from the blaze-builder@@ -202,16 +216,16 @@     Char { charContent :: !Char }     -- | A raw Builder that constructs a string containing no     -- newlines.  This is used to represent basic text.-  | Builder {+  | Content {       -- | Length of the text that gets built.-      builderLength :: !Int,+      contentLength :: !Int,       -- | A Builder that constructs the text.-      builderContent :: !Builder+      contentString :: !Lazy.ByteString     }-    -- | A newline.+    -- | An erasable newline.   | Line {       -- | Whether to insert a space when undone by a group.-      insertSpace :: !Bool+      lineKind :: !LineKind     }     -- | Concatenated documents.  An empty list here represents an empty @Doc@.   | Cat {@@ -232,7 +246,7 @@     -- | Choose the \"best\" from among a list of options.   | Choose {       -- | The list of options.-      chooseOptions :: [Doc]+      chooseOptions :: HashSet Doc     }     -- | Set graphics mode options when rendering the child @Doc@.   | Graphics {@@ -241,6 +255,7 @@       -- | Document to render with graphic mode.       graphicsDoc :: Doc     }+    deriving (Eq)  -- | Graphics options for ANSI terminals.  All options are wrapped in -- the 'Maybe' datatype, with 'Nothing' meaning \"leave this option@@ -264,7 +279,81 @@     }     -- | Reset the terminal in this mode.   | Default+    deriving (Ord, Eq) +instance Ord Doc where+  compare Char { charContent = c1 } Char { charContent = c2 } = compare c1 c2+  compare Char {} _ = LT+  compare _ Char {} = GT+  compare Content { contentString = str1 } Content { contentString = str2 } =+    compare str1 str2+  compare Content {} _ = LT+  compare _ Content {} = GT+  compare Line { lineKind = kind1 } Line { lineKind = kind2 } =+    compare kind1 kind2+  compare Line {} _ = LT+  compare _ Line {} = GT+  compare Cat { catDocs = docs1 } Cat { catDocs = docs2 } = compare docs1 docs2+  compare Cat {} _ = LT+  compare _ Cat {} = GT+  compare Nest { nestLevel = lvl1, nestAlign = al1,+                 nestDelay = delay1, nestDoc = doc1 }+          Nest { nestLevel = lvl2, nestAlign = al2,+                 nestDelay = delay2, nestDoc = doc2 } =+    case compare lvl1 lvl2 of+      EQ -> case compare al1 al2 of+        EQ -> case compare delay1 delay2 of+          EQ -> compare doc1 doc2+          out -> out+        out -> out+      out -> out+  compare Nest {} _ = LT+  compare _ Nest {} = GT+  compare Choose { chooseOptions = opts1 } Choose { chooseOptions = opts2 } =+    compare (sort (HashSet.toList opts1)) (sort (HashSet.toList opts2))+  compare Choose {} _ = LT+  compare _ Choose {} = GT+  compare Graphics { graphicsSGR = sgr1, graphicsDoc = doc1 }+          Graphics { graphicsSGR = sgr2, graphicsDoc = doc2 } =+    case compare sgr1 sgr2 of+      EQ -> compare doc1 doc2+      out -> out++instance Hashable LineKind where+  hashWithSalt s = hashWithSalt s . fromEnum++instance Hashable Doc where+  hashWithSalt s Char { charContent = c } =+    s `hashWithSalt` (0 :: Int) `hashWithSalt` c+  hashWithSalt s Content { contentLength = len, contentString = str } =+    s `hashWithSalt` (1 :: Int) `hashWithSalt` len `hashWithSalt` str+  hashWithSalt s Line { lineKind = kind } =+    s `hashWithSalt` (2 :: Int) `hashWithSalt` kind+  hashWithSalt s Cat { catDocs = docs } =+    s `hashWithSalt` (3 :: Int) `hashWithSalt` docs+  hashWithSalt s Nest { nestLevel = lvl, nestAlign = al,+                        nestDelay = delay, nestDoc = doc } =+    s `hashWithSalt` (4 :: Int) `hashWithSalt` lvl `hashWithSalt`+    al `hashWithSalt` delay `hashWithSalt` doc+  hashWithSalt s Choose { chooseOptions = opts } =+    s `hashWithSalt` (5 :: Int) `hashWithSalt` sort (HashSet.toList opts)+  hashWithSalt s Graphics { graphicsSGR = sgr, graphicsDoc = doc } =+    s `hashWithSalt` (6 :: Int) `hashWithSalt` sgr `hashWithSalt` doc++instance Hashable Graphics where+  hashWithSalt s Options { consoleIntensity = consIntensity,+                           swapForegroundBackground = swap,+                           underlining = underline,+                           foreground = fore,+                           background = back,+                           blinkSpeed = blink } =+    s `hashWithSalt` (0 :: Int) `hashWithSalt`+    fmap fromEnum consIntensity `hashWithSalt`+    fmap fromEnum swap `hashWithSalt` fmap fromEnum underline `hashWithSalt`+    fmap (fromEnum *** fromEnum) fore `hashWithSalt`+    fmap (fromEnum *** fromEnum) back `hashWithSalt` fmap fromEnum blink+  hashWithSalt s Default = s `hashWithSalt` (1 :: Int)+ -- | Generate a 'Doc' representing a graphics mode switch. switchGraphics :: Graphics -> Graphics -> Builder switchGraphics _ Default = fromString (setSGRCode [Reset])@@ -342,22 +431,26 @@ -- | A 'Doc' consisting of a linebreak, that is not turned into a -- space when erased by a 'group'. line :: Doc-line = Line { insertSpace = False }+line = Line { lineKind = Soft }  -- | A 'Doc' consisting of a linebreak, that is turned into a space -- when erased by a 'group'. linebreak :: Doc-linebreak = Line { insertSpace = True }+linebreak = Line { lineKind = Break } +-- | A 'Doc' consisting of a linebreak that cannot be erased by a 'group'.+hardline :: Doc+hardline = Line { lineKind = Hard }+ -- | A 'Doc' consisting of a space character, that can be turned into -- a linebreak in order to break lines that are too long. softline :: Doc-softline = Choose { chooseOptions = [ char ' ', linebreak ] }+softline = Choose { chooseOptions = HashSet.fromList [ char ' ', linebreak ] }  -- | An empty 'Doc' that can be turned into a linebreak in order to -- break lines that are too long. softbreak :: Doc-softbreak = Choose { chooseOptions = [ empty, line ] }+softbreak = Choose { chooseOptions = HashSet.fromList [ empty, line ] }  -- | A 'Doc' containing a single character. char :: Char -> Doc@@ -366,22 +459,22 @@  -- | Create a 'Doc' containing a string. string :: String -> Doc-string str = Builder { builderContent = fromString str,-                       builderLength = length str }+string str = Content { contentString = Lazy.UTF8.fromString str,+                       contentLength = length str }  -- | Create a 'Doc' containing a bytestring. bytestring :: Strict.ByteString -> Doc bytestring txt   | Strict.null txt = empty-  | otherwise = Builder { builderLength = Strict.UTF8.length txt,-                          builderContent = fromByteString txt }+  | otherwise = Content { contentLength = Strict.UTF8.length txt,+                          contentString = Lazy.fromStrict txt }  -- | Create a 'Doc' containing a lazy bytestring lazyBytestring :: Lazy.ByteString -> Doc lazyBytestring txt   | Lazy.null txt = empty-  | otherwise = Builder { builderLength = Lazy.UTF8.length txt,-                          builderContent = fromLazyByteString txt }+  | otherwise = Content { contentLength = Lazy.UTF8.length txt,+                          contentString = txt }  -- | The character @(@ lparen :: Doc@@ -443,7 +536,7 @@ dot :: Doc dot = char '.' --- | The character @\@+-- | The character @\\@ backslash :: Doc backslash = char '\\' @@ -798,6 +891,10 @@ (<+>) :: Doc -> Doc -> Doc left <+> right = left <> space <> right +-- | Join two 'Doc's with a 'hardline' in between them.+(<!>) :: Doc -> Doc -> Doc+left <!> right = left <> hardline <> right+ -- | Join two 'Doc's with a 'line' in between them. (<$>) :: Doc -> Doc -> Doc left <$> right = left <> line <> right@@ -832,7 +929,7 @@ choose :: [Doc] -> Doc choose [] = empty choose [doc] = doc-choose docs = Choose { chooseOptions = docs }+choose docs = Choose { chooseOptions = HashSet.fromList docs }  -- | Concatenate a list of 'Doc's.  This is generally more efficient -- than repeatedly using 'beside' or '<>'.@@ -856,11 +953,11 @@  -- | Join a list of 'Doc's using either 'hsep' or 'vsep'. sep :: [Doc] -> Doc-sep docs = Choose { chooseOptions = [hsep docs, vsep docs] }+sep docs = Choose { chooseOptions = HashSet.fromList [hsep docs, vsep docs] }  -- | Join a list of 'Doc's using either 'hcat' or 'vcat'. cat :: [Doc] -> Doc-cat docs = Choose { chooseOptions = [hcat docs, vcat docs] }+cat docs = Choose { chooseOptions = HashSet.fromList [hcat docs, vcat docs] }  -- | Join a list of 'Doc's with 'softline's in between each.  This is -- generally more efficient than repeatedly using '</>'.@@ -897,30 +994,42 @@  -- | Erase all linebreaks in a 'Doc' and replace them with either -- spaces or nothing, depending on the kind of linebreak.-flatten :: Doc -> Doc-flatten Line { insertSpace = True } = Char { charContent = ' ' }-flatten Line { insertSpace = False } = empty-flatten Cat { catDocs = docs } = Cat { catDocs = map flatten docs }+flatten :: Doc -> Maybe Doc+flatten Line { lineKind = Hard } = Nothing+flatten Line { lineKind = Break } = Just Char { charContent = ' ' }+flatten Line { lineKind = Soft } = Just empty+flatten Cat { catDocs = docs } =+  case mapMaybe flatten docs of+    [] -> Nothing+    flatinner -> Just Cat { catDocs = flatinner } flatten Choose { chooseOptions = docs } =-  Choose { chooseOptions = map flatten docs }-flatten n @ Nest { nestDoc = inner } = n { nestDoc = flatten inner }-flatten doc = doc+  case mapMaybe flatten (HashSet.toList docs) of+    [] -> Nothing+    flatdocs -> Just Choose { chooseOptions = HashSet.fromList flatdocs }+flatten n @ Nest { nestDoc = inner } =+  do+    flatinner <- flatten inner+    return n { nestDoc = flatinner }+flatten doc = Just doc  -- | A 'Doc' that 'choose's between the unmodified argument, or the -- 'flatten'ed version of the argument. group :: Doc -> Doc-group doc = Choose { chooseOptions = [ doc, flatten doc ] }+group doc = case flatten doc of+  Just flatdoc -> Choose { chooseOptions = HashSet.fromList [ doc, flatdoc ] }+  Nothing -> doc  -- | Produce a 'Builder' that renders the 'Doc' to one line. buildOneLine :: Doc -> Builder buildOneLine Char { charContent = chr } = fromChar chr-buildOneLine Builder { builderContent = builder } = builder-buildOneLine Line { insertSpace = True } = fromChar ' '-buildOneLine Line { insertSpace = False } = mempty+buildOneLine Content { contentString = builder } = fromLazyByteString builder+buildOneLine Line { lineKind = Break } = fromChar ' '+buildOneLine Line { lineKind = Soft } = mempty+buildOneLine Line { lineKind = Hard } = fromChar '\n' buildOneLine Cat { catDocs = docs } = mconcat (map buildOneLine docs) buildOneLine Nest { nestDoc = inner } = buildOneLine inner-buildOneLine Choose { chooseOptions = first : _ } = buildOneLine first-buildOneLine Choose {} = error "Choose with no options"+buildOneLine Choose { chooseOptions = opts } =+  buildOneLine (head (HashSet.toList opts)) buildOneLine Graphics { graphicsDoc = inner } = buildOneLine inner  -- | Render the entire 'Doc' to one line.  Good for output that@@ -937,12 +1046,12 @@ -- | Produce a 'Builder' that renders the 'Doc' quickly. buildFast :: Doc -> Builder buildFast Char { charContent = chr } = fromChar chr-buildFast Builder { builderContent = builder } = builder+buildFast Content { contentString = builder } = fromLazyByteString builder buildFast Line {} = fromChar '\n' buildFast Cat { catDocs = docs } = mconcat (map buildFast docs) buildFast Nest { nestDoc = inner } = buildFast inner-buildFast Choose { chooseOptions = first : _ } = buildFast first-buildFast Choose {} = error "Choose with no options"+buildFast Choose { chooseOptions = opts } =+  buildFast (head (HashSet.toList opts)) buildFast Graphics { graphicsDoc = inner } = buildFast inner  -- | Render the entire 'Doc', preserving newlines, but without any@@ -957,24 +1066,6 @@ putFast handle =   toByteStringIO (Strict.hPut handle) . buildFast --- | A rendering of a document.---- Renderings store three basic things: A notion of the "badness" of--- this particular rendering (represented by the overrun and the--- number of lines), the indentation mode for the next document, and a--- function that actually produces the Builder.-data Render =-  Render {-    -- | The number of lines in the document.-    renderLines :: !Word,-    -- | The largest amount by which we've overrun.-    renderOverrun :: !Column,-    -- | A builder that constructs the document.-    renderBuilder :: !(Int -> Int -> Builder),-    -- | Indentation mode for the next document.-    renderIndent :: !Indent-  }- -- | Column data type.  Represents how rendered documents affect the -- current column. @@ -1094,26 +1185,65 @@         Maximum { maxFixed = fixed2, maxRelative = rel2 } =   Maximum { maxFixed = max fixed2 (fixed1 + rel2), maxRelative = rel1 + rel2 } --- | Offsets structure.  this is used as a key in a hash table.  It is--- also important to how the algorithm works.  Renderings represent--- "chunks", which have an ending column and a maximum column.  The--- algorithm glues these chunks together, then evaluates their--- "badness" using the 'advance' function to recalculate the ending--- column and the maximum starting offset.-data Offsets =-  Offsets {+-- | A rendering of a document.+-- Renderings store three basic things: A notion of the "badness" of+-- this particular rendering (represented by the overrun and the+-- number of lines), the indentation mode for the next document, and a+-- function that actually produces the Builder.+data Render =+  Render {     -- | Upper-bound: Highest starting column for this document     -- without causing overrun.  If this is negative, it means you've     -- overrun by that much.-    offsetUpper :: !Int,+    renderUpper :: !Int,     -- | Ending column.-    offsetCol :: !Column+    renderCol :: !Column,+    -- | The number of lines in the document.+    renderLines :: !Word,+    -- | The largest amount by which we've overrun.+    renderOverrun :: !Column,+    -- | A builder that constructs the document.+    renderBuilder :: !(Int -> Int -> Builder),+    -- | Indentation mode for the next document.+    renderIndent :: !Indent   }-  deriving Eq -instance Hashable Offsets where-  hashWithSalt s Offsets { offsetUpper = upper, offsetCol = col } =-    s `hashWithSalt` upper `hashWithSalt` col+-- | Determine whether the first 'Render' is strictly better than the second.+subsumes :: Render -> Render -> Bool+-- Simple comparisons: if the upper bound is greater, the lines are+-- less, and the column is less, then the render is always better.+subsumes Render { renderUpper = upper1, renderLines = lines1,+                  renderCol = Fixed { fixedOffset = col1 } }+         Render { renderUpper = upper2, renderLines = lines2,+                  renderCol = Fixed { fixedOffset = col2 } } =+  upper1 >= upper2 && lines1 <= lines2 && col1 <= col2+subsumes Render { renderUpper = upper1, renderLines = lines1,+                  renderCol = Relative { relOffset = col1 } }+         Render { renderUpper = upper2, renderLines = lines2,+                  renderCol = Relative { relOffset = col2 } } =+  upper1 >= upper2 && lines1 <= lines2 && col1 <= col2+-- A fixed column offset can subsume a relative offset+subsumes Render { renderUpper = upper1, renderLines = lines1,+                  renderCol = Fixed { fixedOffset = col1 } }+         Render { renderUpper = upper2, renderLines = lines2,+                  renderCol = Relative { relOffset = col2 } } =+  upper1 >= upper2 && lines1 <= lines2 && col1 <= col2+-- For two maximums, it's a straightaway comparison+subsumes Render { renderUpper = upper1, renderLines = lines1,+                  renderCol = Maximum { maxRelative = rel1,+                                        maxFixed = fixed1 } }+         Render { renderUpper = upper2, renderLines = lines2,+                  renderCol = Maximum { maxRelative = rel2,+                                        maxFixed = fixed2 } } =+  upper1 >= upper2 && lines1 <= lines2 && rel1 <= rel2 && fixed1 <= fixed2+-- Fixed can subsume a maximum as above+subsumes Render { renderUpper = upper1, renderLines = lines1,+                  renderCol =  Fixed { fixedOffset = col1 } }+         Render { renderUpper = upper2, renderLines = lines2,+                  renderCol = Maximum { maxRelative = rel2,+                                        maxFixed = fixed2 } } =+  upper1 >= upper2 && lines1 <= lines2 && col1 <= rel2 && col1 <= fixed2+subsumes _ _ = False  -- | A result.  This is split into 'Single' and 'Multi' in order to -- optimize for the common case of a single possible rendering.@@ -1123,12 +1253,7 @@     -- | A single possible rendering.     Single {       -- | The rendered document.-      singleRender :: !Render,-      -- | The first column at which this render causes an overrun.-      -- Same as 'offsetUpper'.-      singleUpper :: !Int,-      -- | The current column at the end of rendering.-      singleCol :: !Column+      singleRender :: !Render     }     -- | Multiple possible renderings.   | Multi {@@ -1136,44 +1261,37 @@       -- upper-bound (meaning the first column at which using any of       -- the contents will cause an overrun).  The second map is       -- indexed by the ending column.-      multiOptions :: !(HashMap Offsets Render)+      multiOptions :: ![Render]     }  -- | Generate n spaces makespaces :: Int -> Builder makespaces n = fromLazyByteString (Lazy.Char8.replicate (fromIntegral n) ' ') --- | Pick the best rendering of two.-bestRender :: Render -> Render -> Render-bestRender r1 @ Render { renderLines = lines1, renderOverrun = overrun1 }-           r2 @ Render { renderLines = lines2, renderOverrun = overrun2 }-    -- If one overruns less than the other, pick that one.-  | overrun1 < overrun2 = r1-  | overrun1 > overrun2 = r2-    -- Otherwise, pick the shortest one.-  | otherwise = if lines1 < lines2 then r1 else r2---- Add a result into the HashMap-insertRender :: Int -> Column -> Render -> HashMap Offsets Render ->-                HashMap Offsets Render-insertRender upper col render =-  let-    offsets = Offsets { offsetUpper = upper, offsetCol = col }-  in-    HashMap.insertWith bestRender offsets render+-- Add a 'Render' into a result set, ensuring that any subsumed+-- renders are dropped.+--+-- TODO: The asymptotic runtime of this could likely be improved by some+-- kind of tree structure; however, the design of this structure is+-- nontrivial, due to the 3+-dimensional nature of subsumption, and+-- the wierd interactions between the various kinds of column offsets.+insertRender :: [Render] -> Render -> [Render]+insertRender renders ins+    -- If the inserted element is subsumed by anything in the+    -- list, then don't insert it at all.+  | any (`subsumes` ins) renders = renders+    -- Otherwise, add the element to the list, and drop everything it subsumes.+  | otherwise = ins : filter (not . subsumes ins) renders  -- If a result only has one possibility, convert it to a Single. -- Otherwise, leave it.-packResult :: HashMap Offsets Render -> Result-packResult opts =-  case HashMap.toList opts of-    [(Offsets { offsetUpper = upper, offsetCol = col }, render)] ->-      Single { singleCol = col, singleUpper = upper, singleRender = render }-    _ -> Multi { multiOptions = opts }+packResult :: [Render] -> Result+packResult [opt] = Single { singleRender = opt }+packResult opts = Multi { multiOptions = opts }  -- Pick the best result out of a set of results.  Used at the end to -- pick the final result.-bestRenderInOpts :: HashMap Offsets Render -> Render+bestRenderInOpts :: [Render] -> Render bestRenderInOpts =   let     -- | Compare two Renders.  Less than means better.@@ -1184,21 +1302,18 @@         EQ -> compare lines1 lines2         out -> out   in-    minimumBy compareRenders . HashMap.elems+    minimumBy compareRenders  -- | Append operation on complete states.  A complete state is the -- contents of an Offset and a Render (ie. the contents of Single, or -- the contents of an entry in a Multi combined with the corresponding -- key).-appendOne :: (Int, Column, Render) -> (Int, Column, Render) ->-             (Int, Column, Render)-appendOne (upper1, col1, Render { renderBuilder = build1,-                                  renderLines = lines1,-                                  renderOverrun = overrun1 })-          (upper2, col2, Render { renderBuilder = build2,-                                  renderLines = lines2,-                                  renderOverrun = overrun2,-                                  renderIndent = ind }) =+appendOne :: Render -> Render -> Render+appendOne Render { renderUpper = upper1, renderLines = lines1, renderCol = col1,+                   renderOverrun = overrun1, renderBuilder = build1 }+          Render { renderUpper = upper2, renderLines = lines2, renderCol = col2,+                   renderOverrun = overrun2, renderBuilder = build2,+                   renderIndent = ind } =   let     -- The new build is completely determined by the first render's     -- starting column.@@ -1243,13 +1358,13 @@         else Fixed { fixedOffset = 0 }    in-    -- For the new column, use advance-    (newupper, col1 `advance` col2,-     Render { renderBuilder = newbuild, renderIndent = ind,-              -- For the new overrun, take the max of the existing-              -- overruns and newoverrun-              renderOverrun = max (max overrun1 overrun2) newoverrun,-              renderLines = lines1 + lines2 })+    Render { renderBuilder = newbuild, renderIndent = ind,+             renderLines = lines1 + lines2, renderUpper = newupper,+             -- For the new overrun, take the max of the existing+             -- overruns and newoverrun+             renderOverrun = max (max overrun1 overrun2) newoverrun,+             -- For the new column, use advance+             renderCol = col1 `advance` col2 }  -- | Combine two results into a Multi.  This achieves the same result -- as HashMap.unionWith bestRender (meaning, union these maps,@@ -1257,46 +1372,19 @@ -- index), but handles Singles as well. mergeResults :: Result -> Result -> Result -- Single is equivalent to a single-entry HashMap-mergeResults s1 @ Single { singleRender =-                              r1 @ Render { renderOverrun = overrun1,-                                            renderLines = lines1 },-                           singleUpper = upper1, singleCol = col1 }-             s2 @ Single { singleRender =-                              r2 @ Render { renderOverrun = overrun2,-                                            renderLines = lines2 },-                           singleUpper = upper2, singleCol = col2 }-  -- If the keys would collide-  | upper1 == upper2 && col1 == col2 =-    -- Duplicate the functionality of bestRender-    if overrun1 < overrun2-      then s1-      else if overrun1 > overrun2-        then s2-        else if lines1 < lines2-          then s1-          else s2-  -- Otherwise, create a Multi-  | otherwise =-    Multi { multiOptions =-               HashMap.fromList [(Offsets { offsetUpper = upper1,-                                            offsetCol = col1 },-                                  r1),-                                 (Offsets { offsetUpper = upper2,-                                            offsetCol = col2 },-                                  r2)] }-mergeResults Single { singleRender = render, singleUpper = upper,-                      singleCol = col }+mergeResults s1 @ Single { singleRender = r1 }+             s2 @ Single { singleRender = r2 }+  | subsumes r1 r2 = s1+  | subsumes r2 r1 = s2+  | otherwise = Multi { multiOptions = [r1, r2] }+mergeResults Single { singleRender = render }              Multi { multiOptions = opts } =-  -- Do an insertWith bestRender-  let-    offsets = Offsets { offsetUpper = upper, offsetCol = col }-  in-   Multi { multiOptions = HashMap.insertWith bestRender offsets render opts }+  packResult (insertRender opts render) -- This operation is commutative mergeResults m @ Multi {} s @ Single {} = mergeResults s m -- Otherwise it's a straightaway HashMap union mergeResults Multi { multiOptions = opts1 } Multi { multiOptions = opts2 } =-  Multi { multiOptions = HashMap.unionWith bestRender opts1 opts2 }+  packResult (foldl insertRender opts1 opts2)  -- Add indentation on to a builder.  Note, this is used to create the -- builder functions used in Render.@@ -1349,25 +1437,22 @@         -- Single characters have a single possibility, a relative         -- ending position one beyond the start, and an upper-bound         -- one shorter than the maximum width.-        Single {-          singleRender =-             Render { renderLines = 0, renderOverrun = overrun,-                      renderBuilder = builder, renderIndent = None },-          singleCol = Relative 1, singleUpper = maxcol - 1-        }-    buildDynamic _ _ ind Builder { builderContent = txt, builderLength = len } =+        Single { singleRender =+                    Render { renderOverrun = overrun, renderIndent = None,+                             renderBuilder = builder, renderCol = Relative 1,+                             renderLines = 0, renderUpper = maxcol - 1 } }+    buildDynamic _ _ ind Content { contentString = txt, contentLength = len } =       let         -- Why would you have maxcol == 0?  Who knows, but check for it.         overrun = if maxcol >= len then Relative 0 else Relative (len - maxcol)-        builder = contentBuilder ind txt+        builder = contentBuilder ind (fromLazyByteString txt)       in         -- Text has a single possibility and a relative ending position         -- equal to its length-       Single {-         singleRender = Render { renderLines = 0, renderOverrun = overrun,-                                 renderBuilder = builder, renderIndent = None },-         singleCol = Relative len, singleUpper = maxcol - len-       }+       Single { singleRender =+                   Render { renderLines = 0, renderUpper = maxcol - len,+                            renderBuilder = builder, renderCol = Relative len,+                            renderIndent = None, renderOverrun = overrun } }     buildDynamic _ nesting _ Line {} =       -- A newline starts at the nesting level, has no overrun, and an       -- upper-bound equal to the maximum column width.@@ -1377,100 +1462,71 @@         singleRender = Render { renderOverrun = Fixed { fixedOffset = 0 },                                 renderIndent = Full, renderLines = 1,                                 renderBuilder = const $! const $!-                                                fromChar '\n' },-        singleCol = nesting, singleUpper = maxcol-      }+                                                fromChar '\n',+                                renderCol = nesting, renderUpper = maxcol } }     -- This is for an empty cat, ie. the empty document     buildDynamic _ _ ind Cat { catDocs = [] } =       -- The empty document has no content, no overrun, a relative end       -- position of 0, and an upper-bound of maxcol.       Single {-        singleRender = Render { renderOverrun = Fixed { fixedOffset = 0 },-                                renderIndent = ind, renderLines = 0,-                                renderBuilder = const mempty },-        singleCol = Relative { relOffset = 0 }, singleUpper = maxcol-      }+        singleRender = Render { renderOverrun = Fixed 0, renderIndent = ind,+                                renderLines = 0, renderBuilder = const mempty,+                                renderCol = Relative 0, renderUpper = maxcol } }     buildDynamic sgr nesting ind Cat { catDocs = first : rest } =       let         -- Glue two Results together.  This gets used in a fold.         appendResults :: Result -> Doc -> Result         -- The accumulated result is a Single.         appendResults Single { singleRender =-                                  render1 @ Render { renderIndent = ind' },-                               singleUpper = upper1, singleCol = col1 } doc' =+                                  render1 @ Render { renderIndent = ind' } }+                      doc' =           -- Render the document.           case buildDynamic sgr nesting ind' doc' of             -- If there's a single result, it's easy; just use appendOne.-            Single { singleUpper = upper2, singleCol = col2,-                     singleRender = render2 } ->+            Single { singleRender = render2  } ->               let-                (newupper, newcol, newrender) =-                  appendOne (upper1, col1, render1) (upper2, col2, render2)+                newrender = appendOne render1 render2               in-                Single { singleUpper = newupper, singleCol = newcol,-                         singleRender = newrender }+                Single { singleRender = newrender }             -- Otherwise, we have to fold over all the options and             -- glue on the accumulated result.             Multi { multiOptions = opts } ->               let                 -- Level 2 fold function: glue the accumulated result                 -- on to an option.-                foldfun :: HashMap Offsets Render -> Offsets -> Render ->-                           HashMap Offsets Render-                foldfun accum Offsets { offsetUpper = upper2,-                                        offsetCol = col2 } render2 =-                  let-                    (newupper, newcol, newrender) =-                      appendOne (upper1, col1, render1) (upper2, col2, render2)-                  in-                    insertRender newupper newcol newrender accum+                foldfun :: [Render] -> Render -> [Render]+                foldfun accum = insertRender accum . appendOne render1               in                 -- Fold it up, then use packResult.-                packResult (HashMap.foldlWithKey' foldfun HashMap.empty opts)+                packResult (foldl foldfun [] opts)         -- If the accumulate result is a multi, then we'll need to         -- glue the next render on to each option.         appendResults Multi { multiOptions = opts } doc' =           let             -- Outer fold, over each option in the accumulated result,             -- gluing on the next render.-            outerfold :: HashMap Offsets Render -> Offsets -> Render ->-                         HashMap Offsets Render-            outerfold accum Offsets { offsetUpper = upper1,-                                      offsetCol = col1 }-                      render1 @ Render { renderIndent = ind' } =+            outerfold :: [Render] -> Render -> [Render]+            outerfold accum render1 @ Render { renderIndent = ind' } =               case buildDynamic sgr nesting ind' doc' of                 -- If the render is a single result, then just glue it                 -- on to the current option.-                Single { singleUpper = upper2, singleCol = col2,-                         singleRender = render2 } ->-                  let-                    (newupper, newcol, newrender) =-                      appendOne (upper1, col1, render1) (upper2, col2, render2)-                  in-                    insertRender newupper newcol newrender accum+                Single { singleRender = render2 } ->+                  insertRender accum (appendOne render1 render2)                 -- If the render result is ALSO a Multi, then we need                 -- to do another level of fold to glue those options                 -- on to the current one.                 Multi { multiOptions = opts2 } ->                   let                     -- Innermost fold, glues two options together-                    innerfold :: HashMap Offsets Render -> Offsets -> Render ->-                                 HashMap Offsets Render-                    innerfold accum' Offsets { offsetUpper = upper2,-                                               offsetCol = col2 } render2 =-                      let-                        (newupper, newcol, newrender) =-                          appendOne (upper1, col1, render1)-                                    (upper2, col2, render2)-                      in-                        insertRender newupper newcol newrender accum'+                    innerfold :: [Render] -> Render -> [Render]+                    innerfold accum' = insertRender accum' . appendOne render1                   in                     -- Don't bother calling packResult here, we'll do                     -- it at the end anyway.-                    HashMap.foldlWithKey' innerfold accum opts2+                    foldl innerfold accum opts2           in             -- Fold it up, then use packResult.-            packResult (HashMap.foldlWithKey' outerfold HashMap.empty opts)+            packResult (foldl outerfold [] opts)          -- Build the first item         firstres = buildDynamic sgr nesting ind first@@ -1519,11 +1575,11 @@         s @ Single { singleRender = r } -> s { singleRender = updateRender r }         -- Update all renders for a Multi.         m @ Multi { multiOptions = opts } ->-          m { multiOptions = HashMap.map updateRender opts }+          m { multiOptions = map updateRender opts }     buildDynamic sgr nesting ind Choose { chooseOptions = options } =       let         -- Build up all the components-        results = map (buildDynamic sgr nesting ind) options+        results = map (buildDynamic sgr nesting ind) (HashSet.toList options)       in         -- Now merge them into an minimal set of options         foldl1 mergeResults results@@ -1542,7 +1598,7 @@           s @ Single { singleRender = render } ->             s { singleRender = wrapBuilder render }           m @ Multi { multiOptions = opts } ->-            m { multiOptions = HashMap.map wrapBuilder opts }+            m { multiOptions = map wrapBuilder opts }       -- Otherwise, skip it entirely       | otherwise = buildDynamic sgr2 nesting ind inner