summaryrefslogtreecommitdiffhomepage
path: root/tests/Language/Haskell/Stylish/Step/Data/Tests.hs
diff options
context:
space:
mode:
Diffstat (limited to 'tests/Language/Haskell/Stylish/Step/Data/Tests.hs')
-rw-r--r--tests/Language/Haskell/Stylish/Step/Data/Tests.hs887
1 files changed, 822 insertions, 65 deletions
diff --git a/tests/Language/Haskell/Stylish/Step/Data/Tests.hs b/tests/Language/Haskell/Stylish/Step/Data/Tests.hs
index b43e6dc..1d50bf1 100644
--- a/tests/Language/Haskell/Stylish/Step/Data/Tests.hs
+++ b/tests/Language/Haskell/Stylish/Step/Data/Tests.hs
@@ -1,9 +1,11 @@
+{-# LANGUAGE OverloadedLists #-}
+{-# LANGUAGE OverloadedStrings #-}
module Language.Haskell.Stylish.Step.Data.Tests
( tests
) where
import Language.Haskell.Stylish.Step.Data
-import Language.Haskell.Stylish.Tests.Util (testStep)
+import Language.Haskell.Stylish.Tests.Util (assertSnippet, testStep)
import Test.Framework (Test, testGroup)
import Test.Framework.Providers.HUnit (testCase)
import Test.HUnit (Assertion, (@=?))
@@ -35,6 +37,39 @@ tests = testGroup "Language.Haskell.Stylish.Step.Data.Tests"
, testCase "case 22" case22
, testCase "case 23" case23
, testCase "case 24" case24
+ , testCase "case 25" case25
+ , testCase "case 26" case26
+ , testCase "case 27" case27
+ , testCase "case 28" case28
+ , testCase "case 29" case29
+ , testCase "case 30" case30
+ , testCase "case 31" case31
+ , testCase "case 32" case32
+ , testCase "case 33" case33
+ , testCase "case 34" case34
+ , testCase "case 35" case35
+ , testCase "case 36" case36
+ , testCase "case 37" case37
+ , testCase "case 38" case38
+ , testCase "case 39" case39
+ , testCase "case 40" case40
+ , testCase "case 41" case41
+ , testCase "case 42" case42
+ , testCase "case 43" case43
+ , testCase "case 44" case44
+ , testCase "case 45" case45
+ , testCase "case 46" case46
+ , testCase "case 47" case47
+ , testCase "case 48" case48
+ , testCase "case 49" case49
+ , testCase "case 50" case50
+ , testCase "case 51" case51
+ , testCase "case 52" case52
+ , testCase "case 53" case53
+ , testCase "case 54" case54
+ , testCase "case 55" case55
+ , testCase "case 56" case56
+ , testCase "case 57" case57
]
case00 :: Assertion
@@ -165,7 +200,7 @@ case07 = expected @=? testStep (step sameSameStyle) input
expected = input
case08 :: Assertion
-case08 = input @=? testStep (step sameSameStyle) input
+case08 = expected @=? testStep (step sameSameStyle) input
where
input = unlines
[ "module Herp where"
@@ -173,6 +208,11 @@ case08 = input @=? testStep (step sameSameStyle) input
, "data Phantom a ="
, " Phantom"
]
+ expected = unlines
+ [ "module Herp where"
+ , ""
+ , "data Phantom a = Phantom"
+ ]
case09 :: Assertion
case09 = expected @=? testStep (step indentIndentStyle4) input
@@ -333,7 +373,8 @@ case16 = expected @=? testStep (step indentIndentStyle) input
, ""
, "data Foo"
, " = Foo"
- , " { a :: Int -- ^ comment"
+ , " { a :: Int"
+ , " -- ^ comment"
, " }"
]
@@ -419,7 +460,70 @@ case20 = input @=? testStep (step indentIndentStyle) input
]
case21 :: Assertion
-case21 = expected @=? testStep (step sameSameStyle) input
+case21 = assertSnippet (step sameSameStyle)
+ [ "data Foo a"
+ , " = Foo { a :: Int,"
+ , " a2 :: String"
+ , " -- ^ some haddock"
+ , " }"
+ , " | Bar { b :: a } deriving (Eq, Show)"
+ , " deriving (ToJSON)"
+ ]
+ [ "data Foo a = Foo { a :: Int"
+ , " , a2 :: String"
+ , " -- ^ some haddock"
+ , " }"
+ , " | Bar { b :: a"
+ , " }"
+ , " deriving (Eq, Show)"
+ , " deriving (ToJSON)"
+ ]
+
+case22 :: Assertion
+case22 = assertSnippet (step sameIndentStyle)
+ [ "data Foo a"
+ , " = Foo { a :: Int,"
+ , " a2 :: String"
+ , " -- ^ some haddock"
+ , " }"
+ , " | Bar { b :: a } deriving (Eq, Show)"
+ , " deriving (ToJSON)"
+ ]
+ [ "data Foo a = Foo"
+ , " { a :: Int"
+ , " , a2 :: String"
+ , " -- ^ some haddock"
+ , " }"
+ , " | Bar"
+ , " { b :: a"
+ , " }"
+ , " deriving (Eq, Show)"
+ , " deriving (ToJSON)"
+ ]
+
+case23 :: Assertion
+case23 = assertSnippet (step indentSameStyle)
+ [ "data Foo a"
+ , " = Foo { a :: Int,"
+ , " a2 :: String"
+ , " -- ^ some haddock"
+ , " }"
+ , " | Bar { b :: a } deriving (Eq, Show)"
+ , " deriving (ToJSON)"
+ ]
+ [ "data Foo a"
+ , " = Foo { a :: Int"
+ , " , a2 :: String"
+ , " -- ^ some haddock"
+ , " }"
+ , " | Bar { b :: a"
+ , " }"
+ , " deriving (Eq, Show)"
+ , " deriving (ToJSON)"
+ ]
+
+case24 :: Assertion
+case24 = expected @=? testStep (step indentIndentStyle) input
where
input = unlines
[ "data Foo a"
@@ -432,18 +536,21 @@ case21 = expected @=? testStep (step sameSameStyle) input
]
expected = unlines
- [ "data Foo a = Foo { a :: Int"
- , " , a2 :: String"
- , " -- ^ some haddock"
- , " }"
- , " | Bar { b :: a"
- , " }"
+ [ "data Foo a"
+ , " = Foo"
+ , " { a :: Int"
+ , " , a2 :: String"
+ , " -- ^ some haddock"
+ , " }"
+ , " | Bar"
+ , " { b :: a"
+ , " }"
, " deriving (Eq, Show)"
, " deriving (ToJSON)"
]
-case22 :: Assertion
-case22 = expected @=? testStep (step sameIndentStyle) input
+case25 :: Assertion
+case25 = expected @=? testStep (step indentIndentStyle { cBreakSingleConstructors = False }) input
where
input = unlines
[ "data Foo a"
@@ -451,86 +558,736 @@ case22 = expected @=? testStep (step sameIndentStyle) input
, " a2 :: String"
, " -- ^ some haddock"
, " }"
- , " | Bar { b :: a } deriving (Eq, Show)"
+ , " deriving (Eq, Show)"
, " deriving (ToJSON)"
]
expected = unlines
[ "data Foo a = Foo"
- , " { a :: Int"
- , " , a2 :: String"
- , " -- ^ some haddock"
- , " }"
- , " | Bar"
- , " { b :: a"
- , " }"
+ , " { a :: Int"
+ , " , a2 :: String"
+ , " -- ^ some haddock"
+ , " }"
, " deriving (Eq, Show)"
, " deriving (ToJSON)"
]
-case23 :: Assertion
-case23 = expected @=? testStep (step indentSameStyle) input
+case26 :: Assertion
+case26 = expected @=? testStep (step indentIndentStyle) input
where
input = unlines
- [ "data Foo a"
- , " = Foo { a :: Int,"
- , " a2 :: String"
- , " -- ^ some haddock"
- , " }"
- , " | Bar { b :: a } deriving (Eq, Show)"
- , " deriving (ToJSON)"
- ]
+ [ "module Herp where"
+ , ""
+ , "data Foo = Foo { a :: Int } deriving (FromJSON) via Bla Foo"
+ ]
expected = unlines
- [ "data Foo a"
- , " = Foo { a :: Int"
- , " , a2 :: String"
- , " -- ^ some haddock"
- , " }"
- , " | Bar { b :: a"
- , " }"
- , " deriving (Eq, Show)"
- , " deriving (ToJSON)"
+ [ "module Herp where"
+ , ""
+ , "data Foo"
+ , " = Foo"
+ , " { a :: Int"
+ , " }"
+ , " deriving (FromJSON) via Bla Foo"
]
-case24 :: Assertion
-case24 = expected @=? testStep (step indentIndentStyle) input
+case27 :: Assertion
+case27 = expected @=? testStep (step sameIndentStyle { cBreakEnums = True }) input
where
input = unlines
- [ "data Foo a"
- , " = Foo { a :: Int,"
- , " a2 :: String"
- , " -- ^ some haddock"
- , " }"
- , " | Bar { b :: a } deriving (Eq, Show)"
- , " deriving (ToJSON)"
- ]
+ [ "module Herp where"
+ , ""
+ , "data Foo = Foo | Bar | Baz deriving (Eq, Show)"
+ ]
expected = unlines
- [ "data Foo a"
- , " = Foo"
- , " { a :: Int"
- , " , a2 :: String"
- , " -- ^ some haddock"
- , " }"
- , " | Bar"
- , " { b :: a"
- , " }"
- , " deriving (Eq, Show)"
- , " deriving (ToJSON)"
+ [ "module Herp where"
+ , ""
+ , "data Foo"
+ , " = Foo"
+ , " | Bar"
+ , " | Baz"
+ , " deriving (Eq, Show)"
+ ]
+
+case28 :: Assertion
+case28 = expected @=? testStep (step sameIndentStyle { cBreakEnums = True }) input
+ where
+ input = unlines
+ [ "module Some.Types where"
+ , ""
+ , "newtype BankCode = BankCode {"
+ , " unBankCode :: Text"
+ , " }"
+ , " deriving stock (Generic, Eq, Show)"
+ , " deriving anyclass (Newtype)"
+ , ""
+ , "newtype CheckDigit = CheckDigit { unCheckDigit :: Text }"
+ , " deriving stock (Generic, Eq, Show)"
+ , " deriving anyclass (Newtype)"
+ , ""
+ , "newtype WrappedInt = WrappedInt Int"
+ , " deriving stock (Generic, Eq, Show)"
+ , " deriving anyclass (Newtype)"
+ , ""
+ , "data MandateStatus"
+ , " = Approved"
+ , " | Failed"
+ , " | UserCanceled"
+ , " | Inactive"
+ , " deriving stock (Generic, Show, Eq, Enum, Bounded)"
+ , " deriving (ToJSON, FromJSON) via SnakeCaseCapsEnumEncoding MandateStatus"
+ ]
+
+ expected = unlines
+ [ "module Some.Types where"
+ , ""
+ , "newtype BankCode = BankCode { unBankCode :: Text }"
+ , " deriving stock (Eq, Generic, Show)"
+ , " deriving anyclass (Newtype)"
+ , ""
+ , "newtype CheckDigit = CheckDigit { unCheckDigit :: Text }"
+ , " deriving stock (Eq, Generic, Show)"
+ , " deriving anyclass (Newtype)"
+ , ""
+ , "newtype WrappedInt = WrappedInt Int"
+ , " deriving stock (Eq, Generic, Show)"
+ , " deriving anyclass (Newtype)"
+ , ""
+ , "data MandateStatus"
+ , " = Approved"
+ , " | Failed"
+ , " | UserCanceled"
+ , " | Inactive"
+ , " deriving stock (Bounded, Enum, Eq, Generic, Show)"
+ , " deriving (FromJSON, ToJSON) via SnakeCaseCapsEnumEncoding MandateStatus"
+ ]
+
+case29 :: Assertion
+case29 = expected @=? testStep (step sameIndentStyle) input
+ where
+ input = unlines
+ [ "module Some.Types where"
+ , ""
+ , "data NonEmpty a"
+ , " = a :| [a]"
+ ]
+
+ expected = unlines
+ [ "module Some.Types where"
+ , ""
+ , "data NonEmpty a = a :| [a]"
+ ]
+
+case30 :: Assertion
+case30 = expected @=? testStep (step sameIndentStyle { cBreakEnums = True }) input
+ where
+ expected = input
+ input = unlines
+ [ "data ReasonCode"
+ , " = MissingTenantId"
+ , " -- Transaction errors:"
+ , " | TransactionDoesNotExist"
+ , " | TransactionAlreadyExists"
+ , " -- Engine errors:"
+ , " | EnginePersistenceError"
+ , " | EngineValidationError"
+ , " -- | Transaction was created in Info mode"
+ , " | RegisteredByNetworkEngine"
+ , " -- | Transaction was created in Routing mode"
+ , " | SentToNetworkEngine"
+ , " -- Network connection reasons:"
+ , " | SentToNetworkConnection"
+ , " | ReceivedByNetworkConnection"
+ , " | ValidatedByNetworkConnection"
+ ]
+
+
+case31 :: Assertion
+case31 = expected @=? testStep (step indentIndentStyle { cBreakEnums = True }) input
+ where
+ expected = input
+ input = unlines
+ [ "data ConfiguredLogger"
+ , " -- | Logs to file"
+ , " = LogTo FilePath"
+ , " -- | Logs to stdout"
+ , " | LogToConsole"
+ , " -- | No logging, discards all messages"
+ , " | NoLogging"
+ , " deriving stock (Generic, Show)"
+ ]
+
+case32 :: Assertion
+case32 = expected @=? testStep (step indentIndentStyle { cBreakEnums = True }) input
+ where
+ expected = input
+ input = unlines
+ [ "data RejectionReason"
+ , " -- InvalidState"
+ , " = CancellationFailed"
+ , " | TotalAmountConfirmationInvalid"
+ , " -- InvalidApiUsage"
+ , " | AccessTokenNotActive"
+ , " | VersionNotFound"
+ , " -- ValidationFailed"
+ , " | BankAccountExists"
+ , " deriving stock (Eq, Generic, Show)"
+ , " deriving (FromJSON, ToJSON) via SnakeCaseLowercaseEnumEncoding RejectionReason"
+ ]
+
+case33 :: Assertion
+case33 = expected @=? testStep (step indentIndentStyle { cBreakEnums = True, cBreakSingleConstructors = False }) input
+ where
+ input = unlines
+ [ "module Some.Types where"
+ , ""
+ , "newtype NonEmpty a = NonEmpty { unNonEmpty :: a }"
+ ]
+
+ expected = unlines
+ [ "module Some.Types where"
+ , ""
+ , "newtype NonEmpty a"
+ , " = NonEmpty { unNonEmpty :: a }"
+ ]
+
+case34 :: Assertion
+case34 = expected @=? testStep (step indentIndentStyle { cVia = Indent 2 }) input
+ where
+ input = unlines
+ [ "module Some.Types where"
+ , ""
+ , "newtype NonEmpty a = NonEmpty { unNonEmpty :: a }"
+ , " deriving (ToJSON, FromJSON) via Something Magic (NonEmpty a)"
+ ]
+
+ expected = unlines
+ [ "module Some.Types where"
+ , ""
+ , "newtype NonEmpty a"
+ , " = NonEmpty { unNonEmpty :: a }"
+ , " deriving (FromJSON, ToJSON)"
+ , " via Something Magic (NonEmpty a)"
+ ]
+
+case35 :: Assertion
+case35 = expected @=? testStep (step indentIndentStyle { cBreakEnums = True, cBreakSingleConstructors = False }) input
+ where
+ input = unlines
+ [ "module Some.Types where"
+ , ""
+ , "data Foo = Foo"
+ , " { _transfer :: MonetaryAmount"
+ , " -> TransactionId"
+ , " -> m (Either CreditTransferError TransactionId)"
+ , " }"
+ ]
+
+ expected = unlines
+ [ "module Some.Types where"
+ , ""
+ , "data Foo = Foo"
+ , " { _transfer :: MonetaryAmount -> TransactionId -> m (Either CreditTransferError TransactionId)"
+ , " }"
+ ]
+
+case36 :: Assertion
+case36 = expected @=? testStep (step indentIndentStyle { cBreakEnums = True, cBreakSingleConstructors = False }) input
+ where
+ input = unlines
+ [ "module Some.Types where"
+ , ""
+ , "data Foo = Foo"
+ , " { _transfer :: (a -> b)"
+ , " -> TransactionId"
+ , " -> m (Either CreditTransferError TransactionId)"
+ , " }"
+ ]
+
+ expected = unlines
+ [ "module Some.Types where"
+ , ""
+ , "data Foo = Foo"
+ , " { _transfer :: (a -> b) -> TransactionId -> m (Either CreditTransferError TransactionId)"
+ , " }"
+ ]
+
+case37 :: Assertion
+case37 = expected @=? testStep (step indentIndentStyle { cVia = Indent 2 }) input
+ where
+ input = unlines
+ [ "module Some.Types where"
+ , ""
+ , "newtype UndoFlowData"
+ , " = UndoFlowData { flowDataDetails :: FlowDataDetails }"
+ , " deriving stock (Generic, Eq, Show)"
+ , " deriving (ToJSON, FromJSON)"
+ , " via AddConstTextFields '[\"type0\" := \"undo\","
+ , " \"type1\" := \"undo\","
+ , " \"reversal_indicator\" := \"Undo\"] FlowDataDetails"
+ ]
+
+ expected = unlines
+ [ "module Some.Types where"
+ , ""
+ , "newtype UndoFlowData"
+ , " = UndoFlowData { flowDataDetails :: FlowDataDetails }"
+ , " deriving stock (Eq, Generic, Show)"
+ , " deriving (FromJSON, ToJSON)"
+ , " via AddConstTextFields '[\"type0\" := \"undo\", \"type1\" := \"undo\", \"reversal_indicator\" := \"Undo\"] FlowDataDetails"
+ ]
+
+case38 :: Assertion
+case38 = expected @=? testStep (step indentIndentStyle { cVia = Indent 2 }) input
+ where
+ input = unlines
+ [ "data Flat = Flat"
+ , " { foo :: Int"
+ , " , bar :: Text"
+ , " , baz :: Double"
+ , " , qux :: Bool"
+ , " }"
+ , " deriving stock (Generic, Show, Eq)"
+ , " deriving (FromJSON, ToJSON)"
+ , " via GenericEncoded"
+ , " '[ FieldLabelModifier :="
+ , " '[ \"foo\" ==> \"nestFoo#foo\""
+ , " , \"bar\" ==> \"nestBar#bar\""
+ , " , \"baz\" ==> \"nestFoo#baz\""
+ , " ]"
+ , " ]"
+ , " Flat"
+ ]
+
+ expected = unlines
+ [ "data Flat"
+ , " = Flat"
+ , " { foo :: Int"
+ , " , bar :: Text"
+ , " , baz :: Double"
+ , " , qux :: Bool"
+ , " }"
+ , " deriving stock (Eq, Generic, Show)"
+ , " deriving (FromJSON, ToJSON)"
+ , " via GenericEncoded '[FieldLabelModifier := '[\"foo\" ==> \"nestFoo#foo\", \"bar\" ==> \"nestBar#bar\", \"baz\" ==> \"nestFoo#baz\"]] Flat"
+ ]
+
+case39 :: Assertion
+case39 = expected @=? testStep (step indentIndentStyle { cVia = Indent 2 }) input
+ where
+ input = unlines
+ [ "data CreditTransfer = CreditTransfer"
+ , " { nestedCreditorInfo :: CreditorInfo"
+ , " }"
+ , " deriving stock (Show, Eq, Generic)"
+ , " deriving (ToJSON, FromJSON) via"
+ , " ( UntaggedEncoded NordeaCreditTransfer"
+ , " & AddConstTextFields"
+ , " '[ \"request_type\" ':= \"credit_transfer\""
+ , " , \"provider\" ':= \"nordea\""
+ , " ]"
+ , " & FlattenFields '[\"nested_creditor_info\"]"
+ , " & RenameKeys"
+ , " '[ \"nested_creditor_info.creditor_agent_bic\" ==> \"creditor_agent_bic\""
+ , " , \"nested_creditor_info.creditor_iban\" ==> \"creditor_iban\""
+ , " , \"nested_creditor_info.creditor_name\" ==> \"creditor_name\""
+ , " , \"nested_creditor_info.creditor_account\" ==> \"creditor_account\""
+ , " ]"
+ , " )"
+ ]
+
+ expected = unlines
+ [ "data CreditTransfer"
+ , " = CreditTransfer"
+ , " { nestedCreditorInfo :: CreditorInfo"
+ , " }"
+ , " deriving stock (Eq, Generic, Show)"
+ , " deriving (FromJSON, ToJSON)"
+ , " via (UntaggedEncoded NordeaCreditTransfer & AddConstTextFields '[\"request_type\" ':= \"credit_transfer\", \"provider\" ':= \"nordea\"] & FlattenFields '[\"nested_creditor_info\"] & RenameKeys '[\"nested_creditor_info.creditor_agent_bic\" ==> \"creditor_agent_bic\", \"nested_creditor_info.creditor_iban\" ==> \"creditor_iban\", \"nested_creditor_info.creditor_name\" ==> \"creditor_name\", \"nested_creditor_info.creditor_account\" ==> \"creditor_account\"])"
+ ]
+
+case40 :: Assertion
+case40 = expected @=? testStep (step indentIndentStyle { cBreakSingleConstructors = False }) input
+ where
+ input = unlines
+ [ "module X where"
+ , ""
+ , "data a :==> b ="
+ , " Arr a b"
+ ]
+
+ expected = unlines
+ [ "module X where"
+ , ""
+ , "data a :==> b = Arr a b"
+ ]
+
+case41 :: Assertion
+case41 = expected @=? testStep (step indentIndentStyle) input
+ where
+ input = expected
+
+ expected = unlines
+ [ "module X where"
+ , ""
+ , "data Callback"
+ , " -- | Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor"
+ , " -- incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis"
+ , " -- nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat."
+ , " -- Duis aute irure dolor in reprehenderit in voluptate velit esse cillum dolore"
+ , " -- eu fugiat nulla pariatur. Excepteur sint occaecat cupidatat non proident,"
+ , " -- sunt in culpa qui officia deserunt mollit anim id est laborum."
+ , " = KafkaTopic"
+ , " { callbackTopic :: CallbackTopic"
+ , " -- ^ Name of topic to send updates to"
+ , " , callbackFormat :: CallbackFormat"
+ , " -- ^ The format used to send these updates"
+ , " }"
+ , " deriving stock (Eq, Generic, Show)"
+ , " deriving (FromJSON, ToJSON) via IdiomaticWithDescription CallbackDesc Callback"
+ , " deriving (HasGen) via Generically Callback"
+ , " deriving (FromField) via JsonField Callback"
+ ]
+
+case42 :: Assertion
+case42 = expected @=? testStep (step indentIndentStyle) input
+ where
+ input = expected
+
+ expected = unlines
+ [ "module X where"
+ , ""
+ , "data SignupError"
+ , " = IdempotencyConflict"
+ , " | ValidationError Text -- TODO: might be a sumtype of possible error codes"
+ , " deriving stock (Eq, Generic, Show)"
+ ]
+
+case43 :: Assertion
+case43 = expected @=? testStep (step indentIndentStyle { cBreakEnums = True, cBreakSingleConstructors = False }) input
+ where
+ input = expected
+
+ expected = unlines
+ [ "module X where"
+ , ""
+ , "data CallbackResult"
+ , " -- | Callback successfully sent"
+ , " = Success"
+ , " -- | Kafka error received"
+ , " | KafkaIssue KafkaError"
+ , " deriving (Eq, Show)"
+ ]
+
+-- This test showcases a difficult to solve issue. If the comment is in a
+-- deriving clause, it's very hard to guess the correct position of the entire
+-- block. E.g. the deriving clause itself has the wrong position. However, if
+-- we look at all deriving clauses we know where they start and end.
+--
+-- This means that we've needed to make the decision to put all inline comments
+-- before the deriving clause itself
+case44 :: Assertion
+case44 = expected @=? testStep (step indentIndentStyle { cBreakEnums = True, cBreakSingleConstructors = False, cVia = Indent 2 }) input
+ where
+ input = unlines
+ [ "module X where"
+ , ""
+ , " data CreditTransfer = CreditTransfer"
+ , " { amount :: Amount -- ^ 1 <= amount <= 999_999_999_999"
+ , " , date :: Day"
+ , " , accountNumber :: Account"
+ , " }"
+ , " deriving stock (Eq, Generic, Show)"
+ , " deriving (FromJSON, ToJSON) via"
+ , " AddConstTextFields"
+ , " '[\"notification_type\" ':= \"credit_transaction\""
+ , " -- Note that the bcio name has \"transaction\""
+ , " -- rather than \"transfer\""
+ , " ]"
+ , " (UntaggedEncoded CreditTransfer)"
+ ]
+ expected = unlines
+ [ "module X where"
+ , ""
+ , "data CreditTransfer = CreditTransfer"
+ , " { amount :: Amount"
+ , " -- ^ 1 <= amount <= 999_999_999_999"
+ , " , date :: Day"
+ , " , accountNumber :: Account"
+ , " }"
+ , " -- Note that the bcio name has \"transaction\""
+ , " -- rather than \"transfer\""
+ , " deriving stock (Eq, Generic, Show)"
+ , " deriving (FromJSON, ToJSON)"
+ , " via AddConstTextFields '[\"notification_type\" ':= \"credit_transaction\"] (UntaggedEncoded CreditTransfer)"
+ ]
+
+case45 :: Assertion
+case45 = expected @=? testStep (step indentIndentStyle { cBreakEnums = True, cBreakSingleConstructors = False, cVia = Indent 2 }) input
+ where
+ input = expected
+ expected = unlines
+ [ "module X where"
+ , ""
+ , "data CreditTransfer = CreditTransfer"
+ , " { amount :: Amount"
+ , " -- ^ 1 <= amount <= 999_999_999_999"
+ , " , date :: Day"
+ , " , accountNumber :: Account"
+ , " }"
+ , " -- Note that the bcio name has \"transaction\""
+ , " -- rather than \"transfer\""
+ , " deriving stock (Eq, Generic, Show)"
+ , " deriving (FromJSON, ToJSON)"
+ , " via AddConstTextFields '[\"notification_type\" ':= \"credit_transaction\"] (UntaggedEncoded CreditTransfer)"
+ ]
+
+case46 :: Assertion
+case46 = expected @=? testStep (step indentIndentStyle { cBreakEnums = True, cBreakSingleConstructors = False, cVia = Indent 2 }) input
+ where
+ input = expected
+ expected = unlines
+ [ "module X where"
+ , ""
+ , "-- | A format detailing which encoding to use for the settlement events"
+ , "data CallbackFormat"
+ , " -- | The Avro schema is to be used"
+ , " = AvroEngineEvent"
+ , " deriving (Bounded, Enum, Eq, Generic, Show)"
+ , " deriving (FromJSON, ToJSON)"
+ , " via TypeTaggedWithDescription FormatDesc CallbackFormat"
+ , " deriving (HasGen)"
+ , " via EnumBounded CallbackFormat"
+ ]
+
+case47 :: Assertion
+case47 = expected @=? testStep (step indentIndentStyle) input
+ where
+ input = expected
+ expected = unlines
+ [ "module X where"
+ , ""
+ , "-- | A GADT example"
+ , "data T a where"
+ , " D1 :: Int -> T String"
+ , " D2 :: T Bool"
+ , " D3 :: (a, a) -> T [a]"
+ ]
+
+case48 :: Assertion
+case48 = expected @=? testStep (step indentIndentStyle) input
+ where
+ input = expected
+ expected = unlines
+ [ "module X where"
+ , ""
+ , "-- | A GADT example"
+ , "data T a where"
+ , " D1 :: Int -> T String"
+ , " D2 :: T Bool"
+ , " D3 :: forall a. (Eq a, Bounded a) => (a, a) -> T [a]"
+ ]
+
+case49 :: Assertion
+case49 = expected @=? testStep (step indentIndentStyle) input
+ where
+ input = expected
+ expected = unlines
+ [ "module X where"
+ , ""
+ , "-- | A GADT example"
+ , "data T a where"
+ , " D1 :: Int -> T String"
+ , " D2 :: T Bool"
+ , " D3 :: forall a. (Eq a) => (a, a) -> T [a]"
+ ]
+
+case50 :: Assertion
+case50 = expected @=? testStep (step indentIndentStyle { cCurriedContext = True }) input
+ where
+ input = expected
+ expected = unlines
+ [ "module X where"
+ , ""
+ , "-- | A GADT example"
+ , "data T a where"
+ , " D1 :: Int -> T String"
+ , " D2 :: T Bool"
+ , " D3 :: forall a. Eq a => (a, a) -> T [a]"
+ ]
+
+case51 :: Assertion
+case51 = expected @=? testStep (step indentIndentStyle { cCurriedContext = True }) input
+ where
+ input = unlines
+ [ "module X where"
+ , ""
+ , "-- | A GADT example"
+ , "data T a where"
+ , " D1 :: Int -> T String"
+ , " D2 :: T Bool"
+ , " D3 :: forall a. (Eq a) => (a, a) -> T [a]"
+ ]
+ expected = unlines
+ [ "module X where"
+ , ""
+ , "-- | A GADT example"
+ , "data T a where"
+ , " D1 :: Int -> T String"
+ , " D2 :: T Bool"
+ , " D3 :: forall a. Eq a => (a, a) -> T [a]"
+ ]
+
+case52 :: Assertion
+case52 = expected @=? testStep (step indentIndentStyle { cBreakSingleConstructors = False, cCurriedContext = True }) input
+ where
+ input = unlines
+ [ "module X where"
+ , ""
+ , "data Foo = Foo"
+ , " { foo :: forall a b. (Eq a, Bounded b) => a -> b -> [(a, b)]"
+ , " }"
+ ]
+ expected = unlines
+ [ "module X where"
+ , ""
+ , "data Foo = Foo"
+ , " { foo :: forall a b. Eq a => Bounded b => a -> b -> [(a, b)]"
+ , " }"
+ ]
+
+case53 :: Assertion
+case53 = expected @=? testStep (step indentIndentStyle { cMaxColumns = MaxColumns 80 }) input
+ where
+ input = unlines
+ [ "newtype Foo m a"
+ , " = Foo (m a)"
+ , " deriving newtype (Functor, Applicative, Monad, MonadError, MonadCatch, Foldable, Monoid)"
+ ]
+ expected = unlines
+ [ "newtype Foo m a"
+ , " = Foo (m a)"
+ , " deriving newtype"
+ , " ( Applicative"
+ , " , Foldable"
+ , " , Functor"
+ , " , Monad"
+ , " , MonadCatch"
+ , " , MonadError"
+ , " , Monoid"
+ , " )"
+ ]
+
+case54 :: Assertion
+case54 = expected @=? testStep (step indentIndentStyle { cMaxColumns = MaxColumns 80 }) input
+ where
+ input = unlines
+ [ "newtype Foo m a"
+ , " = Foo (m a)"
+ , " deriving newtype (Functor, Applicative, Monad)"
+ ]
+ expected = unlines
+ [ "newtype Foo m a"
+ , " = Foo (m a)"
+ , " deriving newtype (Applicative, Functor, Monad)"
+ ]
+
+case55 :: Assertion
+case55 = expected @=? testStep (step sameSameNoSortStyle) input
+ where
+ input = unlines
+ [ "data Foo = Foo deriving (Z, Y, X, Bar, Abcd)"
]
+ expected = input
+
+case56 :: Assertion
+case56 = assertSnippet (step defaultConfig)
+ [ "data Foo = Foo"
+ , " { -- | Comment"
+ , " bar :: Int"
+ , " , baz :: Int"
+ , " }"
+ ]
+ [ "data Foo = Foo"
+ , " { -- | Comment"
+ , " bar :: Int"
+ , " , baz :: Int"
+ , " }"
+ ]
+
+case57 :: Assertion
+case57 = assertSnippet (step defaultConfig)
+ [ "data Foo = Foo"
+ , " { {- | A"
+ , " -}"
+ , " fooA :: Int"
+ , ""
+ , " {- | B"
+ , " -}"
+ , " , fooB :: Int"
+ , ""
+ , " {- | C"
+ , " -}"
+ , " , fooC :: Int"
+ , ""
+ , " {- | D"
+ , " -}"
+ , " , fooD :: Int"
+ , ""
+ , " {- | E"
+ , " -}"
+ , " , fooE :: Int"
+ , ""
+ , " {- | F"
+ , " -}"
+ , " , fooFooFoo :: Int"
+ , ""
+ , " {- | G"
+ , " -}"
+ , " , fooBarBar :: Int"
+ , " }"
+ ]
+ [ "data Foo = Foo"
+ , " { {- | A"
+ , " -}"
+ , " fooA :: Int"
+ , " {- | B"
+ , " -}"
+ , " , fooB :: Int"
+ , " {- | C"
+ , " -}"
+ , " , fooC :: Int"
+ , " {- | D"
+ , " -}"
+ , " , fooD :: Int"
+ , " {- | E"
+ , " -}"
+ , " , fooE :: Int"
+ , " {- | F"
+ , " -}"
+ , " , fooFooFoo :: Int"
+ , " {- | G"
+ , " -}"
+ , " , fooBarBar :: Int"
+ , " }"
+ ]
+
sameSameStyle :: Config
-sameSameStyle = Config SameLine SameLine 2 2
+sameSameStyle = Config SameLine SameLine 2 2 False True SameLine False True NoMaxColumns
sameIndentStyle :: Config
-sameIndentStyle = Config SameLine (Indent 2) 2 2
+sameIndentStyle = Config SameLine (Indent 2) 2 2 False True SameLine False True NoMaxColumns
indentSameStyle :: Config
-indentSameStyle = Config (Indent 2) SameLine 2 2
+indentSameStyle = Config (Indent 2) SameLine 2 2 False True SameLine False True NoMaxColumns
indentIndentStyle :: Config
-indentIndentStyle = Config (Indent 2) (Indent 2) 2 2
+indentIndentStyle = Config (Indent 2) (Indent 2) 2 2 False True SameLine False True NoMaxColumns
indentIndentStyle4 :: Config
-indentIndentStyle4 = Config (Indent 4) (Indent 4) 4 4
+indentIndentStyle4 = Config (Indent 4) (Indent 4) 4 4 False True SameLine False True NoMaxColumns
+
+sameSameNoSortStyle :: Config
+sameSameNoSortStyle = Config SameLine SameLine 2 2 False True SameLine False False NoMaxColumns