diff --git a/src/Network/Minio/XmlParser.hs b/src/Network/Minio/XmlParser.hs index 0709b4b..039f526 100644 --- a/src/Network/Minio/XmlParser.hs +++ b/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 diff --git a/test/Network/Minio/XmlParser/Test.hs b/test/Network/Minio/XmlParser/Test.hs index eb15d4b..52204a7 100644 --- a/test/Network/Minio/XmlParser/Test.hs +++ b/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. diff --git a/test/Spec.hs b/test/Spec.hs index b49aed2..7696455 100644 --- a/test/Spec.hs +++ b/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)]) ]