From 5bb5cfc570c360ca872716fe0d51688771975c9f Mon Sep 17 00:00:00 2001 From: koral Date: Sat, 25 Jan 2025 17:44:51 +0100 Subject: [PATCH 1/2] ci: Run hlint --- .github/workflows/tests.yml | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/.github/workflows/tests.yml b/.github/workflows/tests.yml index eb5bc4b..d01cf09 100755 --- a/.github/workflows/tests.yml +++ b/.github/workflows/tests.yml @@ -48,10 +48,19 @@ jobs: enable-stack: true stack-version: 'latest' stack-no-global: true + + - name: 'Set up HLint' + uses: haskell-actions/hlint-setup@v2 + + - name: 'Run HLint' + uses: haskell-actions/hlint-run@v2 + with: + path: xml-conduit/src/ + # fail-on: warning + - name: Build and run tests shell: bash run: | set -ex - # stack upgrade --force-download stack --version stack test --fast --no-terminal --resolver=${{ matrix.resolver }} From 4baf20e3094a0ae77ac4889a6dc26e5d3e398733 Mon Sep 17 00:00:00 2001 From: koral Date: Sat, 25 Jan 2025 18:15:39 +0100 Subject: [PATCH 2/2] style: Fix hlint warnings --- xml-conduit/src/Text/XML.hs | 2 +- xml-conduit/src/Text/XML/Cursor.hs | 2 +- xml-conduit/src/Text/XML/Stream/Parse.hs | 2 +- xml-conduit/src/Text/XML/Stream/Render/Internal.hs | 2 +- xml-conduit/src/Text/XML/Stream/Token.hs | 8 ++++---- xml-conduit/src/Text/XML/Unresolved.hs | 2 +- 6 files changed, 9 insertions(+), 9 deletions(-) diff --git a/xml-conduit/src/Text/XML.hs b/xml-conduit/src/Text/XML.hs index a7ef5e9..eb574e8 100644 --- a/xml-conduit/src/Text/XML.hs +++ b/xml-conduit/src/Text/XML.hs @@ -272,7 +272,7 @@ fromEvents = do d <- D.fromEvents either (lift . throwM . UnresolvedEntityException) return $ fromXMLDocument d -data UnresolvedEntityException = UnresolvedEntityException (Set Text) +newtype UnresolvedEntityException = UnresolvedEntityException (Set Text) deriving (Show, Typeable) instance Exception UnresolvedEntityException diff --git a/xml-conduit/src/Text/XML/Cursor.hs b/xml-conduit/src/Text/XML/Cursor.hs index 035d450..f178bc0 100644 --- a/xml-conduit/src/Text/XML/Cursor.hs +++ b/xml-conduit/src/Text/XML/Cursor.hs @@ -195,7 +195,7 @@ laxAttribute n c = case node c of NodeElement e -> do (n', v) <- Map.toList $ elementAttributes e - guard $ (on (==) T.toCaseFold) n (nameLocalName n') + guard $ on (==) T.toCaseFold n (nameLocalName n') return v _ -> [] diff --git a/xml-conduit/src/Text/XML/Stream/Parse.hs b/xml-conduit/src/Text/XML/Stream/Parse.hs index 2a376cd..38c0305 100644 --- a/xml-conduit/src/Text/XML/Stream/Parse.hs +++ b/xml-conduit/src/Text/XML/Stream/Parse.hs @@ -1152,7 +1152,7 @@ newtype AttrParser a = AttrParser { runAttrParser :: [(Name, [Content])] -> Eith instance Monad AttrParser where (AttrParser f) >>= g = AttrParser $ \as -> - either Left (\(as', f') -> runAttrParser (g f') as') (f as) + (\(as', f') -> runAttrParser (g f') as') =<< (f as) instance Functor AttrParser where fmap = liftM instance Applicative AttrParser where diff --git a/xml-conduit/src/Text/XML/Stream/Render/Internal.hs b/xml-conduit/src/Text/XML/Stream/Render/Internal.hs index 1fff667..95e1523 100644 --- a/xml-conduit/src/Text/XML/Stream/Render/Internal.hs +++ b/xml-conduit/src/Text/XML/Stream/Render/Internal.hs @@ -405,7 +405,7 @@ content :: (Monad m) => Text -> ConduitT i Event m () content = yield . EventContent . ContentText -- | A list of attributes. -data Attributes = Attributes [(Name, [Content])] +newtype Attributes = Attributes [(Name, [Content])] instance Monoid Attributes where mempty = Attributes mempty diff --git a/xml-conduit/src/Text/XML/Stream/Token.hs b/xml-conduit/src/Text/XML/Stream/Token.hs index 7d440f6..3ee9819 100644 --- a/xml-conduit/src/Text/XML/Stream/Token.hs +++ b/xml-conduit/src/Text/XML/Stream/Token.hs @@ -52,7 +52,7 @@ tokenToBuilder (TokenBeginElement name attrs' isEmpty indent) = foldAttrs (if indent == 0 || lessThan3 attrs then oneSpace - else mconcat $ ("\n" : replicate indent " ")) + else mconcat ("\n" : replicate indent " ")) attrs <> (if isEmpty then "/>" else ">") where @@ -101,10 +101,10 @@ data EscapeContext = ECContent -- ^ .. {-# INLINE charUtf8XmlEscaped #-} charUtf8XmlEscaped :: EscapeContext -> E.BoundedPrim Word8 charUtf8XmlEscaped ec = - (condB (> _gt) (E.liftFixedToBounded E.word8)) $ - (condB (== _lt) (fixed4 (_am,(_l,(_t,_sc))))) $ -- < + condB (> _gt) (E.liftFixedToBounded E.word8) $ + condB (== _lt) (fixed4 (_am,(_l,(_t,_sc)))) $ -- < escapeFor ECContent (condB (== _gt) (fixed4 (_am,(_g,(_t,_sc))))) $ -- > - (condB (== _am) (fixed5 (_am,(_a,(_m,(_p,_sc)))))) $ -- & + condB (== _am) (fixed5 (_am,(_a,(_m,(_p,_sc))))) $ -- & escapeFor ECDoubleArg (condB (== _dq) (fixed6 (_am,(_q,(_u,(_o,(_t,_sc))))))) $ -- " escapeFor ECSingleArg (condB (== _sq) (fixed6 (_am,(_a,(_p,(_o,(_s,_sc))))))) $ -- ' (E.liftFixedToBounded E.word8) -- fallback for Chars smaller than '>' diff --git a/xml-conduit/src/Text/XML/Unresolved.hs b/xml-conduit/src/Text/XML/Unresolved.hs index b0be490..51b673c 100644 --- a/xml-conduit/src/Text/XML/Unresolved.hs +++ b/xml-conduit/src/Text/XML/Unresolved.hs @@ -219,7 +219,7 @@ elementFromEvents = goE goN = do x <- CL.peek case x of - Just (_, EventBeginElement n as) -> (Just . NodeElement) <$> goE' n as + Just (_, EventBeginElement n as) -> Just . NodeElement <$> goE' n as Just (_, EventInstruction i) -> dropReturn $ Just $ NodeInstruction i Just (_, EventContent c) -> dropReturn $ Just $ NodeContent c Just (_, EventComment t) -> dropReturn $ Just $ NodeComment t