diff --git a/fourmolu.yaml b/fourmolu.yaml new file mode 100644 index 0000000..40cd005 --- /dev/null +++ b/fourmolu.yaml @@ -0,0 +1,51 @@ +# Number of spaces per indentation step +indentation: 2 + +# Max line length for automatic line breaking +column-limit: 200 + +# Styling of arrows in type signatures (choices: trailing, leading, or leading-args) +function-arrows: trailing + +# How to place commas in multi-line lists, records, etc. (choices: leading or trailing) +comma-style: leading + +# Styling of import/export lists (choices: leading, trailing, or diff-friendly) +import-export-style: leading + +# Whether to full-indent or half-indent 'where' bindings past the preceding body +indent-wheres: false + +# Whether to leave a space before an opening record brace +record-brace-space: true + +# Number of spaces between top-level declarations +newlines-between-decls: 1 + +# How to print Haddock comments (choices: single-line, multi-line, or multi-line-compact) +haddock-style: multi-line + +# How to print module docstring +haddock-style-module: null + +# Styling of let blocks (choices: auto, inline, newline, or mixed) +let-style: auto + +# How to align the 'in' keyword with respect to the 'let' keyword (choices: left-align, right-align, or no-space) +in-style: right-align + +# Whether to put parentheses around a single constraint (choices: auto, always, or never) +single-constraint-parens: always + +# Output Unicode syntax (choices: detect, always, or never) +unicode: never + +# Give the programmer more choice on where to insert blank lines +respectful: true + +# Fixity information for operators +fixities: [] + +# Module reexports Fourmolu should know about +reexports: [] + diff --git a/src-testdep/OkChannel.hs b/src-testdep/OkChannel.hs index 15da032..42f7aa3 100644 --- a/src-testdep/OkChannel.hs +++ b/src-testdep/OkChannel.hs @@ -2,16 +2,16 @@ {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE KindSignatures #-} -module OkChannel ( - M (..), - ReceiveException (..), - SendException, - showsPrecReceiveException, - showsPrecSendException, - Resource, - send, - receive, -) where +module OkChannel + ( M (..) + , ReceiveException (..) + , SendException + , showsPrecReceiveException + , showsPrecSendException + , Resource + , send + , receive + ) where import Data.Bytes (Bytes) import Data.Bytes.Chunks (Chunks (ChunksCons, ChunksNil)) diff --git a/src-types/Http/Exchange/Types.hs b/src-types/Http/Exchange/Types.hs index 0404dea..47790cd 100644 --- a/src-types/Http/Exchange/Types.hs +++ b/src-types/Http/Exchange/Types.hs @@ -1,9 +1,9 @@ {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DerivingStrategies #-} -module Http.Exchange.Types ( - HttpException (..), -) where +module Http.Exchange.Types + ( HttpException (..) + ) where import Control.Exception qualified as E import Data.Bytes (Bytes) @@ -48,7 +48,7 @@ instance Show HttpException where showsPrec _ ExpectedCrlfAfterChunkLength = showString "ExpectedCrlfAfterChunkLength" showsPrec _ ExpectedCrlfBeforeChunkLength = showString "ExpectedCrlfBeforeChunkLength" showsPrec _ HeadersMalformed = showString "HeadersMalformed" - showsPrec _ HeadersEndOfInput{} = showString "HeadersEndOfInput{..}" + showsPrec _ HeadersEndOfInput {} = showString "HeadersEndOfInput{..}" showsPrec _ HeadersTooLarge = showString "HeadersTooLarge" showsPrec _ ImplementationMistake = showString "ImplementationMistake" showsPrec _ NonNumericChunkLength = showString "NonNumericChunkLength" diff --git a/src/Exchange.hs b/src/Exchange.hs index bf628cf..344adcc 100644 --- a/src/Exchange.hs +++ b/src/Exchange.hs @@ -4,12 +4,12 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} -module Exchange ( - Exception (..), - HttpException (..), - exchange, - exchangeDiscardBody, -) where +module Exchange + ( Exception (..) + , HttpException (..) + , exchange + , exchangeDiscardBody + ) where import Channel (M, ReceiveException, Resource, SendException, receive, send) import Control.Monad (when) @@ -156,7 +156,7 @@ receiveResponsePreserveBody :: receiveResponsePreserveBody !ctx = receiveHeaders ctx >>= \case Left err -> pure (Left err) - Right (resp@Response.Response{headers}, post) -> case lookupTransferEncoding headers of + Right (resp@Response.Response {headers}, post) -> case lookupTransferEncoding headers of Left err -> pure (Left (Http err)) Right enc -> case enc of Nonchunked -> handleNonchunkedBody ctx resp post headers @@ -168,7 +168,7 @@ receiveResponseDiscardBody :: receiveResponseDiscardBody !ctx = receiveHeaders ctx >>= \case Left err -> pure (Left err) - Right (resp@Response.Response{headers}, post) -> case lookupTransferEncoding headers of + Right (resp@Response.Response {headers}, post) -> case lookupTransferEncoding headers of Left err -> pure (Left (Http err)) Right enc -> case enc of Nonchunked -> discardNonchunkedBody ctx resp post headers @@ -322,7 +322,7 @@ splitEndOfHeaders !b = case Bytes.findTetragramIndex 0x0D 0x0A 0x0D 0x0A b of lookupTransferEncoding :: Headers -> Either HttpException TransferEncoding lookupTransferEncoding !hdrs = case Headers.lookupTransferEncoding hdrs of - Right Header{value} -> case value of + Right Header {value} -> case value of "chunked" -> Right Chunked _ -> Left E.TransferEncodingUnrecognized Left Missing -> Right Nonchunked @@ -333,7 +333,7 @@ lookupContentLength !hdrs = case Headers.lookupContentLength hdrs of Left Missing -> Right 0 Left Duplicate -> Left E.ContentLengthDuplicated - Right Header{value} -> case readMaybe (T.unpack value) of + Right Header {value} -> case readMaybe (T.unpack value) of Nothing -> Left E.ContentLengthMalformed Just i -> do when (i > 8_000_000_000) (Left E.ContentLengthTooLarge) diff --git a/test/Main.hs b/test/Main.hs index 829deb0..a7c558e 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -27,37 +27,37 @@ tests = testGroup "tests" [ testCase "get-a" $ do - (input, output, Bodied{body}) <- evaluateM (E.exchange () getReqA) (Chunks.fromBytes getRespA) + (input, output, Bodied {body}) <- evaluateM (E.exchange () getReqA) (Chunks.fromBytes getRespA) body @=? ChunksNil input @=? mempty output @=? Chunks.concat (Request.bodiedToChunks getReqA) , testCase "get-chunked-a" $ do - (input, output, Bodied{body}) <- evaluateM (E.exchange () getReqA) (Chunks.fromBytes getRespChunkedA) + (input, output, Bodied {body}) <- evaluateM (E.exchange () getReqA) (Chunks.fromBytes getRespChunkedA) body @=? ChunksNil input @=? mempty output @=? Chunks.concat (Request.bodiedToChunks getReqA) , testCase "get-chunked-byte-by-byte-a" $ do - (input, output, Bodied{body}) <- evaluateM (E.exchange () getReqA) (bytesToSingleByteChunks getRespChunkedA) + (input, output, Bodied {body}) <- evaluateM (E.exchange () getReqA) (bytesToSingleByteChunks getRespChunkedA) body @=? ChunksNil input @=? mempty output @=? Chunks.concat (Request.bodiedToChunks getReqA) , testCase "get-body-a" $ do - (input, output, Bodied{body}) <- evaluateM (E.exchange () getReqA) (Chunks.fromBytes getRespBodyA) + (input, output, Bodied {body}) <- evaluateM (E.exchange () getReqA) (Chunks.fromBytes getRespBodyA) input @=? mempty body @=? ChunksCons (Ascii.fromString "helloworld") ChunksNil output @=? Chunks.concat (Request.bodiedToChunks getReqA) , testCase "get-chunked-b" $ do - (input, output, Bodied{body}) <- evaluateM (E.exchange () getReqA) (Chunks.fromBytes getRespChunkedB) + (input, output, Bodied {body}) <- evaluateM (E.exchange () getReqA) (Chunks.fromBytes getRespChunkedB) Ascii.fromString "hello to my friends." @=? Chunks.concat body mempty @=? input Chunks.concat (Request.bodiedToChunks getReqA) @=? output , testCase "get-chunked-byte-by-byte-b" $ do - (input, output, Bodied{body}) <- evaluateM (E.exchange () getReqA) (bytesToSingleByteChunks getRespChunkedB) + (input, output, Bodied {body}) <- evaluateM (E.exchange () getReqA) (bytesToSingleByteChunks getRespChunkedB) Ascii.fromString "hello to my friends." @=? Chunks.concat body mempty @=? input Chunks.concat (Request.bodiedToChunks getReqA) @=? output , testCase "get-chunked-two-by-two-b" $ do - (input, output, Bodied{body}) <- evaluateM (E.exchange () getReqA) (bytesToDoubletonByteChunks getRespChunkedB) + (input, output, Bodied {body}) <- evaluateM (E.exchange () getReqA) (bytesToDoubletonByteChunks getRespChunkedB) Ascii.fromString "hello to my friends." @=? Chunks.concat body mempty @=? input Chunks.concat (Request.bodiedToChunks getReqA) @=? output @@ -101,7 +101,7 @@ getReqA = , headers = Headers.fromArray $ Exts.fromList - [ Header{name = "Host", value = "example.com"} + [ Header {name = "Host", value = "example.com"} ] } , body = mempty