Update with changes for ormolu 0.5.0.0 (#171)

- Add ormolu check to CI

.github/workflows/ci.yml

@@ -21,9 +21,15 @@ env:
   MINIO_SECURE: 1
 
 jobs:
+  ormolu:
+    runs-on: ubuntu-latest
+    steps:
+      - uses: actions/checkout@v2
+      - uses: mrkkrp/ormolu-action@v6
   cabal:
     name: ${{ matrix.os }} / ghc-${{ matrix.ghc }} / cabal-${{ matrix.cabal }}
     runs-on: ${{ matrix.os }}
+    needs: ormolu
     strategy:
       matrix:
         os: [ubuntu-latest, windows-latest] # Removed macos-latest due to cert issues.

examples/PresignedGetObject.hs

@@ -77,7 +77,8 @@ main = do
       let hdrOpt (k, v) = B.concat ["-H '", original k, ": ", v, "'"]
           curlCmd =
             B.intercalate " " $
-              ["curl --fail"] ++ map hdrOpt headers
+              ["curl --fail"]
+                ++ map hdrOpt headers
                 ++ ["-o /tmp/myfile", B.concat ["'", url, "'"]]
 
       putStrLn $

examples/PresignedPutObject.hs

@@ -48,7 +48,8 @@ main = do
       let hdrOpt (k, v) = B.concat ["-H '", original k, ": ", v, "'"]
           curlCmd =
             B.intercalate " " $
-              ["curl "] ++ map hdrOpt headers
+              ["curl "]
+                ++ map hdrOpt headers
                 ++ ["-T /tmp/myfile", B.concat ["'", url, "'"]]
 
       putStrLn $

src/Network/Minio/AdminAPI.hs

@@ -432,7 +432,9 @@ healPath bucket prefix = do
   if (isJust bucket)
     then
       encodeUtf8 $
-        "v1/heal/" <> fromMaybe "" bucket <> "/"
+        "v1/heal/"
+          <> fromMaybe "" bucket
+          <> "/"
           <> fromMaybe "" prefix
     else encodeUtf8 ("v1/heal/" :: Text)
 
@@ -611,9 +613,9 @@ buildAdminRequest areq = do
         areq
           { ariPayloadHash = Just sha256Hash,
             ariHeaders =
-              hostHeader :
+              hostHeader
-              sha256Header sha256Hash :
+                : sha256Header sha256Hash
-              ariHeaders areq
+                : ariHeaders areq
           }
       signReq = toRequest ci newAreq
       sp =

src/Network/Minio/CopyObject.hs

@@ -50,8 +50,8 @@ copyObjectInternal b' o srcInfo = do
                || (endOffset >= srcSize)
            )
     )
-    $ throwIO $
+    $ throwIO
-      MErrVInvalidSrcObjByteRange range
+    $ MErrVInvalidSrcObjByteRange range
 
   -- 1. If sz > 64MiB (minPartSize) use multipart copy, OR
   -- 2. If startOffset /= 0 use multipart copy

src/Network/Minio/Data.hs

@@ -587,7 +587,8 @@ defaultGetObjectOptions =
 
 gooToHeaders :: GetObjectOptions -> [HT.Header]
 gooToHeaders goo =
-  rangeHdr ++ zip names values
+  rangeHdr
+    ++ zip names values
     ++ maybe [] (toPutObjectHeaders . SSEC) (gooSSECKey goo)
   where
     names =

src/Network/Minio/ListOps.hs

@@ -143,12 +143,12 @@ listIncompleteUploads bucket prefix recurse = loop Nothing Nothing
                 C..| CC.sinkList
           return $ foldl' (\sizeSofar p -> opiSize p + sizeSofar) 0 partInfos
 
-      CL.sourceList $
+      CL.sourceList
-        map
+        $ map
           ( \((uKey, uId, uInitTime), size) ->
               UploadInfo uKey uId uInitTime size
           )
-          $ zip (lurUploads res) aggrSizes
+        $ zip (lurUploads res) aggrSizes
 
       when (lurHasMore res) $
         loop (lurNextKey res) (lurNextUpload res)

src/Network/Minio/PresignedOperations.hs

@@ -53,9 +53,11 @@ import Network.Minio.Errors
 import Network.Minio.Sign.V4
 import Network.URI (uriToString)
 
+{- ORMOLU_DISABLE -}
 #if MIN_VERSION_aeson(2,0,0)
 import qualified Data.Aeson.Key as A
 #endif
+{- ORMOLU_ENABLE -}
 
 -- | Generate a presigned URL. This function allows for advanced usage
 -- - for simple cases prefer the `presigned*Url` functions.
@@ -178,6 +180,7 @@ data PostPolicyCondition
   | PPCRange Text Int64 Int64
   deriving stock (Show, Eq)
 
+{- ORMOLU_DISABLE -}
 instance Json.ToJSON PostPolicyCondition where
   toJSON (PPCStartsWith k v) = Json.toJSON ["starts-with", k, v]
 #if MIN_VERSION_aeson(2,0,0)
@@ -196,6 +199,7 @@ instance Json.ToJSON PostPolicyCondition where
 #endif
   toEncoding (PPCRange k minVal maxVal) =
     Json.foldable [Json.toJSON k, Json.toJSON minVal, Json.toJSON maxVal]
+{- ORMOLU_ENABLE -}
 
 -- | A PostPolicy is required to perform uploads via browser forms.
 data PostPolicy = PostPolicy
@@ -338,7 +342,8 @@ presignedPostPolicy p = do
       url =
         toStrictBS $
           toLazyByteString $
-            scheme <> byteString (getHostAddr ci)
+            scheme
+              <> byteString (getHostAddr ci)
               <> byteString "/"
               <> byteString bucket
               <> byteString "/"

src/Network/Minio/S3API.hs

@@ -131,7 +131,8 @@ parseGetObjectHeaders object headers =
   let metadataPairs = getMetadata headers
       userMetadata = getUserMetadataMap metadataPairs
       metadata = getNonUserMetadataMap metadataPairs
-   in ObjectInfo <$> Just object
+   in ObjectInfo
+        <$> Just object
         <*> getLastModifiedHeader headers
         <*> getETagHeader headers
         <*> getContentLength headers
@@ -387,8 +388,8 @@ srcInfoToHeaders srcInfo =
           "/",
           srcObject srcInfo
         ]
-  ) :
+  )
-  rangeHdr
+    : rangeHdr
     ++ zip names values
   where
     names =
@@ -519,14 +520,14 @@ listIncompleteUploads' bucket prefix delimiter keyMarker uploadIdMarker maxKeys
   where
     -- build query params
     params =
-      ("uploads", Nothing) :
+      ("uploads", Nothing)
-      mkOptionalParams
+        : mkOptionalParams
-        [ ("prefix", prefix),
+          [ ("prefix", prefix),
-          ("delimiter", delimiter),
+            ("delimiter", delimiter),
-          ("key-marker", keyMarker),
+            ("key-marker", keyMarker),
-          ("upload-id-marker", uploadIdMarker),
+            ("upload-id-marker", uploadIdMarker),
-          ("max-uploads", show <$> maxKeys)
+            ("max-uploads", show <$> maxKeys)
-        ]
+          ]
 
 -- | List parts of an ongoing multipart upload.
 listIncompleteParts' ::

src/Network/Minio/Sign/V4.hs

@@ -198,14 +198,14 @@ mkCanonicalRequest ::
   ByteString
 mkCanonicalRequest !isStreaming !sp !req !headersForSign =
   let canonicalQueryString =
-        B.intercalate "&" $
+        B.intercalate "&"
-          map (\(x, y) -> B.concat [x, "=", y]) $
+          $ map (\(x, y) -> B.concat [x, "=", y])
-            sort $
+          $ sort
-              map
+          $ map
-                ( \(x, y) ->
+            ( \(x, y) ->
-                    (uriEncode True x, maybe "" (uriEncode True) y)
+                (uriEncode True x, maybe "" (uriEncode True) y)
-                )
+            )
-                $ (parseQuery $ NC.queryString req)
+          $ (parseQuery $ NC.queryString req)
       sortedHeaders = sort headersForSign
       canonicalHeaders =
         B.concat $
@@ -298,8 +298,8 @@ signV4Stream !payloadLength !sp !req =
          in case ceMay of
               Nothing -> ("content-encoding", "aws-chunked") : hs
               Just (_, ce) ->
-                ("content-encoding", ce <> ",aws-chunked") :
+                ("content-encoding", ce <> ",aws-chunked")
-                filter (\(x, _) -> x /= "content-encoding") hs
+                  : filter (\(x, _) -> x /= "content-encoding") hs
       -- headers to be added to the request
       datePair = ("X-Amz-Date", awsTimeFormatBS ts)
       computedHeaders =
@@ -385,7 +385,8 @@ signV4Stream !payloadLength !sp !req =
                 let strToSign = chunkStrToSign prevSign (hashSHA256 bs)
                     nextSign = computeSignature strToSign signingKey
                     chunkBS =
-                      toHexStr lps <> ";chunk-signature="
+                      toHexStr lps
+                        <> ";chunk-signature="
                         <> nextSign
                         <> "\r\n"
                         <> bs

src/Network/Minio/XmlGenerator.hs

@@ -105,7 +105,8 @@ instance ToXNode Notification where
 toXNodesWithArnName :: Text -> Text -> NotificationConfig -> XNode
 toXNodesWithArnName eltName arnName (NotificationConfig itemId arn events fRule) =
   XNode eltName $
-    [XLeaf "Id" itemId, XLeaf arnName arn] ++ map toXNode events
+    [XLeaf "Id" itemId, XLeaf arnName arn]
+      ++ map toXNode events
       ++ [toXNode fRule]
 
 instance ToXNode Filter where

src/Network/Minio/XmlParser.hs

@@ -235,7 +235,8 @@ parseNotification xmldata = do
       qcfg = map node $ r $/ s3Elem' "QueueConfiguration"
       tcfg = map node $ r $/ s3Elem' "TopicConfiguration"
       lcfg = map node $ r $/ s3Elem' "CloudFunctionConfiguration"
-  Notification <$> (mapM (parseNode ns "Queue") qcfg)
+  Notification
+    <$> (mapM (parseNode ns "Queue") qcfg)
     <*> (mapM (parseNode ns "Topic") tcfg)
     <*> (mapM (parseNode ns "CloudFunction") lcfg)
   where
@@ -249,8 +250,11 @@ parseNotification xmldata = do
           arn = T.concat $ c $/ s3Elem ns arnName &/ content
           events = catMaybes $ map textToEvent $ c $/ s3Elem ns "Event" &/ content
           rules =
-            c $/ s3Elem ns "Filter" &/ s3Elem ns "S3Key"
+            c
-              &/ s3Elem ns "FilterRule" &| getFilterRule ns
+              $/ s3Elem ns "Filter"
+              &/ s3Elem ns "S3Key"
+              &/ s3Elem ns "FilterRule"
+              &| getFilterRule ns
       return $
         NotificationConfig
           itemId
@@ -264,6 +268,7 @@ parseSelectProgress xmldata = do
   let bScanned = T.concat $ r $/ element "BytesScanned" &/ content
       bProcessed = T.concat $ r $/ element "BytesProcessed" &/ content
       bReturned = T.concat $ r $/ element "BytesReturned" &/ content
-  Progress <$> parseDecimal bScanned
+  Progress
+    <$> parseDecimal bScanned
     <*> parseDecimal bProcessed
     <*> parseDecimal bReturned

test/LiveServer.hs

@@ -136,7 +136,8 @@ basicTests = funTestWithBucket "Basic tests" $
     unless (length (filter (== bucket) $ map biName buckets) == 1) $
       liftIO $
         assertFailure
-          ( "The bucket " ++ show bucket
+          ( "The bucket "
+              ++ show bucket
               ++ " was expected to exist."
           )
 
@@ -367,11 +368,11 @@ highLevelListingTest = funTestWithBucket "High-level listObjects Test" $
     step "High-level recursive listing of objects"
     objects <- C.runConduit $ listObjects bucket Nothing True C..| sinkList
 
-    liftIO $
+    liftIO
-      assertEqual
+      $ assertEqual
         "Objects match failed!"
         (Just $ sort expectedObjects)
-        $ extractObjectsFromList objects
+      $ extractObjectsFromList objects
 
     step "High-level listing of objects (version 1)"
     itemsV1 <- C.runConduit $ listObjectsV1 bucket Nothing False C..| sinkList
@@ -385,45 +386,45 @@ highLevelListingTest = funTestWithBucket "High-level listObjects Test" $
         listObjectsV1 bucket Nothing True
           C..| sinkList
 
-    liftIO $
+    liftIO
-      assertEqual
+      $ assertEqual
         "Objects match failed!"
         (Just $ sort expectedObjects)
-        $ extractObjectsFromList objectsV1
+      $ extractObjectsFromList objectsV1
 
     let expectedPrefListing = ["dir/o1", "dir/dir1/", "dir/dir2/"]
         expectedPrefListingRec = Just ["dir/dir1/o2", "dir/dir2/o3", "dir/o1"]
     step "High-level listing with prefix"
     prefItems <- C.runConduit $ listObjects bucket (Just "dir/") False C..| sinkList
-    liftIO $
+    liftIO
-      assertEqual
+      $ assertEqual
         "Objects/Dirs under prefix match failed!"
         expectedPrefListing
-        $ extractObjectsAndDirsFromList prefItems
+      $ extractObjectsAndDirsFromList prefItems
 
     step "High-level listing with prefix recursive"
     prefItemsRec <- C.runConduit $ listObjects bucket (Just "dir/") True C..| sinkList
-    liftIO $
+    liftIO
-      assertEqual
+      $ assertEqual
         "Objects/Dirs under prefix match recursive failed!"
         expectedPrefListingRec
-        $ extractObjectsFromList prefItemsRec
+      $ extractObjectsFromList prefItemsRec
 
     step "High-level listing with prefix (version 1)"
     prefItemsV1 <- C.runConduit $ listObjectsV1 bucket (Just "dir/") False C..| sinkList
-    liftIO $
+    liftIO
-      assertEqual
+      $ assertEqual
         "Objects/Dirs under prefix match failed!"
         expectedPrefListing
-        $ extractObjectsAndDirsFromList prefItemsV1
+      $ extractObjectsAndDirsFromList prefItemsV1
 
     step "High-level listing with prefix recursive (version 1)"
     prefItemsRecV1 <- C.runConduit $ listObjectsV1 bucket (Just "dir/") True C..| sinkList
-    liftIO $
+    liftIO
-      assertEqual
+      $ assertEqual
         "Objects/Dirs under prefix match recursive failed!"
         expectedPrefListingRec
-        $ extractObjectsFromList prefItemsRecV1
+      $ extractObjectsFromList prefItemsRecV1
 
     step "Cleanup actions"
     forM_ expectedObjects $

test/Spec.hs

@@ -79,7 +79,9 @@ qcProps =
                           listToMaybe sizes
                     | otherwise -> False
            in n < 0
-                || ( isPNumsAscendingFrom1 && isOffsetsAsc && isSumSizeOk
+                || ( isPNumsAscendingFrom1
+                       && isOffsetsAsc
+                       && isSumSizeOk
                        && isSizesConstantExceptLast
                        && isMinPartSizeOk
                    ),
@@ -105,7 +107,8 @@ qcProps =
               isContParts =
                 length fsts == length snds
                   && and (map (\(a, b) -> a == b + 1) $ zip fsts snds)
-           in start < 0 || start > end
+           in start < 0
+                || start > end
                 || (isLastPartOk && isFirstPartOk && isPartSizesOk && isContParts),
       QC.testProperty "mkSSECKey:" $
         \w8s ->