diff options
Diffstat (limited to 'src/Text/Pandoc/Readers/Odt/StyleReader.hs')
| -rw-r--r-- | src/Text/Pandoc/Readers/Odt/StyleReader.hs | 43 |
1 files changed, 20 insertions, 23 deletions
diff --git a/src/Text/Pandoc/Readers/Odt/StyleReader.hs b/src/Text/Pandoc/Readers/Odt/StyleReader.hs index 6129c1664..58be8e4a3 100644 --- a/src/Text/Pandoc/Readers/Odt/StyleReader.hs +++ b/src/Text/Pandoc/Readers/Odt/StyleReader.hs @@ -131,13 +131,12 @@ type StyleReaderSafe a b = XMLReaderSafe FontPitches a b -- | A reader for font pitches fontPitchReader :: XMLReader _s _x FontPitches fontPitchReader = executeIn NsOffice "font-face-decls" ( - ( withEveryL NsStyle "font-face" $ liftAsSuccess ( + withEveryL NsStyle "font-face" (liftAsSuccess ( findAttr' NsStyle "name" &&& lookupDefaultingAttr NsStyle "font-pitch" - ) - ) - >>?^ ( M.fromList . (foldl accumLegalPitches []) ) + )) + >>?^ ( M.fromList . foldl accumLegalPitches [] ) ) where accumLegalPitches ls (Nothing,_) = ls accumLegalPitches ls (Just n,p) = (n,p):ls @@ -383,11 +382,11 @@ data ListLevelStyle = ListLevelStyle { listLevelType :: ListLevelType instance Show ListLevelStyle where show ListLevelStyle{..} = "<LLS|" - ++ (show listLevelType) + ++ show listLevelType ++ "|" - ++ (maybeToString listItemPrefix) - ++ (show listItemFormat) - ++ (maybeToString listItemSuffix) + ++ maybeToString listItemPrefix + ++ show listItemFormat + ++ maybeToString listItemSuffix ++ ">" where maybeToString = fromMaybe "" @@ -483,14 +482,14 @@ readTextProperties = ( liftA6 PropT ( searchAttr NsXSL_FO "font-style" False isFontEmphasised ) ( searchAttr NsXSL_FO "font-weight" False isFontBold ) - ( findPitch ) + findPitch ( getAttr NsStyle "text-position" ) - ( readUnderlineMode ) - ( readStrikeThroughMode ) + readUnderlineMode + readStrikeThroughMode ) where isFontEmphasised = [("normal",False),("italic",True),("oblique",True)] isFontBold = ("normal",False):("bold",True) - :(map ((,True).show) ([100,200..900]::[Int])) + :map ((,True).show) ([100,200..900]::[Int]) readUnderlineMode :: StyleReaderSafe _x (Maybe UnderlineMode) readUnderlineMode = readLineMode "text-underline-mode" @@ -510,7 +509,7 @@ readLineMode modeAttr styleAttr = proc x -> do Nothing -> returnA -< Just UnderlineModeNormal else returnA -< Nothing where - isLinePresent = [("none",False)] ++ map (,True) + isLinePresent = ("none",False) : map (,True) [ "dash" , "dot-dash" , "dot-dot-dash" , "dotted" , "long-dash" , "solid" , "wave" ] @@ -547,20 +546,18 @@ readListStyle = findAttr NsStyle "name" >>?! keepingTheValue ( liftA ListStyle - $ ( liftA3 SM.union3 + $ liftA3 SM.union3 ( readListLevelStyles NsText "list-level-style-number" LltNumbered ) ( readListLevelStyles NsText "list-level-style-bullet" LltBullet ) - ( readListLevelStyles NsText "list-level-style-image" LltImage ) - ) >>^ M.mapMaybe chooseMostSpecificListLevelStyle + ( readListLevelStyles NsText "list-level-style-image" LltImage ) >>^ M.mapMaybe chooseMostSpecificListLevelStyle ) -- readListLevelStyles :: Namespace -> ElementName -> ListLevelType -> StyleReaderSafe _x (SM.SetMap Int ListLevelStyle) readListLevelStyles namespace elementName levelType = - ( tryAll namespace elementName (readListLevelStyle levelType) + tryAll namespace elementName (readListLevelStyle levelType) >>^ SM.fromList - ) -- readListLevelStyle :: ListLevelType -> StyleReader _x (Int, ListLevelStyle) @@ -632,7 +629,7 @@ parents style styles = unfoldr findNextParent style -- Ha! getStyleFamily :: Style -> Styles -> Maybe StyleFamily getStyleFamily style@Style{..} styles = styleFamily - <|> (F.asum $ map (`getStyleFamily` styles) $ parents style styles) + <|> F.asum (map (`getStyleFamily` styles) $ parents style styles) -- | Each 'Style' has certain 'StyleProperties'. But sometimes not all property -- values are specified. Instead, a value might be inherited from a @@ -654,7 +651,7 @@ stylePropertyChain style styles -- extendedStylePropertyChain :: [Style] -> Styles -> [StyleProperties] extendedStylePropertyChain [] _ = [] -extendedStylePropertyChain [style] styles = (stylePropertyChain style styles) - ++ (maybeToList (fmap (lookupDefaultStyle' styles) (getStyleFamily style styles))) -extendedStylePropertyChain (style:trace) styles = (stylePropertyChain style styles) - ++ (extendedStylePropertyChain trace styles) +extendedStylePropertyChain [style] styles = stylePropertyChain style styles + ++ maybeToList (fmap (lookupDefaultStyle' styles) (getStyleFamily style styles)) +extendedStylePropertyChain (style:trace) styles = stylePropertyChain style styles + ++ extendedStylePropertyChain trace styles |