balkon 0.2.1.0 → 0.3.0.0
raw patch · 37 files changed
+1091/−693 lines, 37 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Data.Text.ParagraphLayout: class Paginable pl
+ Data.Text.ParagraphLayout: paragraphSpanBounds :: Paragraph -> NonEmpty Int
+ Data.Text.ParagraphLayout: paragraphSpanTexts :: Paragraph -> [Text]
+ Data.Text.ParagraphLayout: paragraphText :: Paragraph -> Text
Files
- CHANGELOG.md +19/−0
- balkon.cabal +7/−3
- cabal.project +11/−0
- lib/Data/Text/ParagraphLayout.hs +28/−23
- lib/Data/Text/ParagraphLayout/ParagraphConstruction.hs +4/−4
- lib/Data/Text/ParagraphLayout/Rect.hs +9/−9
- src/Data/Text/ParagraphLayout/Internal/BiDiReorder.hs +57/−0
- src/Data/Text/ParagraphLayout/Internal/Break.hs +11/−11
- src/Data/Text/ParagraphLayout/Internal/Fragment.hs +8/−8
- src/Data/Text/ParagraphLayout/Internal/LineHeight.hs +2/−1
- src/Data/Text/ParagraphLayout/Internal/LinePagination.hs +10/−10
- src/Data/Text/ParagraphLayout/Internal/Paginable.hs +12/−9
- src/Data/Text/ParagraphLayout/Internal/Paragraph.hs +0/−72
- src/Data/Text/ParagraphLayout/Internal/ParagraphConstruction.hs +10/−11
- src/Data/Text/ParagraphLayout/Internal/ParagraphLayout.hs +0/−103
- src/Data/Text/ParagraphLayout/Internal/ParagraphLine.hs +7/−3
- src/Data/Text/ParagraphLayout/Internal/ParagraphOptions.hs +30/−0
- src/Data/Text/ParagraphLayout/Internal/Plain.hs +68/−82
- src/Data/Text/ParagraphLayout/Internal/Plain/Paragraph.hs +89/−0
- src/Data/Text/ParagraphLayout/Internal/Plain/ParagraphLayout.hs +92/−0
- src/Data/Text/ParagraphLayout/Internal/ProtoFragment.hs +15/−3
- src/Data/Text/ParagraphLayout/Internal/Rect.hs +21/−11
- src/Data/Text/ParagraphLayout/Internal/ResolvedSpan.hs +9/−5
- src/Data/Text/ParagraphLayout/Internal/Run.hs +7/−6
- src/Data/Text/ParagraphLayout/Internal/Span.hs +9/−8
- src/Data/Text/ParagraphLayout/Internal/TextContainer.hs +59/−43
- src/Data/Text/ParagraphLayout/Internal/Zipper.hs +20/−29
- test/Data/Text/ParagraphLayout/FontLoader.hs +15/−14
- test/Data/Text/ParagraphLayout/Internal/BiDiReorderSpec.hs +230/−0
- test/Data/Text/ParagraphLayout/Internal/BreakSpec.hs +71/−70
- test/Data/Text/ParagraphLayout/Internal/LinePaginationSpec.hs +30/−30
- test/Data/Text/ParagraphLayout/Internal/RunSpec.hs +1/−1
- test/Data/Text/ParagraphLayout/Internal/TextContainerSpec.hs +23/−19
- test/Data/Text/ParagraphLayout/Internal/ZipperSpec.hs +60/−59
- test/Data/Text/ParagraphLayout/ParagraphData.hs +26/−26
- test/Data/Text/ParagraphLayout/SpanData.hs +6/−5
- test/Data/Text/ParagraphLayoutSpec.hs +15/−15
CHANGELOG.md view
@@ -1,5 +1,24 @@ # Revision history for Balkón +## 0.3.0.0 -- 2023-04-13++* Added partial support for bidirectional text+ (LTR and RTL in the same paragraph).++ * The paragraph direction is assumed to be LTR.+ This will be configurable in a future interface.++ * Only strong directional characters are used to determine text direction.++ * The direction of weak directional characters and neutral characters is+ determined by the nearest preceding strong directional character, or if+ none is found, the nearest following strong directional character.++ * Explicit bidirectional formatting characters are ignored.++* Exposed functions to allow verification of correct input text slicing:+ `paragraphSpanBounds`, `paragraphSpanTexts`, and `paragraphText`.+ ## 0.2.1.0 -- 2023-04-04 * Added pagination.
balkon.cabal view
@@ -14,7 +14,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change-version: 0.2.1.0+version: 0.3.0.0 stability: experimental @@ -67,6 +67,7 @@ -- Extra source files to be distributed with the package, such as examples, -- or a tutorial module. extra-source-files:+ cabal.project, .golden/arabicFiller20em/golden, .golden/czechHelloParagraph/golden, .golden/czechHelloParagraphNarrow/golden,@@ -124,16 +125,18 @@ -- Modules exported to tests and to the public part of the library. exposed-modules:+ Data.Text.ParagraphLayout.Internal.BiDiReorder, Data.Text.ParagraphLayout.Internal.Break, Data.Text.ParagraphLayout.Internal.Fragment, Data.Text.ParagraphLayout.Internal.LineHeight, Data.Text.ParagraphLayout.Internal.LinePagination, Data.Text.ParagraphLayout.Internal.Paginable,- Data.Text.ParagraphLayout.Internal.Paragraph, Data.Text.ParagraphLayout.Internal.ParagraphConstruction,- Data.Text.ParagraphLayout.Internal.ParagraphLayout, Data.Text.ParagraphLayout.Internal.ParagraphLine,+ Data.Text.ParagraphLayout.Internal.ParagraphOptions, Data.Text.ParagraphLayout.Internal.Plain,+ Data.Text.ParagraphLayout.Internal.Plain.Paragraph,+ Data.Text.ParagraphLayout.Internal.Plain.ParagraphLayout, Data.Text.ParagraphLayout.Internal.Rect, Data.Text.ParagraphLayout.Internal.ResolvedSpan, Data.Text.ParagraphLayout.Internal.Run,@@ -185,6 +188,7 @@ other-modules: Data.Text.ParagraphLayoutSpec, Data.Text.ParagraphLayout.FontLoader,+ Data.Text.ParagraphLayout.Internal.BiDiReorderSpec, Data.Text.ParagraphLayout.Internal.BreakSpec, Data.Text.ParagraphLayout.Internal.LinePaginationSpec, Data.Text.ParagraphLayout.Internal.RunSpec,
+ cabal.project view
@@ -0,0 +1,11 @@+packages: ./balkon.cabal++-- Include documentation for reexported internal modules.+documentation: True+haddock-internal: True++-- Include links to documentation for dependencies.+-- (Not sure why this is not the default.)+package *+ documentation: True+ haddock-html-location: https://hackage.haskell.org/package/$pkg-$version/docs
lib/Data/Text/ParagraphLayout.hs view
@@ -13,29 +13,33 @@ -- -- Y coordinates increase from bottom to top. module Data.Text.ParagraphLayout- (Fragment(Fragment, fragmentPen, fragmentRect, fragmentGlyphs)- ,LineHeight(Absolute, Normal)- ,PageContinuity(Break, Continue)- ,PageOptions- (PageOptions- ,pageCurrentHeight- ,pageNextHeight- ,pageOrphans- ,pageWidows+ ( Fragment (Fragment, fragmentPen, fragmentRect, fragmentGlyphs)+ , LineHeight (Absolute, Normal)+ , PageContinuity (Break, Continue)+ , PageOptions+ ( PageOptions+ , pageCurrentHeight+ , pageNextHeight+ , pageOrphans+ , pageWidows )- ,Paragraph(Paragraph)- ,ParagraphLayout(ParagraphLayout, paragraphRect, spanLayouts)- ,ParagraphOptions- (ParagraphOptions- ,paragraphFont- ,paragraphLineHeight- ,paragraphMaxWidth+ , Paginable+ , Paragraph (Paragraph)+ , ParagraphLayout (ParagraphLayout, paragraphRect, spanLayouts)+ , ParagraphOptions+ ( ParagraphOptions+ , paragraphFont+ , paragraphLineHeight+ , paragraphMaxWidth )- ,Span(Span, spanLength, spanOptions)- ,SpanLayout(SpanLayout)- ,SpanOptions(SpanOptions, spanLanguage)- ,layoutPlain- ,paginate+ , Span (Span, spanLength, spanOptions)+ , SpanLayout (SpanLayout)+ , SpanOptions (SpanOptions, spanLanguage)+ , layoutPlain+ , paginate+ , paragraphSpanBounds+ , paragraphSpanTexts+ , paragraphText ) where @@ -43,7 +47,8 @@ import Data.Text.ParagraphLayout.Internal.LineHeight import Data.Text.ParagraphLayout.Internal.LinePagination import Data.Text.ParagraphLayout.Internal.Paginable-import Data.Text.ParagraphLayout.Internal.Paragraph-import Data.Text.ParagraphLayout.Internal.ParagraphLayout+import Data.Text.ParagraphLayout.Internal.ParagraphOptions import Data.Text.ParagraphLayout.Internal.Plain+import Data.Text.ParagraphLayout.Internal.Plain.Paragraph+import Data.Text.ParagraphLayout.Internal.Plain.ParagraphLayout import Data.Text.ParagraphLayout.Internal.Span
lib/Data/Text/ParagraphLayout/ParagraphConstruction.hs view
@@ -10,10 +10,10 @@ -- -- > "ignored prefix" |<>| "ignored suffix" module Data.Text.ParagraphLayout.ParagraphConstruction- ((>|)- ,(>|<)- ,(|<)- ,(|<>|)+ ( (>|)+ , (>|<)+ , (|<)+ , (|<>|) ) where
lib/Data/Text/ParagraphLayout/Rect.hs view
@@ -1,15 +1,15 @@ -- | Representation of an axis-aligned rectangle on a 2D plane, with one of its -- corners being a designated origin point. module Data.Text.ParagraphLayout.Rect- (Rect(Rect, x_origin, y_origin, x_size, y_size)- ,height- ,width- ,x_max- ,x_min- ,x_terminus- ,y_max- ,y_min- ,y_terminus+ ( Rect (Rect, x_origin, y_origin, x_size, y_size)+ , height+ , width+ , x_max+ , x_min+ , x_terminus+ , y_max+ , y_min+ , y_terminus ) where
+ src/Data/Text/ParagraphLayout/Internal/BiDiReorder.hs view
@@ -0,0 +1,57 @@+module Data.Text.ParagraphLayout.Internal.BiDiReorder+ ( Level+ , WithLevel+ , level+ , reorder+ )+where++import Data.List.NonEmpty (NonEmpty ((:|)))+import qualified Data.List.NonEmpty as NonEmpty+import Data.Semigroup (sconcat)+import Data.Word (Word8)++-- | BiDi level, between 0 and 125 inclusive.+-- Even values mean left-to-right text.+-- Odd values mean right-to-left text.+type Level = Word8++-- | Typeclass for any data structure with an associated BiDi level.+class WithLevel a where+ level :: a -> Level++-- | Generic reordering of bidirectional text according to rule L2 of UAX #9+-- <https://www.unicode.org/reports/tr9/#Reordering_Resolved_Levels>.+--+-- Given an input in logical order and its corresponding BiDi levels,+-- this algorithm produces output in visual order, always from left to right.+--+-- Although defined by UAX #9 for reordering on the glyph level, this can also+-- be used for reordering runs of text, provided that the glyphs within each+-- shaped run are already ordered visually from left to right. This is the case+-- for HarfBuzz output.+reorder :: WithLevel a => NonEmpty a -> NonEmpty a+reorder xs = reorderLevels minOddLevel maxLevel xs+ where+ minOddLevel = minimum oddLevels+ maxLevel = maximum levels+ oddLevels = 1 :| NonEmpty.filter odd levels+ levels = NonEmpty.map level xs++-- | For each integer value from @high@ to @low@ inclusive, reverse any+-- contiguous sequence of items that are at the given level or higher.+--+-- The value of @low@ must be at least 1 to avoid integer overflow.+reorderLevels :: WithLevel a => Level -> Level -> NonEmpty a -> NonEmpty a+reorderLevels low high xs =+ if low > high+ then xs+ else reorderLevels low (high - 1) $ reorderLevel high xs++-- | Reverse any contiguous sequence of items that are at level @lvl@ or higher.+reorderLevel :: WithLevel a => Level -> NonEmpty a -> NonEmpty a+reorderLevel lvl xs = sconcat $ NonEmpty.map reverseHigh $ groupHigh xs+ where+ reverseHigh g@(x :| _) = if isHigh x then NonEmpty.reverse g else g+ groupHigh = NonEmpty.groupWith1 isHigh+ isHigh x = level x >= lvl
src/Data/Text/ParagraphLayout/Internal/Break.hs view
@@ -6,22 +6,22 @@ -- `Text` and the position of the break. The internal offset of the `Text` from -- the start of its underlying byte array is excluded. module Data.Text.ParagraphLayout.Internal.Break- (LineBreak(..)- ,locale- ,breaksDesc- ,subOffsetsDesc+ ( LineBreak (..)+ , locale+ , breaksDesc+ , subOffsetsDesc ) where import Data.Text (Text) import Data.Text.Foreign (lengthWord8) import Data.Text.ICU- (Break- ,Breaker- ,LocaleName(Locale)- ,breaksRight- ,brkPrefix- ,brkStatus+ ( Break+ , Breaker+ , LocaleName (Locale)+ , breaksRight+ , brkPrefix+ , brkStatus ) -- | Strictness levels of line-breaking rules,@@ -47,7 +47,7 @@ -- including case changes and converting hyphens to underscores. -- -- This filter is here just to stop syntactically incorrect input.- clean = takeWhile (`elem` ['A'..'Z'] ++ ['a'..'z'] ++ "_-")+ clean = takeWhile (`elem` ['A' .. 'Z'] ++ ['a' .. 'z'] ++ "_-") -- | List of all breaks in the given text, with offsets in descending order, -- including the status of the break if applicable.
src/Data/Text/ParagraphLayout/Internal/Fragment.hs view
@@ -1,7 +1,7 @@ module Data.Text.ParagraphLayout.Internal.Fragment- (Fragment(..)- ,ShapedRun- ,shapedRun)+ ( Fragment (..)+ , ShapedRun+ , shapedRun) where import Data.Int (Int32)@@ -25,19 +25,19 @@ -- want to use for detecting position-based events such as mouse clicks. -- -- Beware that actual glyphs will not be drawn exactly to the borders of- -- this rectangle – they may be offset inwards and they can also extend+ -- this rectangle -- they may be offset inwards and they can also extend -- outwards! -- -- These are not the typographic bounding boxes that you use for determining- -- the area to draw on – you need FreeType or a similar library for that.+ -- the area to draw on -- you need FreeType or a similar library for that. -- -- The origin coordinates are relative to the paragraph. , fragmentPen :: (Int32, Int32) -- ^ Coordinates of the initial pen position, from which the first glyph- -- should be drawn, relative to the origin of the `fragmentRect`.- -- Each glyph's `x_advance` or `y_advance` are then used to move the pen- -- position for the next glyph.+ -- should be drawn, relative to the origin of the `fragmentRect`. Each+ -- glyph's `Data.Text.Glyphize.x_advance` or `Data.Text.Glyphize.y_advance`+ -- are then used to move the pen position for the next glyph. , fragmentGlyphs :: [(GlyphInfo, GlyphPos)] -- ^ Glyphs contained in the fragment, as returned from HarfBuzz.
src/Data/Text/ParagraphLayout/Internal/LineHeight.hs view
@@ -1,8 +1,9 @@-module Data.Text.ParagraphLayout.Internal.LineHeight (LineHeight(..))+module Data.Text.ParagraphLayout.Internal.LineHeight (LineHeight (..)) where import Data.Int (Int32) +-- | Determines the preferred line height of text in the resulting layout. data LineHeight = Normal
src/Data/Text/ParagraphLayout/Internal/LinePagination.hs view
@@ -7,22 +7,22 @@ -- -- Assumptions: ----- * Lines are laid out from top to bottom.--- * Each page has the same size.+-- - Lines are laid out from top to bottom.+-- - Each page has the same size. -- (Preceding context may limit the space available on the given page, but it -- is assumed that the space on every following page can be used in full.) module Data.Text.ParagraphLayout.Internal.LinePagination- (Line- ,lineHeight- ,PageContinuity(Break, Continue)- ,bestSplit- ,paginateLines+ ( Line+ , lineHeight+ , PageContinuity (Break, Continue)+ , bestSplit+ , paginateLines ) where import Data.Int (Int32) import Data.List (dropWhileEnd, genericLength)-import Data.List.NonEmpty (NonEmpty((:|)))+import Data.List.NonEmpty (NonEmpty ((:|))) import qualified Data.List.NonEmpty as NonEmpty -- | Representation of a line of text with a known height.@@ -186,9 +186,9 @@ splitsWithTotal' :: Line a => Int32 -> [a] -> [a] -> [(Int32, ([a], [a]))] splitsWithTotal' _ _ [] = []-splitsWithTotal' total closed (x:xs) = split : splits+splitsWithTotal' total closed (x : xs) = split : splits where split = (newTotal, (reverse newClosed, xs)) splits = splitsWithTotal' newTotal newClosed xs- newClosed = x:closed+ newClosed = x : closed newTotal = total + lineHeight x
src/Data/Text/ParagraphLayout/Internal/Paginable.hs view
@@ -1,16 +1,17 @@ module Data.Text.ParagraphLayout.Internal.Paginable- (PageOptions(..)- ,Paginable- ,paginate+ ( PageOptions (..)+ , Paginable+ , paginate ) where import Data.Int (Int32) import Data.Text.ParagraphLayout.Internal.LinePagination-import Data.Text.ParagraphLayout.Internal.ParagraphLayout import Data.Text.ParagraphLayout.Internal.ParagraphLine+import Data.Text.ParagraphLayout.Internal.Plain.ParagraphLayout +-- | Defines options for breaking a layout into pages. data PageOptions = PageOptions { pageCurrentHeight :: Int32@@ -41,25 +42,26 @@ -- -- Explanation of return values: --- -- * @(`Continue`, p, `Nothing`)@+ -- - @(`Continue`, p, `Nothing`)@ -- means that @p@ is the entire layout and fits best on the current page. --- -- * @(`Break`, p, `Nothing`)@+ -- - @(`Break`, p, `Nothing`)@ -- means that @p@ is the entire layout and fits best on a new page. -- In other words, @p@ should be preceded by a page break. --- -- * @(`Continue`, p, `Just` rest)@+ -- - @(`Continue`, p, `Just` rest)@ -- means that @p@ is a part of the layout that fits best on the current -- page, and @rest@ should be passed to this function again. -- In other words, @p@ should be followed by a page break. --- -- * @(`Break`, p, `Just` rest)@+ -- - @(`Break`, p, `Just` rest)@ -- means that @p@ is a part of the layout that fits best on a new page, -- and @rest@ should be passed to this function again. -- In other words, @p@ should be surrounded by page breaks -- on both sides. paginate :: PageOptions -> pl -> (PageContinuity, pl, Maybe pl) +-- | Internal implementation of paginating a simple list of generic lines. instance Line a => Paginable [a] where paginate opts ls = case paginateLines o w h1 h2 ls of (c, p, []) -> (c, p, Nothing)@@ -70,7 +72,8 @@ h1 = pageCurrentHeight opts h2 = pageNextHeight opts --- | Break a paragraph in order to fit the given pagination constraints.+-- | Implementation of paginating a plain text paragraph layout.+-- Breaks the layout on page boundaries and automatically adjusts coordinates. instance Paginable ParagraphLayout where paginate opts pl = case paginate opts (cutLines pl) of (c, p, Nothing) -> (c, mergeLines p, Nothing)
− src/Data/Text/ParagraphLayout/Internal/Paragraph.hs
@@ -1,72 +0,0 @@-module Data.Text.ParagraphLayout.Internal.Paragraph- (Paragraph(..)- ,ParagraphOptions(..)- )-where--import Data.Int (Int32)-import Data.Text.Array (Array)-import Data.Text.Glyphize (Font)--import Data.Text.ParagraphLayout.Internal.LineHeight-import Data.Text.ParagraphLayout.Internal.Span---- | Text to be laid out as a single paragraph.------ May be divided into any number of neighbouring spans, each of which will--- be represented as a separate `SpanLayout` in the resulting layout.------ The input text must be encoded as UTF-8 in a contiguous byte array.------ You may need to use "Data.Text.Internal" in order to determine the byte--- array and the necessary offsets to construct the paragraph without copying--- data.------ For simple use cases, it may be sufficient to construct paragraphs using--- [ParagraphConstruction]("Data.Text.ParagraphLayout.ParagraphConstruction").-data Paragraph = Paragraph-- Array- -- ^ A byte array containing the whole text to be laid out, in UTF-8.- --- -- This array will be passed to "Data.Text.Glyphize", which passes it to- -- [@hb_buffer_add_utf8()@]- -- (https://harfbuzz.github.io/harfbuzz-hb-buffer.html#hb-buffer-add-utf8).- --- -- In the output, `Data.Text.Glyphize.cluster` will be a byte offset of- -- the corresponding input character from this array.-- Int- -- ^ Byte offset of the first span from the start of the byte array.- -- Any characters preceding this offset will not be shaped, but may still- -- be used to influence the shape of neighbouring characters.-- [Span]- -- ^ Parts of the text to be laid out, in logical order.- -- The initial offset plus total length of all spans must not exceed- -- the bounds of the byte array.- -- Any characters following the last span will not be shaped, but may still- -- be used to influence the shape of neighbouring characters.-- ParagraphOptions- -- ^ Options applying to the paragraph as a whole.--data ParagraphOptions = ParagraphOptions-- { paragraphFont :: Font- -- ^ Font to be used for shaping and measurement.- -- Make sure to set its scale (see `Data.Text.Glyphize.optionScale`) using- -- the same units that you want in the output.-- , paragraphLineHeight :: LineHeight- -- ^ Preferred line height of the resulting box fragments.-- , paragraphMaxWidth :: Int32- -- ^ Line width at which line breaking should occur.- -- Lines will be broken at language-appropriate boundaries.- -- If a line still exceeds this limit then, it will be broken at character- -- boundaries, and if it already consists of a single cluster that cannot- -- be further broken down, it will overflow.-- }- deriving (Eq, Show)
src/Data/Text/ParagraphLayout/Internal/ParagraphConstruction.hs view
@@ -1,23 +1,22 @@ module Data.Text.ParagraphLayout.Internal.ParagraphConstruction- ((>|)- ,(>|<)- ,(|<)- ,(|<>|)+ ( (>|)+ , (>|<)+ , (|<)+ , (|<>|) ) where import Data.Text (pack) import Data.Text.Foreign (lengthWord8)-import Data.Text.Internal (Text(Text))+import Data.Text.Internal (Text (Text)) import Data.Text.Internal.Lazy (chunk, empty) import qualified Data.Text.Internal.Lazy as Lazy import Data.Text.Lazy (toStrict)-import Data.Text.ParagraphLayout.Internal.Plain- (Paragraph(Paragraph)- ,ParagraphOptions- )-import Data.Text.ParagraphLayout.Internal.Span (Span(Span), SpanOptions) +import Data.Text.ParagraphLayout.Internal.ParagraphOptions+import Data.Text.ParagraphLayout.Internal.Plain.Paragraph+import Data.Text.ParagraphLayout.Internal.Span (Span (Span), SpanOptions)+ -- | Create first span with optional ignored suffix. infixr 5 >| (>|) :: (SpanOptions, String) -> String -> (Lazy.Text, [Span])@@ -34,7 +33,7 @@ (>|<) :: (SpanOptions, String) -> (Lazy.Text, [Span]) -> (Lazy.Text, [Span]) (spanLanguage, spanText) >|< (oldText, oldSpans) = (newText, newSpans) where- newSpans = newSpan:oldSpans+ newSpans = newSpan : oldSpans newSpan = Span (lengthWord8 packedSpanText) spanLanguage newText = chunk packedSpanText oldText packedSpanText = pack spanText
− src/Data/Text/ParagraphLayout/Internal/ParagraphLayout.hs
@@ -1,103 +0,0 @@-module Data.Text.ParagraphLayout.Internal.ParagraphLayout- (ParagraphLayout(..)- ,appendFragments- ,emptyParagraphLayout- ,filterFragments- ,mapFragments- ,paragraphFragments- ,paragraphLayout- ,paragraphOriginX- ,paragraphOriginY- ,paragraphSpanBounds- ,shapedRuns- )-where--import Data.Int (Int32)-import Data.List.NonEmpty (NonEmpty)-import qualified Data.List.NonEmpty as NonEmpty--import Data.Text.ParagraphLayout.Internal.Fragment-import Data.Text.ParagraphLayout.Internal.Paragraph-import Data.Text.ParagraphLayout.Internal.Rect-import Data.Text.ParagraphLayout.Internal.Span---- | The resulting layout of the whole paragraph.-data ParagraphLayout = ParagraphLayout- { paragraphRect :: Rect Int32- -- ^ The containing block (CSS3).- , spanLayouts :: [SpanLayout]- }- deriving (Eq, Read, Show)---- | Calculate the offsets into the `Paragraph`'s underlying `Data.Text.Array`--- where each span starts and ends, in ascending order. The resulting list--- will be one larger than the list of input spans.-paragraphSpanBounds :: Paragraph -> NonEmpty Int-paragraphSpanBounds (Paragraph _ initialOffset spans _) =- NonEmpty.scanl (+) initialOffset (map spanLength spans)--paragraphOriginX :: (Num a) => a-paragraphOriginX = 0--paragraphOriginY :: (Num a) => a-paragraphOriginY = 0--empty :: (Num a) => Rect a-empty = Rect- { x_origin = paragraphOriginX- , y_origin = paragraphOriginY- , x_size = 0- , y_size = 0- }--containRects :: (Ord a, Num a) => [Rect a] -> Rect a-containRects = foldr union empty---- | Wrap the given `SpanLayout`s and compute their containing rectangle.-paragraphLayout :: [SpanLayout] -> ParagraphLayout-paragraphLayout sls = ParagraphLayout pRect sls- where pRect = containRects $ concat $ map spanRects sls---- | A `ParagraphLayout` with an infinite number of empty spans.--- Useful as an identity element for `appendFragments`.-emptyParagraphLayout :: ParagraphLayout-emptyParagraphLayout = ParagraphLayout empty $ repeat (SpanLayout [])---- | Remove fragments that do not match the given predicate.------ The containing rectangle will be recalculated.-filterFragments :: (Fragment -> Bool) -> ParagraphLayout -> ParagraphLayout-filterFragments fragPred (ParagraphLayout _ sls) = paragraphLayout sls'- where- sls' = map slMapFunc sls- slMapFunc (SpanLayout frags) = SpanLayout (filter fragPred frags)---- | Run a mapping function over each fragment inside a `ParagraphLayout`.------ The containing rectangle will be recalculated.-mapFragments :: (Fragment -> Fragment) -> ParagraphLayout -> ParagraphLayout-mapFragments fragMapFunc (ParagraphLayout _ sls) = paragraphLayout sls'- where- sls' = map slMapFunc sls- slMapFunc (SpanLayout frags) = SpanLayout (map fragMapFunc frags)---- | Combine fragments from two `ParagraphLayout`s.------ The containing rectangle will be recalculated.-appendFragments :: ParagraphLayout -> ParagraphLayout -> ParagraphLayout-appendFragments pla plb = paragraphLayout sls'- where- sls' = zipWith zipFunc slsa slsb- slsa = spanLayouts pla- slsb = spanLayouts plb- zipFunc (SpanLayout fa) (SpanLayout fb) = SpanLayout (fa ++ fb)---- | Return all fragments of shaped text in one flat list,--- discarding information about their associated spans.-paragraphFragments :: ParagraphLayout -> [Fragment]-paragraphFragments pl = concat $ map spanFragments $ spanLayouts pl---- | Return all shaped runs in the paragraph.-shapedRuns :: ParagraphLayout -> [ShapedRun]-shapedRuns pl = map shapedRun $ paragraphFragments pl
src/Data/Text/ParagraphLayout/Internal/ParagraphLine.hs view
@@ -1,4 +1,8 @@-module Data.Text.ParagraphLayout.Internal.ParagraphLine (cutLines, mergeLines)+module Data.Text.ParagraphLayout.Internal.ParagraphLine+ ( ParagraphLine+ , cutLines+ , mergeLines+ ) where import Data.Int (Int32)@@ -6,7 +10,7 @@ import Data.Text.ParagraphLayout.Internal.Fragment import Data.Text.ParagraphLayout.Internal.LinePagination-import Data.Text.ParagraphLayout.Internal.ParagraphLayout+import Data.Text.ParagraphLayout.Internal.Plain.ParagraphLayout import Data.Text.ParagraphLayout.Internal.Rect -- | Represents one line of a `ParagraphLayout`.@@ -17,7 +21,7 @@ -- | Split the given `ParagraphLayout` into individual lines. cutLines :: ParagraphLayout -> [ParagraphLine]-cutLines pl = map (\y -> cutLine y pl) (lineOrigins pl)+cutLines pl = map (\ y -> cutLine y pl) (lineOrigins pl) -- | Reduce the given `ParagraphLayout` to fragments with the given `y_origin`. --
+ src/Data/Text/ParagraphLayout/Internal/ParagraphOptions.hs view
@@ -0,0 +1,30 @@+module Data.Text.ParagraphLayout.Internal.ParagraphOptions+ ( ParagraphOptions (..)+ )+where++import Data.Int (Int32)+import Data.Text.Glyphize (Font)++import Data.Text.ParagraphLayout.Internal.LineHeight++-- | Defines options relevant to the entire paragraph.+data ParagraphOptions = ParagraphOptions++ { paragraphFont :: Font+ -- ^ Font to be used for shaping and measurement.+ -- Make sure to set its scale (see `Data.Text.Glyphize.optionScale`) using+ -- the same units that you want in the output.++ , paragraphLineHeight :: LineHeight+ -- ^ Preferred line height of the resulting box fragments.++ , paragraphMaxWidth :: Int32+ -- ^ Line width at which line breaking should occur.+ -- Lines will be broken at language-appropriate boundaries.+ -- If a line still exceeds this limit then, it will be broken at character+ -- boundaries, and if it already consists of a single cluster that cannot+ -- be further broken down, it will overflow.++ }+ deriving (Eq, Show)
src/Data/Text/ParagraphLayout/Internal/Plain.hs view
@@ -1,42 +1,39 @@-module Data.Text.ParagraphLayout.Internal.Plain- (Paragraph(..)- ,ParagraphLayout(..)- ,ParagraphOptions(..)- ,SpanLayout(..)- ,layoutPlain- )+module Data.Text.ParagraphLayout.Internal.Plain (layoutPlain) where -import Control.Applicative (ZipList(ZipList), getZipList)+import Control.Applicative (ZipList (ZipList), getZipList)+import Data.Foldable (toList) import Data.Int (Int32) import Data.List (mapAccumL)-import Data.List.NonEmpty (NonEmpty((:|)))+import Data.List.NonEmpty (NonEmpty ((:|)), nonEmpty, (<|)) import qualified Data.List.NonEmpty as NonEmpty+import Data.Maybe (catMaybes)+import Data.Text (Text) import Data.Text.Foreign (lengthWord8) import Data.Text.Glyphize- (Buffer(..)- ,ContentType(ContentTypeUnicode)- ,Direction(..)- ,FontExtents(..)- ,GlyphInfo- ,GlyphPos- ,defaultBuffer- ,fontExtentsForDir- ,shape+ ( Buffer (..)+ , ContentType (ContentTypeUnicode)+ , FontExtents (..)+ , GlyphInfo+ , GlyphPos+ , defaultBuffer+ , fontExtentsForDir+ , shape ) import Data.Text.ICU (Breaker, LocaleName, breakCharacter, breakLine)-import qualified Data.Text.ICU as BreakStatus (Line(Hard))-import Data.Text.Internal (Text(Text))+import qualified Data.Text.ICU as BreakStatus (Line (Hard)) import qualified Data.Text.Lazy as Lazy +import Data.Text.ParagraphLayout.Internal.BiDiReorder import Data.Text.ParagraphLayout.Internal.Break import Data.Text.ParagraphLayout.Internal.Fragment import Data.Text.ParagraphLayout.Internal.LineHeight-import Data.Text.ParagraphLayout.Internal.Paragraph-import Data.Text.ParagraphLayout.Internal.ParagraphLayout+import Data.Text.ParagraphLayout.Internal.ParagraphOptions+import Data.Text.ParagraphLayout.Internal.Plain.Paragraph+import Data.Text.ParagraphLayout.Internal.Plain.ParagraphLayout import qualified Data.Text.ParagraphLayout.Internal.ProtoFragment as PF import Data.Text.ParagraphLayout.Internal.Rect-import Data.Text.ParagraphLayout.Internal.ResolvedSpan (WithSpan(WithSpan))+import Data.Text.ParagraphLayout.Internal.ResolvedSpan (WithSpan (WithSpan)) import qualified Data.Text.ParagraphLayout.Internal.ResolvedSpan as RS import Data.Text.ParagraphLayout.Internal.Run import Data.Text.ParagraphLayout.Internal.Span@@ -48,7 +45,10 @@ where sls = map SpanLayout fragsBySpan fragsBySpan = take (length spans) $ RS.splitBySpanIndex frags- frags = layoutAndAlignLines maxWidth $ spansToRunsWrapped spans+ frags = case nonEmpty wrappedRuns of+ Just xs -> layoutAndAlignLines maxWidth xs+ Nothing -> []+ wrappedRuns = spansToRunsWrapped spans maxWidth = paragraphMaxWidth opts spans = resolveSpans p @@ -66,69 +66,53 @@ -- necessary to fit within the requested line width. -- -- The output is a flat list of fragments positioned in both dimensions.-layoutAndAlignLines :: Int32 -> [WithSpan Run] -> [WithSpan Fragment]+layoutAndAlignLines :: Int32 -> NonEmpty (WithSpan Run) -> [WithSpan Fragment] layoutAndAlignLines maxWidth runs = frags where- frags = concat fragsInLines+ frags = concatMap NonEmpty.toList fragsInLines (_, fragsInLines) = mapAccumL positionLineH originY canonicalLines- canonicalLines = map canonicalOrder logicalLines- logicalLines = layoutLines maxWidth runs+ canonicalLines = fmap reorder logicalLines+ logicalLines = nonEmptyItems $ layoutLines maxWidth runs originY = paragraphOriginY --- | Reorder the given fragments from logical order to whatever order HarfBuzz--- uses (LTR for horizontal text, TTB for vertical text), so that cluster order--- is preserved even across runs.-canonicalOrder :: [WithSpan PF.ProtoFragment] -> [WithSpan PF.ProtoFragment]-canonicalOrder [] = []-canonicalOrder pfs@((WithSpan _ headPF):_) = case PF.direction headPF of- -- TODO: Update for bidi.- Just DirLTR -> pfs- Just DirRTL -> reverse pfs- Just DirTTB -> pfs- Just DirBTT -> reverse pfs- -- If no guess can be made, use LTR.- -- TODO: Add explicit direction to input interface.- Nothing -> pfs+nonEmptyItems :: Foldable t => t [a] -> [NonEmpty a]+nonEmptyItems = catMaybes . map nonEmpty . toList -- | Create a multi-line layout from the given runs, splitting them as -- necessary to fit within the requested line width. -- -- The output is a two-dimensional list of fragments positioned along the -- horizontal axis.-layoutLines :: Int32 -> [WithSpan Run] -> [[WithSpan PF.ProtoFragment]]-layoutLines maxWidth runs- | null rest+layoutLines ::+ Int32 -> NonEmpty (WithSpan Run) -> NonEmpty [WithSpan PF.ProtoFragment]+layoutLines maxWidth runs = case nonEmpty rest of -- Everything fits. We are done.- = fitting : []- | otherwise+ Nothing -> NonEmpty.singleton fitting -- Something fits, the rest goes on the next line.- = fitting : layoutLines maxWidth rest+ Just rest' -> fitting <| layoutLines maxWidth rest' where (fitting, rest) = layoutAndWrapRunsH maxWidth runs -- TODO: Allow a run across multiple spans (e.g. if they only differ by colour). -- | Position all the given horizontal fragments on the same line,--- using `originY` as its top edge, and return the bottom edge for continuation.+-- using @originY@ as its top edge, and return the bottom edge for continuation. -- -- Glyphs will be aligned by their ascent line, similar to the behaviour of -- @vertical-align: top@ in CSS. -- -- TODO: For rich text, allow other types of vertical alignment.-positionLineH :: Int32 -> [WithSpan PF.ProtoFragment] ->- (Int32, [WithSpan Fragment])+positionLineH :: Int32 -> NonEmpty (WithSpan PF.ProtoFragment) ->+ (Int32, NonEmpty (WithSpan Fragment)) positionLineH originY pfs = (nextY, frags) where- -- A line with no fragments will be considered to have zero height.- -- This can happen when line breaking produces a line that contains- -- only spaces.- nextY = if null rects then originY else maximum $ map y_min rects- rects = map (\(WithSpan _ r) -> fragmentRect r) frags- frags = snd $ mapAccumL (positionFragmentH originY) originX pfs+ nextY = maximum $ fmap y_min rects+ rects = fmap (\ (WithSpan _ r) -> fragmentRect r) frags+ (_, frags) = mapAccumL (positionFragmentH originY) originX pfs originX = paragraphOriginX -- | Position the given horizontal fragment on a line,--- using `originY` as its top edge and `originX` as its left edge,+-- using @originY@ as its top edge and @originX@ as its left edge, -- returning the X coordinate of its right edge for continuation. positionFragmentH :: Int32 -> Int32 -> WithSpan PF.ProtoFragment -> (Int32, WithSpan Fragment)@@ -152,13 +136,13 @@ -- | Calculate layout for multiple horizontal runs, breaking them as necessary -- to fit as much content as possible without exceeding the maximum line width, -- and return the remaining runs to be placed on other lines.-layoutAndWrapRunsH :: Int32 -> [WithSpan Run] ->+layoutAndWrapRunsH :: Int32 -> NonEmpty (WithSpan Run) -> ([WithSpan PF.ProtoFragment], [WithSpan Run]) layoutAndWrapRunsH maxWidth runs = NonEmpty.head $ validLayouts where validLayouts = dropWhile1 tooLong layouts tooLong (pfs, _) = totalAdvances pfs > maxWidth- layouts = NonEmpty.map layoutFst splits+ layouts = fmap layoutFst splits layoutFst (runs1, runs2) = (layoutRunsH runs1, runs2) -- TODO: Consider optimising. -- We do not need to look for soft breaks further than the@@ -176,8 +160,8 @@ -- -- If there is no hard line break in the input, the first output list will -- contain the whole input, and the second output list will be empty.-hardSplit :: [WithSpan Run] -> ([WithSpan Run], [WithSpan Run])-hardSplit runs = trimFst $ NonEmpty.last $ splits+hardSplit :: NonEmpty (WithSpan Run) -> ([WithSpan Run], [WithSpan Run])+hardSplit runs = allowFstEmpty $ trimFst $ NonEmpty.last $ splits where trimFst (runs1, runs2) = (trim runs1, runs2) trim@@ -187,7 +171,7 @@ -- TODO: Consider optimising. -- We do not need to look for any line breaks further than the -- shortest hard break.- splits = noSplit :| hSplits+ splits = noSplit :| map allowSndEmpty hSplits noSplit = (runs, []) hSplits = -- from longest to shortest splitTextsBy (map fst . filter isHard . runLineBreaks) runs@@ -205,8 +189,8 @@ -- The results in the form (prefix, suffix) will be ordered so that items -- closer to the start of the list are preferred for line breaking, but without -- considering overflows.-softSplits :: [WithSpan Run] -> [([WithSpan Run], [WithSpan Run])]-softSplits runs = map trimFst splits+softSplits :: NonEmpty (WithSpan Run) -> [([WithSpan Run], [WithSpan Run])]+softSplits runs = map (allowSndEmpty . trimFst) splits where trimFst (runs1, runs2) = (trim runs1, runs2) trim = trimTextsStart isStartSpace . trimTextsEnd isEndSpace@@ -217,6 +201,12 @@ -- shortest line break. cSplits = splitTextsBy (map fst . runCharacterBreaks) runs +allowFstEmpty :: (NonEmpty a, b) -> ([a], b)+allowFstEmpty (a, b) = (NonEmpty.toList a, b)++allowSndEmpty :: (a, NonEmpty b) -> (a, [b])+allowSndEmpty (a, b) = (a, NonEmpty.toList b)+ -- | The suffix remaining after removing the longest prefix of the list for -- which the predicate holds, except always including at least the last element -- of the original list.@@ -234,7 +224,7 @@ -- | Sum of all advances within the given fragments. totalAdvances :: [WithSpan PF.ProtoFragment] -> Int32-totalAdvances pfs = sum $ map (\(WithSpan _ pf) -> PF.advance pf) pfs+totalAdvances pfs = sum $ map (\ (WithSpan _ pf) -> PF.advance pf) pfs -- | Calculate layout for the given horizontal run and attach extra information. layoutRunH :: WithSpan Run -> WithSpan PF.ProtoFragment@@ -270,25 +260,24 @@ features = [] resolveSpans :: Paragraph -> [RS.ResolvedSpan]-resolveSpans p@(Paragraph arr pStart spans pOpts) = do+resolveSpans p@(Paragraph _ pStart spans pOpts) = do let sBounds = paragraphSpanBounds p- let pEnd = NonEmpty.last sBounds+ let sTexts = paragraphSpanTexts p+ let pText = paragraphText p let sStarts = NonEmpty.init sBounds- let sLengths = map spanLength spans - (i, s, sStart, sLen) <- getZipList $ (,,,)- <$> ZipList [0..]+ (i, s, sStart, sText) <- getZipList $ (,,,)+ <$> ZipList [0 ..] <*> ZipList spans <*> ZipList sStarts- <*> ZipList sLengths+ <*> ZipList sTexts let lang = spanLanguage $ spanOptions s- let lBreaks = paragraphBreaks breakLine p pEnd lang- let cBreaks = paragraphBreaks breakCharacter p pEnd lang+ let lBreaks = paragraphBreaks breakLine pText lang+ let cBreaks = paragraphBreaks breakCharacter pText lang return RS.ResolvedSpan { RS.spanIndex = i , RS.spanOffsetInParagraph = sStart - pStart- -- TODO: Consider adding checks for array bounds.- , RS.spanText = Text arr sStart sLen+ , RS.spanText = sText , RS.spanFont = paragraphFont pOpts , RS.spanLineHeight = paragraphLineHeight pOpts , RS.spanLanguage = lang@@ -296,12 +285,9 @@ , RS.spanCharacterBreaks = subOffsetsDesc (sStart - pStart) cBreaks } -paragraphBreaks :: (LocaleName -> Breaker a) -> Paragraph -> Int -> String ->- [(Int, a)]-paragraphBreaks breakFunc (Paragraph arr off _ _) end lang =- breaksDesc (breakFunc (locale lang LBAuto)) paragraphText- where- paragraphText = Text arr off (end - off)+paragraphBreaks :: (LocaleName -> Breaker a) -> Text -> String -> [(Int, a)]+paragraphBreaks breakFunc txt lang =+ breaksDesc (breakFunc (locale lang LBAuto)) txt runLineBreaks :: WithSpan Run -> [(Int, BreakStatus.Line)] runLineBreaks (WithSpan rs run) =
+ src/Data/Text/ParagraphLayout/Internal/Plain/Paragraph.hs view
@@ -0,0 +1,89 @@+module Data.Text.ParagraphLayout.Internal.Plain.Paragraph+ ( Paragraph (..)+ , paragraphSpanBounds+ , paragraphSpanTexts+ , paragraphText+ )+where++import Data.List.NonEmpty (NonEmpty)+import qualified Data.List.NonEmpty as NonEmpty+import Data.Text.Array (Array)+import Data.Text.Internal (Text (Text))++import Data.Text.ParagraphLayout.Internal.ParagraphOptions+import Data.Text.ParagraphLayout.Internal.Span++-- | Text to be laid out as a single paragraph.+--+-- May be divided into any number of neighbouring spans, each of which will+-- be represented as a separate `SpanLayout` in the resulting layout.+--+-- The input text must be encoded as UTF-8 in a contiguous byte array.+--+-- You may need to use "Data.Text.Internal" in order to determine the byte+-- array and the necessary offsets to construct the paragraph without copying+-- data.+--+-- For simple use cases, it may be sufficient to construct paragraphs using+-- [ParagraphConstruction]("Data.Text.ParagraphLayout.ParagraphConstruction").+data Paragraph = Paragraph++ Array+ -- ^ A byte array containing the whole text to be laid out, in UTF-8.+ --+ -- This array will be passed to "Data.Text.Glyphize", which passes it to+ -- [@hb_buffer_add_utf8()@]+ -- (https://harfbuzz.github.io/harfbuzz-hb-buffer.html#hb-buffer-add-utf8).+ --+ -- In the output, `Data.Text.Glyphize.cluster` will be a byte offset of+ -- the corresponding input character from this array.++ Int+ -- ^ Byte offset of the first span from the start of the byte array.+ -- Any characters preceding this offset will not be shaped, but may still+ -- be used to influence the shape of neighbouring characters.++ [Span]+ -- ^ Parts of the text to be laid out, in logical order.+ -- The initial offset plus total length of all spans must not exceed+ -- the bounds of the byte array.+ -- Any characters following the last span will not be shaped, but may still+ -- be used to influence the shape of neighbouring characters.++ ParagraphOptions+ -- ^ Options applying to the paragraph as a whole.++-- | Calculate the offsets into the `Paragraph`'s underlying `Data.Text.Array`+-- where each span starts and ends, in ascending order. The resulting list+-- will be one larger than the list of input spans.+--+-- You can use this function to verify that Balkón will slice the input text+-- correctly.+paragraphSpanBounds :: Paragraph -> NonEmpty Int+paragraphSpanBounds (Paragraph _ initialOffset spans _) =+ -- TODO: Consider adding checks for array bounds.+ NonEmpty.scanl (+) initialOffset (map spanLength spans)++-- | Turn each span of the input `Paragraph` into a `Text`.+--+-- You can use this function to verify that Balkón will slice the input text+-- correctly.+paragraphSpanTexts :: Paragraph -> [Text]+paragraphSpanTexts p@(Paragraph arr _ _ _) = zipWith toText sStarts sEnds+ where+ toText start end = Text arr start (end - start)+ sStarts = NonEmpty.init sBounds+ sEnds = NonEmpty.tail sBounds+ sBounds = paragraphSpanBounds p++-- | Turn all spans of the input `Paragraph` into one combined `Text`.+--+-- You can use this function to verify that Balkón will slice the input text+-- correctly.+paragraphText :: Paragraph -> Text+paragraphText p@(Paragraph arr _ _ _) = Text arr start (end - start)+ where+ start = NonEmpty.head sBounds+ end = NonEmpty.last sBounds+ sBounds = paragraphSpanBounds p
+ src/Data/Text/ParagraphLayout/Internal/Plain/ParagraphLayout.hs view
@@ -0,0 +1,92 @@+module Data.Text.ParagraphLayout.Internal.Plain.ParagraphLayout+ ( ParagraphLayout (..)+ , appendFragments+ , emptyParagraphLayout+ , filterFragments+ , mapFragments+ , paragraphFragments+ , paragraphLayout+ , paragraphOriginX+ , paragraphOriginY+ , shapedRuns+ )+where++import Data.Int (Int32)++import Data.Text.ParagraphLayout.Internal.Fragment+import Data.Text.ParagraphLayout.Internal.Rect+import Data.Text.ParagraphLayout.Internal.Span++-- | The resulting layout of the whole paragraph.+data ParagraphLayout = ParagraphLayout+ { paragraphRect :: Rect Int32+ -- ^ The containing block (CSS3).+ , spanLayouts :: [SpanLayout]+ }+ deriving (Eq, Read, Show)++paragraphOriginX :: (Num a) => a+paragraphOriginX = 0++paragraphOriginY :: (Num a) => a+paragraphOriginY = 0++empty :: (Num a) => Rect a+empty = Rect+ { x_origin = paragraphOriginX+ , y_origin = paragraphOriginY+ , x_size = 0+ , y_size = 0+ }++containRects :: (Ord a, Num a) => [Rect a] -> Rect a+containRects = foldr union empty++-- | Wrap the given `SpanLayout`s and compute their containing rectangle.+paragraphLayout :: [SpanLayout] -> ParagraphLayout+paragraphLayout sls = ParagraphLayout pRect sls+ where pRect = containRects $ concat $ map spanRects sls++-- | A `ParagraphLayout` with an infinite number of empty spans.+-- Useful as an identity element for `appendFragments`.+emptyParagraphLayout :: ParagraphLayout+emptyParagraphLayout = ParagraphLayout empty $ repeat (SpanLayout [])++-- | Remove fragments that do not match the given predicate.+--+-- The containing rectangle will be recalculated.+filterFragments :: (Fragment -> Bool) -> ParagraphLayout -> ParagraphLayout+filterFragments fragPred (ParagraphLayout _ sls) = paragraphLayout sls'+ where+ sls' = map slMapFunc sls+ slMapFunc (SpanLayout frags) = SpanLayout (filter fragPred frags)++-- | Run a mapping function over each fragment inside a `ParagraphLayout`.+--+-- The containing rectangle will be recalculated.+mapFragments :: (Fragment -> Fragment) -> ParagraphLayout -> ParagraphLayout+mapFragments fragMapFunc (ParagraphLayout _ sls) = paragraphLayout sls'+ where+ sls' = map slMapFunc sls+ slMapFunc (SpanLayout frags) = SpanLayout (map fragMapFunc frags)++-- | Combine fragments from two `ParagraphLayout`s.+--+-- The containing rectangle will be recalculated.+appendFragments :: ParagraphLayout -> ParagraphLayout -> ParagraphLayout+appendFragments pla plb = paragraphLayout sls'+ where+ sls' = zipWith zipFunc slsa slsb+ slsa = spanLayouts pla+ slsb = spanLayouts plb+ zipFunc (SpanLayout fa) (SpanLayout fb) = SpanLayout (fa ++ fb)++-- | Return all fragments of shaped text in one flat list,+-- discarding information about their associated spans.+paragraphFragments :: ParagraphLayout -> [Fragment]+paragraphFragments pl = concat $ map spanFragments $ spanLayouts pl++-- | Return all shaped runs in the paragraph.+shapedRuns :: ParagraphLayout -> [ShapedRun]+shapedRuns pl = map shapedRun $ paragraphFragments pl
src/Data/Text/ParagraphLayout/Internal/ProtoFragment.hs view
@@ -1,12 +1,14 @@ module Data.Text.ParagraphLayout.Internal.ProtoFragment- (ProtoFragment(direction, advance, glyphs)- ,protoFragmentH+ ( ProtoFragment (direction, advance, glyphs)+ , protoFragmentH ) where import Data.Int (Int32)-import Data.Text.Glyphize (Direction, GlyphInfo, GlyphPos(x_advance))+import Data.Text.Glyphize (Direction (..), GlyphInfo, GlyphPos (x_advance)) +import Data.Text.ParagraphLayout.Internal.BiDiReorder+ -- | A box fragment which has not been positioned yet. data ProtoFragment = ProtoFragment { direction :: Maybe Direction@@ -23,3 +25,13 @@ protoFragmentH dir gs = ProtoFragment dir adv gs where adv = sum $ map (x_advance . snd) gs++instance WithLevel ProtoFragment where+ level pf = case direction pf of+ -- TODO: Allow externally set paragraph embedding level.+ -- TODO: Properly calculate BiDi levels.+ Just DirLTR -> 0+ Just DirRTL -> 1+ Just DirTTB -> 0+ Just DirBTT -> 1+ Nothing -> 0
src/Data/Text/ParagraphLayout/Internal/Rect.hs view
@@ -1,20 +1,30 @@ -- | Representation of an axis-aligned rectangle on a 2D plane, with one of its -- corners being a designated origin point. module Data.Text.ParagraphLayout.Internal.Rect- (Rect(Rect, x_origin, y_origin, x_size, y_size)- ,height- ,union- ,width- ,x_max- ,x_min- ,x_terminus- ,y_max- ,y_min- ,y_terminus+ ( Rect (Rect, x_origin, y_origin, x_size, y_size)+ , height+ , union+ , width+ , x_max+ , x_min+ , x_terminus+ , y_max+ , y_min+ , y_terminus ) where -data Rect a = Rect { x_origin :: a, y_origin :: a, x_size :: a, y_size :: a }+-- | An axis-aligned rectangle on a 2D plane.+data Rect a = Rect+ { x_origin :: a+ -- ^ X coordinate of the corner designated as the rectangle's origin.+ , y_origin :: a+ -- ^ Y coordinate of the corner designated as the rectangle's origin.+ , x_size :: a+ -- ^ Signed difference between the X coordinates of the rectangle's sides.+ , y_size :: a+ -- ^ Signed difference between the Y coordinates of the rectangle's sides.+ } deriving (Eq, Read, Show) -- | Absolute difference between the X coordinates of the rectangle's sides.
src/Data/Text/ParagraphLayout/Internal/ResolvedSpan.hs view
@@ -1,7 +1,7 @@ module Data.Text.ParagraphLayout.Internal.ResolvedSpan- (ResolvedSpan(..)- ,WithSpan(WithSpan)- ,splitBySpanIndex+ ( ResolvedSpan (..)+ , WithSpan (WithSpan)+ , splitBySpanIndex ) where @@ -9,6 +9,7 @@ import Data.Text.Glyphize (Font) import qualified Data.Text.ICU as BreakStatus (Line) +import Data.Text.ParagraphLayout.Internal.BiDiReorder import Data.Text.ParagraphLayout.Internal.LineHeight import Data.Text.ParagraphLayout.Internal.TextContainer @@ -33,7 +34,7 @@ instance TextContainer ResolvedSpan where getText = spanText --- | Wrapper for temporarily mapping the relationship to a `Span`.+-- | Wrapper for temporarily mapping the relationship to a `ResolvedSpan`. data WithSpan a = WithSpan ResolvedSpan a instance Functor WithSpan where@@ -48,8 +49,11 @@ dropWhileStart p (WithSpan rs c) = WithSpan rs (dropWhileStart p c) dropWhileEnd p (WithSpan rs c) = WithSpan rs (dropWhileEnd p c) +instance WithLevel a => WithLevel (WithSpan a) where+ level (WithSpan _ x) = level x+ splitBySpanIndex :: [WithSpan a] -> [[a]]-splitBySpanIndex xs = [getBySpanIndex i xs | i <- [0..]]+splitBySpanIndex xs = [getBySpanIndex i xs | i <- [0 ..]] getBySpanIndex :: Int -> [WithSpan a] -> [a] getBySpanIndex idx xs = map contents $ filter matchingIndex $ xs
src/Data/Text/ParagraphLayout/Internal/Run.hs view
@@ -1,16 +1,16 @@-module Data.Text.ParagraphLayout.Internal.Run (Run(..), spanToRuns)+module Data.Text.ParagraphLayout.Internal.Run (Run (..), ScriptCode, spanToRuns) where import Data.List (mapAccumL)-import Data.List.NonEmpty (NonEmpty((:|)))+import Data.List.NonEmpty (NonEmpty ((:|))) import Data.Text (Text) import qualified Data.Text as Text import Data.Text.Foreign (dropWord8, lengthWord8, takeWord8)-import Data.Text.Glyphize (Direction(..))+import Data.Text.Glyphize (Direction (..)) import qualified Data.Text.ICU.Char as ICUChar import Data.Text.ParagraphLayout.Internal.ResolvedSpan-import Data.Text.ParagraphLayout.Internal.Script (charScript)+import Data.Text.ParagraphLayout.Internal.Script import Data.Text.ParagraphLayout.Internal.TextContainer import Data.Text.ParagraphLayout.Internal.Zipper @@ -96,7 +96,7 @@ Nothing -> curRuns Just choice -> let headRun@(nextZipper, _, _) :| tailRuns = foldRun choice curRuns- in protoRuns' nextZipper (headRun:tailRuns)+ in protoRuns' nextZipper (headRun : tailRuns) foldRun :: ZipperChoice -> [ProtoRun] -> NonEmpty ProtoRun @@ -115,7 +115,8 @@ s2 = charScript (nextChar x) -- | Simplified detection of text direction for unidirectional text.-mergeDirections :: Maybe Direction -> Maybe Direction -> Merged (Maybe Direction)+mergeDirections :: Maybe Direction -> Maybe Direction ->+ Merged (Maybe Direction) mergeDirections Nothing Nothing = Merged Nothing mergeDirections (Just d1) Nothing = Merged (Just d1) mergeDirections Nothing (Just d2) = Merged (Just d2)
src/Data/Text/ParagraphLayout/Internal/Span.hs view
@@ -1,9 +1,9 @@ module Data.Text.ParagraphLayout.Internal.Span- (Span(..)- ,SpanLayout(..)- ,SpanOptions(..)- ,spanFragments- ,spanRects+ ( Span (..)+ , SpanLayout (..)+ , SpanOptions (..)+ , spanFragments+ , spanRects ) where @@ -27,7 +27,7 @@ } deriving (Eq, Read, Show) --- TODO: Add all relevant attributes.+-- | Defines options relevant to the layout of a single span of text. data SpanOptions = SpanOptions { spanLanguage :: String@@ -38,11 +38,12 @@ -- Used for selecting the appropriate glyphs and line breaking rules, -- primarily in East Asian languages. + -- TODO: Add all relevant attributes. } deriving (Eq, Read, Show) --- | The resulting layout of each span, which may include multiple fragments if--- broken over multiple lines.+-- | The resulting layout of each span, which may include multiple fragments+-- as required by line breaking, text writing direction, and changes of script. data SpanLayout = SpanLayout [Fragment] -- TODO: Consider merging fragments created by script changes. deriving (Eq, Read, Show)
src/Data/Text/ParagraphLayout/Internal/TextContainer.hs view
@@ -1,19 +1,22 @@ module Data.Text.ParagraphLayout.Internal.TextContainer- (SeparableTextContainer- ,TextContainer- ,dropWhileEnd- ,dropWhileStart- ,getText- ,splitTextAt8- ,splitTextsBy- ,trimTextsEnd- ,trimTextsEndPreserve- ,trimTextsStart- ,trimTextsStartPreserve+ ( SeparableTextContainer+ , TextContainer+ , dropWhileEnd+ , dropWhileStart+ , getText+ , splitTextAt8+ , splitTextsBy+ , trimTextsEnd+ , trimTextsEndPreserve+ , trimTextsStart+ , trimTextsStartPreserve ) where -import Data.List.NonEmpty (NonEmpty((:|)))+import Data.Foldable (toList)+import Data.List.NonEmpty (NonEmpty ((:|)), nonEmpty)+import qualified Data.List.NonEmpty as NonEmpty+import Data.Maybe (catMaybes) import Data.Text (Text) import qualified Data.Text as Text import Data.Text.Foreign (dropWord8, takeWord8)@@ -55,88 +58,101 @@ -- | Treat a list of text containers as a contiguous sequence, -- and find all possible ways to split them into two non-empty lists,--- using the given function to find valit split offsets in `Data.Word.Word8`+-- using the given function to find valid split offsets in `Data.Word.Word8` -- units from the beginning of each container. -- -- The results in the form (prefix, suffix) will be ordered from the longest -- prefix to shortest.-splitTextsBy :: SeparableTextContainer a => (a -> [Int]) -> [a] -> [([a], [a])]+splitTextsBy :: (SeparableTextContainer a, Foldable f) =>+ (a -> [Int]) -> f a -> [(NonEmpty a, NonEmpty a)] splitTextsBy breakFunc tcs =- filter notEmpty $ splitTextsBy' breakFunc [] (reverse tcs)- where- notEmpty (prefix, suffix) = not (null prefix || null suffix)+ nonEmptyPairs $ splitTextsBy' breakFunc [] $ reverse $ toList tcs -splitTextsBy' :: SeparableTextContainer a => (a -> [Int]) -> [a] -> [a] ->- [([a], [a])]+splitTextsBy' :: SeparableTextContainer a =>+ (a -> [Int]) -> [a] -> [a] -> [([a], [a])] splitTextsBy' _ _ [] = []-splitTextsBy' breakFunc closed (tc:tcs) =- fullSplits ++ splitTextsBy' breakFunc (tc:closed) tcs+splitTextsBy' breakFunc closed (tc : tcs) =+ fullSplits ++ splitTextsBy' breakFunc (tc : closed) tcs where fullSplits = map mergeWithRest tcSplits mergeWithRest (x1, x2) = (reverse $ collapse $ x1 :| tcs, collapse $ x2 :| closed)- tcSplits = map (\i -> splitTextAt8 i tc) tcBreakOffsets+ tcSplits = map (\ i -> splitTextAt8 i tc) tcBreakOffsets tcBreakOffsets = breakFunc tc +-- | Turn pairs of normal lists into pairs of `NonEmpty` lists,+-- removing pairs in which either list is empty.+nonEmptyPairs :: [([a], [b])] -> [(NonEmpty a, NonEmpty b)]+nonEmptyPairs = catMaybes . map nonEmptyPair++-- | Turn a pair of normal lists into `Just` a pair of `NonEmpty` lists,+-- or `Nothing` if either list is empty.+nonEmptyPair :: ([a], [b]) -> Maybe (NonEmpty a, NonEmpty b)+nonEmptyPair (xs, ys) = case (nonEmpty xs, nonEmpty ys) of+ (Just xs1, Just ys1) -> Just (xs1, ys1)+ (_, _) -> Nothing+ -- | If the first container in the list is empty, remove it. collapse :: SeparableTextContainer a => NonEmpty a -> [a] collapse (tc :| tcs) | Text.null (getText tc) = tcs- | otherwise = tc:tcs+ | otherwise = tc : tcs -- | Treat a list of text containers as a contiguous sequence, -- and remove a prefix of characters that match the given predicate. -- -- Empty text containers are removed from the output, so the result may -- potentially be an empty list.-trimTextsStart :: SeparableTextContainer a => (Char -> Bool) -> [a] -> [a]-trimTextsStart p tcs = trimTextsStart' p tcs+trimTextsStart :: (SeparableTextContainer a, Foldable f) =>+ (Char -> Bool) -> f a -> [a]+trimTextsStart p tcs = trimTextsStart' p $ toList tcs -- | Treat a list of text containers as a contiguous sequence, -- and remove a prefix of characters that match the given predicate. -- -- Empty text containers are removed from the output except the first one, -- which is instead truncated to zero length.-trimTextsStartPreserve ::- SeparableTextContainer a => (Char -> Bool) -> [a] -> [a]-trimTextsStartPreserve _ [] = []-trimTextsStartPreserve p ins@(in1:_) = case trimTextsStart' p ins of- [] -> [truncateText in1]- out -> out+trimTextsStartPreserve :: SeparableTextContainer a =>+ (Char -> Bool) -> NonEmpty a -> NonEmpty a+trimTextsStartPreserve p tcs =+ case nonEmpty $ trimTextsStart p $ NonEmpty.toList tcs of+ Nothing -> NonEmpty.singleton $ truncateText $ NonEmpty.head tcs+ Just out -> out -- | Treat a list of text containers as a contiguous sequence, -- and remove a suffix of characters that match the given predicate. -- -- Empty text containers are removed from the output, so the result may -- potentially be an empty list.-trimTextsEnd :: SeparableTextContainer a => (Char -> Bool) -> [a] -> [a]-trimTextsEnd p tcs = trimTextsEnd' p (reverse tcs)+trimTextsEnd :: (SeparableTextContainer a, Foldable f) =>+ (Char -> Bool) -> f a -> [a]+trimTextsEnd p tcs = trimTextsEnd' p $ reverse $ toList tcs -- | Treat a list of text containers as a contiguous sequence, -- and remove a suffix of characters that match the given predicate. -- -- Empty text containers are removed from the output except the first one, -- which is instead truncated to zero length.-trimTextsEndPreserve ::- SeparableTextContainer a => (Char -> Bool) -> [a] -> [a]-trimTextsEndPreserve _ [] = []-trimTextsEndPreserve p ins@(in1:_) = case trimTextsEnd' p (reverse ins) of- [] -> [truncateText in1]- out -> out+trimTextsEndPreserve :: SeparableTextContainer a =>+ (Char -> Bool) -> NonEmpty a -> NonEmpty a+trimTextsEndPreserve p tcs =+ case nonEmpty $ trimTextsEnd p $ NonEmpty.toList tcs of+ Nothing -> NonEmpty.singleton $ truncateText $ NonEmpty.head tcs+ Just out -> out trimTextsStart' :: SeparableTextContainer a => (Char -> Bool) -> [a] -> [a] trimTextsStart' _ [] = []-trimTextsStart' p (tc:tcs)+trimTextsStart' p (tc : tcs) | Text.null (getText trimmed) = trimTextsStart' p tcs- | otherwise = trimmed:tcs+ | otherwise = trimmed : tcs where trimmed = dropWhileStart p tc trimTextsEnd' :: SeparableTextContainer a => (Char -> Bool) -> [a] -> [a] trimTextsEnd' _ [] = []-trimTextsEnd' p (tc:tcs)+trimTextsEnd' p (tc : tcs) | Text.null (getText trimmed) = trimTextsEnd' p tcs- | otherwise = reverse $ trimmed:tcs+ | otherwise = reverse $ trimmed : tcs where trimmed = dropWhileEnd p tc
src/Data/Text/ParagraphLayout/Internal/Zipper.hs view
@@ -3,36 +3,27 @@ -- All measurements are in UTF-8 code points, each of which can be between -- 1 and 4 bytes long (inclusive). module Data.Text.ParagraphLayout.Internal.Zipper- (Zipper(preceding, following)- ,advanceBy- ,atEnd- ,atStart- ,next- ,recombine- ,splitAt- ,start- ,step+ ( Zipper (preceding, following)+ , advanceBy+ , atEnd+ , atStart+ , next+ , recombine+ , splitAt+ , start+ , step ) where +import Data.Bool (Bool, otherwise)+import Data.Char (Char)+import Data.Functor (fmap)+import Data.Int (Int)+import Data.Maybe (Maybe (Just, Nothing))+import Data.Ord ((<=), (>=)) import Data.Text (measureOff, null, uncons)-import Data.Text.Internal (Text(Text), empty)-import Prelude- (Bool- ,Char- ,Eq- ,Int- ,Maybe(Just, Nothing)- ,Show- ,fmap- ,fst- ,otherwise- ,(+)- ,(-)- ,(.)- ,(<=)- ,(>=)- )+import Data.Text.Internal (Text (Text), empty)+import Prelude (Eq, Show, fst, (+), (-), (.)) -- | Represents a body of text with a read cursor which can be moved forward. data Zipper = Zipper { preceding :: Text, following :: Text }@@ -101,8 +92,8 @@ -- | /O(1)/ Unsafe recombination of two `Text`s. ----- Requires that both `Text`s are based on the same `Array` and adjacent to--- each other.+-- Requires that both `Text`s are based on the same `Data.Text.Array`+-- and adjacent to each other. recombine' :: Text -> Text -> Text recombine' (Text _ _ 0) t = t recombine' t (Text _ _ 0) = t@@ -133,4 +124,4 @@ -- Requires that @m@ be within the bounds of the `Text`, not at the beginning -- or at the end, and not inside a code point. dropWord8 :: Int -> Text -> Text-dropWord8 m (Text arr off len) = Text arr (off+m) (len-m)+dropWord8 m (Text arr off len) = Text arr (off + m) (len - m)
test/Data/Text/ParagraphLayout/FontLoader.hs view
@@ -1,25 +1,26 @@ module Data.Text.ParagraphLayout.FontLoader- (arabicFont- ,devanagariFont- ,latinFont- ,loadFont- ,writeFontInfo+ ( arabicFont+ , devanagariFont+ , latinFont+ , loadFont+ , writeFontInfo ) where import Data.ByteString (readFile)+import Data.List (concat, (++)) import Data.Text.Glyphize- (Font- ,FontOptions- ,createFace- ,createFontWithOptions- ,faceIndex- ,fontFace- ,fontPPEm- ,fontScale+ ( Font+ , FontOptions+ , createFace+ , createFontWithOptions+ , faceIndex+ , fontFace+ , fontPPEm+ , fontScale ) import Data.Word (Word)-import Prelude (concat, return, show, ($), (++))+import Prelude (return, show, ($)) import System.FilePath (FilePath, (</>)) import System.IO (IO, writeFile)
+ test/Data/Text/ParagraphLayout/Internal/BiDiReorderSpec.hs view
@@ -0,0 +1,230 @@+module Data.Text.ParagraphLayout.Internal.BiDiReorderSpec where++import Data.Foldable (toList)+import Data.List.NonEmpty (NonEmpty, fromList)+import Data.Word (Word8)++import Test.Hspec+import Data.Text.ParagraphLayout.Internal.BiDiReorder++ne :: [a] -> NonEmpty a+ne = fromList++data ExampleItem = ExampleItem Word8 String+ deriving (Eq, Show)++instance WithLevel ExampleItem where+ level (ExampleItem lvl _) = lvl++toString :: ExampleItem -> String+toString (ExampleItem _ str) = str++toStrings :: Foldable t => t ExampleItem -> [String]+toStrings = map toString . toList++singleItemLevel :: Level -> NonEmpty ExampleItem+singleItemLevel lvl = ne+ [ ExampleItem lvl "item"+ ]++flatLevel :: Level -> NonEmpty ExampleItem+flatLevel lvl = ne+ [ ExampleItem lvl "start"+ , ExampleItem lvl "mid"+ , ExampleItem lvl "end"+ ]++-- | Example 1 from <https://www.unicode.org/reports/tr9/#L2>,+-- split into words and individual punctuation marks.+example1Words :: NonEmpty ExampleItem+example1Words = ne+ [ ExampleItem 0 "car"+ , ExampleItem 0 "means"+ , ExampleItem 1 "CAR"+ , ExampleItem 0 "."+ ]++-- | Example 2 from <https://www.unicode.org/reports/tr9/#L2>,+-- split into words and individual punctuation marks.+example2Words :: NonEmpty ExampleItem+example2Words = ne+ [ ExampleItem 2 "car"+ , ExampleItem 1 "MEANS"+ , ExampleItem 1 "CAR"+ , ExampleItem 1 "."+ ]++-- | Example 3 from <https://www.unicode.org/reports/tr9/#L2>,+-- split into words and individual punctuation marks.+example3Words :: NonEmpty ExampleItem+example3Words = ne+ [ ExampleItem 0 "he"+ , ExampleItem 0 "said"+ , ExampleItem 0 "“"+ , ExampleItem 2 "car"+ , ExampleItem 1 "MEANS"+ , ExampleItem 1 "CAR"+ , ExampleItem 0 "."+ , ExampleItem 0 "”"+ , ExampleItem 0 "“"+ , ExampleItem 1 "IT"+ , ExampleItem 1 "DOES"+ , ExampleItem 0 ","+ , ExampleItem 0 "”"+ , ExampleItem 0 "she"+ , ExampleItem 0 "agreed"+ , ExampleItem 0 "."+ ]++-- | Example 4 from <https://www.unicode.org/reports/tr9/#L2>,+-- split into words and individual punctuation marks.+example4Words :: NonEmpty ExampleItem+example4Words = ne+ [ ExampleItem 1 "DID"+ , ExampleItem 1 "YOU"+ , ExampleItem 1 "SAY"+ , ExampleItem 1 "’"+ , ExampleItem 2 "he"+ , ExampleItem 2 "said"+ , ExampleItem 2 "“"+ , ExampleItem 4 "car"+ , ExampleItem 3 "MEANS"+ , ExampleItem 3 "CAR"+ , ExampleItem 2 "”"+ , ExampleItem 1 "‘"+ , ExampleItem 1 "?"+ ]++-- | Example 4 from <https://www.unicode.org/reports/tr9/#L2>,+-- split into individual characters.+example4Characters :: NonEmpty ExampleItem+example4Characters = ne+ [ ExampleItem 1 "D"+ , ExampleItem 1 "I"+ , ExampleItem 1 "D"+ , ExampleItem 1 " "+ , ExampleItem 1 "Y"+ , ExampleItem 1 "O"+ , ExampleItem 1 "U"+ , ExampleItem 1 " "+ , ExampleItem 1 "S"+ , ExampleItem 1 "A"+ , ExampleItem 1 "Y"+ , ExampleItem 1 " "+ , ExampleItem 1 "’"+ , ExampleItem 1 ">"+ , ExampleItem 2 "h"+ , ExampleItem 2 "e"+ , ExampleItem 2 " "+ , ExampleItem 2 "s"+ , ExampleItem 2 "a"+ , ExampleItem 2 "i"+ , ExampleItem 2 "d"+ , ExampleItem 2 " "+ , ExampleItem 2 "“"+ , ExampleItem 2 "<"+ , ExampleItem 4 "c"+ , ExampleItem 4 "a"+ , ExampleItem 4 "r"+ , ExampleItem 3 " "+ , ExampleItem 3 "M"+ , ExampleItem 3 "E"+ , ExampleItem 3 "A"+ , ExampleItem 3 "N"+ , ExampleItem 3 "S"+ , ExampleItem 3 " "+ , ExampleItem 3 "C"+ , ExampleItem 3 "A"+ , ExampleItem 3 "R"+ , ExampleItem 2 "="+ , ExampleItem 2 "”"+ , ExampleItem 1 "="+ , ExampleItem 1 "‘"+ , ExampleItem 1 "?"+ ]++spec :: Spec+spec = do++ describe "reorder" $ do++ it "passes through single item at level 0" $ do+ toStrings (reorder $ singleItemLevel 0) `shouldBe` ["item"]++ it "passes through single item at level 1" $ do+ toStrings (reorder $ singleItemLevel 1) `shouldBe` ["item"]++ it "passes through single item at level 2" $ do+ toStrings (reorder $ singleItemLevel 2) `shouldBe` ["item"]++ it "passes through single item at level 3" $ do+ toStrings (reorder $ singleItemLevel 3) `shouldBe` ["item"]++ it "does not reverse at level 0" $ do+ toStrings (reorder $ flatLevel 0) `shouldBe` ["start", "mid", "end"]++ it "reverses at level 1" $ do+ toStrings (reorder $ flatLevel 1) `shouldBe` ["end", "mid", "start"]++ it "does not reverse at level 2" $ do+ toStrings (reorder $ flatLevel 2) `shouldBe` ["start", "mid", "end"]++ it "reverses at level 3" $ do+ toStrings (reorder $ flatLevel 3) `shouldBe` ["end", "mid", "start"]++ it "reorders UAX #9 example 1 as words" $+ toStrings (reorder example1Words) `shouldBe`+ [ "car"+ , "means"+ , "CAR"+ , "."+ ]++ it "reorders UAX #9 example 2 as words" $+ toStrings (reorder example2Words) `shouldBe`+ [ "."+ , "CAR"+ , "MEANS"+ , "car"+ ]++ it "reorders UAX #9 example 3 as words" $+ toStrings (reorder example3Words) `shouldBe`+ [ "he"+ , "said"+ , "“"+ , "CAR"+ , "MEANS"+ , "car"+ , "."+ , "”"+ , "“"+ , "DOES"+ , "IT"+ , ","+ , "”"+ , "she"+ , "agreed"+ , "."+ ]++ it "reorders UAX #9 example 4 as words" $+ toStrings (reorder example4Words) `shouldBe`+ [ "?"+ , "‘"+ , "he"+ , "said"+ , "“"+ , "CAR"+ , "MEANS"+ , "car"+ , "”"+ , "’"+ , "SAY"+ , "YOU"+ , "DID"+ ]++ it "reorders UAX #9 example 4 as characters" $+ concat (toStrings (reorder example4Characters)) `shouldBe`+ "?‘=he said “<RAC SNAEM car=”>’ YAS UOY DID"
test/Data/Text/ParagraphLayout/Internal/BreakSpec.hs view
@@ -3,13 +3,13 @@ import Control.Monad (forM_) import Data.Text (empty, pack, singleton) import Data.Text.ICU- (LocaleName(Locale)- ,breakCharacter- ,breakLine- ,breakSentence- ,breakWord+ ( LocaleName (Locale)+ , breakCharacter+ , breakLine+ , breakSentence+ , breakWord )-import qualified Data.Text.ICU as BreakStatus (Line(..), Word(..))+import qualified Data.Text.ICU as BreakStatus (Line (..), Word (..)) import Test.Hspec import Data.Text.ParagraphLayout.Internal.Break@@ -29,106 +29,106 @@ it "finds break at offset 0 in non-empty input" $ b "en" (singleton 'a') `shouldBe`- [(0, BreakStatus.Soft)]+ [ (0, BreakStatus.Soft)] it "finds hard break after newline" $ b "en" (pack "hello\nworld") `shouldBe`- [(6, BreakStatus.Hard)- ,(0, BreakStatus.Soft)+ [ (6, BreakStatus.Hard)+ , (0, BreakStatus.Soft) ] it "finds hard break after each of newlines" $ b "en" (pack "hello\n\nworld") `shouldBe`- [(7, BreakStatus.Hard)- ,(6, BreakStatus.Hard)- ,(0, BreakStatus.Soft)+ [ (7, BreakStatus.Hard)+ , (6, BreakStatus.Hard)+ , (0, BreakStatus.Soft) ] it "finds soft breaks after spaces and tabs" $ b "en" (pack "a few\twords") `shouldBe`- [(6, BreakStatus.Soft)- ,(2, BreakStatus.Soft)- ,(0, BreakStatus.Soft)+ [ (6, BreakStatus.Soft)+ , (2, BreakStatus.Soft)+ , (0, BreakStatus.Soft) ] it "finds soft breaks after each run of whitespace" $ b "en" (pack " a few\t more \n words\n") `shouldBe`- [(16, BreakStatus.Soft)- ,(15, BreakStatus.Hard)- ,(9, BreakStatus.Soft)- ,(4, BreakStatus.Soft)- ,(1, BreakStatus.Soft)- ,(0, BreakStatus.Soft)+ [ (16, BreakStatus.Soft)+ , (15, BreakStatus.Hard)+ , (9, BreakStatus.Soft)+ , (4, BreakStatus.Soft)+ , (1, BreakStatus.Soft)+ , (0, BreakStatus.Soft) ] it "finds soft breaks after spaces and hyphens" $ b "cs" (pack "následuje stanice Frýdek-Místek") `shouldBe`- [(27, BreakStatus.Soft)- ,(19, BreakStatus.Soft)- ,(11, BreakStatus.Soft)- ,(0, BreakStatus.Soft)+ [ (27, BreakStatus.Soft)+ , (19, BreakStatus.Soft)+ , (11, BreakStatus.Soft)+ , (0, BreakStatus.Soft) ] it "finds soft breaks in Japanese kana" $ b "ja" (pack "トイレはどこですか?") `shouldBe`- [(24, BreakStatus.Soft)- ,(21, BreakStatus.Soft)- ,(18, BreakStatus.Soft)- ,(15, BreakStatus.Soft)- ,(12, BreakStatus.Soft)- ,(9, BreakStatus.Soft)- ,(6, BreakStatus.Soft)- ,(3, BreakStatus.Soft)- ,(0, BreakStatus.Soft)+ [ (24, BreakStatus.Soft)+ , (21, BreakStatus.Soft)+ , (18, BreakStatus.Soft)+ , (15, BreakStatus.Soft)+ , (12, BreakStatus.Soft)+ , (9, BreakStatus.Soft)+ , (6, BreakStatus.Soft)+ , (3, BreakStatus.Soft)+ , (0, BreakStatus.Soft) ] let jaText = pack "五ヶ月‡コード" let jaBreaksStrict =- [(18, BreakStatus.Soft)- ,(12, BreakStatus.Soft)- ,(9, BreakStatus.Soft)- ,(6, BreakStatus.Soft)- ,(0, BreakStatus.Soft)+ [ (18, BreakStatus.Soft)+ , (12, BreakStatus.Soft)+ , (9, BreakStatus.Soft)+ , (6, BreakStatus.Soft)+ , (0, BreakStatus.Soft) ] let jaBreaksLoose =- [(18, BreakStatus.Soft)- ,(15, BreakStatus.Soft)- ,(12, BreakStatus.Soft)- ,(9, BreakStatus.Soft)- ,(6, BreakStatus.Soft)- ,(3, BreakStatus.Soft)- ,(0, BreakStatus.Soft)+ [ (18, BreakStatus.Soft)+ , (15, BreakStatus.Soft)+ , (12, BreakStatus.Soft)+ , (9, BreakStatus.Soft)+ , (6, BreakStatus.Soft)+ , (3, BreakStatus.Soft)+ , (0, BreakStatus.Soft) ] -- Observed behaviour. -- Not sure why Chinese rules are stricter for Japanese text. -- This behaviour may change with future versions of ICU. let expectedStrictLocales =- [""- ,"en"- ,"ja@lb=strict"- ,"zh"- ,"zh_Hans"- ,"zh_Hant"- ,"zxx"- ,"zxx-any-invalid-suffix"+ [ ""+ , "en"+ , "ja@lb=strict"+ , "zh"+ , "zh_Hans"+ , "zh_Hant"+ , "zxx"+ , "zxx-any-invalid-suffix" ] let expectedLooseLocales =- ["@lb=loose"- ,"en@lb=loose"- ,"ja"- ,"ja_JP"- ,"ja-JP"- ,"ja-any-invalid-suffix"- ,"zh@lb=loose"- ,"zxx-any-invalid-suffix@lb=loose"+ [ "@lb=loose"+ , "en@lb=loose"+ , "ja"+ , "ja_JP"+ , "ja-JP"+ , "ja-any-invalid-suffix"+ , "zh@lb=loose"+ , "zxx-any-invalid-suffix@lb=loose" ] - expectedStrictLocales `forM_` \l ->+ expectedStrictLocales `forM_` \ l -> it ("uses strict line breaks for " ++ l ++ " locale") $ b l jaText `shouldBe` jaBreaksStrict - expectedLooseLocales `forM_` \l ->+ expectedLooseLocales `forM_` \ l -> it ("uses loose line breaks for " ++ l ++ " locale") $ b l jaText `shouldBe` jaBreaksLoose @@ -155,15 +155,16 @@ it "finds break at offset 0 in non-empty input" $ b "en" (singleton 'a') `shouldBe`- [(0, BreakStatus.Uncategorized)]+ [ (0, BreakStatus.Uncategorized)+ ] it "finds breaks after runs of letters and spaces" $ b "en" (pack "a few words") `shouldBe`- [(8, BreakStatus.Uncategorized)- ,(5, BreakStatus.Letter)- ,(2, BreakStatus.Uncategorized)- ,(1, BreakStatus.Letter)- ,(0, BreakStatus.Uncategorized)+ [ (8, BreakStatus.Uncategorized)+ , (5, BreakStatus.Letter)+ , (2, BreakStatus.Uncategorized)+ , (1, BreakStatus.Letter)+ , (0, BreakStatus.Uncategorized) ] -- Useful for breaking inside words for narrow output.
test/Data/Text/ParagraphLayout/Internal/LinePaginationSpec.hs view
@@ -24,7 +24,7 @@ let ls = emptyLines let page = bestSplit 1 1 - ([-30, -5, 0, 5, 30, 90, 100, 110] :: [Int32]) `forM_` \h ->+ ([-30, -5, 0, 5, 30, 90, 100, 110] :: [Int32]) `forM_` \ h -> it ("maxHeight = " ++ show h ++ " returns empty lists") $ page h ls `shouldBe` ([], [])@@ -33,17 +33,17 @@ let ls = tenLines let page = bestSplit 1 1 - ([-30, -5, 0, 5] :: [Int32]) `forM_` \h ->+ ([-30, -5, 0, 5] :: [Int32]) `forM_` \ h -> it ("maxHeight = " ++ show h ++ " puts all in second list") $ page h ls `shouldBe` ([], [10, 10, 10, 10, 10, 10, 10, 10, 10, 10]) - ([30, 35] :: [Int32]) `forM_` \h ->+ ([30, 35] :: [Int32]) `forM_` \ h -> it ("maxHeight = " ++ show h ++ " puts 3 in first list") $ page h ls `shouldBe` ([10, 10, 10], [10, 10, 10, 10, 10, 10, 10]) - ([100, 110] :: [Int32]) `forM_` \h ->+ ([100, 110] :: [Int32]) `forM_` \ h -> it ("maxHeight = " ++ show h ++ " puts all in first list") $ page h ls `shouldBe` ([10, 10, 10, 10, 10, 10, 10, 10, 10, 10], [])@@ -52,34 +52,34 @@ let ls = tenLines let page = bestSplit 3 4 -- Acceptable page breaks:- -- * 0 + 10- -- * 3 + 7- -- * 4 + 6- -- * 5 + 5- -- * 6 + 4- -- * 10 + 0+ -- - 0 + 10+ -- - 3 + 7+ -- - 4 + 6+ -- - 5 + 5+ -- - 6 + 4+ -- - 10 + 0 - ([0, 10, 15, 25] :: [Int32]) `forM_` \h ->+ ([0, 10, 15, 25] :: [Int32]) `forM_` \ h -> it ("maxHeight = " ++ show h ++ " ensures 3 orphans") $ page h ls `shouldBe` ([], [10, 10, 10, 10, 10, 10, 10, 10, 10, 10]) - ([30, 35] :: [Int32]) `forM_` \h ->+ ([30, 35] :: [Int32]) `forM_` \ h -> it ("maxHeight = " ++ show h ++ " puts 3 in first list") $ page h ls `shouldBe` ([10, 10, 10], [10, 10, 10, 10, 10, 10, 10]) - ([40, 45] :: [Int32]) `forM_` \h ->+ ([40, 45] :: [Int32]) `forM_` \ h -> it ("maxHeight = " ++ show h ++ " puts 4 in first list") $ page h ls `shouldBe` ([10, 10, 10, 10], [10, 10, 10, 10, 10, 10]) - ([60, 75, 90] :: [Int32]) `forM_` \h ->+ ([60, 75, 90] :: [Int32]) `forM_` \ h -> it ("maxHeight = " ++ show h ++ " ensures 4 widows") $ page h ls `shouldBe` ([10, 10, 10, 10, 10, 10], [10, 10, 10, 10]) - ([100, 110] :: [Int32]) `forM_` \h ->+ ([100, 110] :: [Int32]) `forM_` \ h -> it ("maxHeight = " ++ show h ++ " puts all in first list") $ page h ls `shouldBe` ([10, 10, 10, 10, 10, 10, 10, 10, 10, 10], [])@@ -88,21 +88,21 @@ let ls = tenLines let page = bestSplit 6 4 -- Acceptable page breaks:- -- * 0 + 10- -- * 6 + 4- -- * 10 + 0+ -- - 0 + 10+ -- - 6 + 4+ -- - 10 + 0 - ([0, 10, 15, 35, 50, 55] :: [Int32]) `forM_` \h ->+ ([0, 10, 15, 35, 50, 55] :: [Int32]) `forM_` \ h -> it ("maxHeight = " ++ show h ++ " ensures 6 orphans") $ page h ls `shouldBe` ([], [10, 10, 10, 10, 10, 10, 10, 10, 10, 10]) - ([60, 65, 85, 95] :: [Int32]) `forM_` \h ->+ ([60, 65, 85, 95] :: [Int32]) `forM_` \ h -> it ("maxHeight = " ++ show h ++ " puts 6 in first list") $ page h ls `shouldBe` ([10, 10, 10, 10, 10, 10], [10, 10, 10, 10]) - ([100, 110] :: [Int32]) `forM_` \h ->+ ([100, 110] :: [Int32]) `forM_` \ h -> it ("maxHeight = " ++ show h ++ " puts all in first list") $ page h ls `shouldBe` ([10, 10, 10, 10, 10, 10, 10, 10, 10, 10], [])@@ -111,15 +111,15 @@ let ls = tenLines let page = bestSplit 6 5 -- Acceptable page breaks:- -- * 0 + 10- -- * 10 + 0+ -- - 0 + 10+ -- - 10 + 0 - ([0, 10, 60, 65, 85, 95] :: [Int32]) `forM_` \h ->+ ([0, 10, 60, 65, 85, 95] :: [Int32]) `forM_` \ h -> it ("maxHeight = " ++ show h ++ " puts all in second list") $ page h ls `shouldBe` ([], [10, 10, 10, 10, 10, 10, 10, 10, 10, 10]) - ([100, 110] :: [Int32]) `forM_` \h ->+ ([100, 110] :: [Int32]) `forM_` \ h -> it ("maxHeight = " ++ show h ++ " puts all in first list") $ page h ls `shouldBe` ([10, 10, 10, 10, 10, 10, 10, 10, 10, 10], [])@@ -193,11 +193,11 @@ let ls = tenLines let page = paginateLines 5 3 -- Acceptable page breaks:- -- * 0 + 10- -- * 5 + 5- -- * 6 + 4- -- * 7 + 3- -- * 10 + 0+ -- - 0 + 10+ -- - 5 + 5+ -- - 6 + 4+ -- - 7 + 3+ -- - 10 + 0 it "puts all lines on current page if possible" $ page 200 200 ls `shouldBe`
test/Data/Text/ParagraphLayout/Internal/RunSpec.hs view
@@ -1,7 +1,7 @@ module Data.Text.ParagraphLayout.Internal.RunSpec (spec) where import Data.Text (pack)-import Data.Text.Glyphize (Direction(..), emptyFont)+import Data.Text.Glyphize (Direction (..), emptyFont) import Test.Hspec import Data.Text.ParagraphLayout.Internal.ResolvedSpan
test/Data/Text/ParagraphLayout/Internal/TextContainerSpec.hs view
@@ -1,11 +1,15 @@ module Data.Text.ParagraphLayout.Internal.TextContainerSpec (spec) where +import qualified Data.List.NonEmpty import Data.Text (Text, empty, pack) import Data.Text.Foreign (lengthWord8) import Test.Hspec import Data.Text.ParagraphLayout.Internal.TextContainer +ne :: [a] -> Data.List.NonEmpty.NonEmpty a+ne = Data.List.NonEmpty.fromList+ data ExampleContainer = Contain { cText :: Text, cOffset :: Int } deriving (Show, Eq) @@ -64,39 +68,39 @@ d = cOffset c isSpace :: Char -> Bool-isSpace = (==' ')+isSpace = (== ' ') spec :: Spec spec = do describe "splitTextsBy" $ do it "splits example text containers" $ do splitTextsBy exampleBreakPoints exampleContainers `shouldBe`- [ ( [ contain "Vikipedija " 10, contain "(Википеди" 21 ]- , [ contain "ја)" 38 ]+ [ ( ne [ contain "Vikipedija " 10, contain "(Википеди" 21 ]+ , ne [ contain "ја)" 38 ] )- , ( [ contain "Vikipedija " 10, contain "(Википе" 21 ]- , [ contain "дија)" 34 ]+ , ( ne [ contain "Vikipedija " 10, contain "(Википе" 21 ]+ , ne [ contain "дија)" 34 ] )- , ( [ contain "Vikipedija " 10, contain "(Вики" 21 ]- , [ contain "педија)" 30 ]+ , ( ne [ contain "Vikipedija " 10, contain "(Вики" 21 ]+ , ne [ contain "педија)" 30 ] )- , ( [ contain "Vikipedija " 10, contain "(Ви" 21 ]- , [ contain "кипедија)" 26 ]+ , ( ne [ contain "Vikipedija " 10, contain "(Ви" 21 ]+ , ne [ contain "кипедија)" 26 ] )- , ( [ contain "Vikipedija " 10 ]- , [ contain "(Википедија)" 21 ]+ , ( ne [ contain "Vikipedija " 10 ]+ , ne [ contain "(Википедија)" 21 ] )- , ( [ contain "Vikipedi" 10 ]- , [ contain "ja " 18, contain "(Википедија)" 21 ]+ , ( ne [ contain "Vikipedi" 10 ]+ , ne [ contain "ja " 18, contain "(Википедија)" 21 ] )- , ( [ contain "Vikipe" 10 ]- , [ contain "dija " 16, contain "(Википедија)" 21 ]+ , ( ne [ contain "Vikipe" 10 ]+ , ne [ contain "dija " 16, contain "(Википедија)" 21 ] )- , ( [ contain "Viki" 10 ]- , [ contain "pedija " 14, contain "(Википедија)" 21 ]+ , ( ne [ contain "Viki" 10 ]+ , ne [ contain "pedija " 14, contain "(Википедија)" 21 ] )- , ( [ contain "Vi" 10 ]- , [ contain "kipedija " 12, contain "(Википедија)" 21 ]+ , ( ne [ contain "Vi" 10 ]+ , ne [ contain "kipedija " 12, contain "(Википедија)" 21 ] ) ] describe "trimTextsEnd" $ do
test/Data/Text/ParagraphLayout/Internal/ZipperSpec.hs view
@@ -27,140 +27,141 @@ describe "start on empty text" $ do let z = Zipper.start empty- it "is at start" $ do+ it "is at start" $ Zipper.atStart z `shouldBe` True- it "is at end" $ do+ it "is at end" $ Zipper.atEnd z `shouldBe` True- it "has nothing preceding it" $ do+ it "has nothing preceding it" $ Zipper.preceding z `shouldBe` empty- it "has nothing following it" $ do+ it "has nothing following it" $ Zipper.following z `shouldBe` empty- it "has no next character" $ do+ it "has no next character" $ Zipper.next z `shouldBe` Nothing- it "recombines into empty text" $ do+ it "recombines into empty text" $ Zipper.recombine z `shouldBe` empty- it "unchanged by step" $ do+ it "unchanged by step" $ Zipper.step z `shouldBe` z- it "unchanged by advance" $ do+ it "unchanged by advance" $ Zipper.advanceBy 999 z `shouldBe` z describe "start" $ do let z = Zipper.start sampleText- it "is at start" $ do+ it "is at start" $ Zipper.atStart z `shouldBe` True- it "is not at end" $ do+ it "is not at end" $ Zipper.atEnd z `shouldBe` False- it "has nothing preceding it" $ do+ it "has nothing preceding it" $ Zipper.preceding z `shouldBe` empty- it "has everything following it" $ do+ it "has everything following it" $ Zipper.following z `shouldBe` sampleText- it "has next character 'P'" $ do+ it "has next character 'P'" $ Zipper.next z `shouldBe` Just 'P'- it "recombines into original text" $ do+ it "recombines into original text" $ Zipper.recombine z `shouldBe` sampleText describe "split at zero" $ do let z = Zipper.splitAt 0 sampleText- it "is at start" $ do+ it "is at start" $ Zipper.atStart z `shouldBe` True- it "is not at end" $ do+ it "is not at end" $ Zipper.atEnd z `shouldBe` False- it "has nothing preceding it" $ do+ it "has nothing preceding it" $ Zipper.preceding z `shouldBe` empty- it "has everything following it" $ do+ it "has everything following it" $ Zipper.following z `shouldBe` sampleText- it "has next character 'P'" $ do+ it "has next character 'P'" $ Zipper.next z `shouldBe` Just 'P'- it "recombines into original text" $ do+ it "recombines into original text" $ Zipper.recombine z `shouldBe` sampleText describe "split at negative value" $ do let z = Zipper.splitAt (-3) sampleText- it "is at start" $ do+ it "is at start" $ Zipper.atStart z `shouldBe` True- it "is not at end" $ do+ it "is not at end" $ Zipper.atEnd z `shouldBe` False- it "has nothing preceding it" $ do+ it "has nothing preceding it" $ Zipper.preceding z `shouldBe` empty- it "has everything following it" $ do+ it "has everything following it" $ Zipper.following z `shouldBe` sampleText- it "has next character 'P'" $ do+ it "has next character 'P'" $ Zipper.next z `shouldBe` Just 'P'- it "recombines into original text" $ do+ it "recombines into original text" $ Zipper.recombine z `shouldBe` sampleText - midPositions `forM_` \n ->+ midPositions `forM_` \ n -> describe ("split at " ++ (show n)) $ do let z = Zipper.splitAt n sampleText- it "is not at start" $ do+ it "is not at start" $ Zipper.atStart z `shouldBe` False- it "is not at end" $ do+ it "is not at end" $ Zipper.atEnd z `shouldBe` False- it ("preceding text has length " ++ show n) $ do+ it ("preceding text has length " ++ show n) $ Text.length (Zipper.preceding z) `shouldBe` n- it ("following text has length " ++ show (sampleLength-n)) $ do- Text.length (Zipper.following z) `shouldBe` (sampleLength-n)- it "recombines into original text" $ do+ it ("following text has length " ++ show (sampleLength - n)) $+ Text.length (Zipper.following z) `shouldBe` (sampleLength - n)+ it "recombines into original text" $ Zipper.recombine z `shouldBe` sampleText - preMidPositions `forM_` \n ->+ preMidPositions `forM_` \ n -> describe ("split at " ++ (show n) ++ " and step") $ do let z = Zipper.step $ Zipper.splitAt n sampleText- it "is not at start" $ do+ let n' = n + 1+ it "is not at start" $ Zipper.atStart z `shouldBe` False- it "is not at end" $ do+ it "is not at end" $ Zipper.atEnd z `shouldBe` False- it ("preceding text has length " ++ show (n+1)) $ do- Text.length (Zipper.preceding z) `shouldBe` (n+1)- it ("following text has length " ++ show (sampleLength-n-1)) $ do- Text.length (Zipper.following z) `shouldBe` (sampleLength-n-1)- it "recombines into original text" $ do+ it ("preceding text has length " ++ show n') $+ Text.length (Zipper.preceding z) `shouldBe` n'+ it ("following text has length " ++ show (sampleLength - n')) $+ Text.length (Zipper.following z) `shouldBe` (sampleLength - n')+ it "recombines into original text" $ Zipper.recombine z `shouldBe` sampleText describe "start and advance by 3" $ do let z = Zipper.advanceBy 3 $ Zipper.start sampleText- it "should be the same as splitting at 3" $ do+ it "should be the same as splitting at 3" $ z `shouldBe` Zipper.splitAt 3 sampleText- it "has next character 'l'" $ do+ it "has next character 'l'" $ Zipper.next z `shouldBe` Just 'l'- it "recombines into original text" $ do+ it "recombines into original text" $ Zipper.recombine z `shouldBe` sampleText describe "split at 4 and advance by 3" $ do let z = Zipper.advanceBy 3 $ Zipper.splitAt 4 sampleText- it "should be the same as splitting at 7" $ do+ it "should be the same as splitting at 7" $ z `shouldBe` Zipper.splitAt 7 sampleText- it "has next character z-caron" $ do+ it "has next character z-caron" $ Zipper.next z `shouldBe` Just 'ž'- it "recombines into original text" $ do+ it "recombines into original text" $ Zipper.recombine z `shouldBe` sampleText describe "split past text bounds" $ do let z = Zipper.splitAt 999 sampleText- it "is not at start" $ do+ it "is not at start" $ Zipper.atStart z `shouldBe` False- it "is at end" $ do+ it "is at end" $ Zipper.atEnd z `shouldBe` True- it "has everything preceding it" $ do+ it "has everything preceding it" $ Zipper.preceding z `shouldBe` sampleText- it "has nothing following it" $ do+ it "has nothing following it" $ Zipper.following z `shouldBe` empty- it "has no next character" $ do+ it "has no next character" $ Zipper.next z `shouldBe` Nothing- it "recombines into original text" $ do+ it "recombines into original text" $ Zipper.recombine z `shouldBe` sampleText describe "split at 3 and advance past text bounds" $ do let z = Zipper.advanceBy sampleLength $ Zipper.splitAt 3 sampleText- it "is not at start" $ do+ it "is not at start" $ Zipper.atStart z `shouldBe` False- it "is at end" $ do+ it "is at end" $ Zipper.atEnd z `shouldBe` True- it "has everything preceding it" $ do+ it "has everything preceding it" $ Zipper.preceding z `shouldBe` sampleText- it "has nothing following it" $ do+ it "has nothing following it" $ Zipper.following z `shouldBe` empty- it "has no next character" $ do+ it "has no next character" $ Zipper.next z `shouldBe` Nothing- it "recombines into original text" $ do+ it "recombines into original text" $ Zipper.recombine z `shouldBe` sampleText
test/Data/Text/ParagraphLayout/ParagraphData.hs view
@@ -1,26 +1,26 @@ module Data.Text.ParagraphLayout.ParagraphData- (arabicFillerParagraph- ,czechHelloParagraph- ,devanagariAccentParagraph- ,devanagariParagraph- ,devanagariPrefixedAccentParagraph- ,emptyParagraph- ,emptySpanParagraph- ,hardBreaksLTRParagraph- ,hardBreaksRTLParagraph- ,ligatureParagraph- ,loremIpsumParagraph- ,manySpacesParagraph- ,mixedLanguageLTRParagraph- ,mixedScriptSerbianParagraph- ,mixedScriptWordsParagraph- ,spannedArabicFillerParagraph- ,spannedLoremIpsumParagraph- ,trivialParagraph+ ( arabicFillerParagraph+ , czechHelloParagraph+ , devanagariAccentParagraph+ , devanagariParagraph+ , devanagariPrefixedAccentParagraph+ , emptyParagraph+ , emptySpanParagraph+ , hardBreaksLTRParagraph+ , hardBreaksRTLParagraph+ , ligatureParagraph+ , loremIpsumParagraph+ , manySpacesParagraph+ , mixedLanguageLTRParagraph+ , mixedScriptSerbianParagraph+ , mixedScriptWordsParagraph+ , spannedArabicFillerParagraph+ , spannedLoremIpsumParagraph+ , trivialParagraph ) where -import Data.Text.ParagraphLayout (Paragraph, ParagraphOptions, SpanOptions(..))+import Data.Text.ParagraphLayout (Paragraph, ParagraphOptions, SpanOptions (..)) import Data.Text.ParagraphLayout.ParagraphConstruction -- | Span with text in the Czech language.@@ -58,7 +58,7 @@ manySpacesParagraph :: ParagraphOptions -> Paragraph manySpacesParagraph = " " |< zxx " aaaaaa aaaaaa aaaaaa aaaaaa " >| " " --- | Fillter text using the Arabic script.+-- | Filler text using the Arabic script. -- Source: <https://generator.lorem-ipsum.info/_arabic> arabicFillerParagraph :: ParagraphOptions -> Paragraph arabicFillerParagraph = "xxxx" |< zxx "إعلان بأيدي وبغطاء هذه من. عرض غينيا يتمكن واعتلاء في. و فرنسا الثانية وفي, أسر إذ السبب ارتكبها مليارات. فكان الشتاء، ما حتى, غير أن وصغار الأخذ. في الصفحة لهيمنة وتتحمّل وتم, أن أما وبداية الغالي." >| "z"@@ -66,7 +66,7 @@ spannedArabicFillerParagraph :: ParagraphOptions -> Paragraph spannedArabicFillerParagraph = "xxxx" |< zxx "إعلان بأيدي وبغطاء " >|< zxx "هذه من. عرض" >|< zxx " غينيا يتمكن واعتلاء " >|< zxx "في. و فرنسا" >|< zxx " الثانية وفي, أسر " >|< zxx "إذ السبب ارتكبها" >|< zxx " مليارات. فكان الشتاء، " >|< zxx "ما حتى, غير" >|< zxx " أن وصغار الأخذ. " >|< zxx "في الصفحة لهيمنة" >|< zxx " وتتحمّل وتم, أن " >|< zxx "أما وبداية الغالي." >| "z" --- | Fillter text using the Latin script.+-- | Filler text using the Latin script. -- Source: <https://www.lipsum.com/> loremIpsumParagraph :: ParagraphOptions -> Paragraph loremIpsumParagraph = "xxxx" |< zxx "Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat. Duis aute irure dolor in reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla pariatur. Excepteur sint occaecat cupidatat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum." >| "z"@@ -100,11 +100,11 @@ -- | Test hard line breaks with Latin characters: ----- * after a short line (no soft line breaks needed),--- * after a longer line (soft line breaks needed),--- * after a long word (line break in the middle of a word needed),--- * after spaces,--- * after other line breaks.+-- - after a short line (no soft line breaks needed),+-- - after a longer line (soft line breaks needed),+-- - after a long word (line break in the middle of a word needed),+-- - after spaces,+-- - after other line breaks. hardBreaksLTRParagraph :: ParagraphOptions -> Paragraph hardBreaksLTRParagraph = "x" |< zxx "jjjjjj\njjjjjj jjjjjj jjjjjj\nmmmmmm \njjjjjj\n\nmm mm mm" >| ""
test/Data/Text/ParagraphLayout/SpanData.hs view
@@ -1,14 +1,15 @@ module Data.Text.ParagraphLayout.SpanData- (emptySpan- ,czechHello- ,serbianMixedScript+ ( emptySpan+ , czechHello+ , serbianMixedScript ) where import Data.Text (pack) import Data.Text.Glyphize (Font)-import Data.Text.ParagraphLayout (LineHeight(Normal))-import Data.Text.ParagraphLayout.Internal.ResolvedSpan (ResolvedSpan(..))++import Data.Text.ParagraphLayout.Internal.LineHeight+import Data.Text.ParagraphLayout.Internal.ResolvedSpan emptySpan :: Font -> ResolvedSpan emptySpan font = ResolvedSpan
test/Data/Text/ParagraphLayoutSpec.hs view
@@ -1,9 +1,9 @@ module Data.Text.ParagraphLayoutSpec (spec) where import Data.Text.Glyphize- (Font- ,FontOptions(optionPPEm, optionScale)- ,defaultFontOptions+ ( Font+ , FontOptions (optionPPEm, optionScale)+ , defaultFontOptions ) import Test.Hspec@@ -12,7 +12,7 @@ import Data.Text.ParagraphLayout import Data.Text.ParagraphLayout.FontLoader import Data.Text.ParagraphLayout.Internal.Fragment-import Data.Text.ParagraphLayout.Internal.ParagraphLayout+import Data.Text.ParagraphLayout.Internal.Plain.ParagraphLayout import Data.Text.ParagraphLayout.ParagraphData import Data.Text.ParagraphLayout.Rect @@ -55,7 +55,7 @@ instance PrettyShow Pages where prettyShow (Pages ps) = concat [ "["- , concat $ indentedList indent0 $ map (prettyShow . Page') ps+ , concat $ indentedList indent0 $ map (prettyShow . Page') ps , "]" ] @@ -117,19 +117,19 @@ indentedList indent items = prefixTail indent $ suffixInit commaNewline items suffixInit :: String -> [String] -> [String]-suffixInit suffix = mapInit (++suffix)+suffixInit suffix = mapInit (++ suffix) mapInit :: (a -> a) -> [a] -> [a] mapInit _ [] = [] mapInit _ [x] = [x]-mapInit f (x:y:ys) = f x : mapInit f (y:ys)+mapInit f (x : y : ys) = f x : mapInit f (y : ys) prefixTail :: String -> [String] -> [String]-prefixTail prefix = mapTail (prefix++)+prefixTail prefix = mapTail (prefix ++) mapTail :: (a -> a) -> [a] -> [a] mapTail _ [] = []-mapTail f (x:xs) = x:(map f xs)+mapTail f (x : xs) = x : (map f xs) indent0 :: String indent0 = ""@@ -156,8 +156,8 @@ shouldBeGolden output_ name = Golden { output = output_ , encodePretty = show- , writeToFile = \path -> writeFile path . prettyShow- , readFromFile = \path -> readFile path >>= return . read+ , writeToFile = \ path -> writeFile path . prettyShow+ , readFromFile = \ path -> readFile path >>= return . read , goldenFile = ".golden" </> name </> "golden" , actualFile = Just (".golden" </> name </> "actual") , failFirstTime = True@@ -167,8 +167,8 @@ shouldBeGolden output_ name = Golden { output = output_ , encodePretty = show . getPages- , writeToFile = \path -> writeFile path . prettyShow- , readFromFile = \path -> readFile path >>= return . Pages . read+ , writeToFile = \ path -> writeFile path . prettyShow+ , readFromFile = \ path -> readFile path >>= return . Pages . read , goldenFile = ".golden" </> name </> "golden" , actualFile = Just (".golden" </> name </> "actual") , failFirstTime = True@@ -178,8 +178,8 @@ shouldBeGolden output_ name = Golden { output = output_ , encodePretty = show . getShapedRuns- , writeToFile = \path -> writeFile path . prettyShow- , readFromFile = \path -> readFile path >>= return . ShapedRuns . read+ , writeToFile = \ path -> writeFile path . prettyShow+ , readFromFile = \ path -> readFile path >>= return . ShapedRuns . read , goldenFile = ".golden" </> "shapedRuns" </> name </> "golden" , actualFile = Just (".golden" </> "shapedRuns" </> name </> "actual") , failFirstTime = True