Upgrade Ormolu to v0.5.

This upgrades the version of Ormolu required by the HGE repository to v0.5.0.1, and reformats all code accordingly. Ormolu v0.5 reformats code that uses infix operators. This is mostly useful, adding newlines and indentation to make it clear which operators are applied first, but in some cases, it's unpleasant. To make this easier on the eyes, I had to do the following: * Add a few fixity declarations (search for `infix`) * Add parentheses to make precedence clear, allowing Ormolu to keep everything on one line * Rename `relevantEq` to `(==~)` in #6651 and set it to `infix 4` * Add a few _.ormolu_ files (thanks to @hallettj for helping me get started), mostly for Autodocodec operators that don't have explicit fixity declarations In general, I think these changes are quite reasonable. They mostly affect indentation. PR-URL: hasura/graphql-engine-mono#6675 GitOrigin-RevId: cd47d87f1d089fb0bc9dcbbe7798dbceedcd7d83
hasura · Nov 2, 2022 · 342391f · 342391f
1 parent 89f639b
commit 342391f
Show file tree

Hide file tree

Showing 204 changed files with 1,789 additions and 1,294 deletions.
diff --git a/nix/shell.nix b/nix/shell.nix
@@ -52,10 +52,6 @@ let
     # The correct version of GHC.
     pkgs.haskell.compiler.${pkgs.ghcName}
 
-    # We use the default versions of these packages.
-    (versions.ensureVersion pkgs.haskellPackages.ormolu)
-
-    # We build these packages using our custom GHC.
     pkgs.haskell.packages.${pkgs.ghcName}.alex
     pkgs.haskell.packages.${pkgs.ghcName}.apply-refact
     pkgs.haskell.packages.${pkgs.ghcName}.cabal-install
@@ -66,6 +62,7 @@ let
     (versions.ensureVersion pkgs.haskell.packages.${pkgs.ghcName}.hpack)
     pkgs.haskell.packages.${pkgs.ghcName}.hoogle
     pkgs.haskell.packages.${pkgs.ghcName}.hspec-discover
+    (versions.ensureVersion pkgs.haskell.packages.${pkgs.ghcName}.ormolu)
   ];
 
   devInputs = [

diff --git a/scripts/make/lint.mk b/scripts/make/lint.mk
@@ -15,7 +15,6 @@ HLINT_CHECK_VERSION = $(shell jq '.hlint' ./server/VERSIONS.json)
 NIX_FMT = nixpkgs-fmt
 
 ORMOLU = ormolu
-ORMOLU_ARGS = --cabal-default-extensions
 ORMOLU_VERSION = $(shell $(ORMOLU) --version | awk 'NR==1 { print $$2 }')
 ORMOLU_CHECK_VERSION = $(shell jq '.ormolu' ./server/VERSIONS.json)
 
@@ -37,29 +36,29 @@ check-ormolu-version:
 .PHONY: format-hs
 ## format-hs: auto-format Haskell source code using ormolu
 format-hs: check-ormolu-version
-	@echo running ormolu --mode inplace
-	@$(ORMOLU) $(ORMOLU_ARGS) --mode inplace $(HS_FILES)
+	@echo running $(ORMOLU) --mode inplace
+	@$(ORMOLU) --mode inplace $(HS_FILES)
 
 .PHONY: format-hs-changed
 ## format-hs-changed: auto-format Haskell source code using ormolu (changed files only)
 format-hs-changed: check-ormolu-version
-	@echo running ormolu --mode inplace
+	@echo running $(ORMOLU) --mode inplace
 	@if [ -n "$(CHANGED_HS_FILES)" ]; then \
-		$(ORMOLU) $(ORMOLU_ARGS) --mode inplace $(CHANGED_HS_FILES); \
+		$(ORMOLU) --mode inplace $(CHANGED_HS_FILES); \
 	fi
 
 .PHONY: check-format-hs
 ## check-format-hs: check Haskell source code formatting using ormolu
 check-format-hs: check-ormolu-version
-	@echo running ormolu --mode check
-	@$(ORMOLU) $(ORMOLU_ARGS) --mode check $(HS_FILES)
+	@echo running $(ORMOLU) --mode check
+	@$(ORMOLU) --mode check $(HS_FILES)
 
 .PHONY: check-format-hs-changed
 ## check-format-hs-changed: check Haskell source code formatting using ormolu (changed-files-only)
 check-format-hs-changed: check-ormolu-version
-	@echo running ormolu --mode check
+	@echo running $(ORMOLU) --mode check
 	@if [ -n "$(CHANGED_HS_FILES)" ]; then \
-		$(ORMOLU) $(ORMOLU_ARGS) --mode check $(CHANGED_HS_FILES); \
+		$(ORMOLU) --mode check $(CHANGED_HS_FILES); \
 	fi
 
 # We don't bother checking only changed *.nix files, as there's so few.

diff --git a/server/.ormolu b/server/.ormolu
@@ -0,0 +1,2 @@
+infixr 8 .=
+infixr 8 .==
diff --git a/server/VERSIONS.json b/server/VERSIONS.json
@@ -2,5 +2,5 @@
   "ghc": "9.2.4",
   "hlint": "3.4.1",
   "hpack": "0.34.7",
-  "ormolu": "0.3.1.0"
+  "ormolu": "0.5.0.1"
 }
diff --git a/server/lib/aeson-ordered/src/Data/Aeson/Ordered.hs b/server/lib/aeson-ordered/src/Data/Aeson/Ordered.hs
@@ -280,7 +280,7 @@ value = do
     C_n -> A8.string "null" $> Null
     _
       | w >= 48 && w <= 57 || w == 45 ->
-        Number <$> A8.scientific
+          Number <$> A8.scientific
       | otherwise -> fail "not a valid json value"
 {-# INLINE value #-}
 

diff --git a/server/lib/api-tests/test/Test/EventTrigger/PG/EventTriggersRunSQLSpec.hs b/server/lib/api-tests/test/Test/EventTrigger/PG/EventTriggersRunSQLSpec.hs
@@ -172,7 +172,8 @@ args:
         eitherDecode responseBody
           `onLeft` \err ->
             assertFailure
-              ( "In request: " ++ "/v2/query"
+              ( "In request: "
+                  ++ "/v2/query"
                   ++ "Couldn't decode JSON body:"
                   ++ show err
                   ++ "Body was:"

diff --git a/server/lib/api-tests/test/Test/Regression/NullRemoteRelationship8345Spec.hs b/server/lib/api-tests/test/Test/Regression/NullRemoteRelationship8345Spec.hs
@@ -401,17 +401,17 @@ lhsRemoteServerMkLocalTestEnvironment _ = do
         flip foldMap orderByList \LHSHasuraTrackOrderBy {..} ->
           if
               | Just idOrder <- tob_id -> case idOrder of
-                Asc -> compare trackId1 trackId2
-                Desc -> compare trackId2 trackId1
+                  Asc -> compare trackId1 trackId2
+                  Desc -> compare trackId2 trackId1
               | Just titleOrder <- tob_title -> case titleOrder of
-                Asc -> compare trackTitle1 trackTitle2
-                Desc -> compare trackTitle2 trackTitle1
+                  Asc -> compare trackTitle1 trackTitle2
+                  Desc -> compare trackTitle2 trackTitle1
               | Just albumIdOrder <- tob_album_id ->
-                compareWithNullLast albumIdOrder trackAlbumId1 trackAlbumId2
+                  compareWithNullLast albumIdOrder trackAlbumId1 trackAlbumId2
               | Just artistIdOrder <- tob_artist_id ->
-                compareWithNullLast artistIdOrder trackArtistId1 trackArtistId2
+                  compareWithNullLast artistIdOrder trackArtistId1 trackArtistId2
               | otherwise ->
-                error "empty track_order object"
+                  error "empty track_order object"
     compareWithNullLast Desc x1 x2 = compareWithNullLast Asc x2 x1
     compareWithNullLast Asc Nothing Nothing = EQ
     compareWithNullLast Asc (Just _) Nothing = LT

diff --git a/...pi-tests/test/Test/Regression/UsingTheSameFunctionForRootFieldAndComputedField8643Spec.hs b/...pi-tests/test/Test/Regression/UsingTheSameFunctionForRootFieldAndComputedField8643Spec.hs
@@ -60,7 +60,8 @@ functionSetup testEnvironment =
   Fixture.SetupAction
     { setupAction =
         Postgres.run_ testEnvironment $
-          "CREATE FUNCTION " ++ Constants.postgresDb
+          "CREATE FUNCTION "
+            ++ Constants.postgresDb
             ++ ".authors(author_row author) \
                \RETURNS SETOF author AS $$ \
                \  SELECT * \

diff --git a/server/lib/api-tests/test/Test/RemoteRelationship/MetadataAPI/Common.hs b/server/lib/api-tests/test/Test/RemoteRelationship/MetadataAPI/Common.hs
@@ -559,15 +559,15 @@ lhsRemoteServerMkLocalTestEnvironment _ = do
         flip foldMap orderByList \LHSHasuraTrackOrderBy {..} ->
           if
               | Just idOrder <- tob_id -> case idOrder of
-                Asc -> compare trackId1 trackId2
-                Desc -> compare trackId2 trackId1
+                  Asc -> compare trackId1 trackId2
+                  Desc -> compare trackId2 trackId1
               | Just titleOrder <- tob_title -> case titleOrder of
-                Asc -> compare trackTitle1 trackTitle2
-                Desc -> compare trackTitle2 trackTitle1
+                  Asc -> compare trackTitle1 trackTitle2
+                  Desc -> compare trackTitle2 trackTitle1
               | Just albumIdOrder <- tob_album_id ->
-                compareWithNullLast albumIdOrder trackAlbumId1 trackAlbumId2
+                  compareWithNullLast albumIdOrder trackAlbumId1 trackAlbumId2
               | otherwise ->
-                error "empty track_order object"
+                  error "empty track_order object"
     compareWithNullLast Desc x1 x2 = compareWithNullLast Asc x2 x1
     compareWithNullLast Asc Nothing Nothing = EQ
     compareWithNullLast Asc (Just _) Nothing = LT

diff --git a/server/lib/api-tests/test/Test/RemoteRelationship/XToDBArrayRelationshipSpec.hs b/server/lib/api-tests/test/Test/RemoteRelationship/XToDBArrayRelationshipSpec.hs
@@ -601,12 +601,12 @@ lhsRemoteServerMkLocalTestEnvironment _ = do
         flip foldMap orderByList \HasuraArtistOrderBy {..} ->
           if
               | Just idOrder <- aob_id ->
-                compareWithNullLast idOrder artistId1 artistId2
+                  compareWithNullLast idOrder artistId1 artistId2
               | Just nameOrder <- aob_name -> case nameOrder of
-                Asc -> compare artistName1 artistName2
-                Desc -> compare artistName2 artistName1
+                  Asc -> compare artistName1 artistName2
+                  Desc -> compare artistName2 artistName1
               | otherwise ->
-                error "empty artist_order object"
+                  error "empty artist_order object"
     compareWithNullLast Desc x1 x2 = compareWithNullLast Asc x2 x1
     compareWithNullLast Asc Nothing Nothing = EQ
     compareWithNullLast Asc (Just _) Nothing = LT

diff --git a/server/lib/api-tests/test/Test/RemoteRelationship/XToDBObjectRelationshipSpec.hs b/server/lib/api-tests/test/Test/RemoteRelationship/XToDBObjectRelationshipSpec.hs
@@ -598,15 +598,15 @@ lhsRemoteServerMkLocalTestEnvironment _ = do
         flip foldMap orderByList \HasuraTrackOrderBy {..} ->
           if
               | Just idOrder <- tob_id -> case idOrder of
-                Asc -> compare trackId1 trackId2
-                Desc -> compare trackId2 trackId1
+                  Asc -> compare trackId1 trackId2
+                  Desc -> compare trackId2 trackId1
               | Just titleOrder <- tob_title -> case titleOrder of
-                Asc -> compare trackTitle1 trackTitle2
-                Desc -> compare trackTitle2 trackTitle1
+                  Asc -> compare trackTitle1 trackTitle2
+                  Desc -> compare trackTitle2 trackTitle1
               | Just albumIdOrder <- tob_album_id ->
-                compareWithNullLast albumIdOrder trackAlbumId1 trackAlbumId2
+                  compareWithNullLast albumIdOrder trackAlbumId1 trackAlbumId2
               | otherwise ->
-                error "empty track_order object"
+                  error "empty track_order object"
     compareWithNullLast Desc x1 x2 = compareWithNullLast Asc x2 x1
     compareWithNullLast Asc Nothing Nothing = EQ
     compareWithNullLast Asc (Just _) Nothing = LT

diff --git a/server/lib/api-tests/test/Test/RemoteRelationship/XToRemoteSchemaRelationshipSpec.hs b/server/lib/api-tests/test/Test/RemoteRelationship/XToRemoteSchemaRelationshipSpec.hs
@@ -445,15 +445,15 @@ lhsRemoteServerMkLocalTestEnvironment _ = do
         flip foldMap orderByList \LHSHasuraTrackOrderBy {..} ->
           if
               | Just idOrder <- tob_id -> case idOrder of
-                Asc -> compare trackId1 trackId2
-                Desc -> compare trackId2 trackId1
+                  Asc -> compare trackId1 trackId2
+                  Desc -> compare trackId2 trackId1
               | Just titleOrder <- tob_title -> case titleOrder of
-                Asc -> compare trackTitle1 trackTitle2
-                Desc -> compare trackTitle2 trackTitle1
+                  Asc -> compare trackTitle1 trackTitle2
+                  Desc -> compare trackTitle2 trackTitle1
               | Just albumIdOrder <- tob_album_id ->
-                compareWithNullLast albumIdOrder trackAlbumId1 trackAlbumId2
+                  compareWithNullLast albumIdOrder trackAlbumId1 trackAlbumId2
               | otherwise ->
-                error "empty track_order object"
+                  error "empty track_order object"
     compareWithNullLast Desc x1 x2 = compareWithNullLast Asc x2 x1
     compareWithNullLast Asc Nothing Nothing = EQ
     compareWithNullLast Asc (Just _) Nothing = LT

diff --git a/server/lib/api-tests/test/Test/SQLServer/VarcharLiteralsSpec.hs b/server/lib/api-tests/test/Test/SQLServer/VarcharLiteralsSpec.hs
@@ -275,7 +275,8 @@ tests opts = do
 
     actual
       `sqlShouldSatisfy` ( \sql ->
-                             "'horse'" `T.isInfixOf` sql
+                             "'horse'"
+                               `T.isInfixOf` sql
                                && not ("N'horse'" `T.isInfixOf` sql)
                          )
 
@@ -297,7 +298,8 @@ tests opts = do
 
     actual
       `sqlShouldSatisfy` ( \sql ->
-                             "'horse'" `T.isInfixOf` sql
+                             "'horse'"
+                               `T.isInfixOf` sql
                                && not ("N'horse'" `T.isInfixOf` sql)
                          )
 

diff --git a/server/lib/dc-api/.ormolu b/server/lib/dc-api/.ormolu
@@ -0,0 +1 @@
+infixr 8 .=
diff --git a/server/lib/dc-api/src/Hasura/Backends/DataConnector/API.hs b/server/lib/dc-api/src/Hasura/Backends/DataConnector/API.hs
@@ -124,7 +124,7 @@ data Prometheus
 --       we can just demand that agent authors pick one of the following.
 instance Accept Prometheus where
   contentTypes _ =
-    "text" // "plain" /: ("version", "0.0.4") /: ("charset", "utf-8")
+    ("text" // "plain" /: ("version", "0.0.4") /: ("charset", "utf-8"))
       :| ["application" // "openmetrics-text" /: ("version", "0.0.1")]
 
 instance MimeRender Prometheus Text where

diff --git a/server/lib/dc-api/src/Hasura/Backends/DataConnector/API/V0/Query.hs b/server/lib/dc-api/src/Hasura/Backends/DataConnector/API/V0/Query.hs
@@ -71,11 +71,11 @@ instance HasCodec QueryRequest where
     object "QueryRequest" $
       QueryRequest
         <$> requiredField "table" "The name of the table to query"
-        .= _qrTable
+          .= _qrTable
         <*> requiredField "table_relationships" "The relationships between tables involved in the entire query request"
-        .= _qrTableRelationships
+          .= _qrTableRelationships
         <*> requiredField "query" "The details of the query against the table"
-        .= _qrQuery
+          .= _qrQuery
 
 newtype FieldName = FieldName {unFieldName :: Text}
   deriving stock (Eq, Ord, Show, Generic, Data)
@@ -104,17 +104,17 @@ instance HasCodec Query where
     named "Query" . object "Query" $
       Query
         <$> optionalFieldOrNull "fields" "Fields of the query"
-        .= _qFields
+          .= _qFields
         <*> optionalFieldOrNull "aggregates" "Aggregate fields of the query"
-        .= _qAggregates
+          .= _qAggregates
         <*> optionalFieldOrNull "limit" "Optionally limit to N results"
-        .= _qLimit
+          .= _qLimit
         <*> optionalFieldOrNull "offset" "Optionally offset from the Nth result"
-        .= _qOffset
+          .= _qOffset
         <*> optionalFieldOrNull "where" "Optionally constrain the results to satisfy some predicate"
-        .= _qWhere
+          .= _qWhere
         <*> optionalFieldOrNull "order_by" "Optionally order the results by the value of one or more fields"
-        .= _qOrderBy
+          .= _qOrderBy
 
 -- | A relationship consists of the following components:
 --   - a sub-query, from the perspective that a relationship field will occur
@@ -132,9 +132,9 @@ relationshipFieldObjectCodec :: JSONObjectCodec RelationshipField
 relationshipFieldObjectCodec =
   RelationshipField
     <$> requiredField "relationship" "The name of the relationship to follow for the subquery"
-    .= _rfRelationship
+      .= _rfRelationship
     <*> requiredField "query" "Relationship query"
-    .= _rfQuery
+      .= _rfQuery
 
 -- | The specific fields that are targeted by a 'Query'.
 --
@@ -181,9 +181,9 @@ instance HasCodec QueryResponse where
     named "QueryResponse" . object "QueryResponse" $
       QueryResponse
         <$> optionalFieldOrNull "rows" "The rows returned by the query, corresponding to the query's fields"
-        .= _qrRows
+          .= _qrRows
         <*> optionalFieldOrNull "aggregates" "The results of the aggregates returned by the query"
-        .= _qrAggregates
+          .= _qrAggregates
 
 instance HasStatus QueryResponse where
   type StatusOf QueryResponse = 200

diff --git a/server/lib/dc-api/test/Test/SchemaSpec.hs b/server/lib/dc-api/test/Test/SchemaSpec.hs
@@ -38,11 +38,12 @@ spec TestData {..} api sourceName config API.Capabilities {..} = describe "schem
     -- We remove some properties here so that we don't compare them since they vary between agent implementations
     let extractJsonForComparison table =
           let columns = fmap toJSON . sortOn API._ciName $ API._tiColumns table
-           in columns & traverse %~ \column ->
-                column
-                  & _Object . at "type" .~ Nothing -- Types can vary between agents since underlying datatypes can change
-                  & _Object . at "description" .~ Nothing -- Descriptions are not supported by all agents
-                  -- If the agent only supports nullable columns, we make all columns nullable
+           in columns
+                & traverse %~ \column ->
+                  column
+                    & _Object . at "type" .~ Nothing -- Types can vary between agents since underlying datatypes can change
+                    & _Object . at "description" .~ Nothing -- Descriptions are not supported by all agents
+                    -- If the agent only supports nullable columns, we make all columns nullable
     let setExpectedColumnNullability columns =
           if API._dscColumnNullability _cDataSchema == API.OnlyNullableColumns
             then columns & traverse %~ (_Object . at "nullable" ?~ Bool True)

diff --git a/server/lib/graphql-parser-hs/.ormolu b/server/lib/graphql-parser-hs/.ormolu
@@ -0,0 +1 @@
+infix 0 <?>
diff --git a/server/lib/graphql-parser-hs/src/Language/GraphQL/Draft/Parser.hs b/server/lib/graphql-parser-hs/src/Language/GraphQL/Draft/Parser.hs
@@ -112,7 +112,8 @@ variableDefinitions = parens (many1 variableDefinition)
 
 variableDefinition :: Parser AST.VariableDefinition
 variableDefinition =
-  AST.VariableDefinition <$> variable
+  AST.VariableDefinition
+    <$> variable
     <* tok ":"
     <*> graphQLType
     <*> optional defaultValue
@@ -500,7 +501,8 @@ nameParser :: AT.Parser AST.Name
 nameParser =
   AST.unsafeMkName
     <$> tok
-      ( (<>) <$> AT.takeWhile1 isFirstChar
+      ( (<>)
+          <$> AT.takeWhile1 isFirstChar
           <*> AT.takeWhile isNonFirstChar
       )
 {-# INLINE nameParser #-}

diff --git a/server/lib/pg-client-hs/src/Database/PG/Query/Connection.hs b/server/lib/pg-client-hs/src/Database/PG/Query/Connection.hs
@@ -192,7 +192,8 @@ initPQConn ci logger =
 
     whenSerVerNotOk v =
       throwIO $
-        PGConnErr $ "Unsupported postgres version: " <> fromString (show v)
+        PGConnErr $
+          "Unsupported postgres version: " <> fromString (show v)
 
     whenSerVerOk conn = do
       -- Set some parameters and check the response
@@ -318,7 +319,8 @@ checkResult conn mRes =
       msg <- liftIO $ readConnErr conn
       let whenConnOk =
             throwPGIntErr $
-              PGIUnexpected $ "Fatal error (perhaps an OOM): " <> msg
+              PGIUnexpected $
+                "Fatal error (perhaps an OOM): " <> msg
       isConnOk >>= bool (whenConnNotOk msg) whenConnOk
     Just res -> do
       st <- lift $ PQ.resultStatus res
@@ -537,7 +539,8 @@ execQuery ::
 execQuery pgConn pgQuery = do
   resOk <-
     retryOnConnErr pgConn $
-      bool withoutPrepare withPrepare $ allowPrepare && preparable
+      bool withoutPrepare withPrepare $
+        allowPrepare && preparable
   withExceptT PGIUnexpected $ convF resOk
   where
     PGConn conn allowPrepare cancelable _ _ _ _ _ _ = pgConn

diff --git a/server/lib/pg-client-hs/src/Database/PG/Query/Listen.hs b/server/lib/pg-client-hs/src/Database/PG/Query/Listen.hs
@@ -70,7 +70,9 @@ listen pool channel handler = catchConnErr $
     eRes <-
       liftIO $
         runExceptT $
-          execMulti pgConn (mkTemplate listenCmd) $ const $ return ()
+          execMulti pgConn (mkTemplate listenCmd) $
+            const $
+              return ()
     either throwTxErr return eRes
     -- Emit onStart event
     liftIO $ handler PNEOnStart

diff --git a/server/lib/pg-client-hs/src/Database/PG/Query/Transaction.hs b/server/lib/pg-client-hs/src/Database/PG/Query/Transaction.hs
@@ -191,7 +191,8 @@ rawQE ef q args prep = TxET $
   ReaderT $ \pgConn ->
     withExceptT (ef . txErrF) $
       hoist liftIO $
-        execQuery pgConn $ PGQuery (mkTemplate stmt) args prep fromRes
+        execQuery pgConn $
+          PGQuery (mkTemplate stmt) args prep fromRes
   where
     txErrF = PGTxErr stmt args prep
     stmt = getQueryText q