packages feed

symantic-document 1.2.3.20190628 → 1.4.0.20190710

raw patch · 5 files changed

+260/−171 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

- Symantic.Document.API: breakfill :: (Indentable d, Indentable (UnTrans d)) => Trans d => Width -> d -> d
- Symantic.Document.Plain: [plainState_removableIndent] :: PlainState d -> !Indent
- Symantic.Document.Plain: collapseSpaces :: PlainChunk d -> PlainChunk d
- Symantic.Document.Plain: countWords :: [PlainChunk d] -> Natural
- Symantic.Document.Plain: flushLine :: Spaceable d => Plain d
- Symantic.Document.Plain: instance (GHC.Show.Show d, GHC.Base.Monoid d) => GHC.Show.Show (Symantic.Document.Plain.Plain d)
- Symantic.Document.Plain: instance GHC.Show.Show Symantic.Document.Plain.PlainInh
- Symantic.Document.Plain: joinLine :: Spaceable d => PlainInh -> PlainState d -> d
- Symantic.Document.Plain: joinPlainLine :: Monoid d => Spaceable d => [PlainChunk d] -> d
- Symantic.Document.Plain: newlineJustifying :: Spaceable d => Plain d
- Symantic.Document.Plain: padPlainLine :: Spaceable d => [PlainChunk d] -> [Width] -> d
- Symantic.Document.Plain: padPlainLineInits :: Spaceable d => Width -> (Natural, Natural, [PlainChunk d]) -> Line d
+ Symantic.Document.API: endline :: (Wrappable d, Wrappable (UnTrans d)) => Trans d => d
+ Symantic.Document.API: fillOrBreak :: (Indentable d, Indentable (UnTrans d)) => Trans d => Width -> d -> d
+ Symantic.Document.Plain: [plainInh_indenting] :: PlainInh d -> !Plain d
+ Symantic.Document.Plain: [plainState_breakIndent] :: PlainState d -> !Indent
+ Symantic.Document.Plain: collapsePlainChunkSpaces :: PlainChunk d -> PlainChunk d
+ Symantic.Document.Plain: countWordsPlain :: [PlainChunk d] -> Natural
+ Symantic.Document.Plain: flushlinePlain :: Spaceable d => Plain d
+ Symantic.Document.Plain: instance (GHC.Show.Show d, Symantic.Document.API.Spaceable d) => GHC.Show.Show (Symantic.Document.Plain.Plain d)
+ Symantic.Document.Plain: joinLinePlainChunk :: Monoid d => Spaceable d => [PlainChunk d] -> d
+ Symantic.Document.Plain: justifyLinePlain :: Spaceable d => PlainInh d -> PlainState d -> d
+ Symantic.Document.Plain: newlineJustifyingPlain :: Spaceable d => Plain d
+ Symantic.Document.Plain: padLinePlainChunk :: Spaceable d => [PlainChunk d] -> [Width] -> d
+ Symantic.Document.Plain: padLinePlainChunkInits :: Spaceable d => Width -> (Natural, Natural, [PlainChunk d]) -> Line d
- Symantic.Document.API: incrIndent :: (Indentable d, Indentable (UnTrans d)) => Trans d => Indent -> d -> d
+ Symantic.Document.API: incrIndent :: (Indentable d, Indentable (UnTrans d)) => Trans d => d -> Indent -> d -> d
- Symantic.Document.API: setIndent :: (Indentable d, Indentable (UnTrans d)) => Trans d => Indent -> d -> d
+ Symantic.Document.API: setIndent :: (Indentable d, Indentable (UnTrans d)) => Trans d => d -> Indent -> d -> d
- Symantic.Document.Plain: Plain :: (PlainInh -> PlainState d -> ((d -> d, PlainState d) -> PlainFit d) -> PlainFit d) -> Plain d
+ Symantic.Document.Plain: Plain :: (PlainInh d -> PlainState d -> ((d -> d, PlainState d) -> PlainFit d) -> PlainFit d) -> Plain d
- Symantic.Document.Plain: PlainChunk_Ignored :: d -> PlainChunk d
+ Symantic.Document.Plain: PlainChunk_Ignored :: !d -> PlainChunk d
- Symantic.Document.Plain: PlainChunk_Spaces :: Width -> PlainChunk d
+ Symantic.Document.Plain: PlainChunk_Spaces :: !Width -> PlainChunk d
- Symantic.Document.Plain: PlainChunk_Word :: Word d -> PlainChunk d
+ Symantic.Document.Plain: PlainChunk_Word :: !Word d -> PlainChunk d
- Symantic.Document.Plain: PlainInh :: !Maybe Column -> !Bool -> !Width -> PlainInh
+ Symantic.Document.Plain: PlainInh :: !Maybe Column -> !Bool -> !Indent -> !Plain d -> PlainInh d
- Symantic.Document.Plain: [plainInh_indent] :: PlainInh -> !Width
+ Symantic.Document.Plain: [plainInh_indent] :: PlainInh d -> !Indent
- Symantic.Document.Plain: [plainInh_justify] :: PlainInh -> !Bool
+ Symantic.Document.Plain: [plainInh_justify] :: PlainInh d -> !Bool
- Symantic.Document.Plain: [plainInh_width] :: PlainInh -> !Maybe Column
+ Symantic.Document.Plain: [plainInh_width] :: PlainInh d -> !Maybe Column
- Symantic.Document.Plain: [unPlain] :: Plain d -> PlainInh -> PlainState d -> ((d -> d, PlainState d) -> PlainFit d) -> PlainFit d
+ Symantic.Document.Plain: [unPlain] :: Plain d -> PlainInh d -> PlainState d -> ((d -> d, PlainState d) -> PlainFit d) -> PlainFit d
- Symantic.Document.Plain: data PlainInh
+ Symantic.Document.Plain: data PlainInh d
- Symantic.Document.Plain: defPlainInh :: PlainInh
+ Symantic.Document.Plain: defPlainInh :: Spaceable d => PlainInh d
- Symantic.Document.Plain: runPlain :: Monoid d => Plain d -> d
+ Symantic.Document.Plain: runPlain :: Spaceable d => Plain d -> d

Files

Symantic/Document/API.hs view
@@ -413,33 +413,34 @@ class Spaceable d => Indentable d where 	-- | @('align' d)@ make @d@ uses current 'Column' as 'Indent' level. 	align :: d -> d-	-- | @('incrIndent' ind d)@ make @d@ uses current 'Indent' plus @ind@ as 'Indent' level.-	incrIndent :: Indent -> d -> d-	-- | @('setIndent' ind d)@ make @d@ uses @ind@ as 'Indent' level.-	setIndent :: Indent -> d -> d-	-- | @('hang' ind d)@ make @d@ uses current 'Column' plus @ind@ as 'Indent' level.+	-- | @('setIndent' p ind d)@ make @d@ uses @ind@ as 'Indent' level.+	-- Using @p@ as 'Indent' text.+	setIndent :: d -> Indent -> d -> d+	-- | @('incrIndent' p ind d)@ make @d@ uses current 'Indent' plus @ind@ as 'Indent' level.+	-- Appending @p@ to the current 'Indent' text.+	incrIndent :: d -> Indent -> d -> d 	hang :: Indent -> d -> d-	hang ind = align . incrIndent ind+	hang ind = align . incrIndent (spaces ind) ind 	-- | @('fill' w d)@ write @d@, 	-- then if @d@ is not wider than @w@, 	-- write the difference with 'spaces'. 	fill :: Width -> d -> d-	-- | @('breakfill' w d)@ write @d@,+	-- | @('fillOrBreak' w d)@ write @d@, 	-- then if @d@ is not wider than @w@, write the difference with 'spaces' 	-- otherwise write a 'newline' indented to to the start 'Column' of @d@ plus @w@.-	breakfill :: Width -> d -> d+	fillOrBreak :: Width -> d -> d 	-	default align      :: Indentable (UnTrans d) => Trans d => d -> d-	default incrIndent :: Indentable (UnTrans d) => Trans d => Indent -> d -> d-	default setIndent  :: Indentable (UnTrans d) => Trans d => Indent -> d -> d-	default fill       :: Indentable (UnTrans d) => Trans d => Width -> d -> d-	default breakfill  :: Indentable (UnTrans d) => Trans d => Width -> d -> d+	default align         :: Indentable (UnTrans d) => Trans d => d -> d+	default incrIndent    :: Indentable (UnTrans d) => Trans d => d -> Indent -> d -> d+	default setIndent     :: Indentable (UnTrans d) => Trans d => d -> Indent -> d -> d+	default fill          :: Indentable (UnTrans d) => Trans d => Width -> d -> d+	default fillOrBreak   :: Indentable (UnTrans d) => Trans d => Width -> d -> d 	-	align      = noTrans1 align-	incrIndent = noTrans1 . incrIndent-	setIndent  = noTrans1 . setIndent-	fill       = noTrans1 . fill-	breakfill  = noTrans1 . breakfill+	align          = noTrans1 align+	setIndent  p i = noTrans . setIndent  (unTrans p) i . unTrans+	incrIndent p i = noTrans . incrIndent (unTrans p) i . unTrans+	fill           = noTrans1 . fill+	fillOrBreak    = noTrans1 . fillOrBreak  class Listable d where 	ul :: Traversable f => f d -> d@@ -460,12 +461,15 @@ 	breakpoint :: d 	breakspace :: d 	breakalt   :: d -> d -> d+	endline    :: d 	default breakpoint :: Wrappable (UnTrans d) => Trans d => d 	default breakspace :: Wrappable (UnTrans d) => Trans d => d 	default breakalt   :: Wrappable (UnTrans d) => Trans d => d -> d -> d+	default endline    :: Wrappable (UnTrans d) => Trans d => d 	breakpoint = noTrans breakpoint 	breakspace = noTrans breakspace 	breakalt   = noTrans2 breakalt+	endline    = noTrans endline  -- * Class 'Justifiable' class Justifiable d where
Symantic/Document/AnsiText.hs view
@@ -8,6 +8,7 @@ import Data.Char (Char) import Data.Function (($), (.), id) import Data.Functor ((<$>))+import Data.Functor.Identity (Identity(..)) import Data.Monoid (Monoid(..)) import Data.Semigroup (Semigroup(..)) import Data.String (String, IsString(..))@@ -99,11 +100,19 @@ instance Justifiable d => Justifiable (AnsiText d) where 	justify (AnsiText d) = AnsiText $ justify <$> d instance Indentable d => Indentable (AnsiText d) where-	setIndent i (AnsiText d)  = AnsiText $ setIndent i <$> d-	incrIndent i (AnsiText d) = AnsiText $ incrIndent i <$> d-	fill w (AnsiText d)       = AnsiText $ fill w <$> d-	breakfill w (AnsiText d)  = AnsiText $ breakfill w <$> d-	align (AnsiText d)        = AnsiText $ align <$> d+	align (AnsiText d) = AnsiText $ align <$> d+	setIndent p i (AnsiText d) = AnsiText $ ReaderT $ \inh ->+		Identity $+		setIndent+		 (unAnsiText p`runReader`inh) i+		 (runReader d inh)+	incrIndent p i (AnsiText d) = AnsiText $ ReaderT $ \inh ->+		Identity $+		incrIndent+		 (unAnsiText p`runReader`inh) i+		 (runReader d inh)+	fill w (AnsiText d)        = AnsiText $ fill w <$> d+	fillOrBreak w (AnsiText d) = AnsiText $ fillOrBreak w <$> d instance Listable d => Listable (AnsiText d) where 	ul ds = AnsiText $ (ul <$>) $ sequence $ unAnsiText <$> ds 	ol ds = AnsiText $ (ol <$>) $ sequence $ unAnsiText <$> ds@@ -111,6 +120,7 @@ 	setWidth w (AnsiText d) = AnsiText $ setWidth w <$> d 	breakpoint = AnsiText $ return breakpoint 	breakspace = AnsiText $ return breakspace+	endline    = AnsiText $ return endline 	breakalt (AnsiText x) (AnsiText y) = AnsiText $ liftA2 breakalt x y  ansiTextSGR ::@@ -201,11 +211,11 @@ instance Justifiable d => Justifiable (PlainText d) where 	justify (PlainText d) = PlainText $ justify d instance Indentable d => Indentable (PlainText d) where-	setIndent i (PlainText d)  = PlainText $ setIndent i d-	incrIndent i (PlainText d) = PlainText $ incrIndent i d-	fill w (PlainText d)       = PlainText $ fill w d-	breakfill w (PlainText d)  = PlainText $ breakfill w d-	align (PlainText d)        = PlainText $ align d+	align (PlainText d)          = PlainText $ align d+	setIndent  p i (PlainText d) = PlainText $ setIndent  (runPlainText p) i d+	incrIndent p i (PlainText d) = PlainText $ incrIndent (runPlainText p) i d+	fill w (PlainText d)         = PlainText $ fill w d+	fillOrBreak w (PlainText d)  = PlainText $ fillOrBreak w d instance Listable d => Listable (PlainText d) where 	ul ds = PlainText $ ul $ unPlainText <$> ds 	ol ds = PlainText $ ol $ unPlainText <$> ds@@ -213,6 +223,7 @@ 	setWidth w (PlainText d) = PlainText $ setWidth w d 	breakpoint = PlainText breakpoint 	breakspace = PlainText breakspace+	endline    = PlainText endline 	breakalt (PlainText x) (PlainText y) = PlainText $ breakalt x y  plainTextSGR ::
Symantic/Document/Plain.hs view
@@ -3,6 +3,7 @@ {-# LANGUAGE UndecidableInstances #-} module Symantic.Document.Plain where +import Control.Monad (Monad(..)) import Data.Bool import Data.Char (Char) import Data.Eq (Eq(..))@@ -15,7 +16,7 @@ import Data.String (String, IsString(..)) import Data.Text (Text) import Data.Tuple (snd)-import GHC.Natural (minusNatural,quotRemNatural)+import GHC.Natural (minusNatural,minusNaturalMaybe,quotRemNatural) import Numeric.Natural (Natural) import Prelude (fromIntegral, Num(..), pred) import System.Console.ANSI@@ -34,17 +35,17 @@ -- Prepending is done using continuation, like in a difference list. newtype Plain d = Plain  { unPlain ::-     {-curr-}PlainInh ->+     {-curr-}PlainInh d ->      {-curr-}PlainState d ->      {-ok-}( ({-prepend-}(d->d), {-new-}PlainState d) -> PlainFit d) ->      PlainFit d      -- NOTE: equivalent to:      -- ReaderT PlainInh (StateT (PlainState d) (Cont (PlainFit d))) (d->d)  }-instance (Show d, Monoid d) => Show (Plain d) where+instance (Show d, Spaceable d) => Show (Plain d) where 	show = show . runPlain -runPlain :: Monoid d => Plain d -> d+runPlain :: Spaceable d => Plain d -> d runPlain x = 	unPlain x 	 defPlainInh@@ -63,31 +64,34 @@    -- must be written.  , plainState_bufferWidth     :: !Width    -- ^ The 'Width' of the 'plainState_buffer' so far.- , plainState_removableIndent :: !Indent+ , plainState_breakIndent :: !Indent    -- ^ The amount of 'Indent' added by 'breakspace'-   -- that can be removed by breaking the 'space' into a 'newlineJustifying'.+   -- that can be reached by breaking the 'space'+   -- into a 'newlineJustifyingPlain'.  } deriving (Show)  defPlainState :: PlainState d defPlainState = PlainState- { plainState_buffer          = mempty- , plainState_bufferStart     = 0- , plainState_bufferWidth     = 0- , plainState_removableIndent = 0+ { plainState_buffer      = mempty+ , plainState_bufferStart = 0+ , plainState_bufferWidth = 0+ , plainState_breakIndent = 0  }  -- ** Type 'PlainInh'-data PlainInh = PlainInh- { plainInh_width   :: !(Maybe Column)- , plainInh_justify :: !Bool- , plainInh_indent  :: !Width- } deriving (Show)+data PlainInh d = PlainInh+ { plainInh_width     :: !(Maybe Column)+ , plainInh_justify   :: !Bool+ , plainInh_indent    :: !Indent+ , plainInh_indenting :: !(Plain d)+ } -defPlainInh :: PlainInh+defPlainInh :: Spaceable d => PlainInh d defPlainInh = PlainInh- { plainInh_width   = Nothing- , plainInh_justify = False- , plainInh_indent  = 0+ { plainInh_width     = Nothing+ , plainInh_justify   = False+ , plainInh_indent    = 0+ , plainInh_indenting = mempty  }  -- ** Type 'PlainFit'@@ -101,11 +105,11 @@  -- ** Type 'PlainChunk' data PlainChunk d- =   PlainChunk_Ignored d+ =   PlainChunk_Ignored !d      -- ^ Ignored by the justification but kept in place.      -- Used for instance to put ANSI sequences.- |   PlainChunk_Word (Word d)- |   PlainChunk_Spaces Width+ |   PlainChunk_Word !(Word d)+ |   PlainChunk_Spaces !Width      -- ^ 'spaces' preserved to be interleaved      -- correctly with 'PlainChunk_Ignored'. instance Show d => Show (PlainChunk d) where@@ -148,35 +152,57 @@ 	mempty = Plain $ \_inh st k -> k (id,st) 	mappend = (<>) instance Spaceable d => Spaceable (Plain d) where-	-- | The default 'newline' does not justify-	-- 'plainState_buffer', for that use 'newlineJustifying'.-	newline = Plain $ \inh st k ->-		k(\next ->-			(if plainInh_justify inh-				then joinPlainLine $ List.reverse $ plainState_buffer st-				else mempty) <>-			newline<>spaces (plainInh_indent inh)<>next-		 , st-			 { plainState_bufferStart = plainInh_indent inh+	-- | The default 'newline' does not justify 'plainState_buffer',+	-- for that use 'newlineJustifyingPlain'.+	newline = Plain $ \inh st ->+		unPlain+		 (  newlinePlain+		 <> indentPlain+		 <> propagatePlain (plainState_breakIndent st)+		 <> flushlinePlain+		 ) inh st+		where+		indentPlain = Plain $ \inh ->+			unPlain+			 (plainInh_indenting inh)+			 inh{plainInh_justify=False}+		newlinePlain = Plain $ \inh st k ->+			k (\next ->+				(if plainInh_justify inh+					then joinLinePlainChunk $ List.reverse $ plainState_buffer st+					else mempty+				)<>newline<>next+			 , st+			 { plainState_bufferStart = 0 			 , plainState_bufferWidth = 0 			 , plainState_buffer      = mempty-			 }-		 )+			 })+		propagatePlain breakIndent = Plain $ \inh st1 k fits overflow ->+			k (id,st1)+			 fits+			 {-overflow-}(+				-- NOTE: the text after this newline overflows,+				-- so propagate the overflow before this 'newline',+				-- if and only if there is a 'breakspace' before this 'newline'+				-- whose replacement by a 'newline' indents to a lower indent+				-- than this 'newline''s indent.+				-- Otherwise there is no point in propagating the overflow.+				if breakIndent < plainInh_indent inh+				then overflow+				else fits+			 ) 	space = spaces 1 	spaces n = Plain $ \inh st@PlainState{..} k fits overflow -> 		let newWidth = plainState_bufferStart + plainState_bufferWidth + n in 		if plainInh_justify inh 		then-			let newState =-				case plainState_buffer of-				 PlainChunk_Spaces s:bs -> st-					 { plainState_buffer      = PlainChunk_Spaces (s+n):bs-					 }-				 _ -> st-					 { plainState_buffer      = PlainChunk_Spaces n:plainState_buffer-					 , plainState_bufferWidth = plainState_bufferWidth + 1-					 }-			in+			let newState = st+				 { plainState_buffer =+					case plainState_buffer of+					 PlainChunk_Spaces s:buf -> PlainChunk_Spaces (s+n):buf+					 buf -> PlainChunk_Spaces n:buf+				 , plainState_bufferWidth = plainState_bufferWidth + n+				 } in 			case plainInh_width inh of 			 Just maxWidth | maxWidth < newWidth -> 				overflow $ k (id{-(d<>)-}, newState) fits overflow@@ -227,59 +253,70 @@ 		words . 		unLine instance Spaceable d => Indentable (Plain d) where-	align p = (flushLine <>) $ Plain $ \inh st ->-		let currInd = plainState_bufferStart st + plainState_bufferWidth st in-		unPlain p inh{plainInh_indent=currInd} st-	incrIndent i p = Plain $ \inh ->-		unPlain p inh{plainInh_indent = plainInh_indent inh + i}-	setIndent i p = Plain $ \inh ->-		unPlain p inh{plainInh_indent=i}+	align p = (flushlinePlain <>) $ Plain $ \inh st ->+		let col = plainState_bufferStart st + plainState_bufferWidth st in+		unPlain p inh+		 { plainInh_indent    = col+		 , plainInh_indenting =+			if plainInh_indent inh <= col+			then+				plainInh_indenting inh <>+				spaces (col`minusNatural`plainInh_indent inh)+			else spaces col+		 } st+	setIndent d i p = Plain $ \inh ->+		unPlain p inh+		 { plainInh_indent    = i+		 , plainInh_indenting = d+		 }+	incrIndent d i p = Plain $ \inh ->+		unPlain p inh+		 { plainInh_indent    = plainInh_indent inh + i+		 , plainInh_indenting = plainInh_indenting inh <> d+		 }+	 	fill m p = Plain $ \inh0 st0 ->-		let col0 = plainState_bufferStart st0 + plainState_bufferWidth st0 in+		let maxCol = plainState_bufferStart st0 + plainState_bufferWidth st0 + m in 		let p1 = Plain $ \inh1 st1 ->-			let col1 = plainState_bufferStart st1 + plainState_bufferWidth st1 in-			let w | col0 <= col1 = col1`minusNatural`col0-			      | otherwise    = col0`minusNatural`col1 in+			let col = plainState_bufferStart st1 + plainState_bufferWidth st1 in 			unPlain-			 (if w<=m-				then spaces (m`minusNatural`w)+			 (if col <= maxCol+				then spaces (maxCol`minusNatural`col) 				else mempty) 			 inh1 st1 		in 		unPlain (p <> p1) inh0 st0-	breakfill m p = Plain $ \inh0 st0 ->-		let col0 = plainState_bufferStart st0 + plainState_bufferWidth st0 in+	fillOrBreak m p = Plain $ \inh0 st0 ->+		let maxCol = plainState_bufferStart st0 + plainState_bufferWidth st0 + m in 		let p1 = Plain $ \inh1 st1 ->-			let col1 = plainState_bufferStart st1 + plainState_bufferWidth st1 in-			let w | col0 <= col1 = col1`minusNatural`col0-			      | otherwise    = col0`minusNatural`col1 in+			let col = plainState_bufferStart st1 + plainState_bufferWidth st1 in 			unPlain-			 (case w`compare`m of-				 LT -> spaces (m`minusNatural`w)+			 (case col`compare`maxCol of+				 LT -> spaces (maxCol`minusNatural`col) 				 EQ -> mempty-				 GT -> setIndent (col0 + m) newline)-			 inh1 st1+				 GT -> incrIndent (spaces m) m newline+			 ) inh1 st1 		in 		unPlain (p <> p1) inh0 st0 instance (Spaceable d, From (Word Char) d, From (Word String) d) => Listable (Plain d) where 	ul ds = 		catV $ 			(<$> ds) $ \d ->-				from (Word '-')<>space<>flushLine<>align d<>flushLine+				from (Word '-')<>space<>flushlinePlain<>align d<>flushlinePlain 	ol ds = 		catV $ snd $ 			Fold.foldr 			 (\d (i, acc) ->-				(pred i, (from i<>from (Word '.')<>space<>flushLine<>align d<>flushLine) : acc)+				(pred i, (from i<>from (Word '.')<>space<>flushlinePlain<>align d<>flushlinePlain) : acc) 			 ) (Fold.length ds, []) ds instance Spaceable d => Justifiable (Plain d) where-	justify p = (\x -> flushLine <> x <> flushLine) $ Plain $ \inh ->+	justify p = (\x -> flushlinePlain <> x <> flushlinePlain) $ Plain $ \inh -> 		unPlain p inh{plainInh_justify=True}  -- | Commit 'plainState_buffer' upto there, so that it won't be justified.-flushLine :: Spaceable d => Plain d-flushLine = Plain $ \_inh st k ->-	k( (joinPlainLine (collapseSpaces <$> List.reverse (plainState_buffer st)) <>)+flushlinePlain :: Spaceable d => Plain d+flushlinePlain = Plain $ \_inh st k ->+	k( (joinLinePlainChunk (collapsePlainChunkSpaces <$> List.reverse (plainState_buffer st)) <>) 	 , st 		 { plainState_bufferStart = plainState_bufferStart st + plainState_bufferWidth st 		 , plainState_bufferWidth = 0@@ -287,8 +324,8 @@ 		 } 	 ) -collapseSpaces :: PlainChunk d -> PlainChunk d-collapseSpaces = \case+collapsePlainChunkSpaces :: PlainChunk d -> PlainChunk d+collapsePlainChunkSpaces = \case  PlainChunk_Spaces s -> PlainChunk_Spaces (if s > 0 then 1 else 0)  x -> x @@ -296,27 +333,11 @@ 	setWidth w p = Plain $ \inh -> 		unPlain p inh{plainInh_width=w} 	breakpoint = Plain $ \inh st k fits overflow ->-		let newlineInd = plainInh_indent inh in-		k-		 ( id-		 , st-			 { plainState_removableIndent = newlineInd-			 }-		 )+		k(id, st {plainState_breakIndent = plainInh_indent inh}) 		 fits-		 {-overflow-}(\_r ->-			unPlain newlineJustifying inh st k-			 fits-			 {-overflow-}(-				if plainState_removableIndent st < newlineInd-				then overflow-				else fits-			 )-		 )+		 {-overflow-}(\_r -> unPlain newlineJustifyingPlain inh st k fits overflow) 	breakspace = Plain $ \inh st k fits overflow ->-		let newlineInd = plainInh_indent inh in-		k-		 ( if plainInh_justify inh then id else (space <>)+		k( if plainInh_justify inh then id else (space <>) 		 , st 			 { plainState_buffer = 				if plainInh_justify inh@@ -324,38 +345,72 @@ 					 PlainChunk_Spaces s:bs -> PlainChunk_Spaces (s+1):bs 					 bs -> PlainChunk_Spaces 1:bs 				else plainState_buffer st-			 , plainState_bufferWidth      = plainState_bufferWidth st + 1-			 , plainState_removableIndent  = newlineInd+			 , plainState_bufferWidth = plainState_bufferWidth st + 1+			 , plainState_breakIndent = plainInh_indent inh 			 } 		 ) 		 fits-		 {-overflow-}(\_r ->-			unPlain newlineJustifying inh st k-			 fits-			 {-overflow-}(-				if plainState_removableIndent st < newlineInd-				then overflow-				else fits-			 )-		 )+		 {-overflow-}(\_r -> unPlain newlineJustifyingPlain inh st k fits overflow) 	breakalt x y = Plain $ \inh st k fits overflow ->-		unPlain x inh st k fits-		 {-overflow-}(\_r ->-			unPlain y inh st k fits overflow-		 )+		-- NOTE: breakalt must be y if and only if x does not fit,+		-- hence the use of dummyK to limit the test+		-- to overflows raised within x, and drop those raised after x.+		unPlain x inh st dummyK+		 {-fits-}    (\_r -> unPlain x inh st k fits overflow)+		 {-overflow-}(\_r -> unPlain y inh st k fits overflow)+		where+		dummyK (px,_sx) fits _overflow =+			-- NOTE: if px fits, then appending mempty fits+			fits (px mempty)+	endline = Plain $ \inh st k fits _overflow ->+		let col = plainState_bufferStart st + plainState_bufferWidth st in+		case plainInh_width inh >>= (`minusNaturalMaybe` col) of+		 Nothing -> k (id, st) fits fits+		 Just w ->+			let newState = st+				 { plainState_bufferWidth = plainState_bufferWidth st + w+				 } in+			k (id,newState) fits fits  -- | Like 'newline', but justify 'plainState_buffer' before.-newlineJustifying :: Spaceable d => Plain d-newlineJustifying = Plain $ \inh st k ->-	k(\next ->-		(if plainInh_justify inh then joinLine inh st else mempty) <>-		newline<>spaces (plainInh_indent inh)<>next-	 , st-		 { plainState_bufferStart = plainInh_indent inh+newlineJustifyingPlain :: Spaceable d => Plain d+newlineJustifyingPlain = Plain $ \inh st ->+	unPlain+	 (  newlinePlain+	 <> indentPlain+	 <> propagatePlain (plainState_breakIndent st)+	 <> flushlinePlain+	 ) inh st+	where+	indentPlain = Plain $ \inh ->+		unPlain+		 (plainInh_indenting inh)+		 inh{plainInh_justify=False}+	newlinePlain = Plain $ \inh st k ->+		k (\next ->+			(if plainInh_justify inh+				then justifyLinePlain inh st+				else mempty+			)<>newline<>next+		 , st+		 { plainState_bufferStart = 0 		 , plainState_bufferWidth = 0 		 , plainState_buffer      = mempty-		 }-	 )+		 })+	propagatePlain breakIndent = Plain $ \inh st1 k fits overflow ->+		k (id,st1)+		 fits+		 {-overflow-}(+			-- NOTE: the text after this newline overflows,+			-- so propagate the overflow before this 'newline',+			-- if and only if there is a 'breakspace' before this 'newline'+			-- whose replacement by a 'newline' indents to a lower indent+			-- than this 'newline''s indent.+			-- Otherwise there is no point in propagating the overflow.+			if breakIndent < plainInh_indent inh+			then overflow+			else fits+		 )  -- String instance (From (Word String) d, Spaceable d) =>@@ -390,23 +445,22 @@ 	from '\n' = newline 	from c    = from (Word c) - instance (From [SGR] d, Semigroup d) => From [SGR] (Plain d) where 	from sgr = Plain $ \inh st k -> 		if plainInh_justify inh 		then k (id, st {plainState_buffer = PlainChunk_Ignored (from sgr) : plainState_buffer st}) 		else k ((from sgr <>), st) -joinLine ::+justifyLinePlain ::  Spaceable d =>- PlainInh -> PlainState d -> d-joinLine PlainInh{..} PlainState{..} =-	case plainInh_width of-	 Nothing -> joinPlainLine $ List.reverse plainState_buffer+ PlainInh d -> PlainState d -> d+justifyLinePlain inh PlainState{..} =+	case plainInh_width inh of+	 Nothing -> joinLinePlainChunk $ List.reverse plainState_buffer 	 Just maxWidth -> 		if maxWidth < plainState_bufferStart-		|| maxWidth < plainInh_indent-		then joinPlainLine $ List.reverse plainState_buffer+		|| maxWidth < plainInh_indent inh+		then joinLinePlainChunk $ List.reverse plainState_buffer 		else 			let superfluousSpaces = Fold.foldr 				 (\c acc ->@@ -426,14 +480,14 @@ 				max minBufferWidth $ 					maxWidth`minusNatural`plainState_bufferStart 			in-			let wordCount = countWords plainState_buffer in-			unLine $ padPlainLineInits justifyWidth $+			let wordCount = countWordsPlain plainState_buffer in+			unLine $ padLinePlainChunkInits justifyWidth $ 			 (minBufferWidth,wordCount,List.reverse plainState_buffer) --- | @('countWords' ps)@ returns the number of words in @(ps)@+-- | @('countWordsPlain' ps)@ returns the number of words in @(ps)@ -- clearly separated by spaces.-countWords :: [PlainChunk d] -> Natural-countWords = go False 0+countWordsPlain :: [PlainChunk d] -> Natural+countWordsPlain = go False 0  where 	go inWord acc = \case 	 [] -> acc@@ -470,10 +524,10 @@ 	go rr 0   = List.replicate (fromIntegral rr) (q+1) -- when min (b-r) r == r 	go rr bmr = q:(q+1) : go (rr`minusNatural`1) (bmr`minusNatural`1) -padPlainLineInits ::+padLinePlainChunkInits ::  Spaceable d =>  Width -> (Natural, Natural, [PlainChunk d]) -> Line d-padPlainLineInits maxWidth (lineWidth,wordCount,line) = Line $+padLinePlainChunkInits maxWidth (lineWidth,wordCount,line) = Line $ 	if maxWidth <= lineWidth 		-- The gathered line reached or overreached the maxWidth, 		-- hence no padding id needed.@@ -481,19 +535,19 @@ 		-- The case maxWidth <= lineWidth && wordCount == 1 		-- can happen if first word's length is < maxWidth 		-- but second word's len is >= maxWidth.-	then joinPlainLine line+	then joinLinePlainChunk line 	else 		-- Share the missing spaces as evenly as possible 		-- between the words of the line.-		padPlainLine line $ justifyPadding (maxWidth-lineWidth) (wordCount-1)+		padLinePlainChunk line $ justifyPadding (maxWidth-lineWidth) (wordCount-1)  -- | Just concat 'PlainChunk's with no justification.-joinPlainLine :: Monoid d => Spaceable d => [PlainChunk d] -> d-joinPlainLine = mconcat . (runPlainChunk <$>)+joinLinePlainChunk :: Monoid d => Spaceable d => [PlainChunk d] -> d+joinLinePlainChunk = mconcat . (runPlainChunk <$>)  -- | Interleave 'PlainChunk's with 'Width's from 'justifyPadding'.-padPlainLine :: Spaceable d => [PlainChunk d] -> [Width] -> d-padPlainLine = go+padLinePlainChunk :: Spaceable d => [PlainChunk d] -> [Width] -> d+padLinePlainChunk = go 	where 	go (w:ws) lls@(l:ls) = 		case w of
symantic-document.cabal view
@@ -2,7 +2,7 @@ -- PVP:  +-+------- breaking API changes --       | | +----- non-breaking API additions --       | | | +--- code changes with no API change-version: 1.2.3.20190628+version: 1.4.0.20190710 category: Text synopsis: Document symantics. description: Symantics for generating documents.
test/HUnit.hs view
@@ -75,17 +75,17 @@                  , ("abcdefghi","Doc") ])    ==> "let abcdef :: Doc\n    abcde  :: Int -> Doc -> Doc\n    abcdefghi :: Doc"  , "let " <> align (catV $-             (\(name, typ) -> breakfill 6 name <> " ::" <+> typ)+             (\(name, typ) -> fillOrBreak 6 name <> " ::" <+> typ)              <$> [ ("abcdef","Doc")                  , ("abcde","Int -> Doc -> Doc")                  , ("abcdefghi","Doc") ])    ==> "let abcdef :: Doc\n    abcde  :: Int -> Doc -> Doc\n    abcdefghi\n           :: Doc"  , "let " <> align (catV $-             (\(name, typ) -> breakfill 6 name <> " ::" <+> typ)+             (\(name, typ) -> fillOrBreak 6 name <> " ::" <+> typ)              <$> [("abcdefghi","Doc ->\nDoc")])    ==> "let abcdefghi\n           :: Doc ->\n    Doc"  , "let " <> align (catV $-             (\(name, typ) -> breakfill 6 name <> align (" ::" <+> typ))+             (\(name, typ) -> fillOrBreak 6 name <> align (" ::" <+> typ))              <$> [("abcdefghi","Doc ->\nDoc")])    ==> "let abcdefghi\n           :: Doc ->\n          Doc"  , 10 `maxWidth` "1 2 3 4 5 6 7 8 9 10 11 12 13 14 15" ==> "1 2 3 4 5\n6 7 8 9 10\n11 12 13\n14 15"@@ -171,6 +171,26 @@        \      5  6\n\        \      7  8\n\        \      9"+ -- endline breakspaces+ , 10 `maxWidth` ("a"<>endline<>" b") ==> "a\nb"+ -- endline does no justify+ , 10 `maxWidth` justify ("a b"<>endline<>" c") ==> "a b\nc"+ -- endline works overflowed+ , 10 `maxWidth` justify ("abcdefghijk"<>endline<>" a") ==> "abcdefghijk\na"+ -- endline prints no nothing+ , 10 `maxWidth` justify ("12345678"<>endline<>"90ab"<>align (" cdefghijk cdefghijk"))+   ==> "1234567890ab\n\+       \              cdefghijk\n\+       \              cdefghijk"+ -- newline stops overflow+ , 10 `maxWidth` breakalt "fits" "over"<>"\n"<>"12345678901"+   ==> "fits\n\+       \12345678901"+ -- breakalt triggers only if its first argument overflows,+ -- not if what's next overflows.+ , 10 `maxWidth` spaces 2<>align(breakalt "fits" "over"<>newline<>"12345678901")+   ==> "  fits\n\+       \  12345678901"  -- breakspace backtracking is bounded by the removable indentation  -- (hence it can actually wrap a few words in reasonable time).  , 80 `maxWidth`@@ -319,5 +339,5 @@ 		 <> newline <> "]")  fun :: IsString d => Indentable d => Wrappable d => d -> d-fun d = "function(" <> incrIndent 2 (breakalt d (newline<>d<>newline)) <> ")"+fun d = "function(" <> incrIndent (spaces 2) 2 (breakalt d (newline<>d<>newline)) <> ")"