core-text 0.3.0.0 → 0.3.2.0

raw patch · 7 files changed

+879/−830 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• LICENSE +16/−29
• core-text.cabal +7/−6
• lib/Core/Text/Breaking.hs +74/−71
• lib/Core/Text/Bytes.hs +119/−90
• lib/Core/Text/Parsing.hs +6/−6
• lib/Core/Text/Rope.hs +378/−359
• lib/Core/Text/Utilities.hs +279/−269

@@ -1,32 +1,19 @@-Opinionated Haskell Interoperability--Copyright © 2018-2019 Athae Eredh Siniath and Others-All rights reserved.--Redistribution and use in source and binary forms, with or without-modification, are permitted provided that the following conditions-are met:+Copyright © 2018-2021 Athae Eredh Siniath and Others -    1. Redistributions of source code must retain the above copyright-       notice, this list of conditions and the following disclaimer.+Permission is hereby granted, free of charge, to any person obtaining a+copy of this software and associated documentation files (the "Software"),+to deal in the Software without restriction, including without limitation+the rights to use, copy, modify, merge, publish, distribute, sublicense,+and/or sell copies of the Software, and to permit persons to whom the+Software is furnished to do so, subject to the following conditions: -    2. Redistributions in binary form must reproduce the above-       copyright notice, this list of conditions and the following-       disclaimer in the documentation and/or other materials provided-       with the distribution.-      -    3. Neither the name of the project nor the names of its contributors-       may be used to endorse or promote products derived from this -       software without specific prior written permission.+The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software. -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS-"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT-LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR-A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT-OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,-SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT-LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,-DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY-THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT-(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER+DEALINGS IN THE SOFTWARE.

@@ -1,13 +1,13 @@ cabal-version: 1.18 --- This file has been generated from package.yaml by hpack version 0.33.0.+-- This file has been generated from package.yaml by hpack version 0.34.4. -- -- see: https://github.com/sol/hpack ----- hash: 32fe0043eab486639c92b9e8ea6c9c864fd2aa6c21f0861529c72898e51bc67a+-- hash: 5360f5729fffd35e21f13c06edbd41bdc1ffc7334f3f456b64bb16738bcc742d  name:           core-text-version:        0.3.0.0+version:        0.3.2.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@@ -29,10 +29,11 @@ bug-reports:    https://github.com/aesiniath/unbeliever/issues author:         Andrew Cowie <istathar@gmail.com> maintainer:     Andrew Cowie <istathar@gmail.com>-copyright:      © 2018-2020 Athae Eredh Siniath and Others-license:        BSD3+copyright:      © 2018-2021 Athae Eredh Siniath and Others+license:        MIT license-file:   LICENSE-tested-with:    GHC == 8.8.4+tested-with:+    GHC == 8.10.6 build-type:     Simple extra-doc-files:     AnsiColours.png

@@ -2,81 +2,84 @@ {-# OPTIONS_HADDOCK hide #-}  -- This is an Internal module, hidden from Haddock-module Core.Text.Breaking-  ( breakWords,+module Core.Text.Breaking (+    breakWords,     breakLines,     breakPieces,     intoPieces,     intoChunks,     isNewline,-  )-where+) where  import Core.Text.Rope import Data.Char (isSpace) import Data.List (uncons) import qualified Data.Text.Short as S (ShortText, break, empty, null, uncons) --- |--- 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__--- []--- @+{- |+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@@ -86,13 +89,13 @@ -- 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-        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)+    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)  -- -- λ> S.break isSpace "a d"@@ -126,16 +129,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-        then intoRope chunk : emptyRope : []-        else intoRope chunk : intoChunks predicate remainder'+        -- 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'

@@ -6,136 +6,165 @@ {-# 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.-module Core.Text.Bytes-  ( 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,+    emptyBytes,+    packBytes,     Binary (fromBytes, intoBytes),     hOutput,     hInput,      -- * Internals     unBytes,-  )-where+) where -import qualified Data.ByteString as B-  ( ByteString,+import qualified Data.ByteString as B (+    ByteString,+    empty,     hGetContents,     hPut,     pack,     unpack,-  )+ ) import qualified Data.ByteString.Builder as B (Builder, byteString, toLazyByteString)+import qualified Data.ByteString.Char8 as C (+    pack+ ) import qualified Data.ByteString.Lazy as L (ByteString, fromStrict, toStrict) import Data.Hashable (Hashable) import Data.Word (Word8) import GHC.Generics (Generic) 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+    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)--- @------ on the assumption that the bytes in question are UTF-8 (or plain ASCII)--- encoded.+{- |+A zero-length 'Bytes'.+-}+emptyBytes :: Bytes+emptyBytes = StrictBytes B.empty++{- |+For the annoyingly common case of needing to take an ASCII string literal in+your code and use it as a bunch of 'Bytes'.++Done via "Data.ByteString.Char8" so all @Char@s will be truncated to 8 bits+(/i.e./ Latin-1 characters less than 255). You should probably consider this+to be unsafe. Also note that we deliberately do not have a @[Char]@ instance+of 'Binary'; if you need to come back to a textual representation use+'intoRope'.+-}+packBytes :: String -> Bytes+packBytes = StrictBytes . C.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)+@++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.-hInput :: Handle -> IO Bytes-hInput handle = do-  contents <- B.hGetContents handle-  return (StrictBytes contents)+{- |+Read the (entire) contents of a handle into a Bytes object. -{--instance Show Bytes where-    show x = case x of-        StrictBytes b' ->+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)

@@ -12,12 +12,12 @@ import Data.Foldable (foldl') import qualified Data.Text.Short as S (ShortText, foldl') --- |--- 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)

@@ -8,70 +8,70 @@ {-# 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.------ 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+{- |+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,@@ -79,6 +79,7 @@     replicateChar,     widthRope,     splitRope,+    takeRope,     insertRope,     containsCharacter,     findIndexRope,@@ -92,23 +93,22 @@     nullRope,     unsafeIntoRope,     Width (..),-  )-where+) where  import Control.DeepSeq (NFData (..)) import Core.Text.Bytes import qualified Data.ByteString as B (ByteString)-import qualified Data.ByteString.Builder as B-  ( hPutBuilder,+import qualified Data.ByteString.Builder as B (+    hPutBuilder,     toLazyByteString,-  )-import qualified Data.ByteString.Lazy as L-  ( ByteString,+ )+import qualified Data.ByteString.Lazy as L (+    ByteString,     foldrChunks,     toStrict,-  )-import qualified Data.FingerTree as F-  ( FingerTree,+ )+import qualified Data.FingerTree as F (+    FingerTree,     Measured (..),     SearchResult (..),     ViewL (..),@@ -120,25 +120,25 @@     (<|),     (><),     (|>),-  )+ ) import Data.Foldable (foldl', foldr', toList) import Data.Hashable (Hashable, hashWithSalt) import Data.String (IsString (..)) import qualified Data.Text as T (Text)-import qualified Data.Text.Lazy as U-  ( Text,+import qualified Data.Text.Lazy as U (+    Text,     foldrChunks,     fromChunks,     toStrict,-  )-import qualified Data.Text.Lazy.Builder as U-  ( Builder,+ )+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,+import qualified Data.Text.Short as S (+    ShortText,     any,     append,     empty,@@ -154,156 +154,162 @@     toBuilder,     toText,     unpack,-  )+ ) import qualified Data.Text.Short.Unsafe as S (fromByteStringUnsafe) import GHC.Generics (Generic) import System.IO (Handle) --- |--- 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+    pretty (Rope x) = foldr ((<>) . pretty . S.toText) emptyDoc x --- |--- 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--- @+{- |+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.+{- |+A 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 {-# 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'+    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/------ 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@@ -311,60 +317,75 @@  nullRope :: Rope -> Bool nullRope (Rope x) = case F.viewl x of-  F.EmptyL -> True-  (F.:<) piece _ -> S.null piece+    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:------ @--- λ> __splitRope 7 \"abcdef\"__--- (\"abcdef\",\"\")--- λ> __splitRope (-1) \"abcdef\"__--- (\"\", \"abcdef\")--- @+{- |+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-        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))-        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"+    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))+            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"--- @+{- |+Take the first _n_ characters from the beginning of the Rope.++@+λ> __takeRope 3 \"123456789\"__+\"123\"+@+-}+takeRope :: Int -> Rope -> Rope+takeRope i text =+    let (before, _) = splitRope i text+     in before++{- |+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@@ -372,10 +393,10 @@     -- convert this to Maybe monad, maybe     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@@ -390,174 +411,172 @@ -- 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+    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/------ 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.+{- |+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 -> α+    -- | Convert a @Rope@ into another text-like type.+    fromRope :: Rope -> α -  -- |-  -- Take another text-like type and convert it to a @Rope@.-  intoRope :: α -> 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" 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 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" 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 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" 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" 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+    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.------ 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

@@ -8,13 +8,14 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_HADDOCK prune #-} --- |--- 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+{- |+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,@@ -65,8 +66,7 @@     intoChunks,     byteChunk,     intoDocA,-  )-where+) where  import Core.Text.Breaking import Core.Text.Bytes@@ -79,8 +79,8 @@ import qualified Data.FingerTree as F (ViewL (..), viewl, (<|)) import qualified Data.List as List (dropWhileEnd, foldl', splitAt) import qualified Data.Text as T-import Data.Text.Prettyprint.Doc-  ( Doc,+import Data.Text.Prettyprint.Doc (+    Doc,     LayoutOptions (LayoutOptions),     PageWidth (AvailablePerLine),     Pretty (..),@@ -96,237 +96,240 @@     softline',     unAnnotateS,     vcat,-  )+ ) import Data.Text.Prettyprint.Doc.Render.Text (renderLazy)-import qualified Data.Text.Short as S-  ( ShortText,+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 System.Console.ANSI.Codes (setSGRCode) import System.Console.ANSI.Types (ConsoleIntensity (..), ConsoleLayer (..), SGR (..)) --- |--- An accumulation of ANSI escape codes used to add colour when pretty--- printing to console.+{- |+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.------ 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.+{- |+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 α :: *+    -- | 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 α -> AnsiColour+    -- | Convert semantic tokens to specific ANSI escape tokens+    colourize :: Token α -> AnsiColour -  -- |-  -- Arrange your type as a 'Doc' @ann@, annotated with your semantic-  -- tokens.-  highlight :: α -> 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")]+    Escapes [SetRGBColor Foreground (sRGB24read "#CC0000")]  -- | Highlighted \"Scarlet Red\" (@#ef2929@ from the Tango color palette). brightRed :: AnsiColour brightRed =-  Escapes [SetRGBColor Foreground (sRGB24read "#EF2929")]+    Escapes [SetRGBColor Foreground (sRGB24read "#EF2929")]  -- | Pure \"Red\" (full RGB red channel only). pureRed :: AnsiColour pureRed =-  Escapes [SetRGBColor Foreground (sRGB 1 0 0)]+    Escapes [SetRGBColor Foreground (sRGB 1 0 0)]  -- | Shadowed \"Chameleon\" (@#4e9a06@ from the Tango color palette). dullGreen :: AnsiColour dullGreen =-  Escapes [SetRGBColor Foreground (sRGB24read "#4E9A06")]+    Escapes [SetRGBColor Foreground (sRGB24read "#4E9A06")]  -- | Highlighted \"Chameleon\" (@#8ae234@ from the Tango color palette). brightGreen :: AnsiColour brightGreen =-  Escapes [SetRGBColor Foreground (sRGB24read "#8AE234")]+    Escapes [SetRGBColor Foreground (sRGB24read "#8AE234")]  -- | Pure \"Green\" (full RGB green channel only). pureGreen :: AnsiColour pureGreen =-  Escapes [SetRGBColor Foreground (sRGB 0 1 0)]+    Escapes [SetRGBColor Foreground (sRGB 0 1 0)]  -- | Medium \"Sky Blue\" (@#3465a4@ from the Tango color palette). dullBlue :: AnsiColour dullBlue =-  Escapes [SetRGBColor Foreground (sRGB24read "#3465A4")]+    Escapes [SetRGBColor Foreground (sRGB24read "#3465A4")]  -- | Highlighted \"Sky Blue\" (@#729fcf@ from the Tango color palette). brightBlue :: AnsiColour brightBlue =-  Escapes [SetRGBColor Foreground (sRGB24read "#729FCF")]+    Escapes [SetRGBColor Foreground (sRGB24read "#729FCF")]  -- | Pure \"Blue\" (full RGB blue channel only). pureBlue :: AnsiColour pureBlue =-  Escapes [SetRGBColor Foreground (sRGB 0 0 1)]+    Escapes [SetRGBColor Foreground (sRGB 0 0 1)]  -- | Dull \"Cyan\" (from the __gnome-terminal__ console theme). dullCyan :: AnsiColour dullCyan =-  Escapes [SetRGBColor Foreground (sRGB24read "#06989A")]+    Escapes [SetRGBColor Foreground (sRGB24read "#06989A")]  -- | Bright \"Cyan\" (from the __gnome-terminal__ console theme). brightCyan :: AnsiColour brightCyan =-  Escapes [SetRGBColor Foreground (sRGB24read "#34E2E2")]+    Escapes [SetRGBColor Foreground (sRGB24read "#34E2E2")]  -- | Pure \"Cyan\" (full RGB blue + green channels). pureCyan :: AnsiColour pureCyan =-  Escapes [SetRGBColor Foreground (sRGB 0 1 1)]+    Escapes [SetRGBColor Foreground (sRGB 0 1 1)]  -- | Medium \"Plum\" (@#75507b@ from the Tango color palette). dullMagenta :: AnsiColour dullMagenta =-  Escapes [SetRGBColor Foreground (sRGB24read "#75507B")]+    Escapes [SetRGBColor Foreground (sRGB24read "#75507B")]  -- | Highlighted \"Plum\" (@#ad7fa8@ from the Tango color palette). brightMagenta :: AnsiColour brightMagenta =-  Escapes [SetRGBColor Foreground (sRGB24read "#AD7FA8")]+    Escapes [SetRGBColor Foreground (sRGB24read "#AD7FA8")]  -- | Pure \"Magenta\" (full RGB red + blue channels). pureMagenta :: AnsiColour pureMagenta =-  Escapes [SetRGBColor Foreground (sRGB 1 0 1)]+    Escapes [SetRGBColor Foreground (sRGB 1 0 1)]  -- | Shadowed \"Butter\" (@#c4a000@ from the Tango color palette). dullYellow :: AnsiColour dullYellow =-  Escapes [SetRGBColor Foreground (sRGB24read "#C4A000")]+    Escapes [SetRGBColor Foreground (sRGB24read "#C4A000")]  -- | Highlighted \"Butter\" (@#fce94f@ from the Tango color palette). brightYellow :: AnsiColour brightYellow =-  Escapes [SetRGBColor Foreground (sRGB24read "#FCE94F")]+    Escapes [SetRGBColor Foreground (sRGB24read "#FCE94F")]  -- | Pure \"Yellow\" (full RGB red + green channels). pureYellow :: AnsiColour pureYellow =-  Escapes [SetRGBColor Foreground (sRGB 1 1 0)]+    Escapes [SetRGBColor Foreground (sRGB 1 1 0)]  -- | Pure \"Black\" (zero in all RGB channels). pureBlack :: AnsiColour pureBlack =-  Escapes [SetRGBColor Foreground (sRGB 0 0 0)]+    Escapes [SetRGBColor Foreground (sRGB 0 0 0)]  -- | Shadowed \"Deep Aluminium\" (@#2e3436@ from the Tango color palette). dullGrey :: AnsiColour dullGrey =-  Escapes [SetRGBColor Foreground (sRGB24read "#2E3436")]+    Escapes [SetRGBColor Foreground (sRGB24read "#2E3436")]  -- | Medium \"Dark Aluminium\" (from the Tango color palette). brightGrey :: AnsiColour brightGrey =-  Escapes [SetRGBColor Foreground (sRGB24read "#555753")]+    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")]+    Escapes [SetRGBColor Foreground (sRGB24read "#999999")]  -- | Pure \"White\" (fully on in all RGB channels). pureWhite :: AnsiColour pureWhite =-  Escapes [SetRGBColor Foreground (sRGB 1 1 1)]+    Escapes [SetRGBColor Foreground (sRGB 1 1 1)]  -- | Medium \"Light Aluminium\" (@#d3d7cf@ from the Tango color palette). dullWhite :: AnsiColour dullWhite =-  Escapes [SetRGBColor Foreground (sRGB24read "#D3D7CF")]+    Escapes [SetRGBColor Foreground (sRGB24read "#D3D7CF")]  -- | Highlighted \"Light Aluminium\" (@#eeeeec@ from the Tango color palette). brightWhite :: AnsiColour brightWhite =-  Escapes [SetRGBColor Foreground (sRGB24read "#EEEEEC")]+    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.+{- |+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)+    Escapes (SetConsoleIntensity BoldIntensity : list)  instance Semigroup AnsiColour where-  (<>) (Escapes list1) (Escapes list2) = Escapes (list1 <> list2)+    (<>) (Escapes list1) (Escapes list2) = Escapes (list1 <> list2)  instance Monoid AnsiColour where-  mempty = Escapes []+    mempty = Escapes []  instance Render Rope where-  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+    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-  highlight 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-  highlight = mconcat . fmap highlight+    type Token [a] = Token a+    colourize = colourize @a+    highlight = mconcat . fmap highlight +instance Render String where+    type Token String = Token Char+    colourize = colourize @Char+    highlight = mconcat . fmap highlight+ instance Render T.Text where-  type Token T.Text = ()-  colourize = const mempty-  highlight 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 brightGreen-  highlight = prettyBytes+    type Token Bytes = ()+    colourize = const brightGreen+    highlight = prettyBytes  prettyBytes :: Bytes -> Doc () prettyBytes =-  annotate () . vcat . twoWords-    . fmap wordToHex-    . byteChunk-    . unBytes+    annotate () . vcat . twoWords+        . fmap wordToHex+        . byteChunk+        . unBytes  twoWords :: [Doc ann] -> [Doc ann] twoWords ds = go ds@@ -334,8 +337,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' "  " @@ -343,17 +346,17 @@ byteChunk = reverse . go []   where     go acc blob =-      let (eight, remainder) = B.splitAt 8 blob-       in if B.length remainder == 0-            then eight : acc-            else go (eight : acc) remainder+        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@@ -364,63 +367,64 @@     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--- @------ which is able to pretty print the document text respecting the available--- width of the terminal.+{- |+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.+-}+ -- 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 . go [] . reAnnotateS (colourize @α)-        . layoutPretty options-        . highlight-        $ thing+    let options = LayoutOptions (AvailablePerLine (columns - 1) 1.0)+     in 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+        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'+                <> replicateChar len ' '+                <> 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      convert :: AnsiColour -> Rope     convert (Escapes codes) = intoRope (setSGRCode codes)@@ -428,161 +432,167 @@     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.+{- |+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-        . highlight-        $ 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.+{- |+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-        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)+    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).------ 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+    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)+    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-    (error "Cannot use [quote| ... |] in a pattern")-    (error "Cannot use [quote| ... |] as a type")-    (error "Cannot use [quote| ... |] for a declaration")+    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")   where     trim :: String -> String     trim = bot . top