From 48cef91d1819387e4f81d0e0c4346d3b156c1101 Mon Sep 17 00:00:00 2001 From: Nikolay Yakimov Date: Tue, 7 Jul 2020 09:04:38 +0300 Subject: [Docx Reader] Refactor/update smushInlines --- src/Text/Pandoc/Readers/Docx/Combine.hs | 76 ++++++++++++++------------------- 1 file changed, 32 insertions(+), 44 deletions(-) (limited to 'src/Text') diff --git a/src/Text/Pandoc/Readers/Docx/Combine.hs b/src/Text/Pandoc/Readers/Docx/Combine.hs index 54736cd0e..7abb4ae23 100644 --- a/src/Text/Pandoc/Readers/Docx/Combine.hs +++ b/src/Text/Pandoc/Readers/Docx/Combine.hs @@ -4,7 +4,8 @@ {- | Module : Text.Pandoc.Readers.Docx.Combine Copyright : © 2014-2020 Jesse Rosenthal , - 2014-2020 John MacFarlane + 2014-2020 John MacFarlane , + 2020 Nikolay Yakimov License : GNU GPL, version 2 or above Maintainer : Jesse Rosenthal @@ -59,7 +60,9 @@ module Text.Pandoc.Readers.Docx.Combine ( smushInlines where import Data.List -import Data.Sequence (ViewL (..), ViewR (..), viewl, viewr, (><), (|>)) +import Data.Bifunctor +import Data.Sequence ( ViewL (..), ViewR (..), viewl, viewr, spanr, spanl + , (><), (|>) ) import qualified Data.Sequence as Seq (null) import Text.Pandoc.Builder @@ -80,14 +83,14 @@ spaceOutInlinesR ms = (stackInlines fs (l <> m'), r) spaceOutInlines :: Inlines -> (Inlines, Inlines, Inlines) spaceOutInlines ils = let (fs, ils') = unstackInlines ils - contents = unMany ils' - left = case viewl contents of - (Space :< _) -> space - _ -> mempty - right = case viewr contents of - (_ :> Space) -> space - _ -> mempty in - (left, stackInlines fs $ trimInlines . Many $ contents, right) + (left, (right, contents')) = second (spanr isSpace) $ spanl isSpace $ unMany ils' + -- NOTE: spanr counterintuitively returns suffix as the FIRST tuple element + in (Many left, stackInlines fs $ Many contents', Many right) + +isSpace :: Inline -> Bool +isSpace Space = True +isSpace SoftBreak = True +isSpace _ = False stackInlines :: [Modifier Inlines] -> Inlines -> Inlines stackInlines [] ms = ms @@ -99,39 +102,24 @@ stackInlines (Modifier f : fs) ms = stackInlines (AttrModifier f attr : fs) ms = f attr $ stackInlines fs ms unstackInlines :: Inlines -> ([Modifier Inlines], Inlines) -unstackInlines ms = case ilModifier ms of - NullModifier -> ([], ms) - _ -> (f : fs, ms') where - f = ilModifier ms - (fs, ms') = unstackInlines $ ilInnards ms - -ilModifier :: Inlines -> Modifier Inlines -ilModifier ils = case viewl (unMany ils) of - (x :< xs) | Seq.null xs -> case x of - (Emph _) -> Modifier emph - (Strong _) -> Modifier strong - (SmallCaps _) -> Modifier smallcaps - (Strikeout _) -> Modifier strikeout - (Superscript _) -> Modifier superscript - (Subscript _) -> Modifier subscript - (Link attr _ tgt) -> Modifier $ linkWith attr (fst tgt) (snd tgt) - (Span attr _) -> AttrModifier spanWith attr - _ -> NullModifier - _ -> NullModifier - -ilInnards :: Inlines -> Inlines -ilInnards ils = case viewl (unMany ils) of - (x :< xs) | Seq.null xs -> case x of - (Emph lst) -> fromList lst - (Strong lst) -> fromList lst - (SmallCaps lst) -> fromList lst - (Strikeout lst) -> fromList lst - (Superscript lst) -> fromList lst - (Subscript lst) -> fromList lst - (Link _ lst _) -> fromList lst - (Span _ lst) -> fromList lst - _ -> ils - _ -> ils +unstackInlines ms = case ilModifierAndInnards ms of + (NullModifier, _) -> ([], ms) + (f, innards ) -> first (f :) $ unstackInlines innards + +ilModifierAndInnards :: Inlines -> (Modifier Inlines, Inlines) +ilModifierAndInnards ils = case viewl $ unMany ils of + x :< xs | Seq.null xs -> case x of + Emph lst -> (Modifier emph, fromList lst) + Strong lst -> (Modifier strong, fromList lst) + SmallCaps lst -> (Modifier smallcaps, fromList lst) + Strikeout lst -> (Modifier strikeout, fromList lst) + Underline lst -> (Modifier underline, fromList lst) + Superscript lst -> (Modifier superscript, fromList lst) + Subscript lst -> (Modifier subscript, fromList lst) + Link attr lst tgt -> (Modifier $ linkWith attr (fst tgt) (snd tgt), fromList lst) + Span attr lst -> (AttrModifier spanWith attr, fromList lst) + _ -> (NullModifier, ils) + _ -> (NullModifier, ils) inlinesL :: Inlines -> (Inlines, Inlines) inlinesL ils = case viewl $ unMany ils of @@ -162,7 +150,7 @@ combineSingletonInlines x y = in case null shared of True | isEmpty xs && isEmpty ys -> - stackInlines (x_rem_attr ++ y_rem_attr) mempty + stackInlines (x_rem_attr <> y_rem_attr) mempty | isEmpty xs -> let (sp, y') = spaceOutInlinesL y in stackInlines x_rem_attr mempty <> sp <> y' -- cgit v1.2.3 From 27465638a16b2105e393ef49e3aeb5240cd80055 Mon Sep 17 00:00:00 2001 From: Nikolay Yakimov Date: Tue, 7 Jul 2020 11:32:17 +0300 Subject: [Docx Reader] Get rid of unused NullModifier in Readers.Docx.Combine --- src/Text/Pandoc/Readers/Docx/Combine.hs | 33 +++++++++++++++------------------ 1 file changed, 15 insertions(+), 18 deletions(-) (limited to 'src/Text') diff --git a/src/Text/Pandoc/Readers/Docx/Combine.hs b/src/Text/Pandoc/Readers/Docx/Combine.hs index 7abb4ae23..c095adc2b 100644 --- a/src/Text/Pandoc/Readers/Docx/Combine.hs +++ b/src/Text/Pandoc/Readers/Docx/Combine.hs @@ -68,7 +68,6 @@ import Text.Pandoc.Builder data Modifier a = Modifier (a -> a) | AttrModifier (Attr -> a -> a) Attr - | NullModifier spaceOutInlinesL :: Inlines -> (Inlines, Inlines) spaceOutInlinesL ms = (l, stackInlines fs (m' <> r)) @@ -94,7 +93,6 @@ isSpace _ = False stackInlines :: [Modifier Inlines] -> Inlines -> Inlines stackInlines [] ms = ms -stackInlines (NullModifier : fs) ms = stackInlines fs ms stackInlines (Modifier f : fs) ms = if isEmpty ms then stackInlines fs ms @@ -103,23 +101,23 @@ stackInlines (AttrModifier f attr : fs) ms = f attr $ stackInlines fs ms unstackInlines :: Inlines -> ([Modifier Inlines], Inlines) unstackInlines ms = case ilModifierAndInnards ms of - (NullModifier, _) -> ([], ms) - (f, innards ) -> first (f :) $ unstackInlines innards + Nothing -> ([], ms) + Just (f, inner) -> first (f :) $ unstackInlines inner -ilModifierAndInnards :: Inlines -> (Modifier Inlines, Inlines) +ilModifierAndInnards :: Inlines -> Maybe (Modifier Inlines, Inlines) ilModifierAndInnards ils = case viewl $ unMany ils of - x :< xs | Seq.null xs -> case x of - Emph lst -> (Modifier emph, fromList lst) - Strong lst -> (Modifier strong, fromList lst) - SmallCaps lst -> (Modifier smallcaps, fromList lst) - Strikeout lst -> (Modifier strikeout, fromList lst) - Underline lst -> (Modifier underline, fromList lst) - Superscript lst -> (Modifier superscript, fromList lst) - Subscript lst -> (Modifier subscript, fromList lst) - Link attr lst tgt -> (Modifier $ linkWith attr (fst tgt) (snd tgt), fromList lst) - Span attr lst -> (AttrModifier spanWith attr, fromList lst) - _ -> (NullModifier, ils) - _ -> (NullModifier, ils) + x :< xs | Seq.null xs -> second fromList <$> case x of + Emph lst -> Just (Modifier emph, lst) + Strong lst -> Just (Modifier strong, lst) + SmallCaps lst -> Just (Modifier smallcaps, lst) + Strikeout lst -> Just (Modifier strikeout, lst) + Underline lst -> Just (Modifier underline, lst) + Superscript lst -> Just (Modifier superscript, lst) + Subscript lst -> Just (Modifier subscript, lst) + Link attr lst tgt -> Just (Modifier $ linkWith attr (fst tgt) (snd tgt), lst) + Span attr lst -> Just (AttrModifier spanWith attr, lst) + _ -> Nothing + _ -> Nothing inlinesL :: Inlines -> (Inlines, Inlines) inlinesL ils = case viewl $ unMany ils of @@ -181,7 +179,6 @@ combineBlocks bs cs = bs <> cs instance (Monoid a, Eq a) => Eq (Modifier a) where (Modifier f) == (Modifier g) = f mempty == g mempty (AttrModifier f attr) == (AttrModifier g attr') = f attr mempty == g attr' mempty - NullModifier == NullModifier = True _ == _ = False isEmpty :: (Monoid a, Eq a) => a -> Bool -- cgit v1.2.3 From 1ae4d76d42eb63ab71b7bd27301501f9cf683cf4 Mon Sep 17 00:00:00 2001 From: Nikolay Yakimov Date: Tue, 7 Jul 2020 12:28:38 +0300 Subject: [Docx Reader] Remove no-op stack/unstackInlines in Readers.Docx.Combine --- src/Text/Pandoc/Readers/Docx/Combine.hs | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) (limited to 'src/Text') diff --git a/src/Text/Pandoc/Readers/Docx/Combine.hs b/src/Text/Pandoc/Readers/Docx/Combine.hs index c095adc2b..22541097c 100644 --- a/src/Text/Pandoc/Readers/Docx/Combine.hs +++ b/src/Text/Pandoc/Readers/Docx/Combine.hs @@ -71,20 +71,18 @@ data Modifier a = Modifier (a -> a) spaceOutInlinesL :: Inlines -> (Inlines, Inlines) spaceOutInlinesL ms = (l, stackInlines fs (m' <> r)) - where (l, m, r) = spaceOutInlines ms - (fs, m') = unstackInlines m + where (l, (fs, m'), r) = spaceOutInlines ms spaceOutInlinesR :: Inlines -> (Inlines, Inlines) spaceOutInlinesR ms = (stackInlines fs (l <> m'), r) - where (l, m, r) = spaceOutInlines ms - (fs, m') = unstackInlines m + where (l, (fs, m'), r) = spaceOutInlines ms -spaceOutInlines :: Inlines -> (Inlines, Inlines, Inlines) +spaceOutInlines :: Inlines -> (Inlines, ([Modifier Inlines], Inlines), Inlines) spaceOutInlines ils = let (fs, ils') = unstackInlines ils (left, (right, contents')) = second (spanr isSpace) $ spanl isSpace $ unMany ils' -- NOTE: spanr counterintuitively returns suffix as the FIRST tuple element - in (Many left, stackInlines fs $ Many contents', Many right) + in (Many left, (fs, Many contents'), Many right) isSpace :: Inline -> Bool isSpace Space = True -- cgit v1.2.3 From 5a1e1db5266f61300601c9511b053a55360d67fb Mon Sep 17 00:00:00 2001 From: Nikolay Yakimov Date: Tue, 7 Jul 2020 13:23:14 +0300 Subject: [Docx Reader] Remove unused LANGUAGE from Readers.Docx.Combine --- src/Text/Pandoc/Readers/Docx/Combine.hs | 2 -- 1 file changed, 2 deletions(-) (limited to 'src/Text') diff --git a/src/Text/Pandoc/Readers/Docx/Combine.hs b/src/Text/Pandoc/Readers/Docx/Combine.hs index 22541097c..f4748baa9 100644 --- a/src/Text/Pandoc/Readers/Docx/Combine.hs +++ b/src/Text/Pandoc/Readers/Docx/Combine.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE PatternGuards #-} {-# LANGUAGE OverloadedStrings #-} {- | Module : Text.Pandoc.Readers.Docx.Combine -- cgit v1.2.3 From f09e18753b999a0f29c3717889e68f68fa643cfe Mon Sep 17 00:00:00 2001 From: Nikolay Yakimov Date: Tue, 7 Jul 2020 13:37:38 +0300 Subject: [Docx Reader] Use null instead of isEmpty in Readers.Docx.Combine --- src/Text/Pandoc/Readers/Docx/Combine.hs | 14 +++++--------- 1 file changed, 5 insertions(+), 9 deletions(-) (limited to 'src/Text') diff --git a/src/Text/Pandoc/Readers/Docx/Combine.hs b/src/Text/Pandoc/Readers/Docx/Combine.hs index f4748baa9..427a73dbe 100644 --- a/src/Text/Pandoc/Readers/Docx/Combine.hs +++ b/src/Text/Pandoc/Readers/Docx/Combine.hs @@ -61,7 +61,6 @@ import Data.List import Data.Bifunctor import Data.Sequence ( ViewL (..), ViewR (..), viewl, viewr, spanr, spanl , (><), (|>) ) -import qualified Data.Sequence as Seq (null) import Text.Pandoc.Builder data Modifier a = Modifier (a -> a) @@ -90,7 +89,7 @@ isSpace _ = False stackInlines :: [Modifier Inlines] -> Inlines -> Inlines stackInlines [] ms = ms stackInlines (Modifier f : fs) ms = - if isEmpty ms + if null ms then stackInlines fs ms else f $ stackInlines fs ms stackInlines (AttrModifier f attr : fs) ms = f attr $ stackInlines fs ms @@ -102,7 +101,7 @@ unstackInlines ms = case ilModifierAndInnards ms of ilModifierAndInnards :: Inlines -> Maybe (Modifier Inlines, Inlines) ilModifierAndInnards ils = case viewl $ unMany ils of - x :< xs | Seq.null xs -> second fromList <$> case x of + x :< xs | null xs -> second fromList <$> case x of Emph lst -> Just (Modifier emph, lst) Strong lst -> Just (Modifier strong, lst) SmallCaps lst -> Just (Modifier smallcaps, lst) @@ -143,12 +142,12 @@ combineSingletonInlines x y = y_rem_attr = filter isAttrModifier y_remaining in case null shared of - True | isEmpty xs && isEmpty ys -> + True | null xs && null ys -> stackInlines (x_rem_attr <> y_rem_attr) mempty - | isEmpty xs -> + | null xs -> let (sp, y') = spaceOutInlinesL y in stackInlines x_rem_attr mempty <> sp <> y' - | isEmpty ys -> + | null ys -> let (x', sp) = spaceOutInlinesR x in x' <> sp <> stackInlines y_rem_attr mempty | otherwise -> @@ -177,9 +176,6 @@ instance (Monoid a, Eq a) => Eq (Modifier a) where (AttrModifier f attr) == (AttrModifier g attr') = f attr mempty == g attr' mempty _ == _ = False -isEmpty :: (Monoid a, Eq a) => a -> Bool -isEmpty x = x == mempty - isAttrModifier :: Modifier a -> Bool isAttrModifier (AttrModifier _ _) = True isAttrModifier _ = False -- cgit v1.2.3