Fix warnings

src/Network/Minio/XmlParser.hs

@@ -66,24 +66,17 @@ parseListObjectsResponse xmldata = do
     root = fromDocument doc
     s3Elem = element . s3Name
 
-    hasMore :: Bool
-    hasMore = "true" == (T.concat $ contentOfChildElem root "IsTruncated")
+    hasMore = ["true"] == (root $/ s3Elem "IsTruncated" &/ content)
 
-    nextToken :: Maybe Text
-    nextToken = listToMaybe $ contentOfChildElem root "NextContinuationToken"
+    nextToken = headMay $ root $/ s3Elem "NextContinuationToken" &/ content
 
-    cPrefTags :: [Cursor]
-    cPrefTags = child root >>= element (s3Name "CommonPrefixes")
-
-    prefixes :: [Text]
-    prefixes = cPrefTags >>= flip contentOfChildElem "Prefix"
+    prefixes = root $/ s3Elem "CommonPrefixes" &/ s3Elem "Prefix" &/ content
 
     keys = root $/ s3Elem "Contents" &/ s3Elem "Key" &/ content
     modTimeStr = root $/ s3Elem "Contents" &/ s3Elem "LastModified" &/ content
     etags = root $/ s3Elem "Contents" &/ s3Elem "ETag" &/ content
     sizeStr = root $/ s3Elem "Contents" &/ s3Elem "Size" &/ content
 
-
   modTimes <- either (throwError . MErrXml) return $
     mapM (parseTimeM True defaultTimeLocale s3TimeFormat . T.unpack) $
     modTimeStr
@@ -91,15 +84,10 @@ parseListObjectsResponse xmldata = do
   sizes <- forM sizeStr $ \str ->
     either (throwError . MErrXml . show) return $ fst <$> decimal str
 
-  let objects = map (uncurry4 ObjectInfo) $ zip4 keys modTimes etags sizes
-  return $ ListObjectsResult hasMore nextToken objects prefixes
-
-  where
+  let
     uncurry4 :: (a -> b -> c -> d -> e) -> (a, b, c, d) -> e
     uncurry4 f (a, b, c, d) = f a b c d
 
-    -- get content of children with given cursor and child-element name.
-    contentOfChildElem :: Cursor -> Text -> [Text]
-    contentOfChildElem cursor elemName = child cursor >>=
-                                         element (s3Name elemName) >>=
-                                         content
+    objects = map (uncurry4 ObjectInfo) $ zip4 keys modTimes etags sizes
+
+  return $ ListObjectsResult hasMore nextToken objects prefixes

test/Network/Minio/XmlParser/Test.hs

@@ -22,14 +22,14 @@ testParseLocation = do
   -- 1. Test parsing of an invalid location constraint xml.
   parsedLocationE <- runExceptT $ parseLocation "ClearlyInvalidXml"
   case parsedLocationE of
-    Right loc -> assertFailure $ "Parsing should have failed => " ++ show parsedLocationE
+    Right _ -> assertFailure $ "Parsing should have failed => " ++ show parsedLocationE
     Left _ -> return ()
 
   forM_ cases $ \(xmldata, expectedLocation) -> do
-    parsedLocationE <- runExceptT $ parseLocation xmldata
-    case parsedLocationE of
+    parsedLocationE1 <- runExceptT $ parseLocation xmldata
+    case parsedLocationE1 of
       Right parsedLocation -> parsedLocation @?= expectedLocation
-      _ -> assertFailure $ "Parsing failed => " ++ show parsedLocationE
+      _ -> assertFailure $ "Parsing failed => " ++ show parsedLocationE1
   where
     cases =  [
       -- 2. Test parsing of a valid location xml.

test/Spec.hs

@@ -116,7 +116,7 @@ liveServerUnitTests = testGroup "Unit tests against a live server"
 
   , funTestWithBucket "Basic listObjects Test" "testbucket3" $ \step bucket -> do
       step "put 10 objects"
-      forM_ [1..10] $ \s ->
+      forM_ [1..10::Int] $ \s ->
         fPutObject bucket (T.concat ["lsb-release", T.pack (show s)]) "/etc/lsb-release"
 
       step "Simple list"
@@ -125,12 +125,12 @@ liveServerUnitTests = testGroup "Unit tests against a live server"
                           ("lsb-release":) .
                           (\x -> [x]) .
                           T.pack .
-                          show) [1..10]
+                          show) [1..10::Int]
       liftIO $ assertEqual "Objects match failed!" expected
         (map oiObject $ lorObjects res)
 
       step "cleanup"
-      forM_ [1..10] $ \s ->
+      forM_ [1..10::Int] $ \s ->
         deleteObject bucket (T.concat ["lsb-release", T.pack (show s)])
   ]