core-text 0.2.3.6 → 0.3.0.0

raw patch · 8 files changed

+1134/−935 lines, 8 filesdep +ansi-terminaldep +colourdep −prettyprinter-ansi-terminaldep ~hashabledep ~prettyprinterbinary-addedPVP ok

version bump matches the API change (PVP)

Dependencies added: ansi-terminal, colour

Dependencies removed: prettyprinter-ansi-terminal

Dependency ranges changed: hashable, prettyprinter

API changes (from Hackage documentation)

Files

• AnsiColours.png binary
• core-text.cabal +11/−8
• lib/Core/Text.hs +25/−27
• lib/Core/Text/Breaking.hs +76/−88
• lib/Core/Text/Bytes.hs +98/−107
• lib/Core/Text/Parsing.hs +20/−22
• lib/Core/Text/Rope.hs +428/−415
• lib/Core/Text/Utilities.hs +476/−268

binary file changed (absent → 92219 bytes)

@@ -1,13 +1,13 @@-cabal-version: 1.12+cabal-version: 1.18  -- This file has been generated from package.yaml by hpack version 0.33.0. -- -- see: https://github.com/sol/hpack ----- hash: 474b85de516532b23adffa6ac413f511b59db0da560430db29418b117b0fbff7+-- hash: 32fe0043eab486639c92b9e8ea6c9c864fd2aa6c21f0861529c72898e51bc67a  name:           core-text-version:        0.2.3.6+version:        0.3.0.0 synopsis:       A rope type based on a finger tree over UTF-8 fragments description:    A rope data type for text, built as a finger tree over UTF-8 text                 fragments. The package also includes utiltiy functions for breaking and@@ -32,8 +32,10 @@ copyright:      © 2018-2020 Athae Eredh Siniath and Others license:        BSD3 license-file:   LICENSE-tested-with:    GHC == 8.8.3+tested-with:    GHC == 8.8.4 build-type:     Simple+extra-doc-files:+    AnsiColours.png  source-repository head   type: git@@ -52,13 +54,14 @@       lib   ghc-options: -Wall -Wwarn -fwarn-tabs   build-depends:-      base >=4.11 && <5+      ansi-terminal+    , base >=4.11 && <5     , bytestring+    , colour     , deepseq     , fingertree-    , hashable >=1.2 && <1.4-    , prettyprinter >=1.2.1.1 && <1.8-    , prettyprinter-ansi-terminal+    , hashable >=1.2+    , prettyprinter >=1.6.2     , template-haskell >=2.14 && <3     , text     , text-short

@@ -1,36 +1,34 @@ {-# OPTIONS_HADDOCK not-home #-} -{-|-A unified Text type providing interoperability between various text-back-ends present in the Haskell ecosystem.--This is intended to be used directly:+-- |+-- A unified Text type providing interoperability between various text+-- back-ends present in the Haskell ecosystem.+--+-- This is intended to be used directly:+--+-- @+-- import "Core.Text"+-- @+--+-- as this module re-exports all of the various components making up this+-- library's text handling subsystem.+module Core.Text+  ( -- * Internal representation -@-import "Core.Text"-@+    -- |+    -- Exposes 'Bytes', a wrapper around different types of binary data, and 'Rope',+    -- a finger-tree over buffers containing text.+    module Core.Text.Bytes,+    module Core.Text.Rope, -as this module re-exports all of the various components making up this-library's text handling subsystem.--}-module Core.Text-    (-        {-* Internal representation -}-{-|-Exposes 'Bytes', a wrapper around different types of binary data, and 'Rope',-a finger-tree over buffers containing text.--}-        module Core.Text.Bytes-      , module Core.Text.Rope+    -- * Useful utilities -        {-* Useful utilities -}-{-|-Useful functions for common use cases.--}-      , module Core.Text.Utilities-    ) where+    -- |+    -- Useful functions for common use cases.+    module Core.Text.Utilities,+  )+where  import Core.Text.Bytes import Core.Text.Rope import Core.Text.Utilities-

@@ -3,88 +3,80 @@  -- This is an Internal module, hidden from Haddock module Core.Text.Breaking-    ( breakWords-    , breakLines-    , breakPieces-    , intoPieces-    , intoChunks-    , isNewline-    )+  ( breakWords,+    breakLines,+    breakPieces,+    intoPieces,+    intoChunks,+    isNewline,+  ) where +import Core.Text.Rope import Data.Char (isSpace)-import Data.Foldable (foldr) import Data.List (uncons)-import qualified Data.Text.Short as S (ShortText, null, break, uncons,empty)--import Core.Text.Rope--{-|-Split a passage of text into a list of words. A line is broken wherever-there is one or more whitespace characters, as defined by "Data.Char"'s-'Data.Char.isSpace'.--Examples:+import qualified Data.Text.Short as S (ShortText, break, empty, null, uncons) -@-λ> __breakWords \"This is a test\"__-[\"This\",\"is\",\"a\",\"test\"]-λ> __breakWords (\"St\" <> \"op and \" <> \"go left\")__-[\"Stop\",\"and\",\"go\",\"left\"]-λ> __breakWords emptyRope__-[]-@--}+-- |+-- Split a passage of text into a list of words. A line is broken wherever+-- there is one or more whitespace characters, as defined by "Data.Char"'s+-- 'Data.Char.isSpace'.+--+-- Examples:+--+-- @+-- λ> __breakWords \"This is a test\"__+-- [\"This\",\"is\",\"a\",\"test\"]+-- λ> __breakWords (\"St\" <> \"op and \" <> \"go left\")__+-- [\"Stop\",\"and\",\"go\",\"left\"]+-- λ> __breakWords emptyRope__+-- []+-- @ breakWords :: Rope -> [Rope] breakWords = filter (not . nullRope) . breakPieces isSpace -{-|-Split a paragraph of text into a list of its individual lines. The-paragraph will be broken wherever there is a @'\n'@ character.--Blank lines will be preserved. Note that as a special case you do /not/ get-a blank entry at the end of the a list of newline terminated strings.--@-λ> __breakLines \"Hello\\n\\nWorld\\n\"__-[\"Hello\",\"\",\"World\"]-@--}+-- |+-- Split a paragraph of text into a list of its individual lines. The+-- paragraph will be broken wherever there is a @'\n'@ character.+--+-- Blank lines will be preserved. Note that as a special case you do /not/ get+-- a blank entry at the end of the a list of newline terminated strings.+--+-- @+-- λ> __breakLines \"Hello\\n\\nWorld\\n\"__+-- [\"Hello\",\"\",\"World\"]+-- @ breakLines :: Rope -> [Rope] breakLines text =-  let-    result = breakPieces isNewline text-    n = length result - 1-    (fore,aft) = splitAt n result-  in case result of-    [] -> []-    [p] -> [p]-    _ -> if aft == [""]-        then fore-        else result+  let result = breakPieces isNewline text+      n = length result - 1+      (fore, aft) = splitAt n result+   in case result of+        [] -> []+        [p] -> [p]+        _ ->+          if aft == [""]+            then fore+            else result -{-|-Predicate testing whether a character is a newline. After-'Data.Char.isSpace' et al in "Data.Char".--}+-- |+-- Predicate testing whether a character is a newline. After+-- 'Data.Char.isSpace' et al in "Data.Char". isNewline :: Char -> Bool isNewline c = c == '\n' {-# INLINEABLE isNewline #-} -{-|-Break a Rope into pieces whereever the given predicate function returns-@True@. If found, that character will not be included on either side. Empty-runs, however, *will* be preserved.--}+-- |+-- Break a Rope into pieces whereever the given predicate function returns+-- @True@. If found, that character will not be included on either side. Empty+-- runs, however, *will* be preserved. breakPieces :: (Char -> Bool) -> Rope -> [Rope] breakPieces predicate text =-  let-    x = unRope text-    (final,result) = foldr (intoPieces predicate) (Nothing,[]) x-  in-    case final of-       Nothing -> result-       Just piece -> intoRope piece : result+  let x = unRope text+      (final, result) = foldr (intoPieces predicate) (Nothing, []) x+   in case final of+        Nothing -> result+        Just piece -> intoRope piece : result  {- Was the previous piece a match, or are we in the middle of a run of@@ -92,18 +84,15 @@ before processing into chunks. -} -- now for right fold-intoPieces :: (Char -> Bool) -> S.ShortText -> (Maybe S.ShortText,[Rope]) -> (Maybe S.ShortText,[Rope])-intoPieces predicate piece (stream,list) =-  let-    piece' = case stream of+intoPieces :: (Char -> Bool) -> S.ShortText -> (Maybe S.ShortText, [Rope]) -> (Maybe S.ShortText, [Rope])+intoPieces predicate piece (stream, list) =+  let piece' = case stream of         Nothing -> piece-        Just previous -> piece <> previous       -- more rope, less text?--    pieces = intoChunks predicate piece'-  in-    case uncons pieces of-        Nothing -> (Nothing,list)-        Just (text,remainder) -> (Just (fromRope text),remainder ++ list)+        Just previous -> piece <> previous -- more rope, less text?+      pieces = intoChunks predicate piece'+   in case uncons pieces of+        Nothing -> (Nothing, list)+        Just (text, remainder) -> (Just (fromRope text), remainder ++ list)  -- -- λ> S.break isSpace "a d"@@ -123,7 +112,7 @@ --  {--This was more easily expressed as +This was more easily expressed as    let     remainder' = S.drop 1 remainder@@ -137,17 +126,16 @@ intoChunks :: (Char -> Bool) -> S.ShortText -> [Rope] intoChunks _ piece | S.null piece = [] intoChunks predicate piece =-  let-    (chunk,remainder) = S.break predicate piece+  let (chunk, remainder) = S.break predicate piece -    -- Handle the special case that a trailing " " (generalized to predicate)-    -- is the only character left.-    (trailing,remainder') = case S.uncons remainder of-        Nothing -> (False,S.empty)-        Just (c,remaining) -> if S.null remaining-            then (predicate c,S.empty)-            else (False,remaining)-  in-    if trailing+      -- Handle the special case that a trailing " " (generalized to predicate)+      -- is the only character left.+      (trailing, remainder') = case S.uncons remainder of+        Nothing -> (False, S.empty)+        Just (c, remaining) ->+          if S.null remaining+            then (predicate c, S.empty)+            else (False, remaining)+   in if trailing         then intoRope chunk : emptyRope : []         else intoRope chunk : intoChunks predicate remainder'

@@ -1,150 +1,141 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE StrictData #-}-{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TypeFamilies #-}-{-# OPTIONS_GHC -fno-warn-unused-imports #-}        -- FIXME-{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}   -- FIXME+{-# LANGUAGE TypeSynonymInstances #-} {-# OPTIONS_HADDOCK prune #-} -{-|-Binary (as opposed to textual) data is encountered in weird corners of the-Haskell ecosystem. We tend to forget (for example) that the content-recieved from a web server is /not/ text until we convert it from UTF-8 (if-that's what it is); and of course that glosses over the fact that something-of content-type @image/jpeg@ is not text in any way, shape, or form.--Bytes also show up when working with crypto algorithms, taking hashes, and-when doing serialization to external binary formats. Although we frequently-display these in terminals (and in URLs!) as text, but we take for granted-that we have actually deserialized the data or rendered the it in-hexidecimal or base64 or...--This module presents a simple wrapper around various representations of-binary data to make it easier to interoperate with libraries supplying-or consuming bytes.--}+-- |+-- Binary (as opposed to textual) data is encountered in weird corners of the+-- Haskell ecosystem. We tend to forget (for example) that the content+-- recieved from a web server is /not/ text until we convert it from UTF-8 (if+-- that's what it is); and of course that glosses over the fact that something+-- of content-type @image/jpeg@ is not text in any way, shape, or form.+--+-- Bytes also show up when working with crypto algorithms, taking hashes, and+-- when doing serialization to external binary formats. Although we frequently+-- display these in terminals (and in URLs!) as text, but we take for granted+-- that we have actually deserialized the data or rendered the it in+-- hexidecimal or base64 or...+--+-- This module presents a simple wrapper around various representations of+-- binary data to make it easier to interoperate with libraries supplying+-- or consuming bytes. module Core.Text.Bytes-    ( Bytes-    , Binary(fromBytes, intoBytes)-    , hOutput-    , hInput-      {-* Internals -}-    , unBytes-    ) where+  ( Bytes,+    Binary (fromBytes, intoBytes),+    hOutput,+    hInput, -import qualified Data.ByteString as B (ByteString, foldl', splitAt-    , pack, unpack, length, hPut, hGetContents)-import qualified Data.ByteString.Char8 as C (pack, unpack)-import qualified Data.ByteString.Builder as B (Builder, toLazyByteString, byteString)+    -- * Internals+    unBytes,+  )+where++import qualified Data.ByteString as B+  ( ByteString,+    hGetContents,+    hPut,+    pack,+    unpack,+  )+import qualified Data.ByteString.Builder as B (Builder, byteString, toLazyByteString) import qualified Data.ByteString.Lazy as L (ByteString, fromStrict, toStrict) import Data.Hashable (Hashable) import Data.Word (Word8) import GHC.Generics (Generic)-import Data.Text.Prettyprint.Doc-    ( Doc, emptyDoc, pretty, annotate, (<+>), hsep, vcat-    , space, punctuate, hcat, group, flatAlt, sep, fillSep-    , line, line', softline, softline', hardline-    )-import Data.Text.Prettyprint.Doc.Render.Terminal (-    color, colorDull, bold, Color(..)) import System.IO (Handle) -{-|-A block of data in binary form.--}+-- |+-- A block of data in binary form. newtype Bytes-    = StrictBytes B.ByteString-    deriving (Show, Eq, Ord, Generic)+  = StrictBytes B.ByteString+  deriving (Show, Eq, Ord, Generic) -{-|-Access the strict 'ByteString' underlying the @Bytes@ type.--}+-- |+-- Access the strict 'ByteString' underlying the @Bytes@ type. unBytes :: Bytes -> B.ByteString unBytes (StrictBytes b') = b' {-# INLINE unBytes #-}  instance Hashable Bytes -{-|-Conversion to and from various types containing binary data into our-convenience Bytes type.--As often as not these conversions are /expensive/; these methods are-here just to wrap calling the relevant functions in a uniform interface.--}+-- |+-- Conversion to and from various types containing binary data into our+-- convenience Bytes type.+--+-- As often as not these conversions are /expensive/; these methods are+-- here just to wrap calling the relevant functions in a uniform interface. class Binary α where-    fromBytes :: Bytes -> α-    intoBytes :: α -> Bytes+  fromBytes :: Bytes -> α+  intoBytes :: α -> Bytes  instance Binary Bytes where-    fromBytes = id-    intoBytes = id+  fromBytes = id+  intoBytes = id -{-| from "Data.ByteString" Strict -}+-- | from "Data.ByteString" Strict instance Binary B.ByteString where-    fromBytes (StrictBytes b') = b'-    intoBytes b' = StrictBytes b'+  fromBytes (StrictBytes b') = b'+  intoBytes b' = StrictBytes b' -{-| from "Data.ByteString.Lazy" -}+-- | from "Data.ByteString.Lazy" instance Binary L.ByteString where-    fromBytes (StrictBytes b') = L.fromStrict b'-    intoBytes b' = StrictBytes (L.toStrict b')      -- expensive+  fromBytes (StrictBytes b') = L.fromStrict b'+  intoBytes b' = StrictBytes (L.toStrict b') -- expensive  instance Binary B.Builder where-    fromBytes (StrictBytes b') = B.byteString b'-    intoBytes b' = StrictBytes (L.toStrict (B.toLazyByteString b'))+  fromBytes (StrictBytes b') = B.byteString b'+  intoBytes b' = StrictBytes (L.toStrict (B.toLazyByteString b')) -{-| from "Data.Word" -}+-- | from "Data.Word" instance Binary [Word8] where-    fromBytes (StrictBytes b') = B.unpack b'-    intoBytes = StrictBytes . B.pack--{-|-Output the content of the 'Bytes' to the specified 'Handle'.--@-    hOutput h b-@--'Core.Program.Execute.output' provides a convenient way to write a @Bytes@-to a file or socket handle from within the 'Core.Program.Execute.Program'-monad.--Don't use this function to write to @stdout@ if you are using any of the-other output or logging facililities of this libarary as you will corrupt-the ordering of output on the user's terminal. Instead do:--@-    'Core.Program.Execute.write' ('intoRope' b)-@+  fromBytes (StrictBytes b') = B.unpack b'+  intoBytes = StrictBytes . B.pack -on the assumption that the bytes in question are UTF-8 (or plain ASCII)-encoded.--}+-- |+-- Output the content of the 'Bytes' to the specified 'Handle'.+--+-- @+--     hOutput h b+-- @+--+-- 'Core.Program.Execute.output' provides a convenient way to write a @Bytes@+-- to a file or socket handle from within the 'Core.Program.Execute.Program'+-- monad.+--+-- Don't use this function to write to @stdout@ if you are using any of the+-- other output or logging facililities of this libarary as you will corrupt+-- the ordering of output on the user's terminal. Instead do:+--+-- @+--     'Core.Program.Execute.write' ('intoRope' b)+-- @+--+-- on the assumption that the bytes in question are UTF-8 (or plain ASCII)+-- encoded. hOutput :: Handle -> Bytes -> IO () hOutput handle (StrictBytes b') = B.hPut handle b' -{-|-Read the (entire) contents of a handle into a Bytes object.--If you want to read the entire contents of a file, you can do:--@-    contents <- 'Core.System.Base.withFile' name 'Core.System.Base.ReadMode' 'hInput'-@--At any kind of scale, Streaming I/O is almost always for better, but for-small files you need to pick apart this is fine.--}+-- |+-- Read the (entire) contents of a handle into a Bytes object.+--+-- If you want to read the entire contents of a file, you can do:+--+-- @+--     contents <- 'Core.System.Base.withFile' name 'Core.System.Base.ReadMode' 'hInput'+-- @+--+-- At any kind of scale, Streaming I/O is almost always for better, but for+-- small files you need to pick apart this is fine. hInput :: Handle -> IO Bytes hInput handle = do-   contents <- B.hGetContents handle-   return (StrictBytes contents)+  contents <- B.hGetContents handle+  return (StrictBytes contents)  {- instance Show Bytes where     show x = case x of-        StrictBytes b' -> +        StrictBytes b' -> -}

@@ -1,39 +1,37 @@-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_HADDOCK hide #-}  -- This is an Internal module, hidden from Haddock module Core.Text.Parsing-    ( calculatePositionEnd-    )+  ( calculatePositionEnd,+  ) where +import Core.Text.Rope import Data.Foldable (foldl') import qualified Data.Text.Short as S (ShortText, foldl') -import Core.Text.Rope+-- |+-- Calculate the line number and column number of a Rope (interpreting it as+-- if is a block of text in a file). By the convention observed by all leading+-- brands of text editor, lines and columns are @1@ origin, so an empty Rope+-- is position @(1,1)@. -{-|-Calculate the line number and column number of a Rope (interpreting it as-if is a block of text in a file). By the convention observed by all leading-brands of text editor, lines and columns are @1@ origin, so an empty Rope-is position @(1,1)@.--} -- Of course, if Rope itself cached position information in the FingerTree -- monoid this would be trivial.-calculatePositionEnd :: Rope -> (Int,Int)+calculatePositionEnd :: Rope -> (Int, Int) calculatePositionEnd text =-  let-    x = unRope text-    (l,c) = foldl' calculateChunk (1,1) x-  in-    (l,c)+  let x = unRope text+      (l, c) = foldl' calculateChunk (1, 1) x+   in (l, c) -calculateChunk :: (Int,Int) -> S.ShortText -> (Int,Int)+calculateChunk :: (Int, Int) -> S.ShortText -> (Int, Int) calculateChunk loc piece =-    S.foldl' f loc piece+  S.foldl' f loc piece   where-    f :: (Int,Int) -> Char -> (Int,Int)-    f !(!l,!c) ch = if ch == '\n'-        then (l+1,1)-        else (l,c+1)+    f :: (Int, Int) -> Char -> (Int, Int)+    f !(!l, !c) ch =+      if ch == '\n'+        then (l + 1, 1)+        else (l, c + 1)

@@ -1,282 +1,309 @@-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TypeSynonymInstances #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE StrictData #-}+{-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE InstanceSigs #-}-{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE StrictData #-}+{-# LANGUAGE TypeSynonymInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -{-|-If you're accustomed to working with text in almost any other programming-language, you'd be aware that a \"string\" typically refers to an in-memory-/array/ of characters. Traditionally this was a single ASCII byte per-character; more recently UTF-8 variable byte encodings which dramatically-complicates finding offsets but which gives efficient support for the-entire Unicode character space. In Haskell, the original text type,-'String', is implemented as a list of 'Char' which, because a Haskell list-is implemented as a /linked-list of boxed values/, is wildly inefficient at-any kind of scale.--In modern Haskell there are two primary ways to represent text.--First is via the [rather poorly named] @ByteString@ from the __bytestring__-package (which is an array of bytes in pinned memory). The-"Data.ByteString.Char8" submodule gives you ways to manipulate those arrays-as if they were ASCII characters. Confusingly there are both strict-(@Data.ByteString@) and lazy (@Data.ByteString.Lazy@) variants which are-often hard to tell the difference between when reading function signatures-or haddock documentation. The performance problem an immutable array backed-data type runs into is that appending a character (that is, ASCII byte) or-concatonating a string (that is, another array of ASCII bytes) is very-expensive and requires allocating a new larger array and copying the whole-thing into it. This led to the development of \"builders\" which amortize-this reallocation cost over time, but it can be cumbersome to switch-between @Builder@, the lazy @ByteString@ that results, and then having to-inevitably convert to a strict @ByteString@ because that's what the next-function in your sequence requires.--The second way is through the opaque @Text@ type of "Data.Text" from the-__text__ package, which is well tuned and high-performing but suffers from-the same design; it is likewise backed by arrays. Rather surprisingly, the-storage backing Text objects are encoded in UTF-16, meaning every time you-want to work with unicode characters that came in from /anywhere/ else and-which inevitably are UTF-8 encoded you have to convert to UTF-16 and copy-into a new array, wasting time and memory.--In this package we introduce 'Rope', a text type backed by the 2-3-'Data.FingerTree.FingerTree' data structure from the __fingertree__-package. This is not an uncommon solution in many languages as finger trees-support exceptionally efficient appending to either end and good-performance inserting anywhere else (you often find them as the backing-data type underneath text editors for this reason). Rather than 'Char' the-pieces of the rope are 'Data.Text.Short.ShortText' from the __text-short__-package, which are UTF-8 encoded and in normal memory managed by the-Haskell runtime. Conversion from other Haskell text types is not /O(1)/-(UTF-8 validity must be checked, or UTF-16 decoded, or...), but in our-benchmarking the performance has been comparable to the established types-and you may find the resultant interface for combining chunks is comparable-to using a Builder, without being forced to use a Builder.--'Rope' is used as the text type throughout this library. If you use the-functions within this package (rather than converting to other text types)-operations are quite efficient. When you do need to convert to another type-you can use 'fromRope' or 'intoRope' from the 'Textual' typeclass.+-- |+-- If you're accustomed to working with text in almost any other programming+-- language, you'd be aware that a \"string\" typically refers to an in-memory+-- /array/ of characters. Traditionally this was a single ASCII byte per+-- character; more recently UTF-8 variable byte encodings which dramatically+-- complicates finding offsets but which gives efficient support for the+-- entire Unicode character space. In Haskell, the original text type,+-- 'String', is implemented as a list of 'Char' which, because a Haskell list+-- is implemented as a /linked-list of boxed values/, is wildly inefficient at+-- any kind of scale.+--+-- In modern Haskell there are two primary ways to represent text.+--+-- First is via the [rather poorly named] @ByteString@ from the __bytestring__+-- package (which is an array of bytes in pinned memory). The+-- "Data.ByteString.Char8" submodule gives you ways to manipulate those arrays+-- as if they were ASCII characters. Confusingly there are both strict+-- (@Data.ByteString@) and lazy (@Data.ByteString.Lazy@) variants which are+-- often hard to tell the difference between when reading function signatures+-- or haddock documentation. The performance problem an immutable array backed+-- data type runs into is that appending a character (that is, ASCII byte) or+-- concatonating a string (that is, another array of ASCII bytes) is very+-- expensive and requires allocating a new larger array and copying the whole+-- thing into it. This led to the development of \"builders\" which amortize+-- this reallocation cost over time, but it can be cumbersome to switch+-- between @Builder@, the lazy @ByteString@ that results, and then having to+-- inevitably convert to a strict @ByteString@ because that's what the next+-- function in your sequence requires.+--+-- The second way is through the opaque @Text@ type of "Data.Text" from the+-- __text__ package, which is well tuned and high-performing but suffers from+-- the same design; it is likewise backed by arrays. Rather surprisingly, the+-- storage backing Text objects are encoded in UTF-16, meaning every time you+-- want to work with unicode characters that came in from /anywhere/ else and+-- which inevitably are UTF-8 encoded you have to convert to UTF-16 and copy+-- into a new array, wasting time and memory.+--+-- In this package we introduce 'Rope', a text type backed by the 2-3+-- 'Data.FingerTree.FingerTree' data structure from the __fingertree__+-- package. This is not an uncommon solution in many languages as finger trees+-- support exceptionally efficient appending to either end and good+-- performance inserting anywhere else (you often find them as the backing+-- data type underneath text editors for this reason). Rather than 'Char' the+-- pieces of the rope are 'Data.Text.Short.ShortText' from the __text-short__+-- package, which are UTF-8 encoded and in normal memory managed by the+-- Haskell runtime. Conversion from other Haskell text types is not /O(1)/+-- (UTF-8 validity must be checked, or UTF-16 decoded, or...), but in our+-- benchmarking the performance has been comparable to the established types+-- and you may find the resultant interface for combining chunks is comparable+-- to using a Builder, without being forced to use a Builder.+--+-- 'Rope' is used as the text type throughout this library. If you use the+-- functions within this package (rather than converting to other text types)+-- operations are quite efficient. When you do need to convert to another type+-- you can use 'fromRope' or 'intoRope' from the 'Textual' typeclass.+--+-- Note that we haven't tried to cover the entire gamut of operations or+-- customary convenience functions you would find in the other libraries; so+-- far 'Rope' is concentrated on aiding interoperation, being good at+-- appending (lots of) small pieces, and then efficiently taking the resultant+-- text object out to a file handle, be that the terminal console, a file, or+-- a network socket.+module Core.Text.Rope+  ( -- * Rope type+    Rope,+    emptyRope,+    singletonRope,+    replicateRope,+    replicateChar,+    widthRope,+    splitRope,+    insertRope,+    containsCharacter,+    findIndexRope, -Note that we haven't tried to cover the entire gamut of operations or-customary convenience functions you would find in the other libraries; so-far 'Rope' is concentrated on aiding interoperation, being good at-appending (lots of) small pieces, and then efficiently taking the resultant-text object out to a file handle, be that the terminal console, a file, or-a network socket.+    -- * Interoperation and Output+    Textual (fromRope, intoRope, appendRope),+    hWrite, --}-module Core.Text.Rope-    ( {-* Rope type -}-      Rope-    , emptyRope-    , singletonRope-    , replicateRope-    , replicateChar-    , widthRope-    , splitRope-    , insertRope-    , containsCharacter-    , findIndexRope-      {-* Interoperation and Output -}-    , Textual(fromRope, intoRope, appendRope)-    , hWrite-      {-* Internals -}-    , unRope-    , nullRope-    , unsafeIntoRope-    , Width(..)-    ) where+    -- * Internals+    unRope,+    nullRope,+    unsafeIntoRope,+    Width (..),+  )+where -import Control.DeepSeq (NFData(..))+import Control.DeepSeq (NFData (..))+import Core.Text.Bytes import qualified Data.ByteString as B (ByteString)-import qualified Data.ByteString.Builder as B (toLazyByteString-    , hPutBuilder)-import qualified Data.ByteString.Lazy as L (ByteString, toStrict-    , foldrChunks)-import qualified Data.FingerTree as F (FingerTree, Measured(..), empty-    , singleton, (><), (<|), (|>), search, SearchResult(..), null-    , viewl, ViewL(..))-import Data.Foldable (foldr, foldr', foldl', foldMap, toList, any)+import qualified Data.ByteString.Builder as B+  ( hPutBuilder,+    toLazyByteString,+  )+import qualified Data.ByteString.Lazy as L+  ( ByteString,+    foldrChunks,+    toStrict,+  )+import qualified Data.FingerTree as F+  ( FingerTree,+    Measured (..),+    SearchResult (..),+    ViewL (..),+    empty,+    null,+    search,+    singleton,+    viewl,+    (<|),+    (><),+    (|>),+  )+import Data.Foldable (foldl', foldr', toList) import Data.Hashable (Hashable, hashWithSalt)-import Data.String (IsString(..))+import Data.String (IsString (..)) import qualified Data.Text as T (Text)-import qualified Data.Text.Lazy as U (Text, fromChunks, foldrChunks-    , toStrict)-import qualified Data.Text.Lazy.Builder as U (Builder, toLazyText-    , fromText)-import Data.Text.Prettyprint.Doc (Pretty(..), emptyDoc)-import qualified Data.Text.Short as S (ShortText, length, any, null-    , fromText, toText, fromByteString, pack, unpack, singleton-    , append, empty, toBuilder, splitAt, findIndex, replicate)+import qualified Data.Text.Lazy as U+  ( Text,+    foldrChunks,+    fromChunks,+    toStrict,+  )+import qualified Data.Text.Lazy.Builder as U+  ( Builder,+    fromText,+    toLazyText,+  )+import Data.Text.Prettyprint.Doc (Pretty (..), emptyDoc)+import qualified Data.Text.Short as S+  ( ShortText,+    any,+    append,+    empty,+    findIndex,+    fromByteString,+    fromText,+    length,+    null,+    pack,+    replicate,+    singleton,+    splitAt,+    toBuilder,+    toText,+    unpack,+  ) import qualified Data.Text.Short.Unsafe as S (fromByteStringUnsafe) import GHC.Generics (Generic) import System.IO (Handle) -import Core.Text.Bytes--{-|-A type for textual data. A rope is text backed by a tree data structure,-rather than a single large continguous array, as is the case for strings.--There are three use cases:--/Referencing externally sourced data/--Often we interpret large blocks of data sourced from external systems as-text. Ideally we would hold onto this without copying the memory, but (as-in the case of @ByteString@ which is the most common source of data) before-we can treat it as text we have to validate the UTF-8 content. Safety-first. We also copy it out of pinned memory, allowing the Haskell runtime-to manage the storage.--/Interoperating with other libraries/--The only constant of the Haskell universe is that you won't have the right-combination of {strict, lazy} × {@Text@, @ByteString@, @String@, @[Word8]@,-etc} you need for the next function call. The 'Textual' typeclass provides-for moving between different text representations. To convert between-@Rope@ and something else use 'fromRope'; to construct a @Rope@ from-textual content in another type use 'intoRope'.--You can get at the underlying finger tree with the 'unRope' function.--/Assembling text to go out/--This involves considerable appending of data, very very occaisionally-inserting it. Often the pieces are tiny. To add text to a @Rope@ use the-'appendRope' method as below or the ('Data.Semigroup.<>') operator from-"Data.Monoid" (like you would have with a @Builder@).--Output to a @Handle@ can be done efficiently with 'hWrite'.--}+-- |+-- A type for textual data. A rope is text backed by a tree data structure,+-- rather than a single large continguous array, as is the case for strings.+--+-- There are three use cases:+--+-- /Referencing externally sourced data/+--+-- Often we interpret large blocks of data sourced from external systems as+-- text. Ideally we would hold onto this without copying the memory, but (as+-- in the case of @ByteString@ which is the most common source of data) before+-- we can treat it as text we have to validate the UTF-8 content. Safety+-- first. We also copy it out of pinned memory, allowing the Haskell runtime+-- to manage the storage.+--+-- /Interoperating with other libraries/+--+-- The only constant of the Haskell universe is that you won't have the right+-- combination of {strict, lazy} × {@Text@, @ByteString@, @String@, @[Word8]@,+-- etc} you need for the next function call. The 'Textual' typeclass provides+-- for moving between different text representations. To convert between+-- @Rope@ and something else use 'fromRope'; to construct a @Rope@ from+-- textual content in another type use 'intoRope'.+--+-- You can get at the underlying finger tree with the 'unRope' function.+--+-- /Assembling text to go out/+--+-- This involves considerable appending of data, very very occaisionally+-- inserting it. Often the pieces are tiny. To add text to a @Rope@ use the+-- 'appendRope' method as below or the ('Data.Semigroup.<>') operator from+-- "Data.Monoid" (like you would have with a @Builder@).+--+-- Output to a @Handle@ can be done efficiently with 'hWrite'. newtype Rope-    = Rope (F.FingerTree Width S.ShortText)-    deriving Generic+  = Rope (F.FingerTree Width S.ShortText)+  deriving (Generic)  instance NFData Rope where-    rnf (Rope x) = foldMap (\piece -> rnf piece) x+  rnf (Rope x) = foldMap (\piece -> rnf piece) x  instance Show Rope where-    show text = "\"" ++ fromRope text ++ "\""+  show text = "\"" ++ fromRope text ++ "\""  instance Eq Rope where-    (==) (Rope x1) (Rope x2) = (==) (stream x1) (stream x2)-      where-        stream x = foldMap S.unpack x+  (==) (Rope x1) (Rope x2) = (==) (stream x1) (stream x2)+    where+      stream x = foldMap S.unpack x  instance Ord Rope where-    compare (Rope x1) (Rope x2) = compare x1 x2+  compare (Rope x1) (Rope x2) = compare x1 x2  instance Pretty Rope where-    pretty (Rope x) = foldr ((<>) . pretty . S.toText) emptyDoc x --{-|-Access the finger tree underlying the @Rope@. You'll want the following-imports:+  pretty (Rope x) = foldr ((<>) . pretty . S.toText) emptyDoc x -@-import qualified "Data.FingerTree" as F  -- from the __fingertree__ package-import qualified "Data.Text.Short" as S  -- from the __text-short__ package-@--}+-- |+-- Access the finger tree underlying the @Rope@. You'll want the following+-- imports:+--+-- @+-- import qualified "Data.FingerTree" as F  -- from the __fingertree__ package+-- import qualified "Data.Text.Short" as S  -- from the __text-short__ package+-- @ unRope :: Rope -> F.FingerTree Width S.ShortText unRope (Rope x) = x {-# INLINE unRope #-} --{-|-The length of the @Rope@, in characters. This is the monoid used to-structure the finger tree underlying the @Rope@.--}+-- |+-- The length of the @Rope@, in characters. This is the monoid used to+-- structure the finger tree underlying the @Rope@. newtype Width = Width Int-    deriving (Eq, Ord, Show, Num, Generic)+  deriving (Eq, Ord, Show, Num, Generic)  instance F.Measured Width S.ShortText where-    measure :: S.ShortText -> Width-    measure piece = Width (S.length piece)+  measure :: S.ShortText -> Width+  measure piece = Width (S.length piece)  instance Semigroup Width where-    (<>) (Width w1) (Width w2) = Width (w1 + w2)+  (<>) (Width w1) (Width w2) = Width (w1 + w2)  instance Monoid Width where-    mempty = Width 0-    mappend = (<>)+  mempty = Width 0+  mappend = (<>)  -- here Maybe we just need type Strand = ShortText and then Rope is -- FingerTree Strand or Builder (Strand)  instance IsString Rope where-    fromString "" = emptyRope-    fromString xs = Rope . F.singleton . S.pack $ xs+  fromString "" = emptyRope+  fromString xs = Rope . F.singleton . S.pack $ xs  instance Semigroup Rope where-    (<>) text1@(Rope x1) text2@(Rope x2) =-        if F.null x2-            then text1-            else if F.null x1-                then text2-                else Rope ((F.><) x1 x2) -- god I hate these operators+  (<>) text1@(Rope x1) text2@(Rope x2) =+    if F.null x2+      then text1+      else+        if F.null x1+          then text2+          else Rope ((F.><) x1 x2) -- god I hate these operators  instance Monoid Rope where-    mempty = emptyRope-    mappend = (<>)+  mempty = emptyRope+  mappend = (<>) -{-|-An zero-length 'Rope'. You can also use @\"\"@ presuming the-__@OverloadedStrings@__ language extension is turned on in your source-file.--}+-- |+-- An zero-length 'Rope'. You can also use @\"\"@ presuming the+-- __@OverloadedStrings@__ language extension is turned on in your source+-- file. emptyRope :: Rope emptyRope = Rope F.empty-{-# INLINABLE emptyRope #-}+{-# INLINEABLE emptyRope #-} -{-|-A 'Rope' with but a single character.--}+-- |+-- A 'Rope' with but a single character. singletonRope :: Char -> Rope singletonRope = Rope . F.singleton . S.singleton --{-|-Repeat the input 'Rope' @n@ times. The follows the same semantics as other-@replicate@ functions; if you ask for zero copies you'll get an empty text-and if you ask for lots of @""@ you'll get ... an empty text.--/Implementation note/--Rather than copying the input /n/ times, this will simply add structure to hold /n/-references to the provided input text.--}+-- |+-- Repeat the input 'Rope' @n@ times. The follows the same semantics as other+-- @replicate@ functions; if you ask for zero copies you'll get an empty text+-- and if you ask for lots of @""@ you'll get ... an empty text.+--+-- /Implementation note/+--+-- Rather than copying the input /n/ times, this will simply add structure to hold /n/+-- references to the provided input text. replicateRope :: Int -> Rope -> Rope replicateRope count (Rope x) =-  let-    x' = foldr (\ _ acc -> (F.><) x acc) F.empty [1..count]-  in-    Rope x'--{-|-Repeat the input 'Char' @n@ times. This is a special case of-'replicateRope' above.--/Implementation note/+  let x' = foldr (\_ acc -> (F.><) x acc) F.empty [1 .. count]+   in Rope x' -Rather than making a huge FingerTree full of single characters, this-function will allocate a single ShortText comprised of the repeated input-character.--}+-- |+-- Repeat the input 'Char' @n@ times. This is a special case of+-- 'replicateRope' above.+--+-- /Implementation note/+--+-- Rather than making a huge FingerTree full of single characters, this+-- function will allocate a single ShortText comprised of the repeated input+-- character. replicateChar :: Int -> Char -> Rope replicateChar count = Rope . F.singleton . S.replicate count . S.singleton -{-|-Get the length of this text, in characters.--}+-- |+-- Get the length of this text, in characters. widthRope :: Rope -> Int widthRope = foldr' f 0 . unRope   where@@ -284,79 +311,71 @@  nullRope :: Rope -> Bool nullRope (Rope x) = case F.viewl x of-    F.EmptyL        -> True-    (F.:<) piece _  -> S.null piece--{-|-Break the text into two pieces at the specified offset.--Examples:--@-λ> __splitRope 0 \"abcdef\"__-(\"\", \"abcdef\")-λ> __splitRope 3 \"abcdef\"__-(\"abc\", \"def\")-λ> __splitRope 6 \"abcdef\"__-(\"abcdef\",\"\")-@--Going off either end behaves sensibly:+  F.EmptyL -> True+  (F.:<) piece _ -> S.null piece -@-λ> __splitRope 7 \"abcdef\"__-(\"abcdef\",\"\")-λ> __splitRope (-1) \"abcdef\"__-(\"\", \"abcdef\")-@--}-splitRope :: Int -> Rope -> (Rope,Rope)+-- |+-- Break the text into two pieces at the specified offset.+--+-- Examples:+--+-- @+-- λ> __splitRope 0 \"abcdef\"__+-- (\"\", \"abcdef\")+-- λ> __splitRope 3 \"abcdef\"__+-- (\"abc\", \"def\")+-- λ> __splitRope 6 \"abcdef\"__+-- (\"abcdef\",\"\")+-- @+--+-- Going off either end behaves sensibly:+--+-- @+-- λ> __splitRope 7 \"abcdef\"__+-- (\"abcdef\",\"\")+-- λ> __splitRope (-1) \"abcdef\"__+-- (\"\", \"abcdef\")+-- @+splitRope :: Int -> Rope -> (Rope, Rope) splitRope i text@(Rope x) =-  let-    pos = Width i-    result = F.search (\w1 _ -> w1 >= pos) x-  in-    case result of+  let pos = Width i+      result = F.search (\w1 _ -> w1 >= pos) x+   in case result of         F.Position before piece after ->-          let-            (Width w) = F.measure before-            (one,two) = S.splitAt (i - w) piece-          in-            (Rope ((F.|>) before one),Rope ((F.<|) two after))+          let (Width w) = F.measure before+              (one, two) = S.splitAt (i - w) piece+           in (Rope ((F.|>) before one), Rope ((F.<|) two after))         F.OnLeft -> (Rope F.empty, text)         F.OnRight -> (text, Rope F.empty)         F.Nowhere -> error "Position not found in split. Probable cause: predicate function given not monotonic. This is supposed to be unreachable" -{-|-Insert a new piece of text into an existing @Rope@ at the specified offset.--Examples:--@-λ> __insertRope 3 \"Con\" \"Def 1\"__-"DefCon 1"-λ> __insertRope 0 \"United \" \"Nations\"__-"United Nations"-@--}+-- |+-- Insert a new piece of text into an existing @Rope@ at the specified offset.+--+-- Examples:+--+-- @+-- λ> __insertRope 3 \"Con\" \"Def 1\"__+-- "DefCon 1"+-- λ> __insertRope 0 \"United \" \"Nations\"__+-- "United Nations"+-- @ insertRope :: Int -> Rope -> Rope -> Rope insertRope 0 (Rope new) (Rope x) = Rope ((F.><) new x) insertRope i (Rope new) text =-  let-    (Rope before,Rope after) = splitRope i text-  in-    Rope (mconcat [before, new, after])+  let (Rope before, Rope after) = splitRope i text+   in Rope (mconcat [before, new, after])  findIndexRope :: (Char -> Bool) -> Rope -> Maybe Int-findIndexRope predicate = fst . foldl f (Nothing,0) . unRope+findIndexRope predicate = fst . foldl f (Nothing, 0) . unRope   where     -- convert this to Maybe monad, maybe-    f :: (Maybe Int,Int) -> S.ShortText -> (Maybe Int,Int)+    f :: (Maybe Int, Int) -> S.ShortText -> (Maybe Int, Int)     f acc piece = case acc of-        (Just j,_) -> (Just j,0)-        (Nothing,!i) -> case S.findIndex predicate piece of-            Nothing -> (Nothing,i + S.length piece)-            Just !j -> (Just (i + j),0)+      (Just j, _) -> (Just j, 0)+      (Nothing, !i) -> case S.findIndex predicate piece of+        Nothing -> (Nothing, i + S.length piece)+        Just !j -> (Just (i + j), 0)  -- -- Manual instance to get around the fact that FingerTree doesn't have a@@ -371,180 +390,174 @@ -- corresponding tree. -- instance Hashable Rope where-    hashWithSalt salt (Rope x) = foldl' f salt x-      where-        f :: Int -> S.ShortText  -> Int-        f num piece = hashWithSalt num piece--{-|-Machinery to interpret a type as containing valid Unicode that can be-represented as a @Rope@ object.--/Implementation notes/+  hashWithSalt salt (Rope x) = foldl' f salt x+    where+      f :: Int -> S.ShortText -> Int+      f num piece = hashWithSalt num piece -Given that @Rope@ is backed by a finger tree, 'append' is relatively-inexpensive, plus whatever the cost of conversion is. There is a subtle-trap, however: if adding small fragments of that were obtained by slicing-(for example) a large ByteString we would end up holding on to a reference-to the entire underlying block of memory. This module is optimized to-reduce heap fragmentation by letting the Haskell runtime and garbage-collector manage the memory, so instances are expected to /copy/ these-substrings out of pinned memory.+-- |+-- Machinery to interpret a type as containing valid Unicode that can be+-- represented as a @Rope@ object.+--+-- /Implementation notes/+--+-- Given that @Rope@ is backed by a finger tree, 'append' is relatively+-- inexpensive, plus whatever the cost of conversion is. There is a subtle+-- trap, however: if adding small fragments of that were obtained by slicing+-- (for example) a large ByteString we would end up holding on to a reference+-- to the entire underlying block of memory. This module is optimized to+-- reduce heap fragmentation by letting the Haskell runtime and garbage+-- collector manage the memory, so instances are expected to /copy/ these+-- substrings out of pinned memory.+--+-- The @ByteString@ instance requires that its content be valid UTF-8. If not+-- an empty @Rope@ will be returned.+--+-- Several of the 'fromRope' implementations are expensive and involve a lot+-- of intermediate allocation and copying. If you're ultimately writing to a+-- handle prefer 'hWrite' which will write directly to the output buffer.+class Textual α where+  -- |+  -- Convert a @Rope@ into another text-like type.+  fromRope :: Rope -> α -The @ByteString@ instance requires that its content be valid UTF-8. If not-an empty @Rope@ will be returned.+  -- |+  -- Take another text-like type and convert it to a @Rope@.+  intoRope :: α -> Rope -Several of the 'fromRope' implementations are expensive and involve a lot-of intermediate allocation and copying. If you're ultimately writing to a-handle prefer 'hWrite' which will write directly to the output buffer.--}-class Textual α where-    {-|-Convert a @Rope@ into another text-like type.-    -}-    fromRope :: Rope -> α-    {-|-Take another text-like type and convert it to a @Rope@.-    -}-    intoRope :: α -> Rope-    {-|-Append some text to this @Rope@. The default implementation is basically a-convenience wrapper around calling 'intoRope' and 'mappend'ing it to your-text (which will work just fine, but for some types more efficient-implementations are possible).-    -}-    appendRope :: α -> Rope -> Rope-    appendRope thing text = text <> intoRope thing+  -- |+  -- Append some text to this @Rope@. The default implementation is basically a+  -- convenience wrapper around calling 'intoRope' and 'mappend'ing it to your+  -- text (which will work just fine, but for some types more efficient+  -- implementations are possible).+  appendRope :: α -> Rope -> Rope+  appendRope thing text = text <> intoRope thing  instance Textual (F.FingerTree Width S.ShortText) where-    fromRope = unRope-    intoRope = Rope+  fromRope = unRope+  intoRope = Rope  instance Textual Rope where-    fromRope = id-    intoRope = id-    appendRope (Rope x2) (Rope x1) = Rope ((F.><) x1 x2)+  fromRope = id+  intoRope = id+  appendRope (Rope x2) (Rope x1) = Rope ((F.><) x1 x2) -{-| from "Data.Text.Short" -}+-- | from "Data.Text.Short" instance Textual S.ShortText where-    fromRope = foldr S.append S.empty . unRope-    intoRope = Rope . F.singleton-    appendRope piece (Rope x) = Rope ((F.|>) x piece)+  fromRope = foldr S.append S.empty . unRope+  intoRope = Rope . F.singleton+  appendRope piece (Rope x) = Rope ((F.|>) x piece) -{-| from "Data.Text" Strict -}+-- | from "Data.Text" Strict instance Textual T.Text where-    fromRope = U.toStrict . U.toLazyText . foldr f mempty . unRope-      where-        f :: S.ShortText -> U.Builder -> U.Builder-        f piece built = (<>) (U.fromText (S.toText piece)) built+  fromRope = U.toStrict . U.toLazyText . foldr f mempty . unRope+    where+      f :: S.ShortText -> U.Builder -> U.Builder+      f piece built = (<>) (U.fromText (S.toText piece)) built -    intoRope t = Rope (F.singleton (S.fromText t))-    appendRope chunk (Rope x) = Rope ((F.|>) x (S.fromText chunk))+  intoRope t = Rope (F.singleton (S.fromText t))+  appendRope chunk (Rope x) = Rope ((F.|>) x (S.fromText chunk)) -{-| from "Data.Text.Lazy" -}+-- | from "Data.Text.Lazy" instance Textual U.Text where-    fromRope (Rope x) = U.fromChunks . fmap S.toText . toList $ x-    intoRope t = Rope (U.foldrChunks ((F.<|) . S.fromText) F.empty t)+  fromRope (Rope x) = U.fromChunks . fmap S.toText . toList $ x+  intoRope t = Rope (U.foldrChunks ((F.<|) . S.fromText) F.empty t) -{-| from "Data.ByteString" Strict -}+-- | from "Data.ByteString" Strict instance Textual B.ByteString where-    fromRope = L.toStrict . B.toLazyByteString . foldr g mempty . unRope-      where-        g piece built = (<>) (S.toBuilder piece) built+  fromRope = L.toStrict . B.toLazyByteString . foldr g mempty . unRope+    where+      g piece built = (<>) (S.toBuilder piece) built -    -- If the input ByteString does not contain valid UTF-8 then an empty-    -- Rope will be returned. That's not ideal.-    intoRope b' = case S.fromByteString b' of-        Just piece -> Rope (F.singleton piece)-        Nothing -> Rope F.empty         -- bad+  -- If the input ByteString does not contain valid UTF-8 then an empty+  -- Rope will be returned. That's not ideal.+  intoRope b' = case S.fromByteString b' of+    Just piece -> Rope (F.singleton piece)+    Nothing -> Rope F.empty -- bad -    -- ditto-    appendRope b' (Rope x) = case S.fromByteString b' of-        Just piece -> Rope ((F.|>) x piece)-        Nothing -> (Rope x)             -- bad+  -- ditto+  appendRope b' (Rope x) = case S.fromByteString b' of+    Just piece -> Rope ((F.|>) x piece)+    Nothing -> (Rope x) -- bad -{-| from "Data.ByteString.Lazy" -}+-- | from "Data.ByteString.Lazy" instance Textual L.ByteString where-    fromRope = B.toLazyByteString . foldr g mempty . unRope-      where-        g piece built = (<>) (S.toBuilder piece) built+  fromRope = B.toLazyByteString . foldr g mempty . unRope+    where+      g piece built = (<>) (S.toBuilder piece) built -    intoRope b' = Rope (L.foldrChunks ((F.<|) . check) F.empty b')-      where-        check chunk = case S.fromByteString chunk of-            Just piece -> piece-            Nothing -> S.empty          -- very bad+  intoRope b' = Rope (L.foldrChunks ((F.<|) . check) F.empty b')+    where+      check chunk = case S.fromByteString chunk of+        Just piece -> piece+        Nothing -> S.empty -- very bad  instance Textual Bytes where-    fromRope = intoBytes . (fromRope :: Rope -> B.ByteString)-    intoRope = intoRope . unBytes+  fromRope = intoBytes . (fromRope :: Rope -> B.ByteString)+  intoRope = intoRope . unBytes  instance Binary Rope where-    fromBytes = intoRope . unBytes-    intoBytes = intoBytes . (fromRope :: Rope -> B.ByteString)-+  fromBytes = intoRope . unBytes+  intoBytes = intoBytes . (fromRope :: Rope -> B.ByteString) -{-|-If you /know/ the input bytes are valid UTF-8 encoded characters, then-you can use this function to convert to a piece of @Rope@.--}+-- |+-- If you /know/ the input bytes are valid UTF-8 encoded characters, then+-- you can use this function to convert to a piece of @Rope@. unsafeIntoRope :: B.ByteString -> Rope unsafeIntoRope = Rope . F.singleton . S.fromByteStringUnsafe -{-| from "Data.String" -}+-- | from "Data.String" instance Textual [Char] where-    fromRope (Rope x) = foldr h [] x-      where-        h piece string = (S.unpack piece) ++ string -- ugh-    intoRope = Rope . F.singleton . S.pack--{-|-Write the 'Rope' to the given 'Handle'.--@-import "Core.Text"-import "Core.System" -- re-exports stdout--main :: IO ()-main =-  let-    text :: 'Rope'-    text = "Hello World"-  in-    'hWrite' 'System.IO.stdout' text-@-because it's tradition.--Uses 'Data.ByteString.Builder.hPutBuilder' internally which saves all kinds-of intermediate allocation and copying because we can go from the-'Data.Text.Short.ShortText's in the finger tree to-'Data.ByteString.Short.ShortByteString' to-'Data.ByteString.Builder.Builder' to the 'System.IO.Handle''s output buffer-in one go.+  fromRope (Rope x) = foldr h [] x+    where+      h piece string = (S.unpack piece) ++ string -- ugh+  intoRope = Rope . F.singleton . S.pack -If you're working in the-<https://hackage.haskell.org/package/core-program/docs/Core-Program-Execute.html#t:Program Program>-monad, then-<https://hackage.haskell.org/package/core-program/docs/Core-Program-Logging.html#v:write write>-provides an efficient way to write a @Rope@ to @stdout@.--}+-- |+-- Write the 'Rope' to the given 'Handle'.+--+-- @+-- import "Core.Text"+-- import "Core.System" -- re-exports stdout+--+-- main :: IO ()+-- main =+--   let+--     text :: 'Rope'+--     text = "Hello World"+--   in+--     'hWrite' 'System.IO.stdout' text+-- @+-- because it's tradition.+--+-- Uses 'Data.ByteString.Builder.hPutBuilder' internally which saves all kinds+-- of intermediate allocation and copying because we can go from the+-- 'Data.Text.Short.ShortText's in the finger tree to+-- 'Data.ByteString.Short.ShortByteString' to+-- 'Data.ByteString.Builder.Builder' to the 'System.IO.Handle''s output buffer+-- in one go.+--+-- If you're working in the+-- <https://hackage.haskell.org/package/core-program/docs/Core-Program-Execute.html#t:Program Program>+-- monad, then+-- <https://hackage.haskell.org/package/core-program/docs/Core-Program-Logging.html#v:write write>+-- provides an efficient way to write a @Rope@ to @stdout@. hWrite :: Handle -> Rope -> IO () hWrite handle (Rope x) = B.hPutBuilder handle (foldr j mempty x)   where     j piece built = (<>) (S.toBuilder piece) built -{-|-Does the text contain this character?--We've used it to ask whether there are newlines present in a @Rope@, for-example:--@-    if 'containsCharacter' \'\\n\' text-        then handleComplexCase-        else keepItSimple-@--}+-- |+-- Does the text contain this character?+--+-- We've used it to ask whether there are newlines present in a @Rope@, for+-- example:+--+-- @+--     if 'containsCharacter' \'\\n\' text+--         then handleComplexCase+--         else keepItSimple+-- @ containsCharacter :: Char -> Rope -> Bool containsCharacter q (Rope x) = any j x   where

@@ -1,134 +1,332 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_HADDOCK prune #-} -{-|-Useful tools for working with 'Rope's. Support for pretty printing,-multi-line strings, and...--}-module Core.Text.Utilities (-      {-* Pretty printing -}-      Render(..)-    , render-    , renderNoAnsi-      {-* Helpers -}-    , indefinite-    , breakWords-    , breakLines-    , breakPieces-    , isNewline-    , wrap-    , calculatePositionEnd-    , underline-    , leftPadWith-    , rightPadWith-      {-* Multi-line strings -}-    , quote+-- |+-- Useful tools for working with 'Rope's. Support for pretty printing,+-- multi-line strings, and...+--+-- ![ANSI colours](AnsiColours.png)+module Core.Text.Utilities+  ( -- * Pretty printing+    Render (..),+    AnsiColour,+    bold,+    render,+    renderNoAnsi,+    dullRed,+    brightRed,+    pureRed,+    dullGreen,+    brightGreen,+    pureGreen,+    dullBlue,+    brightBlue,+    pureBlue,+    dullCyan,+    brightCyan,+    pureCyan,+    dullMagenta,+    brightMagenta,+    pureMagenta,+    dullYellow,+    brightYellow,+    pureYellow,+    pureBlack,+    dullGrey,+    brightGrey,+    pureGrey,+    pureWhite,+    dullWhite,+    brightWhite, -    -- for testing-    , intoPieces-    , intoChunks+    -- * Helpers+    indefinite,+    breakWords,+    breakLines,+    breakPieces,+    isNewline,+    wrap,+    calculatePositionEnd,+    underline,+    leftPadWith,+    rightPadWith, -    , byteChunk-) where+    -- * Multi-line strings+    quote,+    -- for testing+    intoPieces,+    intoChunks,+    byteChunk,+    intoDocA,+  )+where +import Core.Text.Breaking+import Core.Text.Bytes+import Core.Text.Parsing+import Core.Text.Rope import Data.Bits (Bits (..))+import qualified Data.ByteString as B (ByteString, length, splitAt, unpack) import Data.Char (intToDigit)-import qualified Data.ByteString as B (ByteString, splitAt, length, unpack)-import qualified Data.FingerTree as F ((<|), ViewL(..), viewl)-import qualified Data.List as List (foldl', dropWhileEnd, splitAt)-import Data.Monoid ((<>))+import Data.Colour.SRGB (sRGB, sRGB24read)+import qualified Data.FingerTree as F (ViewL (..), viewl, (<|))+import qualified Data.List as List (dropWhileEnd, foldl', splitAt) import qualified Data.Text as T-import qualified Data.Text.Short as S (ShortText, uncons, toText, replicate-    , singleton)-import Data.Text.Prettyprint.Doc (Doc, layoutPretty , annotate, reAnnotateS-    , unAnnotateS, Pretty(..), pretty, emptyDoc-    , LayoutOptions(LayoutOptions)-    , PageWidth(AvailablePerLine)-    , hsep, vcat, group, flatAlt-    , softline'-    )--import Data.Text.Prettyprint.Doc.Render.Terminal (renderLazy, AnsiStyle-    , color, Color(..))-+import Data.Text.Prettyprint.Doc+  ( Doc,+    LayoutOptions (LayoutOptions),+    PageWidth (AvailablePerLine),+    Pretty (..),+    SimpleDocStream (..),+    annotate,+    emptyDoc,+    flatAlt,+    group,+    hsep,+    layoutPretty,+    pretty,+    reAnnotateS,+    softline',+    unAnnotateS,+    vcat,+  )+import Data.Text.Prettyprint.Doc.Render.Text (renderLazy)+import qualified Data.Text.Short as S+  ( ShortText,+    replicate,+    singleton,+    toText,+    uncons,+  ) import Data.Word (Word8) import Language.Haskell.TH (litE, stringL)-import Language.Haskell.TH.Quote (QuasiQuoter(QuasiQuoter))+import Language.Haskell.TH.Quote (QuasiQuoter (QuasiQuoter))+import System.Console.ANSI.Codes (setSGRCode)+import System.Console.ANSI.Types (ConsoleIntensity (..), ConsoleLayer (..), SGR (..)) -import Core.Text.Bytes-import Core.Text.Breaking-import Core.Text.Parsing-import Core.Text.Rope+-- |+-- An accumulation of ANSI escape codes used to add colour when pretty+-- printing to console.+newtype AnsiColour = Escapes [SGR]  -- change AnsiStyle to a custom token type, perhaps Ansi, which -- has the escape codes already converted to Rope. -{-|-Types which can be rendered "prettily", that is, formatted by a pretty-printer and embossed with beautiful ANSI colours when printed to the-terminal.+-- |+-- Types which can be rendered "prettily", that is, formatted by a pretty+-- printer and embossed with beautiful ANSI colours when printed to the+-- terminal.+--+-- Use 'render' to build text object for later use or+-- <https://hackage.haskell.org/package/core-program/docs/Core-Program-Logging.html Control.Program.Logging>'s+-- <https://hackage.haskell.org/package/core-program/docs/Core-Program-Logging.html#v:writeR writeR>+-- if you're writing directly to console now.+class Render α where+  -- |+  -- Which type are the annotations of your Doc going to be expressed in?+  type Token α :: * -Use 'render' to build text object for later use or-<https://hackage.haskell.org/package/core-program/docs/Core-Program-Logging.html Control.Program.Logging>'s-<https://hackage.haskell.org/package/core-program/docs/Core-Program-Logging.html#v:writeR writeR>-if you're writing directly to console now.--}+  -- |+  -- Convert semantic tokens to specific ANSI escape tokens+  colourize :: Token α -> AnsiColour -class Render α where-    {-|-Which type are the annotations of your Doc going to be expressed in?-    -}-    type Token α :: *-    {-|-Convert semantic tokens to specific ANSI escape tokens-    -}-    colourize :: Token α -> AnsiStyle-    {-|-Arrange your type as a 'Doc' @ann@, annotated with your semantic-tokens.-    -}-    intoDocA :: α -> Doc (Token α)+  -- |+  -- Arrange your type as a 'Doc' @ann@, annotated with your semantic+  -- tokens.+  highlight :: α -> Doc (Token α) +-- | Nothing should be invoking 'intoDocA'.+intoDocA :: α -> Doc (Token α)+intoDocA = error "Nothing should be invoking this method directly."++{-# DEPRECATED intoDocA "method'intoDocA' has been renamed 'highlight'; implement that instead." #-}++-- | Medium \"Scarlet Red\" (@#cc0000@ from the Tango color palette).+dullRed :: AnsiColour+dullRed =+  Escapes [SetRGBColor Foreground (sRGB24read "#CC0000")]++-- | Highlighted \"Scarlet Red\" (@#ef2929@ from the Tango color palette).+brightRed :: AnsiColour+brightRed =+  Escapes [SetRGBColor Foreground (sRGB24read "#EF2929")]++-- | Pure \"Red\" (full RGB red channel only).+pureRed :: AnsiColour+pureRed =+  Escapes [SetRGBColor Foreground (sRGB 1 0 0)]++-- | Shadowed \"Chameleon\" (@#4e9a06@ from the Tango color palette).+dullGreen :: AnsiColour+dullGreen =+  Escapes [SetRGBColor Foreground (sRGB24read "#4E9A06")]++-- | Highlighted \"Chameleon\" (@#8ae234@ from the Tango color palette).+brightGreen :: AnsiColour+brightGreen =+  Escapes [SetRGBColor Foreground (sRGB24read "#8AE234")]++-- | Pure \"Green\" (full RGB green channel only).+pureGreen :: AnsiColour+pureGreen =+  Escapes [SetRGBColor Foreground (sRGB 0 1 0)]++-- | Medium \"Sky Blue\" (@#3465a4@ from the Tango color palette).+dullBlue :: AnsiColour+dullBlue =+  Escapes [SetRGBColor Foreground (sRGB24read "#3465A4")]++-- | Highlighted \"Sky Blue\" (@#729fcf@ from the Tango color palette).+brightBlue :: AnsiColour+brightBlue =+  Escapes [SetRGBColor Foreground (sRGB24read "#729FCF")]++-- | Pure \"Blue\" (full RGB blue channel only).+pureBlue :: AnsiColour+pureBlue =+  Escapes [SetRGBColor Foreground (sRGB 0 0 1)]++-- | Dull \"Cyan\" (from the __gnome-terminal__ console theme).+dullCyan :: AnsiColour+dullCyan =+  Escapes [SetRGBColor Foreground (sRGB24read "#06989A")]++-- | Bright \"Cyan\" (from the __gnome-terminal__ console theme).+brightCyan :: AnsiColour+brightCyan =+  Escapes [SetRGBColor Foreground (sRGB24read "#34E2E2")]++-- | Pure \"Cyan\" (full RGB blue + green channels).+pureCyan :: AnsiColour+pureCyan =+  Escapes [SetRGBColor Foreground (sRGB 0 1 1)]++-- | Medium \"Plum\" (@#75507b@ from the Tango color palette).+dullMagenta :: AnsiColour+dullMagenta =+  Escapes [SetRGBColor Foreground (sRGB24read "#75507B")]++-- | Highlighted \"Plum\" (@#ad7fa8@ from the Tango color palette).+brightMagenta :: AnsiColour+brightMagenta =+  Escapes [SetRGBColor Foreground (sRGB24read "#AD7FA8")]++-- | Pure \"Magenta\" (full RGB red + blue channels).+pureMagenta :: AnsiColour+pureMagenta =+  Escapes [SetRGBColor Foreground (sRGB 1 0 1)]++-- | Shadowed \"Butter\" (@#c4a000@ from the Tango color palette).+dullYellow :: AnsiColour+dullYellow =+  Escapes [SetRGBColor Foreground (sRGB24read "#C4A000")]++-- | Highlighted \"Butter\" (@#fce94f@ from the Tango color palette).+brightYellow :: AnsiColour+brightYellow =+  Escapes [SetRGBColor Foreground (sRGB24read "#FCE94F")]++-- | Pure \"Yellow\" (full RGB red + green channels).+pureYellow :: AnsiColour+pureYellow =+  Escapes [SetRGBColor Foreground (sRGB 1 1 0)]++-- | Pure \"Black\" (zero in all RGB channels).+pureBlack :: AnsiColour+pureBlack =+  Escapes [SetRGBColor Foreground (sRGB 0 0 0)]++-- | Shadowed \"Deep Aluminium\" (@#2e3436@ from the Tango color palette).+dullGrey :: AnsiColour+dullGrey =+  Escapes [SetRGBColor Foreground (sRGB24read "#2E3436")]++-- | Medium \"Dark Aluminium\" (from the Tango color palette).+brightGrey :: AnsiColour+brightGrey =+  Escapes [SetRGBColor Foreground (sRGB24read "#555753")]++-- | Pure \"Grey\" (set at @#999999@, being just over half in all RGB channels).+pureGrey :: AnsiColour+pureGrey =+  Escapes [SetRGBColor Foreground (sRGB24read "#999999")]++-- | Pure \"White\" (fully on in all RGB channels).+pureWhite :: AnsiColour+pureWhite =+  Escapes [SetRGBColor Foreground (sRGB 1 1 1)]++-- | Medium \"Light Aluminium\" (@#d3d7cf@ from the Tango color palette).+dullWhite :: AnsiColour+dullWhite =+  Escapes [SetRGBColor Foreground (sRGB24read "#D3D7CF")]++-- | Highlighted \"Light Aluminium\" (@#eeeeec@ from the Tango color palette).+brightWhite :: AnsiColour+brightWhite =+  Escapes [SetRGBColor Foreground (sRGB24read "#EEEEEC")]++-- |+-- Given an 'AnsiColour', lift it to bold intensity.+--+-- Note that many console fonts do /not/ have a bold face variant, and+-- terminal emulators that "support bold" do so by doubling the thickness of+-- the lines in the glyphs. This may or may not be desirable from a+-- readibility standpoint but really there's only so much you can do to keep+-- users who make poor font choices from making poor font choices.+bold :: AnsiColour -> AnsiColour+bold (Escapes list) =+  Escapes (SetConsoleIntensity BoldIntensity : list)++instance Semigroup AnsiColour where+  (<>) (Escapes list1) (Escapes list2) = Escapes (list1 <> list2)++instance Monoid AnsiColour where+  mempty = Escapes []+ instance Render Rope where-    type Token Rope = ()-    colourize = const mempty-    intoDocA = foldr f emptyDoc . unRope-      where-        f :: S.ShortText -> Doc () -> Doc ()-        f piece built = (<>) (pretty (S.toText piece)) built+  type Token Rope = ()+  colourize = const mempty+  highlight = foldr f emptyDoc . unRope+    where+      f :: S.ShortText -> Doc () -> Doc ()+      f piece built = (<>) (pretty (S.toText piece)) built  instance Render Char where-    type Token Char = ()-    colourize = const mempty-    intoDocA c = pretty c+  type Token Char = ()+  colourize = const mempty+  highlight c = pretty c  instance (Render a) => Render [a] where-    type Token [a] = Token a-    colourize = colourize @a-    intoDocA = mconcat . fmap intoDocA+  type Token [a] = Token a+  colourize = colourize @a+  highlight = mconcat . fmap highlight  instance Render T.Text where-    type Token T.Text = ()-    colourize = const mempty-    intoDocA t = pretty t+  type Token T.Text = ()+  colourize = const mempty+  highlight t = pretty t  -- (), aka Unit, aka **1**, aka something with only one inhabitant  instance Render Bytes where-    type Token Bytes = ()-    colourize = const (color Green)-    intoDocA = prettyBytes+  type Token Bytes = ()+  colourize = const brightGreen+  highlight = prettyBytes  prettyBytes :: Bytes -> Doc ()-prettyBytes = annotate () . vcat . twoWords-    . fmap wordToHex . byteChunk . unBytes+prettyBytes =+  annotate () . vcat . twoWords+    . fmap wordToHex+    . byteChunk+    . unBytes  twoWords :: [Doc ann] -> [Doc ann] twoWords ds = go ds@@ -136,10 +334,8 @@     go [] = []     go [x] = [softline' <> x]     go xs =-      let-        (one:two:[], remainder) = List.splitAt 2 xs-      in-        group (one <> spacer <> two) : go remainder+      let (one : two : [], remainder) = List.splitAt 2 xs+       in group (one <> spacer <> two) : go remainder      spacer = flatAlt softline' "  " @@ -147,230 +343,243 @@ byteChunk = reverse . go []   where     go acc blob =-      let-        (eight, remainder) = B.splitAt 8 blob-      in-        if B.length remainder == 0+      let (eight, remainder) = B.splitAt 8 blob+       in if B.length remainder == 0             then eight : acc             else go (eight : acc) remainder  -- Take an [up to] 8 byte (64 bit) word wordToHex :: B.ByteString -> Doc ann wordToHex eight =-  let-    ws = B.unpack eight-    ds = fmap byteToHex ws-  in-    hsep ds+  let ws = B.unpack eight+      ds = fmap byteToHex ws+   in hsep ds  byteToHex :: Word8 -> Doc ann byteToHex c = pretty hi <> pretty low   where-    !low      = byteToDigit $ c .&. 0xf-    !hi       = byteToDigit $ (c .&. 0xf0) `shiftR` 4+    !low = byteToDigit $ c .&. 0xf+    !hi = byteToDigit $ (c .&. 0xf0) `shiftR` 4      byteToDigit :: Word8 -> Char     byteToDigit = intToDigit . fromIntegral -{-|-Given an object of a type with a 'Render' instance, transform it into a-Rope saturated with ANSI escape codes representing syntax highlighting or-similar colouring, wrapping at the specified @width@.--The obvious expectation is that the next thing you're going to do is send-the Rope to console with:--@-    'Core.Program.Execute.write' ('render' 80 thing)-@--However, the /better/ thing to do is to instead use:--@-    'Core.Program.Execute.writeR' thing-@+-- |+-- Given an object of a type with a 'Render' instance, transform it into a+-- Rope saturated with ANSI escape codes representing syntax highlighting or+-- similar colouring, wrapping at the specified @width@.+--+-- The obvious expectation is that the next thing you're going to do is send+-- the Rope to console with:+--+-- @+--     'Core.Program.Execute.write' ('render' 80 thing)+-- @+--+-- However, the /better/ thing to do is to instead use:+--+-- @+--     'Core.Program.Execute.writeR' thing+-- @+--+-- which is able to pretty print the document text respecting the available+-- width of the terminal. -which is able to pretty print the document text respecting the available-width of the terminal.--} -- the annotation (_ :: α) of the parameter is to bring type a into scope -- at term level so that it can be used by TypedApplications. Which then -- needed AllowAmbiguousTypes, but with all that finally it works: -- colourize no longer needs a in its type signature. render :: Render α => Int -> α -> Rope render columns (thing :: α) =-  let-    options = LayoutOptions (AvailablePerLine (columns - 1) 1.0)-  in-    intoRope . renderLazy . reAnnotateS (colourize @α)-                . layoutPretty options . intoDocA $ thing+  let options = LayoutOptions (AvailablePerLine (columns - 1) 1.0)+   in intoRope . go [] . reAnnotateS (colourize @α)+        . layoutPretty options+        . highlight+        $ thing+  where+    go :: [AnsiColour] -> SimpleDocStream AnsiColour -> Rope+    go as x = case x of+      SFail -> error "Unhandled SFail"+      SEmpty -> emptyRope+      SChar c xs ->+        singletonRope c <> go as xs+      SText _ t xs ->+        intoRope t <> go as xs+      SLine len xs ->+        singletonRope '\n'+          <> intoRope (S.replicate len (S.singleton ' '))+          <> go as xs+      SAnnPush a xs ->+        intoRope (convert a) <> go (a : as) xs+      SAnnPop xs ->+        case as of+          [] -> error "Popped an empty stack"+          -- First discard the current one that's just been popped. Then look+          -- at the next one: if it's the last one, we reset the console back+          -- to normal mode. But if they're piled up, then return to the+          -- previous formatting.+          (_ : as') -> case as' of+            [] -> reset <> go [] xs+            (a : _) -> convert a <> go as' xs -{-|-Having gone to all the trouble to colourize your rendered types...-sometimes you don't want that. This function is like 'render', but removes-all the ANSI escape codes so it comes outformatted but as plain black &-white text.--}+    convert :: AnsiColour -> Rope+    convert (Escapes codes) = intoRope (setSGRCode codes)++    reset :: Rope+    reset = intoRope (setSGRCode [Reset])++-- |+-- Having gone to all the trouble to colourize your rendered types...+-- sometimes you don't want that. This function is like 'render', but removes+-- all the ANSI escape codes so it comes outformatted but as plain black &+-- white text. renderNoAnsi :: Render α => Int -> α -> Rope renderNoAnsi columns (thing :: α) =-  let-    options = LayoutOptions (AvailablePerLine (columns - 1) 1.0)-  in-    intoRope . renderLazy . unAnnotateS-                . layoutPretty options . intoDocA $ thing+  let options = LayoutOptions (AvailablePerLine (columns - 1) 1.0)+   in intoRope . renderLazy . unAnnotateS+        . layoutPretty options+        . highlight+        $ thing  --+ -- | Render "a" or "an" in front of a word depending on English's idea of -- whether it's a vowel or not.--- indefinite :: Rope -> Rope indefinite text =-  let-    x = unRope text-  in-    case F.viewl x of+  let x = unRope text+   in case F.viewl x of         F.EmptyL -> text         piece F.:< _ -> case S.uncons piece of-            Nothing -> text-            Just (c,_)  -> if c `elem` ['A','E','I','O','U','a','e','i','o','u']-                then intoRope ("an " F.<| x)-                else intoRope ("a " F.<| x)--{-|-Often the input text represents a paragraph, but does not have any internal-newlines (representing word wrapping). This function takes a line of text-and inserts newlines to simulate such folding, keeping the line under-the supplied maximum width.--A single word that is excessively long will be included as-is on its own-line (that line will exceed the desired maxium width).+          Nothing -> text+          Just (c, _) ->+            if c `elem` ['A', 'E', 'I', 'O', 'U', 'a', 'e', 'i', 'o', 'u']+              then intoRope ("an " F.<| x)+              else intoRope ("a " F.<| x) -Any trailing newlines will be removed.--}+-- |+-- Often the input text represents a paragraph, but does not have any internal+-- newlines (representing word wrapping). This function takes a line of text+-- and inserts newlines to simulate such folding, keeping the line under+-- the supplied maximum width.+--+-- A single word that is excessively long will be included as-is on its own+-- line (that line will exceed the desired maxium width).+--+-- Any trailing newlines will be removed. wrap :: Int -> Rope -> Rope wrap margin text =-  let-    built = wrapHelper margin (breakWords text)-  in-    built+  let built = wrapHelper margin (breakWords text)+   in built  wrapHelper :: Int -> [Rope] -> Rope wrapHelper _ [] = ""-wrapHelper _ [x]  = x-wrapHelper margin (x:xs) =-    snd $ List.foldl' (wrapLine margin) (widthRope x, x) xs+wrapHelper _ [x] = x+wrapHelper margin (x : xs) =+  snd $ List.foldl' (wrapLine margin) (widthRope x, x) xs  wrapLine :: Int -> (Int, Rope) -> Rope -> (Int, Rope)-wrapLine margin (pos,builder) word =-  let-    wide = widthRope word-    wide' = pos + wide + 1-  in-    if wide' > margin-        then (wide , builder <> "\n" <> word)-        else (wide', builder <> " "  <> word)-+wrapLine margin (pos, builder) word =+  let wide = widthRope word+      wide' = pos + wide + 1+   in if wide' > margin+        then (wide, builder <> "\n" <> word)+        else (wide', builder <> " " <> word)  underline :: Char -> Rope -> Rope underline level text =-  let-    title = fromRope text-    line = T.map (\_ -> level) title-  in-    intoRope line+  let title = fromRope text+      line = T.map (\_ -> level) title+   in intoRope line -{-|-Pad a pieve of text on the left with a specified character to the desired-width. This function is named in homage to the famous result from Computer-Science known as @leftPad@ which has a glorious place in the history of the-world-wide web.--}+-- |+-- Pad a pieve of text on the left with a specified character to the desired+-- width. This function is named in homage to the famous result from Computer+-- Science known as @leftPad@ which has a glorious place in the history of the+-- world-wide web. leftPadWith :: Char -> Int -> Rope -> Rope leftPadWith c digits text =-    intoRope pad <> text+  intoRope pad <> text   where     pad = S.replicate len (S.singleton c)     len = digits - widthRope text --{-|-Right pad a text with the specified character.--}+-- |+-- Right pad a text with the specified character. rightPadWith :: Char -> Int -> Rope -> Rope rightPadWith c digits text =-    text <> intoRope pad+  text <> intoRope pad   where     pad = S.replicate len (S.singleton c)     len = digits - widthRope text --{-|-Multi-line string literals.--To use these you need to enable the @QuasiQuotes@ language extension-in your source file:--@-\{\-\# LANGUAGE OverloadedStrings \#\-\}-\{\-\# LANGUAGE QuasiQuotes \#\-\}-@--you are then able to easily write a string stretching over several lines.--How best to formatting multi-line string literal within your source code is-an aesthetic judgement. Sometimes you don't care about the whitespace-leading a passage (8 spaces in this example):--@-    let message = ['quote'|-        This is a test of the Emergency Broadcast System. Do not be-        alarmed. If this were a real emergency, someone would have tweeted-        about it by now.-    |]-@--because you are feeding it into a 'Data.Text.Prettyprint.Doc.Doc' for-pretty printing and know the renderer will convert the whole text into a-single line and then re-flow it. Other times you will want to have the-string as is, literally:--@-    let poem = ['quote'|-If the sun-    rises-        in the-    west-you     drank-    too much-                last week.-    |]-@--Leading whitespace from the first line and trailing whitespace from the-last line will be trimmed, so this:--@-    let value = ['quote'|-Hello-    |]-@--is translated to:--@-    let value = 'Data.String.fromString' \"Hello\\n\"-@--without the leading newline or trailing four spaces. Note that as string-literals they are presented to your code with 'Data.String.fromString' @::-String -> α@ so any type with an 'Data.String.IsString' instance (as 'Rope'-has) can be constructed from a multi-line @['quote'| ... |]@ literal.+-- |+-- Multi-line string literals.+--+-- To use these you need to enable the @QuasiQuotes@ language extension+-- in your source file:+--+-- @+-- \{\-\# LANGUAGE OverloadedStrings \#\-\}+-- \{\-\# LANGUAGE QuasiQuotes \#\-\}+-- @+--+-- you are then able to easily write a string stretching over several lines.+--+-- How best to formatting multi-line string literal within your source code is+-- an aesthetic judgement. Sometimes you don't care about the whitespace+-- leading a passage (8 spaces in this example):+--+-- @+--     let message = ['quote'|+--         This is a test of the Emergency Broadcast System. Do not be+--         alarmed. If this were a real emergency, someone would have tweeted+--         about it by now.+--     |]+-- @+--+-- because you are feeding it into a 'Data.Text.Prettyprint.Doc.Doc' for+-- pretty printing and know the renderer will convert the whole text into a+-- single line and then re-flow it. Other times you will want to have the+-- string as is, literally:+--+-- @+--     let poem = ['quote'|+-- If the sun+--     rises+--         in the+--     west+-- you     drank+--     too much+--                 last week.+--     |]+-- @+--+-- Leading whitespace from the first line and trailing whitespace from the+-- last line will be trimmed, so this:+--+-- @+--     let value = ['quote'|+-- Hello+--     |]+-- @+--+-- is translated to:+--+-- @+--     let value = 'Data.String.fromString' \"Hello\\n\"+-- @+--+-- without the leading newline or trailing four spaces. Note that as string+-- literals they are presented to your code with 'Data.String.fromString' @::+-- String -> α@ so any type with an 'Data.String.IsString' instance (as 'Rope'+-- has) can be constructed from a multi-line @['quote'| ... |]@ literal. --} -- I thought this was going to be more complicated. quote :: QuasiQuoter-quote = QuasiQuoter-    (litE . stringL . trim)        -- in an expression+quote =+  QuasiQuoter+    (litE . stringL . trim) -- in an expression     (error "Cannot use [quote| ... |] in a pattern")     (error "Cannot use [quote| ... |] as a type")     (error "Cannot use [quote| ... |] for a declaration")@@ -379,8 +588,7 @@     trim = bot . top      top [] = []-    top ('\n':cs) = cs+    top ('\n' : cs) = cs     top str = str      bot = List.dropWhileEnd (== ' ')-