ci: Run hlint

.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 }}

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
 

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
         _ -> []
 

xml-conduit/src/Text/XML/Stream/Parse.hs

@@ -1151,8 +1151,8 @@
 newtype AttrParser a = AttrParser { runAttrParser :: [(Name, [Content])] -> Either SomeException ([(Name, [Content])], a) }
 
 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

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

xml-conduit/src/Text/XML/Stream/Token.hs

@@ -52,7 +52,7 @@
     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,13 +101,13 @@
 {-# INLINE charUtf8XmlEscaped #-}
 charUtf8XmlEscaped :: EscapeContext -> E.BoundedPrim Word8
 charUtf8XmlEscaped ec =
-                          (condB (>  _gt) (E.liftFixedToBounded E.word8)) $
-                          (condB (== _lt) (fixed4 (_am,(_l,(_t,_sc))))) $           -- &lt;
+                          condB (>  _gt) (E.liftFixedToBounded E.word8) $
+                          condB (== _lt) (fixed4 (_am,(_l,(_t,_sc)))) $           -- &lt;
     escapeFor ECContent   (condB (== _gt) (fixed4 (_am,(_g,(_t,_sc))))) $           -- &gt;
-                          (condB (== _am) (fixed5 (_am,(_a,(_m,(_p,_sc)))))) $      -- &amp;
+                          condB (== _am) (fixed5 (_am,(_a,(_m,(_p,_sc))))) $      -- &amp;
     escapeFor ECDoubleArg (condB (== _dq) (fixed6 (_am,(_q,(_u,(_o,(_t,_sc))))))) $ -- &quot;
     escapeFor ECSingleArg (condB (== _sq) (fixed6 (_am,(_a,(_p,(_o,(_s,_sc))))))) $ -- &apos;
     (E.liftFixedToBounded E.word8)         -- fallback for Chars smaller than '>'
   where
     _gt = 62 -- >
     _lt = 60 -- <

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