diff --git a/.ormolu b/.ormolu new file mode 100644 index 00000000..d0d60322 --- /dev/null +++ b/.ormolu @@ -0,0 +1,20 @@ +infixr 0 <| +infixl 0 |> +infixr 2 || +infixr 3 && +infix 4 == +infix 4 /= +infix 4 < +infix 4 > +infix 4 <= +infix 4 >= +infixr 5 ++ +infixl 6 + +infixl 6 - +infixl 7 * +infixl 7 / +infixl 7 // +infixr 8 ^ +infixl 9 << +infixr 9 >> + diff --git a/nri-env-parser/tests/Main.hs b/nri-env-parser/tests/Main.hs index 0909ab3b..f5be25f0 100644 --- a/nri-env-parser/tests/Main.hs +++ b/nri-env-parser/tests/Main.hs @@ -21,57 +21,54 @@ tests = "Environment" [ describe "enum" - [ test "should decode to the correct value" - <| \() -> - Environment.decodePairs - ( Environment.variable - Environment.Variable - { Environment.name = "TEST", - Environment.description = "test", - Environment.defaultValue = "A" - } - ( Environment.enum - [ ("A", A), - ("B", B) - ] - ) - ) - (Dict.singleton "TEST" "A") - |> Expect.equal (Ok A), - test "should error if the value is not in the enum" - <| \() -> - Environment.decodePairs - ( Environment.variable - Environment.Variable - { Environment.name = "TEST", - Environment.description = "test", - Environment.defaultValue = "A" - } - ( Environment.enum - [ ("A", A), - ("B", B) - ] - ) - ) - (Dict.singleton "TEST" "C") - |> Expect.equal (Err "Parsing TEST failed: Unknown option: C ( A, B )"), - test "should use the default value if the key is not present" - <| \() -> - Environment.decodePairs - ( Environment.variable - Environment.Variable - { Environment.name = "TEST", - Environment.description = "test", - Environment.defaultValue = "B" - } - ( Environment.enum - [ ("A", A), - ("B", B) - ] - ) - ) - (Dict.empty) - |> Expect.equal (Ok B) + [ test "should decode to the correct value" <| \() -> + Environment.decodePairs + ( Environment.variable + Environment.Variable + { Environment.name = "TEST", + Environment.description = "test", + Environment.defaultValue = "A" + } + ( Environment.enum + [ ("A", A), + ("B", B) + ] + ) + ) + (Dict.singleton "TEST" "A") + |> Expect.equal (Ok A), + test "should error if the value is not in the enum" <| \() -> + Environment.decodePairs + ( Environment.variable + Environment.Variable + { Environment.name = "TEST", + Environment.description = "test", + Environment.defaultValue = "A" + } + ( Environment.enum + [ ("A", A), + ("B", B) + ] + ) + ) + (Dict.singleton "TEST" "C") + |> Expect.equal (Err "Parsing TEST failed: Unknown option: C ( A, B )"), + test "should use the default value if the key is not present" <| \() -> + Environment.decodePairs + ( Environment.variable + Environment.Variable + { Environment.name = "TEST", + Environment.description = "test", + Environment.defaultValue = "B" + } + ( Environment.enum + [ ("A", A), + ("B", B) + ] + ) + ) + (Dict.empty) + |> Expect.equal (Ok B) ], let enumDecoder = Environment.variable @@ -138,61 +135,57 @@ tests = ], describe "variableWithOptionalPrefix" - [ test "Should use the prefixed value if available" - <| \() -> - Environment.decodePairs - ( Environment.variableWithOptionalPrefix - "PREFIX_" - Environment.Variable - { Environment.name = "TEST", - Environment.description = "test", - Environment.defaultValue = "default" - } - Environment.text - ) - (Dict.singleton "PREFIX_TEST" "prefixed") - |> Expect.equal (Ok "prefixed"), - test "Should use the prefixed value if both prefixed and unprefixed are available" - <| \() -> - Environment.decodePairs - ( Environment.variableWithOptionalPrefix - "PREFIX_" - Environment.Variable - { Environment.name = "TEST", - Environment.description = "test", - Environment.defaultValue = "default" - } - Environment.text - ) - (Dict.fromList [("PREFIX_TEST", "prefixed"), ("TEST", "unprefixed")]) - |> Expect.equal (Ok "prefixed"), - test "Should use the unprefixed value if only unprefixed is available" - <| \() -> - Environment.decodePairs - ( Environment.variableWithOptionalPrefix - "PREFIX_" - Environment.Variable - { Environment.name = "TEST", - Environment.description = "test", - Environment.defaultValue = "default" - } - Environment.text - ) - (Dict.singleton "TEST" "unprefixed") - |> Expect.equal (Ok "unprefixed"), - test "Should use the default value if prefixed nor unprefixed is available" - <| \() -> - Environment.decodePairs - ( Environment.variableWithOptionalPrefix - "PREFIX_" - Environment.Variable - { Environment.name = "TEST", - Environment.description = "test", - Environment.defaultValue = "default" - } - Environment.text - ) - Dict.empty - |> Expect.equal (Ok "default") + [ test "Should use the prefixed value if available" <| \() -> + Environment.decodePairs + ( Environment.variableWithOptionalPrefix + "PREFIX_" + Environment.Variable + { Environment.name = "TEST", + Environment.description = "test", + Environment.defaultValue = "default" + } + Environment.text + ) + (Dict.singleton "PREFIX_TEST" "prefixed") + |> Expect.equal (Ok "prefixed"), + test "Should use the prefixed value if both prefixed and unprefixed are available" <| \() -> + Environment.decodePairs + ( Environment.variableWithOptionalPrefix + "PREFIX_" + Environment.Variable + { Environment.name = "TEST", + Environment.description = "test", + Environment.defaultValue = "default" + } + Environment.text + ) + (Dict.fromList [("PREFIX_TEST", "prefixed"), ("TEST", "unprefixed")]) + |> Expect.equal (Ok "prefixed"), + test "Should use the unprefixed value if only unprefixed is available" <| \() -> + Environment.decodePairs + ( Environment.variableWithOptionalPrefix + "PREFIX_" + Environment.Variable + { Environment.name = "TEST", + Environment.description = "test", + Environment.defaultValue = "default" + } + Environment.text + ) + (Dict.singleton "TEST" "unprefixed") + |> Expect.equal (Ok "unprefixed"), + test "Should use the default value if prefixed nor unprefixed is available" <| \() -> + Environment.decodePairs + ( Environment.variableWithOptionalPrefix + "PREFIX_" + Environment.Variable + { Environment.name = "TEST", + Environment.description = "test", + Environment.defaultValue = "default" + } + Environment.text + ) + Dict.empty + |> Expect.equal (Ok "default") ] ] diff --git a/nri-http/src/Http.hs b/nri-http/src/Http.hs index 9322f334..e21dae13 100644 --- a/nri-http/src/Http.hs +++ b/nri-http/src/Http.hs @@ -104,8 +104,8 @@ handlerWith :: HttpSettings -> Conduit.Acquire Handler handlerWith settings = do doAnything <- liftIO Platform.doAnythingHandler manager <- TLS.newTlsManager - pure - <| Internal.Handler + pure <| + Internal.Handler (_request settings doAnything manager) (_withThirdParty settings manager) (_withThirdPartyIO settings manager) diff --git a/nri-http/test/Main.hs b/nri-http/test/Main.hs index 8453b0d4..4855aba4 100644 --- a/nri-http/test/Main.hs +++ b/nri-http/test/Main.hs @@ -216,8 +216,8 @@ expectRequest run = do let app req _respond = Exception.throwIO (FirstRequest req) log <- Expect.succeeds Platform.logHandler either <- Expect.fromIO <| Exception.try (withServerIO log app run) - Expect.succeeds - <| case either of + Expect.succeeds <| + case either of Prelude.Left (FirstRequest req) -> Task.succeed req Prelude.Right (Ok _) -> Task.fail "Expected a request, but none was received." Prelude.Right (Err err) -> Task.fail (Debug.toString err) diff --git a/nri-kafka/src/Kafka.hs b/nri-kafka/src/Kafka.hs index 1a590acc..f9ffc639 100644 --- a/nri-kafka/src/Kafka.hs +++ b/nri-kafka/src/Kafka.hs @@ -262,8 +262,8 @@ sendHelperAsync producer doAnything onDeliveryCallback msg' = do record' ( \deliveryReport -> do log <- Platform.silentHandler - Task.perform log - <| case deliveryReport of + Task.perform log <| + case deliveryReport of Producer.DeliverySuccess _producerRecord _offset -> onDeliveryCallback _ -> Task.succeed () ) diff --git a/nri-kafka/src/Kafka/Worker/Fetcher.hs b/nri-kafka/src/Kafka/Worker/Fetcher.hs index d474d3ca..8a014190 100644 --- a/nri-kafka/src/Kafka/Worker/Fetcher.hs +++ b/nri-kafka/src/Kafka/Worker/Fetcher.hs @@ -76,8 +76,8 @@ pollingLoop' -- See https://github.com/confluentinc/librdkafka/blob/c282ba2423b2694052393c8edb0399a5ef471b3f/CHANGELOG.md?plain=1#L90-L95 -- -- We have a small app to reproduce the bug. Check out scripts/pause-resume-bug/README.md - MVar.withMVar consumerLock - <| \_ -> Consumer.pollMessageBatch consumer pollingTimeout pollBatchSize + MVar.withMVar consumerLock <| + \_ -> Consumer.pollMessageBatch consumer pollingTimeout pollBatchSize msgs <- Prelude.traverse handleKafkaError eitherMsgs assignment <- Consumer.assignment consumer diff --git a/nri-kafka/src/Kafka/Worker/Internal.hs b/nri-kafka/src/Kafka/Worker/Internal.hs index 104c9265..b6d0ff40 100644 --- a/nri-kafka/src/Kafka/Worker/Internal.hs +++ b/nri-kafka/src/Kafka/Worker/Internal.hs @@ -393,8 +393,8 @@ rebalanceCallback skipOrNot messageFormat observability callback offsetSource co callback state partitionKey - STM.atomically - <| TVar.modifyTVar' (rebalanceInfo state) (Dict.insert partitionKey (Assign, now)) + STM.atomically <| + TVar.modifyTVar' (rebalanceInfo state) (Dict.insert partitionKey (Assign, now)) ) |> map (\_ -> ()) Consumer.RebalanceAssign _ -> Prelude.pure () @@ -604,12 +604,12 @@ pauseAndAnalyticsLoop maxBufferSize consumer consumerLock state pausedPartitions -- See https://github.com/confluentinc/librdkafka/blob/c282ba2423b2694052393c8edb0399a5ef471b3f/CHANGELOG.md?plain=1#L90-L95 -- -- We have a small app to reproduce the bug. Check out scripts/pause-resume-bug/README.md - unless (Set.isEmpty newlyPaused && Set.isEmpty newlyResumed) - <| MVar.withMVar consumerLock - <| \_ -> do - _ <- Consumer.pausePartitions consumer (Set.toList newlyPaused) - _ <- Consumer.resumePartitions consumer (Set.toList newlyResumed) - Prelude.pure () + unless (Set.isEmpty newlyPaused && Set.isEmpty newlyResumed) <| + MVar.withMVar consumerLock <| + \_ -> do + _ <- Consumer.pausePartitions consumer (Set.toList newlyPaused) + _ <- Consumer.resumePartitions consumer (Set.toList newlyResumed) + Prelude.pure () Control.Concurrent.threadDelay 1_000_000 {- 1 second -} pauseAndAnalyticsLoop maxBufferSize consumer consumerLock state desiredPausedPartitions @@ -621,8 +621,8 @@ pausedPartitionKeys (Settings.MaxMsgsPerPartitionBufferedLocally maxBufferSize) |> Prelude.traverse ( \(key, partition) -> do maybeLen <- Partition.length partition - Prelude.pure - <| case maybeLen of + Prelude.pure <| + case maybeLen of Nothing -> Nothing Just length -> if length > maxBufferSize diff --git a/nri-kafka/src/Kafka/Worker/Partition.hs b/nri-kafka/src/Kafka/Worker/Partition.hs index dd73d17a..206c4353 100644 --- a/nri-kafka/src/Kafka/Worker/Partition.hs +++ b/nri-kafka/src/Kafka/Worker/Partition.hs @@ -162,12 +162,12 @@ spawnWorkerThread skipOrNot messageFormat commitOffsets observabilityHandler ana -- partition as soon as this function returns, even if the processing thread -- we start below still needs boot. partition <- - map Partition - <| TVar.newTVarIO - <| case commitOffsets of - ToKafka -> Assigned Seq.empty - Elsewhere offset -> AwaitingSeekTo offset - ElsewhereButToKafkaAsWell offset -> AwaitingSeekTo offset + map Partition <| + TVar.newTVarIO <| + case commitOffsets of + ToKafka -> Assigned Seq.empty + Elsewhere offset -> AwaitingSeekTo offset + ElsewhereButToKafkaAsWell offset -> AwaitingSeekTo offset onStartup partition Exception.finally (processMsgLoop skipOrNot messageFormat commitOffsets observabilityHandler State {analytics, stopping, partition} consumer callback) @@ -441,8 +441,8 @@ peekRecord state = StopThread ( do next <- - STM.atomically - <| do + STM.atomically <| + do let (Partition partition') = partition state backlog' <- TVar.readTVar partition' case backlog' of @@ -529,8 +529,8 @@ append item (Partition partition) = length :: Partition -> Prelude.IO (Maybe Int) length (Partition partition) = do backlog <- TVar.readTVarIO partition - Prelude.pure - <| case backlog of + Prelude.pure <| + case backlog of AwaitingSeekTo _ -> Nothing Stopping -> Nothing Assigned queue -> diff --git a/nri-kafka/test/Helpers.hs b/nri-kafka/test/Helpers.hs index 62a3dff6..acf34412 100644 --- a/nri-kafka/test/Helpers.hs +++ b/nri-kafka/test/Helpers.hs @@ -223,8 +223,8 @@ test description body = ( \task' -> Platform.bracketWithError ( -- create handler - Platform.doAnything doAnything - <| case Environment.decodeDefaults Settings.decoder of + Platform.doAnything doAnything <| + case Environment.decodeDefaults Settings.decoder of Ok settings -> map Ok diff --git a/nri-kafka/test/Spec/Kafka/Worker/Integration.hs b/nri-kafka/test/Spec/Kafka/Worker/Integration.hs index 8ee39ea6..b45782dc 100644 --- a/nri-kafka/test/Spec/Kafka/Worker/Integration.hs +++ b/nri-kafka/test/Spec/Kafka/Worker/Integration.hs @@ -69,8 +69,8 @@ tests = if retryCount < 1 then STM.throwSTM (Prelude.userError "retry please") else - Prelude.pure - <| Worker.SeekToOffset ((Worker.offset partitionOffset) + 1) + Prelude.pure <| + Worker.SeekToOffset ((Worker.offset partitionOffset) + 1) ) msgs' <- waitFor msgsTVar (\items -> Set.size items == 1) -- Assert that the message was recorded on its first retry diff --git a/nri-log-explorer/src/Main.hs b/nri-log-explorer/src/Main.hs index cb4974d4..49b56150 100644 --- a/nri-log-explorer/src/Main.hs +++ b/nri-log-explorer/src/Main.hs @@ -352,37 +352,37 @@ update model msg = _ -> model ) EditorEvent vtyEvent -> - andThen continueAfterUserInteraction - <| withPageEvent model - <| \page -> do - case page of - NoDataPage (EditFilter editor) _ -> do - newEditor <- Edit.handleEditorEvent vtyEvent (currentValue editor) - editRootSpanFilter (setCurrent newEditor editor) (rootSpanPage model) - |> RootSpanPage - |> Prelude.pure - NoDataPage _ _ -> Prelude.pure page - RootSpanPage rootSpanPageData -> - case filter rootSpanPageData of - EditFilter editor -> do - newEditor <- Edit.handleEditorEvent vtyEvent (currentValue editor) - editRootSpanFilter (setCurrent newEditor editor) rootSpanPageData - |> RootSpanPage - |> Prelude.pure - _ -> Prelude.pure page - SpanBreakdownPage spanBreakdownPageData -> - case search spanBreakdownPageData of - EditSearch editor -> do - newEditor <- Edit.handleEditorEvent vtyEvent (currentValue editor) - spanBreakdownPageData - { search = EditSearch (setCurrent newEditor editor), - spans = - spans spanBreakdownPageData - |> Prelude.fmap (Tuple.second >> annotateSearch (Just newEditor)) - } - |> SpanBreakdownPage - |> Prelude.pure - _ -> Prelude.pure page + andThen continueAfterUserInteraction <| + withPageEvent model <| + \page -> do + case page of + NoDataPage (EditFilter editor) _ -> do + newEditor <- Edit.handleEditorEvent vtyEvent (currentValue editor) + editRootSpanFilter (setCurrent newEditor editor) (rootSpanPage model) + |> RootSpanPage + |> Prelude.pure + NoDataPage _ _ -> Prelude.pure page + RootSpanPage rootSpanPageData -> + case filter rootSpanPageData of + EditFilter editor -> do + newEditor <- Edit.handleEditorEvent vtyEvent (currentValue editor) + editRootSpanFilter (setCurrent newEditor editor) rootSpanPageData + |> RootSpanPage + |> Prelude.pure + _ -> Prelude.pure page + SpanBreakdownPage spanBreakdownPageData -> + case search spanBreakdownPageData of + EditSearch editor -> do + newEditor <- Edit.handleEditorEvent vtyEvent (currentValue editor) + spanBreakdownPageData + { search = EditSearch (setCurrent newEditor editor), + spans = + spans spanBreakdownPageData + |> Prelude.fmap (Tuple.second >> annotateSearch (Just newEditor)) + } + |> SpanBreakdownPage + |> Prelude.pure + _ -> Prelude.pure page Next -> withPageEvent model @@ -806,8 +806,8 @@ editorWithCursor :: Edit.Editor Text Name -> List Text -> Brick.Widget Name editorWithCursor editor t = let (_, cursorPos) = TZ.cursorPosition (editor ^. Edit.editContentsL) (before, after) = Data.Text.splitAt cursorPos (Prelude.mconcat t) - in Brick.hBox - <| case Data.Text.uncons after of + in Brick.hBox <| + case Data.Text.uncons after of Just (x, rest) -> [ Brick.txt before, Brick.withAttr "selected" <| Brick.txt <| Data.Text.singleton x, diff --git a/nri-observability/src/Observability.hs b/nri-observability/src/Observability.hs index 46b714d6..0615c9d3 100644 --- a/nri-observability/src/Observability.hs +++ b/nri-observability/src/Observability.hs @@ -63,8 +63,8 @@ handler settings = do reportCounter <- Conduit.liftIO <| newTVarIO (0 :: Int) Conduit.mkAcquire - ( Prelude.pure - <| Handler + ( Prelude.pure <| + Handler ( \requestId span -> do atomically (modifyTVar reportCounter (+ 1)) diff --git a/nri-observability/src/Reporter/Honeycomb/Internal.hs b/nri-observability/src/Reporter/Honeycomb/Internal.hs index f5329b6a..f78743a3 100644 --- a/nri-observability/src/Reporter/Honeycomb/Internal.hs +++ b/nri-observability/src/Reporter/Honeycomb/Internal.hs @@ -519,8 +519,8 @@ handler settings = do if skipLogging then Prelude.pure SampledOut else - Prelude.pure - <| SendToHoneycomb + Prelude.pure <| + SendToHoneycomb SharedTraceData { timer, sampleRate, diff --git a/nri-postgresql/src/Postgres.hs b/nri-postgresql/src/Postgres.hs index 24cc719a..bbc8e11e 100644 --- a/nri-postgresql/src/Postgres.hs +++ b/nri-postgresql/src/Postgres.hs @@ -65,8 +65,8 @@ transaction conn func = -- end :: Platform.Succeeded -> PGConnection -> Task x () end succeeded c = - doIO conn - <| case succeeded of + doIO conn <| + case succeeded of Platform.Succeeded -> pgCommit c Platform.Failed -> pgRollback c Platform.FailedWith _ -> pgRollback c @@ -222,14 +222,14 @@ withConnection :: Connection -> (PGConnection -> Task e a) -> Task e a withConnection conn func = let acquire :: Data.Pool.Pool conn -> Task x (conn, Data.Pool.LocalPool conn) acquire pool = - Log.withContext "acquiring Postgres connection from pool" [] - <| doIO conn - <| Data.Pool.takeResource pool + Log.withContext "acquiring Postgres connection from pool" [] <| + doIO conn <| + Data.Pool.takeResource pool -- release :: Data.Pool.Pool conn -> Platform.Succeeded -> (conn, Data.Pool.LocalPool conn) -> Task y () release pool succeeded (c, localPool) = - doIO conn - <| case succeeded of + doIO conn <| + case succeeded of Platform.Succeeded -> Data.Pool.putResource localPool c Platform.Failed -> diff --git a/nri-postgresql/src/Postgres/Connection.hs b/nri-postgresql/src/Postgres/Connection.hs index c7962eb6..979e6eca 100644 --- a/nri-postgresql/src/Postgres/Connection.hs +++ b/nri-postgresql/src/Postgres/Connection.hs @@ -52,8 +52,8 @@ connectionIO settings = do |> Prelude.fromIntegral doAnything <- Platform.doAnythingHandler pool <- - map Pool - <| Data.Pool.newPool + map Pool <| + Data.Pool.newPool ( Data.Pool.defaultPoolConfig (pgConnect database `Exception.catch` handleError (toConnectionString database)) pgDisconnect diff --git a/nri-postgresql/src/Postgres/Enum.hs b/nri-postgresql/src/Postgres/Enum.hs index e6d599a8..0e6a64e5 100644 --- a/nri-postgresql/src/Postgres/Enum.hs +++ b/nri-postgresql/src/Postgres/Enum.hs @@ -142,80 +142,80 @@ generatePGEnum hsTypeName databaseTypeName mapping = do -- Note: We make sure to capture IO errors and re-throw them below in the Q monad so that our test framework can capture them (maybePGEnumValues :: Either Control.Exception.IOException (List Text)) <- - TH.runIO - <| Control.Exception.try - <| withTPGConnection - ( \connection -> do - -- Check if the databaseTypeName exists on the PG database and is an enum - -- See https://www.postgresql.org/docs/current/catalog-pg-type.html - typeType <- - pgSimpleQuery - connection - ( BSL.fromChunks - [ "SELECT typtype", - " FROM pg_catalog.pg_type", - " JOIN pg_catalog.pg_namespace ON pg_namespace.oid = pg_type.typnamespace", - " WHERE pg_type.typname = '", - Encoding.encodeUtf8 type_enum_name, - "'", - " AND pg_namespace.nspname = '", - Encoding.encodeUtf8 type_schema_name, - "'" - ] - ) - |> fmap - ( \(_, rows) -> - rows - |> List.filterMap - ( \cols -> - case cols of - [enumlabel] -> - Just (pgDecodeRep enumlabel) - _ -> - Nothing - ) + TH.runIO <| + Control.Exception.try <| + withTPGConnection + ( \connection -> do + -- Check if the databaseTypeName exists on the PG database and is an enum + -- See https://www.postgresql.org/docs/current/catalog-pg-type.html + typeType <- + pgSimpleQuery + connection + ( BSL.fromChunks + [ "SELECT typtype", + " FROM pg_catalog.pg_type", + " JOIN pg_catalog.pg_namespace ON pg_namespace.oid = pg_type.typnamespace", + " WHERE pg_type.typname = '", + Encoding.encodeUtf8 type_enum_name, + "'", + " AND pg_namespace.nspname = '", + Encoding.encodeUtf8 type_schema_name, + "'" + ] ) - - _ <- case typeType of - [] -> - fail ("Type " ++ quote (Text.toList databaseTypeName) ++ " does not exist on the database.") - -- 'e' means enum type - ['e'] -> - pure () - _ -> - fail ("Type " ++ quote (Text.toList databaseTypeName) ++ " is not an enum type.") - - enumLabels <- - pgSimpleQuery - connection - ( BSL.fromChunks - [ "SELECT enumlabel", - " FROM pg_catalog.pg_enum", - " WHERE enumtypid = '", - Encoding.encodeUtf8 databaseTypeName, - "'::regtype", - " ORDER BY enumsortorder" - ] - ) - |> fmap - ( \(_, rows) -> - rows - |> List.filterMap - ( \cols -> - case cols of - [enumlabel] -> - Just (pgDecodeRep enumlabel) - _ -> - Nothing - ) + |> fmap + ( \(_, rows) -> + rows + |> List.filterMap + ( \cols -> + case cols of + [enumlabel] -> + Just (pgDecodeRep enumlabel) + _ -> + Nothing + ) + ) + + _ <- case typeType of + [] -> + fail ("Type " ++ quote (Text.toList databaseTypeName) ++ " does not exist on the database.") + -- 'e' means enum type + ['e'] -> + pure () + _ -> + fail ("Type " ++ quote (Text.toList databaseTypeName) ++ " is not an enum type.") + + enumLabels <- + pgSimpleQuery + connection + ( BSL.fromChunks + [ "SELECT enumlabel", + " FROM pg_catalog.pg_enum", + " WHERE enumtypid = '", + Encoding.encodeUtf8 databaseTypeName, + "'::regtype", + " ORDER BY enumsortorder" + ] ) - - case enumLabels of - [] -> - fail ("Enum type " ++ quote (Text.toList databaseTypeName) ++ " does not contain any values.") - vs -> - pure vs - ) + |> fmap + ( \(_, rows) -> + rows + |> List.filterMap + ( \cols -> + case cols of + [enumlabel] -> + Just (pgDecodeRep enumlabel) + _ -> + Nothing + ) + ) + + case enumLabels of + [] -> + fail ("Enum type " ++ quote (Text.toList databaseTypeName) ++ " does not contain any values.") + vs -> + pure vs + ) (pgEnumValues :: List Text) <- case maybePGEnumValues of diff --git a/nri-postgresql/src/Postgres/QueryParser.hs b/nri-postgresql/src/Postgres/QueryParser.hs index f5cb0be6..961e1765 100644 --- a/nri-postgresql/src/Postgres/QueryParser.hs +++ b/nri-postgresql/src/Postgres/QueryParser.hs @@ -40,8 +40,8 @@ data QueryMeta = QueryMeta parser :: Parser QueryMeta parser = - keepLooking - <| asum + keepLooking <| + asum [ delete, insert, select, diff --git a/nri-postgresql/src/Postgres/Settings.hs b/nri-postgresql/src/Postgres/Settings.hs index 09b0c847..cc7909b9 100644 --- a/nri-postgresql/src/Postgres/Settings.hs +++ b/nri-postgresql/src/Postgres/Settings.hs @@ -320,9 +320,9 @@ toPGDatabase then Text.toList host ".s.PGSQL." - ++ show port - |> SockAddrUnix - |> Right + ++ show port + |> SockAddrUnix + |> Right else Left (Text.toList host, show port) } where diff --git a/nri-postgresql/src/Postgres/Test.hs b/nri-postgresql/src/Postgres/Test.hs index 81e4c65e..0ff58fea 100644 --- a/nri-postgresql/src/Postgres/Test.hs +++ b/nri-postgresql/src/Postgres/Test.hs @@ -29,9 +29,8 @@ test :: (Postgres.Connection -> Expect.Expectation) -> Test.Test test description body = - Test.serialize "postgres" - <| Stack.withFrozenCallStack Test.test description - <| \_ -> + Test.serialize "postgres" <| + Stack.withFrozenCallStack Test.test description <| \_ -> Expect.around ( \task' -> do conn <- getTestConnection diff --git a/nri-prelude/src/Expect.hs b/nri-prelude/src/Expect.hs index c322ff2b..f07d3f1d 100644 --- a/nri-prelude/src/Expect.hs +++ b/nri-prelude/src/Expect.hs @@ -577,8 +577,8 @@ assert pred funcName expected actual = let expectedText = Data.Text.pack (Text.Show.Pretty.ppShow actual) let actualText = Data.Text.pack (Text.Show.Pretty.ppShow expected) let numLines text = List.length (Data.Text.lines text) - Stack.withFrozenCallStack Internal.failAssertion funcName - <| Diff.pretty + Stack.withFrozenCallStack Internal.failAssertion funcName <| + Diff.pretty Diff.Config { Diff.separatorText = Just funcName, Diff.wrapping = Diff.Wrap terminalWidth, @@ -658,8 +658,8 @@ fails task = |> Task.onError (\err' -> Task.succeed (Ok err')) |> Task.andThen ( \res -> - Internal.unExpectation - <| case res of + Internal.unExpectation <| + case res of Ok a -> Stack.withFrozenCallStack Internal.pass diff --git a/nri-prelude/src/Platform/DevLog.hs b/nri-prelude/src/Platform/DevLog.hs index 4fc2cb08..ac8f1fc8 100644 --- a/nri-prelude/src/Platform/DevLog.hs +++ b/nri-prelude/src/Platform/DevLog.hs @@ -32,8 +32,8 @@ writeSpanToDevLog span = do fileStatus <- Files.getFileStatus logFile let fileMode = Files.fileMode fileStatus let fileAccessModes = Files.intersectFileModes fileMode Files.accessModes - Control.Monad.unless (fileAccessModes == Files.stdFileMode) - <| Files.setFileMode logFile Files.stdFileMode + Control.Monad.unless (fileAccessModes == Files.stdFileMode) <| + Files.setFileMode logFile Files.stdFileMode Data.ByteString.Lazy.hPut handle (Aeson.encode (now, span)) Data.ByteString.Lazy.hPut handle "\n" ) diff --git a/nri-prelude/src/Test/Internal.hs b/nri-prelude/src/Test/Internal.hs index adc0da27..51ad8fad 100644 --- a/nri-prelude/src/Test/Internal.hs +++ b/nri-prelude/src/Test/Internal.hs @@ -264,8 +264,8 @@ fuzz3 (Fuzzer genA) (Fuzzer genB) (Fuzzer genC) name expectation = fuzzBody :: (Show a) => Fuzzer a -> (a -> Expectation) -> Expectation fuzzBody (Fuzzer gen) expectation = do - Expectation - <| Platform.Internal.Task + Expectation <| + Platform.Internal.Task ( \_log -> do -- For the moment we're not recording traces in fuzz tests. Because -- the test body runs a great many times, we'd record a ton of data @@ -516,8 +516,8 @@ runSingle test' = Platform.Internal.rootTracingSpanIO "" ( \span -> do - when (Platform.Internal.name span == spanName) - <| MVar.putMVar spanVar span + when (Platform.Internal.name span == spanName) <| + MVar.putMVar spanVar span ) spanName ( \log -> @@ -584,8 +584,8 @@ groupBy key xs = Dict.update (key x) ( \val -> - Just - <| case val of + Just <| + case val of Nothing -> [x] Just ys -> x : ys ) diff --git a/nri-prelude/src/Test/Reporter/Stdout.hs b/nri-prelude/src/Test/Reporter/Stdout.hs index fc2587e9..93a681c2 100644 --- a/nri-prelude/src/Test/Reporter/Stdout.hs +++ b/nri-prelude/src/Test/Reporter/Stdout.hs @@ -48,8 +48,8 @@ renderReport results = Internal.OnlysPassed passed skipped -> let amountPassed = List.length passed amountSkipped = List.length skipped - in Prelude.pure - <| List.concat + in Prelude.pure <| + List.concat [ List.concatMap ( \only -> prettyPath yellow only @@ -73,8 +73,8 @@ renderReport results = Internal.PassedWithSkipped passed skipped -> let amountPassed = List.length passed amountSkipped = List.length skipped - in Prelude.pure - <| List.concat + in Prelude.pure <| + List.concat [ List.concatMap ( \only -> prettyPath yellow only @@ -105,10 +105,10 @@ renderReport results = let failures = List.map (map (\(Internal.FailedSpan _ failure) -> failure)) failed srcLocs <- Prelude.traverse Test.Reporter.Internal.readSrcLoc failures let failuresSrcs = List.map renderFailureInFile srcLocs - Prelude.pure - <| List.concat - [ List.concat - <| List.map2 + Prelude.pure <| + List.concat + [ List.concat <| + List.map2 ( \srcLines test -> prettyPath red test ++ srcLines @@ -148,8 +148,8 @@ prettyPath :: (Text.Colour.Chunk -> Text.Colour.Chunk) -> Internal.SingleTest a prettyPath style test = let loc = Internal.loc test in List.concat - [ [ grey - <| chunk + [ [ grey <| + chunk ( "↓ " ++ Text.fromList (Stack.srcLocFile loc) ++ ":" @@ -158,8 +158,8 @@ prettyPath style test = ) ], [ grey - ( chunk - <| Prelude.foldMap + ( chunk <| + Prelude.foldMap (\text -> "↓ " ++ text ++ "\n") (Internal.describes test) ), @@ -170,8 +170,8 @@ prettyPath style test = testFailure :: Internal.SingleTest Internal.Failure -> Text.Colour.Chunk testFailure test = - chunk - <| case Internal.body test of + chunk <| + case Internal.body test of Internal.FailedAssertion msg _ -> msg Internal.ThrewException exception -> "Test threw an exception\n" diff --git a/nri-prelude/tests/DebugSpec.hs b/nri-prelude/tests/DebugSpec.hs index 56b84722..c27b75e1 100644 --- a/nri-prelude/tests/DebugSpec.hs +++ b/nri-prelude/tests/DebugSpec.hs @@ -20,16 +20,16 @@ tests = toStringTests :: List Test toStringTests = - [ test "returns the show form of an empty String" - <| \() -> Expect.equal "\"\"" (Debug.toString ("" :: Text)), - test "returns the show form of an Int" - <| \() -> Expect.equal "0" (Debug.toString (0 :: Int)) + [ test "returns the show form of an empty String" <| \() -> + Expect.equal "\"\"" (Debug.toString ("" :: Text)), + test "returns the show form of an Int" <| \() -> + Expect.equal "0" (Debug.toString (0 :: Int)) ] logTests :: List Test logTests = - [ test "returns passed value" - <| \() -> Expect.equal 3.14 (3.14 :: Float) + [ test "returns passed value" <| \() -> + Expect.equal 3.14 (3.14 :: Float) ] todoTests :: List Test diff --git a/nri-redis/src/Redis/Script.hs b/nri-redis/src/Redis/Script.hs index de759128..064e01a0 100644 --- a/nri-redis/src/Redis/Script.hs +++ b/nri-redis/src/Redis/Script.hs @@ -133,14 +133,14 @@ evaluateScriptParam :: (HasScriptParam a) => a -> EvaluatedToken evaluateScriptParam scriptParam = case getScriptParam scriptParam of Key a -> - EvaluatedVariable - <| EvaluatedParam + EvaluatedVariable <| + EvaluatedParam { kind = RedisKey, value = unquoteString (Debug.toString a) } Literal a -> - EvaluatedVariable - <| EvaluatedParam + EvaluatedVariable <| + EvaluatedParam { kind = ArbitraryValue, value = unquoteString (Debug.toString a) } diff --git a/nri-redis/src/Redis/Settings.hs b/nri-redis/src/Redis/Settings.hs index d4746b96..e7c1e575 100644 --- a/nri-redis/src/Redis/Settings.hs +++ b/nri-redis/src/Redis/Settings.hs @@ -160,8 +160,8 @@ parseRedisSocketSchemeURI uri = in do uriPathText <- uriPathTextFromURI dbNum <- dbNumFromParams (URI.uriQuery uri) - pure - <| defaultConnectInfo + pure <| + defaultConnectInfo { connectPort = UnixSocket (Text.toList uriPathText), connectDatabase = dbNum, connectAuth = maybePasswordFromURI diff --git a/nri-redis/test/Spec.hs b/nri-redis/test/Spec.hs index bccfe6e0..2186fc73 100644 --- a/nri-redis/test/Spec.hs +++ b/nri-redis/test/Spec.hs @@ -9,8 +9,8 @@ import qualified Prelude main :: Prelude.IO () main = Conduit.withAcquire Helpers.getHandlers <| \testHandlers -> - Test.run - <| Test.describe + Test.run <| + Test.describe "nri-redis" [ Spec.Redis.tests testHandlers, Spec.Settings.tests, diff --git a/nri-redis/test/Spec/Redis.hs b/nri-redis/test/Spec/Redis.hs index cbe08b91..85ffca1a 100644 --- a/nri-redis/test/Spec/Redis.hs +++ b/nri-redis/test/Spec/Redis.hs @@ -366,8 +366,8 @@ queryTests redisHandler = let firstKey = "scanTest::key1" let firstValue = "value 1" let nonEmptyDict = - NonEmptyDict.init firstKey firstValue - <| Dict.fromList + NonEmptyDict.init firstKey firstValue <| + Dict.fromList [ ("scanTest::key2", "value 2"), ("scanTest::key3", "value 3"), ("scanTest::key4", "value 4") @@ -390,8 +390,8 @@ queryTests redisHandler = let firstKey = "scanDeleteTest::key1" let firstValue = "value 1" let nonEmptyDict = - NonEmptyDict.init firstKey firstValue - <| Dict.fromList + NonEmptyDict.init firstKey firstValue <| + Dict.fromList [ ("scanDeleteTest::key2", "value 2"), ("scanDeleteTest::key3", "value 3"), ("scanDeleteTest::key4", "value 4") diff --git a/nri-redis/test/Spec/Settings.hs b/nri-redis/test/Spec/Settings.hs index 1add2547..b8843eb4 100644 --- a/nri-redis/test/Spec/Settings.hs +++ b/nri-redis/test/Spec/Settings.hs @@ -242,7 +242,7 @@ decoderWithCustomConnectionStringTests = parseConnectInfoElseFailTest :: String -> Expect.Expectation' ConnectInfo parseConnectInfoElseFailTest uri = do - Expect.succeeds - <| case parseConnectInfo uri of + Expect.succeeds <| + case parseConnectInfo uri of Left err -> Task.fail <| "you wrote this test wrong, got err: " ++ Text.fromList err Right connectInfo -> pure connectInfo diff --git a/nri-test-encoding/src/Test/Encoding.hs b/nri-test-encoding/src/Test/Encoding.hs index 3c5f2beb..bceec811 100644 --- a/nri-test-encoding/src/Test/Encoding.hs +++ b/nri-test-encoding/src/Test/Encoding.hs @@ -18,7 +18,7 @@ examplesToTest name fileName examples = ( "test" "golden-results" Text.toList fileName - |> FilePath.makeValid - |> Text.fromList + |> FilePath.makeValid + |> Text.fromList ) (Examples.render examples) diff --git a/nri-test-encoding/src/Test/Encoding/Routes.hs b/nri-test-encoding/src/Test/Encoding/Routes.hs index ce33fe9b..14b7cd47 100644 --- a/nri-test-encoding/src/Test/Encoding/Routes.hs +++ b/nri-test-encoding/src/Test/Encoding/Routes.hs @@ -142,8 +142,8 @@ routesToText routes = [ case queryParams route of [] -> Nothing queryParams' -> - Just - <| Text.concat + Just <| + Text.concat ( routeName route : "?" : [Text.join "&" (List.map printQueryParam queryParams')] @@ -151,15 +151,15 @@ routesToText routes = case headers route of [] -> Nothing headers' -> - Just - <| Text.join + Just <| + Text.join " " ( routeName route : "headers" : List.map printHeaders headers' ), - Just - <| Text.join + Just <| + Text.join " " [ routeName route, "response", @@ -168,8 +168,8 @@ routesToText routes = case requestBody route of Nothing -> Nothing Just body -> - Just - <| Text.join + Just <| + Text.join " " [ routeName route, "request",