diff options
Diffstat (limited to 'tests/Language/Haskell/Stylish/Step/Data/Tests.hs')
-rw-r--r-- | tests/Language/Haskell/Stylish/Step/Data/Tests.hs | 887 |
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 |