diff options
| author | John MacFarlane <jgm@berkeley.edu> | 2018-01-19 21:25:24 -0800 |
|---|---|---|
| committer | John MacFarlane <jgm@berkeley.edu> | 2018-01-19 21:25:24 -0800 |
| commit | b8ffd834cff717fe424f22e506351f2ecec4655a (patch) | |
| tree | 70359c33066bebf2ec4c54c1c2d78f38b49c0fb8 /src/Text/Pandoc/Readers/Odt | |
| parent | 8b3707de0402165b5691f626370203fa8982a5dc (diff) | |
| download | pandoc-b8ffd834cff717fe424f22e506351f2ecec4655a.tar.gz | |
hlint code improvements.
Diffstat (limited to 'src/Text/Pandoc/Readers/Odt')
| -rw-r--r-- | src/Text/Pandoc/Readers/Odt/Arrows/Utils.hs | 4 | ||||
| -rw-r--r-- | src/Text/Pandoc/Readers/Odt/ContentReader.hs | 19 | ||||
| -rw-r--r-- | src/Text/Pandoc/Readers/Odt/Namespaces.hs | 2 | ||||
| -rw-r--r-- | src/Text/Pandoc/Readers/Odt/StyleReader.hs | 43 |
4 files changed, 32 insertions, 36 deletions
diff --git a/src/Text/Pandoc/Readers/Odt/Arrows/Utils.hs b/src/Text/Pandoc/Readers/Odt/Arrows/Utils.hs index cdfa8f8df..ef8b2d18a 100644 --- a/src/Text/Pandoc/Readers/Odt/Arrows/Utils.hs +++ b/src/Text/Pandoc/Readers/Odt/Arrows/Utils.hs @@ -211,9 +211,9 @@ a ^>>?% f = arr a >>?^ (uncurry f) --- (>>?%?) :: (ArrowChoice a) => FallibleArrow a x f (b,b') - -> (b -> b' -> (Either f c)) + -> (b -> b' -> Either f c) -> FallibleArrow a x f c -a >>?%? f = a >>?^? (uncurry f) +a >>?%? f = a >>?^? uncurry f infixr 1 >>?, >>?^, >>?^? infixr 1 ^>>?, >>?! diff --git a/src/Text/Pandoc/Readers/Odt/ContentReader.hs b/src/Text/Pandoc/Readers/Odt/ContentReader.hs index cc9b798b3..380f16c66 100644 --- a/src/Text/Pandoc/Readers/Odt/ContentReader.hs +++ b/src/Text/Pandoc/Readers/Odt/ContentReader.hs @@ -322,7 +322,7 @@ type InlineModifier = Inlines -> Inlines modifierFromStyleDiff :: PropertyTriple -> InlineModifier modifierFromStyleDiff propertyTriple = composition $ - (getVPosModifier propertyTriple) + getVPosModifier propertyTriple : map (first ($ propertyTriple) >>> ifThen_else ignore) [ (hasEmphChanged , emph ) , (hasChanged isStrong , strong ) @@ -352,7 +352,7 @@ modifierFromStyleDiff propertyTriple = ] hasChanged property triple@(_, property -> newProperty, _) = - maybe True (/=newProperty) (lookupPreviousValue property triple) + (/= Just newProperty) (lookupPreviousValue property triple) hasChangedM property triple@(_, textProps,_) = fromMaybe False $ (/=) <$> property textProps <*> lookupPreviousValueM property triple @@ -362,7 +362,7 @@ modifierFromStyleDiff propertyTriple = lookupPreviousValueM f = lookupPreviousStyleValue ((f =<<).textProperties) lookupPreviousStyleValue f (ReaderState{..},_,mFamily) - = ( findBy f $ extendedStylePropertyChain styleTrace styleSet ) + = findBy f (extendedStylePropertyChain styleTrace styleSet) <|> ( f =<< fmap (lookupDefaultStyle' styleSet) mFamily ) @@ -793,8 +793,7 @@ read_image_src = matchingElement NsDraw "image" Left _ -> returnV "" -< () read_frame_title :: InlineMatcher -read_frame_title = matchingElement NsSVG "title" - $ (matchChildContent [] read_plain_text) +read_frame_title = matchingElement NsSVG "title" (matchChildContent [] read_plain_text) read_frame_text_box :: InlineMatcher read_frame_text_box = matchingElement NsDraw "text-box" @@ -803,12 +802,12 @@ read_frame_text_box = matchingElement NsDraw "text-box" arr read_img_with_caption -< toList paragraphs read_img_with_caption :: [Block] -> Inlines -read_img_with_caption ((Para [Image attr alt (src,title)]) : _) = +read_img_with_caption (Para [Image attr alt (src,title)] : _) = singleton (Image attr alt (src, 'f':'i':'g':':':title)) -- no text, default caption read_img_with_caption (Para (Image attr _ (src,title) : txt) : _) = singleton (Image attr txt (src, 'f':'i':'g':':':title) ) -- override caption with the text that follows -read_img_with_caption ( (Para (_ : xs)) : ys) = - read_img_with_caption ((Para xs) : ys) +read_img_with_caption ( Para (_ : xs) : ys) = + read_img_with_caption (Para xs : ys) read_img_with_caption _ = mempty @@ -909,8 +908,8 @@ post_process (Pandoc m blocks) = Pandoc m (post_process' blocks) post_process' :: [Block] -> [Block] -post_process' ((Table _ a w h r) : (Div ("", ["caption"], _) [Para inlines] ) : xs) = - (Table inlines a w h r) : ( post_process' xs ) +post_process' (Table _ a w h r : Div ("", ["caption"], _) [Para inlines] : xs) = + Table inlines a w h r : post_process' xs post_process' bs = bs read_body :: OdtReader _x (Pandoc, MediaBag) diff --git a/src/Text/Pandoc/Readers/Odt/Namespaces.hs b/src/Text/Pandoc/Readers/Odt/Namespaces.hs index 3c11aeb8e..92e12931d 100644 --- a/src/Text/Pandoc/Readers/Odt/Namespaces.hs +++ b/src/Text/Pandoc/Readers/Odt/Namespaces.hs @@ -48,7 +48,7 @@ instance NameSpaceID Namespace where findID :: NameSpaceIRI -> Maybe Namespace -findID iri = listToMaybe [nsID | (iri',~nsID) <- nsIDs, iri' `isPrefixOf` iri] +findID iri = listToMaybe [nsID | (iri',nsID) <- nsIDs, iri' `isPrefixOf` iri] nsIDmap :: NameSpaceIRIs Namespace nsIDmap = foldr (uncurry $ flip M.insert) M.empty nsIDs 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 |