summaryrefslogtreecommitdiffhomepage
path: root/tests
diff options
context:
space:
mode:
authorJasper Van der Jeugt <m@jaspervdj.be>2020-10-02 13:08:39 +0200
committerJasper Van der Jeugt <m@jaspervdj.be>2020-10-02 13:08:39 +0200
commit250e7091edd93ce5a476706ddd968ef3ec1ef336 (patch)
tree98c1a37f8f7adf031b317f820428184c084b9b49 /tests
parentce3feb1db9a0e7998a66c9dfdc7aebd9bae79477 (diff)
downloadstylish-haskell-250e7091edd93ce5a476706ddd968ef3ec1ef336.tar.gz
Use ghc-lib-parser rather than haskell-src-exts
This patch swaps out the parsing library from `haskell-src-exts` to `ghc-lib-parser`, which gives us better compatibility with GHC. Because almost every module heavily used the Haskell AST provided by `haskell-src-exts`, this was a huge effort and it would not have been possible without Felix Mulder doing an initial port, GSoC student Beatrice Vergani porting several other steps, and Łukasz Gołębiewski and Paweł Szulc who helped me finish up things in the home stretch. I've generally tried to keep styling 100% compatible with what was there before, but some issues may have unintentionally slipped in so please report those. This introduces one new import styling contributed by Felix: when wrapping import lists over multiple lines, you can repeat the module name, e.g.: import Control.Monad.Except as X (ExceptT (..), MonadError (..), liftEither) import Control.Monad.Except as X (runExceptT, withExceptT) This is activated by using `import_align: repeat`. Secondly, a new Step was added, `module_header`, which formats the export list of a module, including the trailing `where` clause. Details for this new step can be found in the `data/stylish-haskell.yaml`. Co-Authored-By: Beatrice Vergani <beatrice.vergani11@gmail.com> Co-Authored-By: Paweł Szulc <paul.szulc@gmail.com> Co-Authored-By: Łukasz Gołębiewski <lukasz.golebiewski@gmail.com> Co-Authored-By: Felix Mulder <felix.mulder@klarna.com>
Diffstat (limited to 'tests')
-rw-r--r--tests/Language/Haskell/Stylish/Config/Tests.hs1
-rw-r--r--tests/Language/Haskell/Stylish/Parse/Tests.hs48
-rw-r--r--tests/Language/Haskell/Stylish/Step/Data/Tests.hs694
-rw-r--r--tests/Language/Haskell/Stylish/Step/Imports/FelixTests.hs382
-rw-r--r--tests/Language/Haskell/Stylish/Step/Imports/Tests.hs341
-rw-r--r--tests/Language/Haskell/Stylish/Step/LanguagePragmas/Tests.hs293
-rw-r--r--tests/Language/Haskell/Stylish/Step/ModuleHeader/Tests.hs301
-rw-r--r--tests/Language/Haskell/Stylish/Step/SimpleAlign/Tests.hs236
-rw-r--r--tests/Language/Haskell/Stylish/Tests.hs8
-rw-r--r--tests/Language/Haskell/Stylish/Tests/Util.hs61
-rw-r--r--tests/TestSuite.hs4
11 files changed, 1930 insertions, 439 deletions
diff --git a/tests/Language/Haskell/Stylish/Config/Tests.hs b/tests/Language/Haskell/Stylish/Config/Tests.hs
index a8b2ee2..73062ab 100644
--- a/tests/Language/Haskell/Stylish/Config/Tests.hs
+++ b/tests/Language/Haskell/Stylish/Config/Tests.hs
@@ -153,6 +153,7 @@ dotStylish = unlines $
, " first_field: \"indent 2\""
, " field_comment: 2"
, " deriving: 4"
+ , " via: \"indent 2\""
, "columns: 110"
, "language_extensions:"
, " - TemplateHaskell"
diff --git a/tests/Language/Haskell/Stylish/Parse/Tests.hs b/tests/Language/Haskell/Stylish/Parse/Tests.hs
index a8ebf39..d46f4a5 100644
--- a/tests/Language/Haskell/Stylish/Parse/Tests.hs
+++ b/tests/Language/Haskell/Stylish/Parse/Tests.hs
@@ -6,7 +6,8 @@ module Language.Haskell.Stylish.Parse.Tests
--------------------------------------------------------------------------------
import Test.Framework (Test, testGroup)
import Test.Framework.Providers.HUnit (testCase)
-import Test.HUnit (Assertion, assert)
+import Test.HUnit (Assertion, assertFailure)
+import GHC.Stack (HasCallStack, withFrozenCallStack)
--------------------------------------------------------------------------------
@@ -33,18 +34,18 @@ tests = testGroup "Language.Haskell.Stylish.Parse"
--------------------------------------------------------------------------------
testShebangExt :: Assertion
-testShebangExt = assert $ isRight $ parseModule [] Nothing input
- where
- input = unlines
- [ "#!env runghc"
- , "{-# LANGUAGE CPP #-}"
- , "#define foo bar \\"
- , " qux"
- ]
+testShebangExt = returnsRight $ parseModule [] Nothing input
+ where
+ input = unlines
+ [ "#!env runghc"
+ , "{-# LANGUAGE CPP #-}"
+ , "#define foo bar \\"
+ , " qux"
+ ]
--------------------------------------------------------------------------------
testBom :: Assertion
-testBom = assert $ isRight $ parseModule [] Nothing input
+testBom = returnsRight $ parseModule [] Nothing input
where
input = unlines
[ '\xfeff' : "foo :: Int"
@@ -54,13 +55,13 @@ testBom = assert $ isRight $ parseModule [] Nothing input
--------------------------------------------------------------------------------
testExtraExtensions :: Assertion
-testExtraExtensions = assert $ isRight $
+testExtraExtensions = returnsRight $
parseModule ["TemplateHaskell"] Nothing "$(foo)"
--------------------------------------------------------------------------------
testMultilineCpp :: Assertion
-testMultilineCpp = assert $ isRight $ parseModule [] Nothing $ unlines
+testMultilineCpp = returnsRight $ parseModule [] Nothing $ unlines
[ "{-# LANGUAGE CPP #-}"
, "#define foo bar \\"
, " qux"
@@ -69,7 +70,7 @@ testMultilineCpp = assert $ isRight $ parseModule [] Nothing $ unlines
--------------------------------------------------------------------------------
testHaskell2010 :: Assertion
-testHaskell2010 = assert $ isRight $ parseModule [] Nothing $ unlines
+testHaskell2010 = returnsRight $ parseModule [] Nothing $ unlines
[ "{-# LANGUAGE Haskell2010 #-}"
, "module X where"
, "foo x | Just y <- x = y"
@@ -78,7 +79,7 @@ testHaskell2010 = assert $ isRight $ parseModule [] Nothing $ unlines
--------------------------------------------------------------------------------
testShebang :: Assertion
-testShebang = assert $ isRight $ parseModule [] Nothing $ unlines
+testShebang = returnsRight $ parseModule [] Nothing $ unlines
[ "#!runhaskell"
, "module Main where"
, "main = return ()"
@@ -87,7 +88,7 @@ testShebang = assert $ isRight $ parseModule [] Nothing $ unlines
--------------------------------------------------------------------------------
testShebangDouble :: Assertion
-testShebangDouble = assert $ isRight $ parseModule [] Nothing $ unlines
+testShebangDouble = returnsRight $ parseModule [] Nothing $ unlines
[ "#!nix-shell"
, "#!nix-shell -i runhaskell -p haskellPackages.ghc"
, "module Main where"
@@ -100,7 +101,7 @@ testShebangDouble = assert $ isRight $ parseModule [] Nothing $ unlines
-- enabled for parsing, even when the pragma is absent.
testGADTs :: Assertion
-testGADTs = assert $ isRight $ parseModule [] Nothing $ unlines
+testGADTs = returnsRight $ parseModule [] Nothing $ unlines
[ "module Main where"
, "data SafeList a b where"
, " Nil :: SafeList a Empty"
@@ -108,36 +109,35 @@ testGADTs = assert $ isRight $ parseModule [] Nothing $ unlines
]
testKindSignatures :: Assertion
-testKindSignatures = assert $ isRight $ parseModule [] Nothing $ unlines
+testKindSignatures = returnsRight $ parseModule [] Nothing $ unlines
[ "module Main where"
, "data D :: * -> * -> * where"
, " D :: a -> b -> D a b"
]
testStandaloneDeriving :: Assertion
-testStandaloneDeriving = assert $ isRight $ parseModule [] Nothing $ unlines
+testStandaloneDeriving = returnsRight $ parseModule [] Nothing $ unlines
[ "module Main where"
, "deriving instance Show MyType"
]
testUnicodeSyntax :: Assertion
-testUnicodeSyntax = assert $ isRight $ parseModule [] Nothing $ unlines
+testUnicodeSyntax = returnsRight $ parseModule [] Nothing $ unlines
[ "module Main where"
, "monadic ∷ (Monad m) ⇒ m a → m a"
, "monadic = id"
]
testXmlSyntaxRegression :: Assertion
-testXmlSyntaxRegression = assert $ isRight $ parseModule [] Nothing $ unlines
+testXmlSyntaxRegression = returnsRight $ parseModule [] Nothing $ unlines
[ "smaller a b = a <b"
]
testMagicHashRegression :: Assertion
-testMagicHashRegression = assert $ isRight $ parseModule [] Nothing $ unlines
+testMagicHashRegression = returnsRight $ parseModule [] Nothing $ unlines
[ "xs = \"foo\"#|1#|'a'#|bar#|Nil"
]
--------------------------------------------------------------------------------
-isRight :: Either a b -> Bool
-isRight (Right _) = True
-isRight _ = False
+returnsRight :: HasCallStack => Show a => Either a b -> Assertion
+returnsRight action = withFrozenCallStack $ either (assertFailure . show) mempty action
diff --git a/tests/Language/Haskell/Stylish/Step/Data/Tests.hs b/tests/Language/Haskell/Stylish/Step/Data/Tests.hs
index b43e6dc..4357af6 100644
--- a/tests/Language/Haskell/Stylish/Step/Data/Tests.hs
+++ b/tests/Language/Haskell/Stylish/Step/Data/Tests.hs
@@ -35,6 +35,36 @@ 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
]
case00 :: Assertion
@@ -165,7 +195,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 +203,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 +368,8 @@ case16 = expected @=? testStep (step indentIndentStyle) input
, ""
, "data Foo"
, " = Foo"
- , " { a :: Int -- ^ comment"
+ , " { a :: Int"
+ , " -- ^ comment"
, " }"
]
@@ -520,17 +556,661 @@ case24 = expected @=? testStep (step indentIndentStyle) input
, " deriving (ToJSON)"
]
+case25 :: Assertion
+case25 = expected @=? testStep (step indentIndentStyle { cBreakSingleConstructors = False }) input
+ where
+ input = unlines
+ [ "data Foo a"
+ , " = Foo { a :: Int,"
+ , " a2 :: String"
+ , " -- ^ some haddock"
+ , " }"
+ , " deriving (Eq, Show)"
+ , " deriving (ToJSON)"
+ ]
+
+ expected = unlines
+ [ "data Foo a = Foo"
+ , " { a :: Int"
+ , " , a2 :: String"
+ , " -- ^ some haddock"
+ , " }"
+ , " deriving (Eq, Show)"
+ , " deriving (ToJSON)"
+ ]
+
+case26 :: Assertion
+case26 = expected @=? testStep (step indentIndentStyle) input
+ where
+ input = unlines
+ [ "module Herp where"
+ , ""
+ , "data Foo = Foo { a :: Int } deriving (FromJSON) via Bla Foo"
+ ]
+
+ expected = unlines
+ [ "module Herp where"
+ , ""
+ , "data Foo"
+ , " = Foo"
+ , " { a :: Int"
+ , " }"
+ , " deriving (FromJSON) via Bla Foo"
+ ]
+
+case27 :: Assertion
+case27 = expected @=? testStep (step sameIndentStyle { cBreakEnums = True }) input
+ where
+ input = unlines
+ [ "module Herp where"
+ , ""
+ , "data Foo = Foo | Bar | Baz deriving (Eq, Show)"
+ ]
+
+ expected = unlines
+ [ "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)"
+ ]
+
sameSameStyle :: Config
-sameSameStyle = Config SameLine SameLine 2 2
+sameSameStyle = Config SameLine SameLine 2 2 False True SameLine False NoMaxColumns
sameIndentStyle :: Config
-sameIndentStyle = Config SameLine (Indent 2) 2 2
+sameIndentStyle = Config SameLine (Indent 2) 2 2 False True SameLine False NoMaxColumns
indentSameStyle :: Config
-indentSameStyle = Config (Indent 2) SameLine 2 2
+indentSameStyle = Config (Indent 2) SameLine 2 2 False True SameLine False NoMaxColumns
indentIndentStyle :: Config
-indentIndentStyle = Config (Indent 2) (Indent 2) 2 2
+indentIndentStyle = Config (Indent 2) (Indent 2) 2 2 False True SameLine False NoMaxColumns
indentIndentStyle4 :: Config
-indentIndentStyle4 = Config (Indent 4) (Indent 4) 4 4
+indentIndentStyle4 = Config (Indent 4) (Indent 4) 4 4 False True SameLine False NoMaxColumns
diff --git a/tests/Language/Haskell/Stylish/Step/Imports/FelixTests.hs b/tests/Language/Haskell/Stylish/Step/Imports/FelixTests.hs
new file mode 100644
index 0000000..98c5d12
--- /dev/null
+++ b/tests/Language/Haskell/Stylish/Step/Imports/FelixTests.hs
@@ -0,0 +1,382 @@
+-- | Tests contributed by Felix Mulder as part of
+-- <https://github.com/jaspervdj/stylish-haskell/pull/293>.
+module Language.Haskell.Stylish.Step.Imports.FelixTests
+ ( tests
+ ) where
+
+--------------------------------------------------------------------------------
+import Test.Framework (Test, testGroup)
+import Test.Framework.Providers.HUnit (testCase)
+import Test.HUnit (Assertion)
+import GHC.Stack (HasCallStack, withFrozenCallStack)
+import Prelude hiding (lines)
+
+--------------------------------------------------------------------------------
+import Language.Haskell.Stylish.Module
+import Language.Haskell.Stylish.Step.Imports
+import Language.Haskell.Stylish.Tests.Util (testStep', (@=??))
+
+
+
+--------------------------------------------------------------------------------
+tests :: Test
+tests = testGroup "Language.Haskell.Stylish.Step.ImportsGHC"
+ [ testCase "Hello world" ex0
+ , testCase "Sorted simple" ex1
+ , testCase "Sorted import lists" ex2
+ , testCase "Sorted import lists and import decls" ex3
+ , testCase "Import constructor all" ex4
+ , testCase "Import constructor specific" ex5
+ , testCase "Import constructor specific sorted" ex6
+ , testCase "Imports step does not change rest of file" ex7
+ , testCase "Imports respect groups" ex8
+ , testCase "Imports respects whitespace between groups" ex9
+ , testCase "Doesn't add extra space after 'hiding'" ex10
+ , testCase "Should be able to format symbolic imports" ex11
+ , testCase "Able to merge equivalent imports" ex12
+ , testCase "Obeys max columns setting" ex13
+ , testCase "Obeys max columns setting with two in each" ex14
+ , testCase "Respects multiple groups" ex15
+ , testCase "Doesn't delete nullary imports" ex16
+ ]
+
+--------------------------------------------------------------------------------
+ex0 :: Assertion
+ex0 = input `assertFormatted` output
+ where
+ input =
+ [ "import B"
+ , "import A"
+ ]
+ output =
+ [ "import A"
+ , "import B"
+ ]
+
+ex1 :: Assertion
+ex1 = input `assertFormatted` output
+ where
+ input =
+ [ "import B"
+ , "import A"
+ , "import C"
+ , "import qualified A"
+ , "import qualified B as X"
+ ]
+ output =
+ [ "import A"
+ , "import qualified A"
+ , "import B"
+ , "import qualified B as X"
+ , "import C"
+ ]
+
+ex2 :: Assertion
+ex2 = input `assertFormatted` output
+ where
+ input =
+ [ "import B"
+ , "import A (X)"
+ , "import C"
+ , "import qualified A as Y (Y)"
+ ]
+ output =
+ [ "import A (X)"
+ , "import qualified A as Y (Y)"
+ , "import B"
+ , "import C"
+ ]
+
+ex3 :: Assertion
+ex3 = input `assertFormatted` output
+ where
+ input =
+ [ "import B"
+ , "import A (X, Z, Y)"
+ , "import C"
+ , "import qualified A as A0 (b, Y, a)"
+ , "import qualified D as D0 (Y, b, a)"
+ , "import qualified E as E0 (b, a, Y)"
+ ]
+ output =
+ [ "import A (X, Y, Z)"
+ , "import qualified A as A0 (Y, a, b)"
+ , "import B"
+ , "import C"
+ , "import qualified D as D0 (Y, a, b)"
+ , "import qualified E as E0 (Y, a, b)"
+ ]
+
+ex4 :: Assertion
+ex4 = input `assertFormatted` output
+ where
+ input =
+ [ "import A (X, Z(..), Y)"
+ ]
+ output =
+ [ "import A (X, Y, Z (..))"
+ ]
+
+ex5 :: Assertion
+ex5 = input `assertFormatted` output
+ where
+ input =
+ [ "import A (X, Z(Z), Y)"
+ ]
+ output =
+ [ "import A (X, Y, Z (Z))"
+ ]
+
+ex6 :: Assertion
+ex6 = input `assertFormatted` output
+ where
+ input =
+ [ "import A (X, Z(X, Z, Y), Y)"
+ ]
+ output =
+ [ "import A (X, Y, Z (X, Y, Z))"
+ ]
+
+ex7 :: Assertion
+ex7 = input `assertFormatted` output
+ where
+ input =
+ [ "module Foo (tests) where"
+ , "import B"
+ , "import A (X, Z, Y)"
+ , "import C"
+ , "import qualified A as A0 (b, Y, a)"
+ , "import qualified D as D0 (Y, b, a)"
+ , "import qualified E as E0 (b, a, Y)"
+ , "-- hello"
+ , "foo :: Int"
+ , "foo = 1"
+ ]
+ output =
+ [ "module Foo (tests) where"
+ , "import A (X, Y, Z)"
+ , "import qualified A as A0 (Y, a, b)"
+ , "import B"
+ , "import C"
+ , "import qualified D as D0 (Y, a, b)"
+ , "import qualified E as E0 (Y, a, b)"
+ , "-- hello"
+ , "foo :: Int"
+ , "foo = 1"
+ ]
+
+ex8 :: Assertion
+ex8 = input `assertFormatted` output
+ where
+ input =
+ [ "import B"
+ , "-- Group divisor"
+ , "import A (X)"
+ , "import C"
+ , "import qualified A as Y (Y)"
+ ]
+ output =
+ [ "import B"
+ , "-- Group divisor"
+ , "import A (X)"
+ , "import qualified A as Y (Y)"
+ , "import C"
+ ]
+
+ex9 :: Assertion
+ex9 = input `assertFormatted` output
+ where
+ input =
+ [ "--------"
+ , "import B"
+ , ""
+ , "-- Group divisor"
+ , "import A (X)"
+ , "import C"
+ , "import qualified A as Y (Y)"
+ ]
+ output =
+ [ "--------"
+ , "import B"
+ , ""
+ , "-- Group divisor"
+ , "import A (X)"
+ , "import qualified A as Y (Y)"
+ , "import C"
+ ]
+
+ex10 :: Assertion
+ex10 = input `assertFormatted` output
+ where
+ input =
+ [ "import B hiding (X)"
+ , "import A hiding (X)"
+ ]
+ output =
+ [ "import A hiding (X)"
+ , "import B hiding (X)"
+ ]
+
+ex11 :: Assertion
+ex11 = input `assertFormatted` output
+ where
+ input =
+ [ "import Data.Aeson ((.=))"
+ , "import A hiding (X)"
+ ]
+ output =
+ [ "import A hiding (X)"
+ , "import Data.Aeson ((.=))"
+ ]
+
+ex12 :: Assertion
+ex12 = input `assertFormatted` output
+ where
+ input =
+ [ "import Data.Aeson ((.=))"
+ , "import Data.Aeson ((.=))"
+ , "import A hiding (X)"
+ ]
+ output =
+ [ "import A hiding (X)"
+ , "import Data.Aeson ((.=))"
+ ]
+
+ex13 :: Assertion
+ex13 = input `assertFormattedCols` output
+ where
+ assertFormattedCols =
+ assertFormatted' (Just 10)
+ input =
+ [ "import Foo (A, B, C, D)"
+ , "import A hiding (X)"
+ ]
+ output =
+ [ "import A hiding (X)"
+ , "import Foo (A)"
+ , "import Foo (B)"
+ , "import Foo (C)"
+ , "import Foo (D)"
+ ]
+
+ex14 :: Assertion
+ex14 = input `assertFormattedCols` output
+ where
+ assertFormattedCols =
+ assertFormatted' (Just 27)
+ input =
+ [ "import Foo (A, B, C, D)"
+ , "import A hiding (X)"
+ ]
+ output =
+ [ "import A hiding (X)"
+ , "import Foo (A, B)"
+ , "import Foo (C, D)"
+ ]
+
+ex15 :: Assertion
+ex15 = input `assertFormattedCols` output
+ where
+ assertFormattedCols =
+ assertFormatted' (Just 100)
+ input =
+ [ "module Custom.Prelude"
+ , " ( LazyByteString"
+ , " , UUID"
+ , " , decodeUtf8Lenient"
+ , " , error"
+ , " , headMay"
+ , " , module X"
+ , " , nextRandomUUID"
+ , " , onChars"
+ , " , proxyOf"
+ , " , show"
+ , " , showStr"
+ , " , toLazyByteString"
+ , " , toStrictByteString"
+ , " , type (~>)"
+ , " , uuidToText"
+ , " ) where"
+ , ""
+ , "--------------------------------------------------------------------------------"
+ , "import Prelude as X hiding ((!!), appendFile, error, foldl, head, putStrLn, readFile, show, tail, take, unlines, unwords, words, writeFile)"
+ , "import qualified Prelude"
+ , ""
+ , "--------------------------------------------------------------------------------"
+ , "import Control.Lens as X ((%~), (&), (.~), (?~), (^.), (^?), _Left, _Right, iat, over, preview, sans, set, to, view)"
+ , "import Control.Lens.Extras as X (is)"
+ , ""
+ , "--------------------------------------------------------------------------------"
+ , "import Control.Applicative as X ((<|>))"
+ , "import Control.Monad as X ((<=<), (>=>), guard, unless, when)"
+ , "import Control.Monad.Except as X (ExceptT (..), MonadError (..), liftEither, runExceptT, withExceptT)"
+ , "import Control.Monad.IO.Unlift as X"
+ , "import Control.Monad.Reader as X (MonadReader (..), ReaderT (..), asks)"
+ , "import Control.Monad.Trans.Class as X (MonadTrans (lift))"
+ , "--------------------------------------------------------------------------------"
+ ]
+ output =
+ [ "module Custom.Prelude"
+ , " ( LazyByteString"
+ , " , UUID"
+ , " , decodeUtf8Lenient"
+ , " , error"
+ , " , headMay"
+ , " , module X"
+ , " , nextRandomUUID"
+ , " , onChars"
+ , " , proxyOf"
+ , " , show"
+ , " , showStr"
+ , " , toLazyByteString"
+ , " , toStrictByteString"
+ , " , type (~>)"
+ , " , uuidToText"
+ , " ) where"
+ , ""
+ , "--------------------------------------------------------------------------------"
+ , "import Prelude as X hiding (appendFile, error, foldl, head, putStrLn, readFile, show, tail, take, unlines, unwords, words, writeFile, (!!))"
+ , "import qualified Prelude"
+ , ""
+ , "--------------------------------------------------------------------------------"
+ , "import Control.Lens as X (_Left, _Right, iat, over, preview, sans, set, to)"
+ , "import Control.Lens as X (view, (%~), (&), (.~), (?~), (^.), (^?))"
+ , "import Control.Lens.Extras as X (is)"
+ , ""
+ , "--------------------------------------------------------------------------------"
+ , "import Control.Applicative as X ((<|>))"
+ , "import Control.Monad as X (guard, unless, when, (<=<), (>=>))"
+ , "import Control.Monad.Except as X (ExceptT (..), MonadError (..), liftEither)"
+ , "import Control.Monad.Except as X (runExceptT, withExceptT)"
+ , "import Control.Monad.IO.Unlift as X"
+ , "import Control.Monad.Reader as X (MonadReader (..), ReaderT (..), asks)"
+ , "import Control.Monad.Trans.Class as X (MonadTrans (lift))"
+ , "--------------------------------------------------------------------------------"
+ ]
+
+ex16 :: Assertion
+ex16 = input `assertFormatted` output
+ where
+ input =
+ [ "module Foo where"
+ , ""
+ , "import B ()"
+ , "import A ()"
+ ]
+ output =
+ [ "module Foo where"
+ , ""
+ , "import A ()"
+ , "import B ()"
+ ]
+
+assertFormatted :: HasCallStack => Lines -> Lines -> Assertion
+assertFormatted = withFrozenCallStack $ assertFormatted' Nothing
+
+assertFormatted' :: HasCallStack => Maybe Int -> Lines -> Lines -> Assertion
+assertFormatted' maxColumns input expected =
+ withFrozenCallStack $ expected @=?? testStep' (step maxColumns felixOptions) input
+ where
+ felixOptions = defaultOptions
+ { listAlign = Repeat
+ }
diff --git a/tests/Language/Haskell/Stylish/Step/Imports/Tests.hs b/tests/Language/Haskell/Stylish/Step/Imports/Tests.hs
index 22031d4..474de66 100644
--- a/tests/Language/Haskell/Stylish/Step/Imports/Tests.hs
+++ b/tests/Language/Haskell/Stylish/Step/Imports/Tests.hs
@@ -5,9 +5,9 @@ module Language.Haskell.Stylish.Step.Imports.Tests
--------------------------------------------------------------------------------
-import Test.Framework (Test, testGroup)
-import Test.Framework.Providers.HUnit (testCase)
-import Test.HUnit (Assertion, (@=?))
+import Test.Framework (Test, testGroup)
+import Test.Framework.Providers.HUnit (testCase)
+import Test.HUnit (Assertion, (@=?))
--------------------------------------------------------------------------------
@@ -15,7 +15,6 @@ import Language.Haskell.Stylish.Step.Imports
import Language.Haskell.Stylish.Tests.Util
-
--------------------------------------------------------------------------------
fromImportAlign :: ImportAlign -> Options
fromImportAlign align = defaultOptions { importAlign = align }
@@ -63,8 +62,8 @@ tests = testGroup "Language.Haskell.Stylish.Step.Imports.Tests"
--------------------------------------------------------------------------------
-input :: String
-input = unlines
+input :: Snippet
+input = Snippet
[ "module Herp where"
, ""
, "import qualified Data.Map as M"
@@ -83,9 +82,9 @@ input = unlines
--------------------------------------------------------------------------------
case01 :: Assertion
-case01 = expected @=? testStep (step (Just 80) $ fromImportAlign Global) input
+case01 = expected @=? testSnippet (step (Just 80) $ fromImportAlign Global) input
where
- expected = unlines
+ expected = Snippet
[ "module Herp where"
, ""
, "import Control.Monad"
@@ -105,9 +104,9 @@ case01 = expected @=? testStep (step (Just 80) $ fromImportAlign Global) input
--------------------------------------------------------------------------------
case02 :: Assertion
-case02 = expected @=? testStep (step (Just 80) $ fromImportAlign Group) input
+case02 = expected @=? testSnippet (step (Just 80) $ fromImportAlign Group) input
where
- expected = unlines
+ expected = Snippet
[ "module Herp where"
, ""
, "import Control.Monad"
@@ -126,9 +125,9 @@ case02 = expected @=? testStep (step (Just 80) $ fromImportAlign Group) input
--------------------------------------------------------------------------------
case03 :: Assertion
-case03 = expected @=? testStep (step (Just 80) $ fromImportAlign None) input
+case03 = expected @=? testSnippet (step (Just 80) $ fromImportAlign None) input
where
- expected = unlines
+ expected = Snippet
[ "module Herp where"
, ""
, "import Control.Monad"
@@ -147,13 +146,13 @@ case03 = expected @=? testStep (step (Just 80) $ fromImportAlign None) input
--------------------------------------------------------------------------------
case04 :: Assertion
-case04 = expected @=? testStep (step (Just 80) $ fromImportAlign Global) input'
+case04 = expected @=? testSnippet (step (Just 80) $ fromImportAlign Global) input'
where
- input' =
+ input' = Snippet $ pure $
"import Data.Aeson.Types (object, typeMismatch, FromJSON(..)," ++
"ToJSON(..), Value(..), parseEither, (.!=), (.:), (.:?), (.=))"
- expected = unlines
+ expected = Snippet
[ "import Data.Aeson.Types (FromJSON (..), ToJSON (..), Value (..),"
, " object, parseEither, typeMismatch, (.!=),"
, " (.:), (.:?), (.=))"
@@ -162,17 +161,18 @@ case04 = expected @=? testStep (step (Just 80) $ fromImportAlign Global) input'
--------------------------------------------------------------------------------
case05 :: Assertion
-case05 = input' @=? testStep (step (Just 80) $ fromImportAlign Group) input'
+case05 = input' @=? testSnippet (step (Just 80) $ fromImportAlign Group) input'
where
- input' = "import Distribution.PackageDescription.Configuration " ++
- "(finalizePackageDescription)\n"
+ -- Putting this on a different line shouldn't really help.
+ input' = Snippet ["import Distribution.PackageDescription.Configuration " ++
+ "(finalizePackageDescription)"]
--------------------------------------------------------------------------------
case06 :: Assertion
-case06 = input' @=? testStep (step (Just 80) $ fromImportAlign File) input'
+case06 = input' @=? testStep' (step (Just 80) $ fromImportAlign File) input'
where
- input' = unlines
+ input' =
[ "import Bar.Qux"
, "import Foo.Bar"
]
@@ -180,15 +180,16 @@ case06 = input' @=? testStep (step (Just 80) $ fromImportAlign File) input'
--------------------------------------------------------------------------------
case07 :: Assertion
-case07 = expected @=? testStep (step (Just 80) $ fromImportAlign File) input'
+case07 =
+ expected @=? testSnippet (step (Just 80) $ fromImportAlign File) input'
where
- input' = unlines
+ input' = Snippet
[ "import Bar.Qux"
, ""
, "import qualified Foo.Bar"
]
- expected = unlines
+ expected = Snippet
[ "import Bar.Qux"
, ""
, "import qualified Foo.Bar"
@@ -197,10 +198,13 @@ case07 = expected @=? testStep (step (Just 80) $ fromImportAlign File) input'
--------------------------------------------------------------------------------
case08 :: Assertion
-case08 = expected
- @=? testStep (step (Just 80) $ Options Global WithAlias True Inline Inherit (LPConstant 4) True False) input
+case08 =
+ let
+ options = Options Global WithAlias True Inline Inherit (LPConstant 4) True False
+ in
+ expected @=? testSnippet (step (Just 80) options) input
where
- expected = unlines
+ expected = Snippet
[ "module Herp where"
, ""
, "import Control.Monad"
@@ -220,10 +224,13 @@ case08 = expected
--------------------------------------------------------------------------------
case08b :: Assertion
-case08b = expected
- @=? testStep (step (Just 80) $ Options Global WithModuleName True Inline Inherit (LPConstant 4) True False) input
+case08b =
+ let
+ options = Options Global WithModuleName True Inline Inherit (LPConstant 4) True False
+ in
+ expected @=? testSnippet (step (Just 80) options) input
where
- expected = unlines
+ expected = Snippet
["module Herp where"
, ""
, "import Control.Monad"
@@ -242,10 +249,13 @@ case08b = expected
--------------------------------------------------------------------------------
case09 :: Assertion
-case09 = expected
- @=? testStep (step (Just 80) $ Options Global WithAlias True Multiline Inherit (LPConstant 4) True False) input
+case09 =
+ let
+ options = Options Global WithAlias True Multiline Inherit (LPConstant 4) True False
+ in
+ expected @=? testSnippet (step (Just 80) options) input
where
- expected = unlines
+ expected = Snippet
[ "module Herp where"
, ""
, "import Control.Monad"
@@ -276,10 +286,13 @@ case09 = expected
--------------------------------------------------------------------------------
case10 :: Assertion
-case10 = expected
- @=? testStep (step (Just 40) $ Options Group WithAlias True Multiline Inherit (LPConstant 4) True False) input
+case10 =
+ let
+ options = Options Group WithAlias True Multiline Inherit (LPConstant 4) True False
+ in
+ expected @=? testSnippet (step (Just 40) options) input
where
- expected = unlines
+ expected = Snippet
[ "module Herp where"
, ""
, "import Control.Monad"
@@ -313,12 +326,16 @@ case10 = expected
]
+
--------------------------------------------------------------------------------
case11 :: Assertion
-case11 = expected
- @=? testStep (step (Just 80) $ Options Group NewLine True Inline Inherit (LPConstant 4) True False) input
+case11 =
+ let
+ options = Options Group NewLine True Inline Inherit (LPConstant 4) True False
+ in
+ expected @=? testSnippet (step (Just 80) options) input
where
- expected = unlines
+ expected = Snippet
[ "module Herp where"
, ""
, "import Control.Monad"
@@ -342,10 +359,13 @@ case11 = expected
case11b :: Assertion
-case11b = expected
- @=? testStep (step (Just 80) $ Options Group WithModuleName True Inline Inherit (LPConstant 4) True False) input
+case11b =
+ let
+ options = Options Group WithModuleName True Inline Inherit (LPConstant 4) True False
+ in
+ expected @=? testSnippet (step (Just 80) options) input
where
- expected = unlines
+ expected = Snippet
[ "module Herp where"
, ""
, "import Control.Monad"
@@ -364,14 +384,17 @@ case11b = expected
--------------------------------------------------------------------------------
case12 :: Assertion
-case12 = expected
- @=? testStep (step (Just 80) $ Options Group NewLine True Inline Inherit (LPConstant 2) True False) input'
+case12 =
+ let
+ options = Options Group NewLine True Inline Inherit (LPConstant 2) True False
+ in
+ expected @=? testSnippet (step (Just 80) options) input'
where
- input' = unlines
+ input' = Snippet
[ "import Data.List (map)"
]
- expected = unlines
+ expected = Snippet
[ "import Data.List"
, " (map)"
]
@@ -379,27 +402,31 @@ case12 = expected
--------------------------------------------------------------------------------
case12b :: Assertion
-case12b = expected
- @=? testStep (step (Just 80) $ Options Group WithModuleName True Inline Inherit (LPConstant 2) True False) input'
+case12b =
+ let
+ options = Options Group WithModuleName True Inline Inherit (LPConstant 2) True False
+ in
+ expected @=? testStep' (step (Just 80) options) input'
where
- input' = unlines
- [ "import Data.List (map)"
- ]
+ input' = ["import Data.List (map)"]
expected = input'
--------------------------------------------------------------------------------
case13 :: Assertion
-case13 = expected
- @=? testStep (step (Just 80) $ Options None WithAlias True InlineWithBreak Inherit (LPConstant 4) True False) input'
+case13 =
+ let
+ options = Options None WithAlias True InlineWithBreak Inherit (LPConstant 4) True False
+ in
+ expected @=? testSnippet (step (Just 80) options) input'
where
- input' = unlines
+ input' = Snippet
[ "import qualified Data.List as List (concat, foldl, foldr, head, init,"
, " last, length, map, null, reverse, tail, (++))"
]
- expected = unlines
+ expected = Snippet
[ "import qualified Data.List as List"
, " (concat, foldl, foldr, head, init, last, length, map, null, reverse, tail,"
, " (++))"
@@ -408,15 +435,18 @@ case13 = expected
--------------------------------------------------------------------------------
case13b :: Assertion
-case13b = expected
- @=? testStep (step (Just 80) $ Options None WithModuleName True InlineWithBreak Inherit (LPConstant 4) True False) input'
+case13b =
+ let
+ options = Options None WithModuleName True InlineWithBreak Inherit (LPConstant 4) True False
+ in
+ expected @=? testSnippet (step (Just 80) options) input'
where
- input' = unlines
+ input' = Snippet
[ "import qualified Data.List as List (concat, foldl, foldr, head, init,"
, " last, length, map, null, reverse, tail, (++))"
]
- expected = unlines
+ expected = Snippet
[ "import qualified Data.List as List"
, " (concat, foldl, foldr, head, init, last, length, map, null, reverse, tail,"
, " (++))"
@@ -425,21 +455,26 @@ case13b = expected
--------------------------------------------------------------------------------
case14 :: Assertion
-case14 = expected
- @=? testStep
- (step (Just 80) $ Options None WithAlias True InlineWithBreak Inherit (LPConstant 10) True False) expected
+case14 =
+ let
+ options = Options None WithAlias True InlineWithBreak Inherit (LPConstant 10) True False
+ in
+ expected @=? testSnippet (step (Just 80) options) expected
where
- expected = unlines
+ expected = Snippet
[ "import qualified Data.List as List (concat, map, null, reverse, tail, (++))"
]
--------------------------------------------------------------------------------
case15 :: Assertion
-case15 = expected
- @=? testStep (step (Just 80) $ Options None AfterAlias True Multiline Inherit (LPConstant 4) True False) input'
+case15 =
+ let
+ options = Options None AfterAlias True Multiline Inherit (LPConstant 4) True False
+ in
+ expected @=? testSnippet (step (Just 80) options) input'
where
- expected = unlines
+ expected = Snippet
[ "import Data.Acid (AcidState)"
, "import qualified Data.Acid as Acid"
, " ( closeAcidState"
@@ -451,7 +486,7 @@ case15 = expected
, "import qualified Herp.Derp.Internal.Types.Foobar as Internal (bar, foo)"
]
- input' = unlines
+ input' = Snippet
[ "import Data.Acid (AcidState)"
, "import qualified Data.Acid as Acid (closeAcidState, createCheckpoint, openLocalStateFrom)"
, "import Data.Default.Class (Default (def))"
@@ -462,10 +497,13 @@ case15 = expected
--------------------------------------------------------------------------------
case16 :: Assertion
-case16 = expected
- @=? testStep (step (Just 80) $ Options None AfterAlias True Multiline Inherit (LPConstant 4) False False) input'
+case16 =
+ let
+ options = Options None AfterAlias True Multiline Inherit (LPConstant 4) False False
+ in
+ expected @=? testSnippet (step (Just 80) options) input'
where
- expected = unlines
+ expected = Snippet
[ "import Data.Acid (AcidState)"
, "import Data.Default.Class (Default(def))"
, ""
@@ -474,7 +512,7 @@ case16 = expected
, "import Data.Foo (Foo(Bar, Foo), Goo(Goo))"
]
- input' = unlines
+ input' = Snippet
[ "import Data.Acid (AcidState)"
, "import Data.Default.Class (Default(def))"
, ""
@@ -486,16 +524,19 @@ case16 = expected
--------------------------------------------------------------------------------
case17 :: Assertion
-case17 = expected
- @=? testStep (step (Just 80) $ Options None AfterAlias True Multiline Inherit (LPConstant 4) True False) input'
+case17 =
+ let
+ options = Options None AfterAlias True Multiline Inherit (LPConstant 4) True False
+ in
+ expected @=? testSnippet (step (Just 80) options) input'
where
- expected = unlines
+ expected = Snippet
[ "import Control.Applicative (Applicative (pure, (<*>)))"
, ""
, "import Data.Identity (Identity (Identity, runIdentity))"
]
- input' = unlines
+ input' = Snippet
[ "import Control.Applicative (Applicative ((<*>),pure))"
, ""
, "import Data.Identity (Identity (runIdentity,Identity))"
@@ -504,10 +545,13 @@ case17 = expected
--------------------------------------------------------------------------------
case18 :: Assertion
-case18 = expected @=? testStep
- (step (Just 40) $ Options None AfterAlias True InlineToMultiline Inherit (LPConstant 4) True False) input'
+case18 =
+ let
+ options = Options None AfterAlias True InlineToMultiline Inherit (LPConstant 4) True False
+ in
+ expected @=? testSnippet (step (Just 40) options) input'
where
- expected = unlines
+ expected = Snippet
----------------------------------------
[ "import Data.Foo as Foo (Bar, Baz, Foo)"
, ""
@@ -521,7 +565,7 @@ case18 = expected @=? testStep
, " )"
]
- input' = unlines
+ input' = Snippet
[ "import Data.Foo as Foo (Bar, Baz, Foo)"
, ""
, "import Data.Identity (Identity (Identity, runIdentity))"
@@ -532,10 +576,13 @@ case18 = expected @=? testStep
--------------------------------------------------------------------------------
case19 :: Assertion
-case19 = expected @=? testStep
- (step (Just 40) $ Options Global NewLine True InlineWithBreak RightAfter (LPConstant 17) True False) case19input
+case19 =
+ let
+ options = Options Global NewLine True InlineWithBreak RightAfter (LPConstant 17) True False
+ in
+ expected @=? testSnippet (step (Just 40) options) case19input
where
- expected = unlines
+ expected = Snippet
----------------------------------------
[ "import Prelude ()"
, "import Prelude.Compat hiding"
@@ -548,14 +595,16 @@ case19 = expected @=? testStep
case19b :: Assertion
-case19b = expected @=? testStep
- (step (Just 40) $ Options File NewLine True InlineWithBreak RightAfter (LPConstant 17) True False) case19input
+case19b =
+ let
+ options = Options File NewLine True InlineWithBreak RightAfter (LPConstant 17) True False
+ in
+ expected @=? testSnippet (step (Just 40) options) case19input
where
- expected = unlines
+ expected = Snippet
----------------------------------------
[ "import Prelude ()"
- , "import Prelude.Compat hiding"
- , " (foldMap)"
+ , "import Prelude.Compat hiding (foldMap)"
, ""
, "import Data.List"
, " (foldl', intercalate,"
@@ -564,14 +613,16 @@ case19b = expected @=? testStep
case19c :: Assertion
-case19c = expected @=? testStep
- (step (Just 40) $ Options File NewLine True InlineWithBreak RightAfter LPModuleName True False) case19input
+case19c =
+ let
+ options = Options File NewLine True InlineWithBreak RightAfter LPModuleName True False
+ in
+ expected @=? testSnippet (step (Just 40) options) case19input
where
- expected = unlines
+ expected = Snippet
----------------------------------------
[ "import Prelude ()"
- , "import Prelude.Compat hiding"
- , " (foldMap)"
+ , "import Prelude.Compat hiding (foldMap)"
, ""
, "import Data.List"
, " (foldl', intercalate,"
@@ -580,10 +631,13 @@ case19c = expected @=? testStep
case19d :: Assertion
-case19d = expected @=? testStep
- (step (Just 40) $ Options Global NewLine True InlineWithBreak RightAfter LPModuleName True False) case19input
+case19d =
+ let
+ options = Options Global NewLine True InlineWithBreak RightAfter LPModuleName True False
+ in
+ expected @=? testSnippet (step (Just 40) options) case19input
where
- expected = unlines
+ expected = Snippet
----------------------------------------
[ "import Prelude ()"
, "import Prelude.Compat hiding"
@@ -595,27 +649,27 @@ case19d = expected @=? testStep
]
-case19input :: String
-case19input = unlines
- [ "import Prelude.Compat hiding (foldMap)"
- , "import Prelude ()"
- , ""
- , "import Data.List (foldl', intercalate, intersperse)"
- ]
+case19input :: Snippet
+case19input = Snippet
+ [ "import Prelude.Compat hiding (foldMap)"
+ , "import Prelude ()"
+ , ""
+ , "import Data.List (foldl', intercalate, intersperse)"
+ ]
--------------------------------------------------------------------------------
case20 :: Assertion
case20 = expected
- @=? testStep (step (Just 80) defaultOptions) input'
+ @=? testSnippet (step (Just 80) defaultOptions) input'
where
- expected = unlines
- [ "import {-# SOURCE #-} Data.ByteString as BS"
- , "import qualified Data.Map as Map"
- , "import Data.Set (empty)"
+ expected = Snippet
+ [ "import {-# SOURCE #-} Data.ByteString as BS"
+ , "import qualified Data.Map as Map"
+ , "import Data.Set (empty)"
, "import {-# SOURCE #-} qualified Data.Text as T"
]
- input' = unlines
+ input' = Snippet
[ "import {-# SOURCE #-} Data.ByteString as BS"
, "import {-# SOURCE #-} qualified Data.Text as T"
, "import qualified Data.Map as Map"
@@ -626,9 +680,9 @@ case20 = expected
--------------------------------------------------------------------------------
case21 :: Assertion
case21 = expected
- @=? testStep (step (Just 80) defaultOptions) input'
+ @=? testSnippet (step (Just 80) defaultOptions) input'
where
- expected = unlines
+ expected = Snippet
[ "{-# LANGUAGE ExplicitNamespaces #-}"
, "import X1 (A, B, C)"
, "import X2 (A, B, C)"
@@ -640,7 +694,7 @@ case21 = expected
, "import X8 (type (+), (+))"
, "import X9 hiding (x, y, z)"
]
- input' = unlines
+ input' = Snippet
[ "{-# LANGUAGE ExplicitNamespaces #-}"
, "import X1 (A, B, A, C, A, B, A)"
, "import X2 (C(), B(), A())"
@@ -657,9 +711,9 @@ case21 = expected
--------------------------------------------------------------------------------
case22 :: Assertion
case22 = expected
- @=? testStep (step (Just 80) defaultOptions) input'
+ @=? testSnippet (step (Just 80) defaultOptions) input'
where
- expected = unlines
+ expected = Snippet
[ "{-# LANGUAGE PackageImports #-}"
, "import A"
, "import \"blah\" A"
@@ -668,7 +722,7 @@ case22 = expected
, "import \"foo\" B (shortName, someLongName, someLongerName,"
, " theLongestNameYet)"
]
- input' = unlines
+ input' = Snippet
[ "{-# LANGUAGE PackageImports #-}"
, "import A"
, "import \"foo\" A"
@@ -683,10 +737,14 @@ case22 = expected
--------------------------------------------------------------------------------
case23 :: Assertion
-case23 = expected
- @=? testStep (step (Just 40) $ Options None AfterAlias False Inline Inherit (LPConstant 4) True True) input'
+case23 =
+ let
+ options = Options None AfterAlias False Inline Inherit (LPConstant 4) True True
+ in
+ expected @=? testSnippet (step (Just 40) options) input'
where
- expected = unlines
+ expected = Snippet
+ ----------------------------------------
[ "import Data.Acid ( AcidState )"
, "import Data.Default.Class ( Default (def) )"
, ""
@@ -696,7 +754,7 @@ case23 = expected
, " Goo )"
]
- input' = unlines
+ input' = Snippet
[ "import Data.Acid (AcidState)"
, "import Data.Default.Class (Default(def))"
, ""
@@ -708,10 +766,14 @@ case23 = expected
--------------------------------------------------------------------------------
case23b :: Assertion
-case23b = expected
- @=? testStep (step (Just 40) $ Options None WithModuleName False Inline Inherit (LPConstant 4) True True) input'
+case23b =
+ let
+ options = Options None WithModuleName False Inline Inherit (LPConstant 4) True True
+ in
+ expected @=? testSnippet (step (Just 40) options) input'
where
- expected = unlines
+ expected = Snippet
+ ----------------------------------------
[ "import Data.Acid ( AcidState )"
, "import Data.Default.Class"
, " ( Default (def) )"
@@ -722,7 +784,7 @@ case23b = expected
, " Goo )"
]
- input' = unlines
+ input' = Snippet
[ "import Data.Acid (AcidState)"
, "import Data.Default.Class (Default(def))"
, ""
@@ -734,10 +796,14 @@ case23b = expected
--------------------------------------------------------------------------------
case24 :: Assertion
-case24 = expected
- @=? testStep (step (Just 40) $ Options None AfterAlias False InlineWithBreak Inherit (LPConstant 4) True True) input'
+case24 =
+ let
+ options = Options None AfterAlias False InlineWithBreak Inherit (LPConstant 4) True True
+ in
+ expected @=? testSnippet (step (Just 40) options) input'
where
- expected = unlines
+ expected = Snippet
+ ----------------------------------------
[ "import Data.Acid ( AcidState )"
, "import Data.Default.Class"
, " ( Default (def) )"
@@ -747,7 +813,7 @@ case24 = expected
, " GooReallyLong )"
]
- input' = unlines
+ input' = Snippet
[ "import Data.Acid (AcidState)"
, "import Data.Default.Class (Default(def))"
, ""
@@ -758,10 +824,13 @@ case24 = expected
--------------------------------------------------------------------------------
case25 :: Assertion
-case25 = expected
- @=? testStep (step (Just 80) $ Options Group AfterAlias False Multiline Inherit (LPConstant 4) False False) input'
+case25 =
+ let
+ options = Options Group AfterAlias False Multiline Inherit (LPConstant 4) False False
+ in
+ expected @=? testSnippet (step (Just 80) options) input'
where
- expected = unlines
+ expected = Snippet
[ "import Data.Acid (AcidState)"
, "import Data.Default.Class (Default(def))"
, ""
@@ -770,7 +839,7 @@ case25 = expected
, ""
, "import Data.Foo (Foo(Bar, Foo), Goo(Goo))"
]
- input' = unlines
+ input' = Snippet
[ "import Data.Acid (AcidState)"
, "import Data.Default.Class (Default(def))"
, ""
@@ -784,22 +853,18 @@ case25 = expected
--------------------------------------------------------------------------------
case26 :: Assertion
case26 = expected
- @=? testStep (step (Just 80) options ) input'
+ @=? testSnippet (step (Just 80) options ) input'
where
options = defaultOptions { listAlign = NewLine, longListAlign = Multiline }
- input' = unlines
- [ "import Data.List"
- ]
- expected = unlines
- [ "import Data.List"
- ]
+ input' = Snippet ["import Data.List"]
+ expected = Snippet ["import Data.List"]
--------------------------------------------------------------------------------
case27 :: Assertion
-case27 = expected @=? testStep (step Nothing $ fromImportAlign Global) input
+case27 = expected @=? testSnippet (step Nothing $ fromImportAlign Global) input
where
- expected = unlines
+ expected = Snippet
[ "module Herp where"
, ""
, "import Control.Monad"
diff --git a/tests/Language/Haskell/Stylish/Step/LanguagePragmas/Tests.hs b/tests/Language/Haskell/Stylish/Step/LanguagePragmas/Tests.hs
index 0ede803..0c19c02 100644
--- a/tests/Language/Haskell/Stylish/Step/LanguagePragmas/Tests.hs
+++ b/tests/Language/Haskell/Stylish/Step/LanguagePragmas/Tests.hs
@@ -1,4 +1,5 @@
--------------------------------------------------------------------------------
+{-# LANGUAGE OverloadedLists #-}
module Language.Haskell.Stylish.Step.LanguagePragmas.Tests
( tests
) where
@@ -7,7 +8,7 @@ module Language.Haskell.Stylish.Step.LanguagePragmas.Tests
--------------------------------------------------------------------------------
import Test.Framework (Test, testGroup)
import Test.Framework.Providers.HUnit (testCase)
-import Test.HUnit (Assertion, (@=?))
+import Test.HUnit (Assertion)
--------------------------------------------------------------------------------
@@ -30,6 +31,7 @@ tests = testGroup "Language.Haskell.Stylish.Step.LanguagePragmas.Tests"
, testCase "case 10" case10
, testCase "case 11" case11
, testCase "case 12" case12
+ , testCase "case 13" case13
]
lANG :: String
@@ -37,202 +39,191 @@ lANG = "LANGUAGE"
--------------------------------------------------------------------------------
case01 :: Assertion
-case01 = expected @=? testStep (step (Just 80) Vertical True False lANG) input
- where
- input = unlines
- [ "{-# LANGUAGE ViewPatterns #-}"
- , "{-# LANGUAGE TemplateHaskell, ViewPatterns #-}"
- , "{-# LANGUAGE ScopedTypeVariables #-}"
- , "module Main where"
- ]
+case01 = assertSnippet
+ (step (Just 80) Vertical True False lANG)
+ [ "{-# LANGUAGE ViewPatterns #-}"
+ , "{-# LANGUAGE TemplateHaskell, ViewPatterns #-}"
+ , "{-# LANGUAGE ScopedTypeVariables #-}"
+ , "module Main where"
+ ]
- expected = unlines
- [ "{-# LANGUAGE ScopedTypeVariables #-}"
- , "{-# LANGUAGE TemplateHaskell #-}"
- , "{-# LANGUAGE ViewPatterns #-}"
- , "module Main where"
- ]
+ [ "{-# LANGUAGE ScopedTypeVariables #-}"
+ , "{-# LANGUAGE TemplateHaskell #-}"
+ , "{-# LANGUAGE ViewPatterns #-}"
+ , "module Main where"
+ ]
--------------------------------------------------------------------------------
case02 :: Assertion
-case02 = expected @=? testStep (step (Just 80) Vertical True True lANG) input
- where
- input = unlines
- [ "{-# LANGUAGE BangPatterns #-}"
- , "{-# LANGUAGE ViewPatterns #-}"
- , "increment ((+ 1) -> x) = x"
- ]
+case02 = assertSnippet
+ (step (Just 80) Vertical True True lANG)
+ [ "{-# LANGUAGE BangPatterns #-}"
+ , "{-# LANGUAGE ViewPatterns #-}"
+ , "increment ((+ 1) -> x) = x"
+ ]
- expected = unlines
- [ "{-# LANGUAGE ViewPatterns #-}"
- , "increment ((+ 1) -> x) = x"
- ]
+ [ "{-# LANGUAGE ViewPatterns #-}"
+ , "increment ((+ 1) -> x) = x"
+ ]
--------------------------------------------------------------------------------
case03 :: Assertion
-case03 = expected @=? testStep (step (Just 80) Vertical True True lANG) input
- where
- input = unlines
- [ "{-# LANGUAGE BangPatterns #-}"
- , "{-# LANGUAGE ViewPatterns #-}"
- , "increment x = case x of !_ -> x + 1"
- ]
+case03 = assertSnippet
+ (step (Just 80) Vertical True True lANG)
+ [ "{-# LANGUAGE BangPatterns #-}"
+ , "{-# LANGUAGE ViewPatterns #-}"
+ , "increment x = case x of !_ -> x + 1"
+ ]
- expected = unlines
- [ "{-# LANGUAGE BangPatterns #-}"
- , "increment x = case x of !_ -> x + 1"
- ]
+ [ "{-# LANGUAGE BangPatterns #-}"
+ , "increment x = case x of !_ -> x + 1"
+ ]
--------------------------------------------------------------------------------
case04 :: Assertion
-case04 = expected @=? testStep (step (Just 80) Compact True False lANG) input
- where
- input = unlines
- [ "{-# LANGUAGE TypeOperators, StandaloneDeriving, DeriveDataTypeable,"
- , " TemplateHaskell #-}"
- , "{-# LANGUAGE TemplateHaskell, ViewPatterns #-}"
- ]
+case04 = assertSnippet
+ (step (Just 80) Compact True False lANG)
+ [ "{-# LANGUAGE TypeOperators, StandaloneDeriving, DeriveDataTypeable,"
+ , " TemplateHaskell #-}"
+ , "{-# LANGUAGE TemplateHaskell, ViewPatterns #-}"
+ ]
- expected = unlines
- [ "{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving, " ++
- "TemplateHaskell,"
- , " TypeOperators, ViewPatterns #-}"
- ]
+ [ "{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving, " ++
+ "TemplateHaskell,"
+ , " TypeOperators, ViewPatterns #-}"
+ ]
--------------------------------------------------------------------------------
case05 :: Assertion
-case05 = expected @=? testStep (step (Just 80) Vertical True False lANG) input
- where
- input = unlines
- [ "{-# LANGUAGE CPP #-}"
- , ""
- , "#if __GLASGOW_HASKELL__ >= 702"
- , "{-# LANGUAGE Trustworthy #-}"
- , "#endif"
- ]
+case05 = assertSnippet
+ (step (Just 80) Vertical True False lANG)
+ [ "{-# LANGUAGE CPP #-}"
+ , ""
+ , "#if __GLASGOW_HASKELL__ >= 702"
+ , "{-# LANGUAGE Trustworthy #-}"
+ , "#endif"
+ ]
- expected = unlines
- [ "{-# LANGUAGE CPP #-}"
- , ""
- , "#if __GLASGOW_HASKELL__ >= 702"
- , "{-# LANGUAGE Trustworthy #-}"
- , "#endif"
- ]
+ [ "{-# LANGUAGE CPP #-}"
+ , ""
+ , "#if __GLASGOW_HASKELL__ >= 702"
+ , "{-# LANGUAGE Trustworthy #-}"
+ , "#endif"
+ ]
--------------------------------------------------------------------------------
case06 :: Assertion
-case06 = expected @=? testStep (step (Just 80) CompactLine True False lANG) input
- where
- input = unlines
- [ "{-# LANGUAGE TypeOperators, StandaloneDeriving, DeriveDataTypeable,"
- , " TemplateHaskell #-}"
- , "{-# LANGUAGE TemplateHaskell, ViewPatterns #-}"
- ]
- expected = unlines
- [ "{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving, " ++
- "TemplateHaskell #-}"
- , "{-# LANGUAGE TypeOperators, ViewPatterns #-}"
- ]
+case06 = assertSnippet
+ (step (Just 80) CompactLine True False lANG)
+ [ "{-# LANGUAGE TypeOperators, StandaloneDeriving, DeriveDataTypeable,"
+ , " TemplateHaskell #-}"
+ , "{-# LANGUAGE TemplateHaskell, ViewPatterns #-}"
+ ]
+ [ "{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving, " ++
+ "TemplateHaskell #-}"
+ , "{-# LANGUAGE TypeOperators, ViewPatterns #-}"
+ ]
--------------------------------------------------------------------------------
case07 :: Assertion
-case07 = expected @=? testStep (step (Just 80) Vertical False False lANG) input
- where
- input = unlines
- [ "{-# LANGUAGE ViewPatterns #-}"
- , "{-# LANGUAGE TemplateHaskell, ViewPatterns #-}"
- , "{-# LANGUAGE ScopedTypeVariables, NoImplicitPrelude #-}"
- , "module Main where"
- ]
+case07 = assertSnippet
+ (step (Just 80) Vertical False False lANG)
+ [ "{-# LANGUAGE ViewPatterns #-}"
+ , "{-# LANGUAGE TemplateHaskell, ViewPatterns #-}"
+ , "{-# LANGUAGE ScopedTypeVariables, NoImplicitPrelude #-}"
+ , "module Main where"
+ ]
- expected = unlines
- [ "{-# LANGUAGE NoImplicitPrelude #-}"
- , "{-# LANGUAGE ScopedTypeVariables #-}"
- , "{-# LANGUAGE TemplateHaskell #-}"
- , "{-# LANGUAGE ViewPatterns #-}"
- , "module Main where"
- ]
+ [ "{-# LANGUAGE NoImplicitPrelude #-}"
+ , "{-# LANGUAGE ScopedTypeVariables #-}"
+ , "{-# LANGUAGE TemplateHaskell #-}"
+ , "{-# LANGUAGE ViewPatterns #-}"
+ , "module Main where"
+ ]
--------------------------------------------------------------------------------
case08 :: Assertion
-case08 = expected @=? testStep (step (Just 80) CompactLine False False lANG) input
- where
- input = unlines
- [ "{-# LANGUAGE TypeOperators, StandaloneDeriving, DeriveDataTypeable,"
- , " TemplateHaskell #-}"
- , "{-# LANGUAGE TemplateHaskell, ViewPatterns #-}"
- ]
- expected = unlines
- [ "{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving, " ++
- "TemplateHaskell #-}"
- , "{-# LANGUAGE TypeOperators, ViewPatterns #-}"
- ]
+case08 = assertSnippet
+ (step (Just 80) CompactLine False False lANG)
+ [ "{-# LANGUAGE TypeOperators, StandaloneDeriving, DeriveDataTypeable,"
+ , " TemplateHaskell #-}"
+ , "{-# LANGUAGE TemplateHaskell, ViewPatterns #-}"
+ ]
+ [ "{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving, " ++
+ "TemplateHaskell #-}"
+ , "{-# LANGUAGE TypeOperators, ViewPatterns #-}"
+ ]
--------------------------------------------------------------------------------
case09 :: Assertion
-case09 = expected @=? testStep (step (Just 80) Compact True False lANG) input
- where
- input = unlines
- [ "{-# LANGUAGE DefaultSignatures, FlexibleInstances, LambdaCase, " ++
- "TypeApplications"
- , " #-}"
- ]
- expected = unlines
- [ "{-# LANGUAGE DefaultSignatures, FlexibleInstances, LambdaCase,"
- , " TypeApplications #-}"
- ]
+case09 = assertSnippet
+ (step (Just 80) Compact True False lANG)
+ [ "{-# LANGUAGE DefaultSignatures, FlexibleInstances, LambdaCase, " ++
+ "TypeApplications"
+ , " #-}"
+ ]
+ [ "{-# LANGUAGE DefaultSignatures, FlexibleInstances, LambdaCase,"
+ , " TypeApplications #-}"
+ ]
--------------------------------------------------------------------------------
case10 :: Assertion
-case10 = expected @=? testStep (step (Just 80) Compact True False lANG) input
- where
- input = unlines
- [ "{-# LANGUAGE NondecreasingIndentation, ScopedTypeVariables,"
- , " TypeApplications #-}"
- ]
- expected = unlines
- [ "{-# LANGUAGE NondecreasingIndentation, ScopedTypeVariables, " ++
- "TypeApplications #-}"
- ]
+case10 = assertSnippet
+ (step (Just 80) Compact True False lANG)
+ [ "{-# LANGUAGE NondecreasingIndentation, ScopedTypeVariables,"
+ , " TypeApplications #-}"
+ ]
+ [ "{-# LANGUAGE NondecreasingIndentation, ScopedTypeVariables, " ++
+ "TypeApplications #-}"
+ ]
--------------------------------------------------------------------------------
case11 :: Assertion
-case11 = expected @=? testStep (step (Just 80) Vertical False False "language") input
- where
- input = unlines
- [ "{-# LANGUAGE ViewPatterns #-}"
- , "{-# LANGUAGE TemplateHaskell, ViewPatterns #-}"
- , "{-# LANGUAGE ScopedTypeVariables, NoImplicitPrelude #-}"
- , "module Main where"
- ]
+case11 = assertSnippet
+ (step (Just 80) Vertical False False "language")
+ [ "{-# LANGUAGE ViewPatterns #-}"
+ , "{-# LANGUAGE TemplateHaskell, ViewPatterns #-}"
+ , "{-# LANGUAGE ScopedTypeVariables, NoImplicitPrelude #-}"
+ , "module Main where"
+ ]
+
+ [ "{-# language NoImplicitPrelude #-}"
+ , "{-# language ScopedTypeVariables #-}"
+ , "{-# language TemplateHaskell #-}"
+ , "{-# language ViewPatterns #-}"
+ , "module Main where"
+ ]
- expected = unlines
- [ "{-# language NoImplicitPrelude #-}"
- , "{-# language ScopedTypeVariables #-}"
- , "{-# language TemplateHaskell #-}"
- , "{-# language ViewPatterns #-}"
- , "module Main where"
- ]
--------------------------------------------------------------------------------
case12 :: Assertion
-case12 = expected @=? testStep (step Nothing Compact False False "language") input
- where
- input = unlines
- [ "{-# LANGUAGE ViewPatterns, OverloadedStrings #-}"
- , "{-# LANGUAGE TemplateHaskell, ViewPatterns #-}"
- , "{-# LANGUAGE ScopedTypeVariables, NoImplicitPrelude #-}"
- , "module Main where"
- ]
+case12 = assertSnippet
+ (step Nothing Compact False False "language")
+ [ "{-# LANGUAGE ViewPatterns, OverloadedStrings #-}"
+ , "{-# LANGUAGE TemplateHaskell, ViewPatterns #-}"
+ , "{-# LANGUAGE ScopedTypeVariables, NoImplicitPrelude #-}"
+ , "module Main where"
+ ]
+
+ [ "{-# language NoImplicitPrelude, OverloadedStrings, ScopedTypeVariables, TemplateHaskell, ViewPatterns #-}"
+ , "module Main where"
+ ]
+
- expected = unlines
- [ "{-# language NoImplicitPrelude, OverloadedStrings, ScopedTypeVariables, TemplateHaskell, ViewPatterns #-}"
- , "module Main where"
+--------------------------------------------------------------------------------
+case13 :: Assertion
+case13 = assertSnippet
+ (step Nothing Vertical True True lANG) input input
+ where
+ input =
+ [ "{-# LANGUAGE BangPatterns #-}"
+ , "{-# LANGUAGE DeriveFunctor #-}"
+ , "main = let !x = 1 + 1 in print x"
]
diff --git a/tests/Language/Haskell/Stylish/Step/ModuleHeader/Tests.hs b/tests/Language/Haskell/Stylish/Step/ModuleHeader/Tests.hs
new file mode 100644
index 0000000..b6d6b89
--- /dev/null
+++ b/tests/Language/Haskell/Stylish/Step/ModuleHeader/Tests.hs
@@ -0,0 +1,301 @@
+{-# LANGUAGE OverloadedLists #-}
+module Language.Haskell.Stylish.Step.ModuleHeader.Tests
+ ( tests
+ ) where
+
+--------------------------------------------------------------------------------
+import Prelude hiding (lines)
+import Test.Framework (Test, testGroup)
+import Test.Framework.Providers.HUnit (testCase)
+import Test.HUnit (Assertion)
+
+--------------------------------------------------------------------------------
+import Language.Haskell.Stylish.Step.ModuleHeader
+import Language.Haskell.Stylish.Tests.Util
+
+
+--------------------------------------------------------------------------------
+tests :: Test
+tests = testGroup "Language.Haskell.Stylish.Printer.ModuleHeader"
+ [ testCase "Hello world" ex0
+ , testCase "Empty exports list" ex1
+ , testCase "Single exported variable" ex2
+ , testCase "Multiple exported variables" ex3
+ , testCase "Only reformats module header" ex4
+ , testCase "Leaving pragmas in place" ex5
+ , testCase "Leaving pragmas in place variant" ex6
+ , testCase "Leaving comments in place" ex7
+ , testCase "Exports all" ex8
+ , testCase "Exports module" ex9
+ , testCase "Exports symbol" ex10
+ , testCase "Respects groups" ex11
+ , testCase "'where' not repeated in case it isn't part of exports" ex12
+ , testCase "Indents absent export list with 2 spaces" ex13
+ , testCase "Indents with 2 spaces" ex14
+ , testCase "Group doc with 2 spaces" ex15
+ , testCase "Does not sort" ex16
+ ]
+
+--------------------------------------------------------------------------------
+ex0 :: Assertion
+ex0 = assertSnippet (step defaultConfig)
+ [ "module Foo where"
+ ]
+ [ "module Foo"
+ , " where"
+ ]
+
+ex1 :: Assertion
+ex1 = assertSnippet (step defaultConfig)
+ [ "module Foo () where"
+ ]
+ [ "module Foo"
+ , " ("
+ , " ) where"
+ ]
+
+ex2 :: Assertion
+ex2 = assertSnippet (step defaultConfig)
+ [ "module Foo (tests) where"
+ ]
+ [ "module Foo"
+ , " ( tests"
+ , " ) where"
+ ]
+
+ex3 :: Assertion
+ex3 = assertSnippet (step defaultConfig)
+ [ "module Foo (t1, t2, t3) where"
+ ]
+ [ "module Foo"
+ , " ( t1"
+ , " , t2"
+ , " , t3"
+ , " ) where"
+ ]
+
+ex4 :: Assertion
+ex4 = assertSnippet (step defaultConfig)
+ [ "module Foo ("
+ , " t1,"
+ , " t3,"
+ , " t2"
+ , ") where"
+ , ""
+ , ""
+ , "-- | Docstring"
+ , "foo :: Int"
+ , "foo = 1"
+ ]
+ [ "module Foo"
+ , " ( t1"
+ , " , t2"
+ , " , t3"
+ , " ) where"
+ , ""
+ , ""
+ , "-- | Docstring"
+ , "foo :: Int"
+ , "foo = 1"
+ ]
+
+ex5 :: Assertion
+ex5 = assertSnippet (step defaultConfig)
+ [ "{-# LANGUAGE DerivingVia #-}"
+ , "-- | This module docs"
+ , "module Foo ("
+ , " t1,"
+ , " t3,"
+ , " t2"
+ , ") where"
+ ]
+ [ "{-# LANGUAGE DerivingVia #-}"
+ , "-- | This module docs"
+ , "module Foo"
+ , " ( t1"
+ , " , t2"
+ , " , t3"
+ , " ) where"
+ ]
+
+ex6 :: Assertion
+ex6 = assertSnippet (step defaultConfig)
+ [ "-- | This module docs"
+ , "{-# LANGUAGE DerivingVia #-}"
+ , "module Foo ("
+ , " t1,"
+ , " t3,"
+ , " t2"
+ , ") where"
+ ]
+ [ "-- | This module docs"
+ , "{-# LANGUAGE DerivingVia #-}"
+ , "module Foo"
+ , " ( t1"
+ , " , t2"
+ , " , t3"
+ , " ) where"
+ ]
+
+ex7 :: Assertion
+ex7 = assertSnippet (step defaultConfig)
+ [ "module Foo -- Foo"
+ , "("
+ , " -- * t1 something"
+ , " t3,"
+ , " t1,"
+ , " -- * t2 something"
+ , " t2"
+ , ") where -- x"
+ , "-- y"
+ ]
+ [ "module Foo -- Foo"
+ , " ( -- * t1 something"
+ , " t1"
+ , " , t3"
+ , " -- * t2 something"
+ , " , t2"
+ , " ) where -- x"
+ , "-- y"
+ ]
+
+
+ex8 :: Assertion
+ex8 = assertSnippet (step defaultConfig)
+ [ "module Foo ("
+ , " -- * t1 something"
+ , " t3,"
+ , " A(..),"
+ , " -- * t2 something"
+ , " t2,"
+ , " t1"
+ , ") where -- x"
+ , "-- y"
+ ]
+ [ "module Foo"
+ , " ( -- * t1 something"
+ , " A (..)"
+ , " , t3"
+ , " -- * t2 something"
+ , " , t1"
+ , " , t2"
+ , " ) where -- x"
+ , "-- y"
+ ]
+
+ex9 :: Assertion
+ex9 = assertSnippet (step defaultConfig)
+ [ "module Foo ("
+ , " -- * t1 something"
+ , " module A,"
+ , " t3,"
+ , " -- * t2 something"
+ , " t2"
+ , ") where -- x"
+ , "-- y"
+ ]
+ [ "module Foo"
+ , " ( -- * t1 something"
+ , " module A"
+ , " , t3"
+ , " -- * t2 something"
+ , " , t2"
+ , " ) where -- x"
+ , "-- y"
+ ]
+
+ex10 :: Assertion
+ex10 = assertSnippet (step defaultConfig)
+ [ "module Foo ("
+ , " (<&>)"
+ , ") where -- x"
+ , "-- y"
+ ]
+ [ "module Foo"
+ , " ( (<&>)"
+ , " ) where -- x"
+ , "-- y"
+ ]
+
+ex11 :: Assertion
+ex11 = assertSnippet (step defaultConfig)
+ [ "module Foo ("
+ , " -- group 1"
+ , " g1_1,"
+ , " g1_0,"
+ , " -- group 2"
+ , " g0_1,"
+ , " g0_0"
+ , ") where"
+ ]
+ [ "module Foo"
+ , " ( -- group 1"
+ , " g1_0"
+ , " , g1_1"
+ , " -- group 2"
+ , " , g0_0"
+ , " , g0_1"
+ , " ) where"
+ ]
+
+ex12 :: Assertion
+ex12 = assertSnippet (step defaultConfig)
+ [ "module Foo"
+ , " where"
+ , "-- hmm"
+ ]
+ [ "module Foo"
+ , " where"
+ , "-- hmm"
+ ]
+
+ex13 :: Assertion
+ex13 = assertSnippet (step defaultConfig {indent = 2})
+ [ "module Foo where"
+ ]
+ [ "module Foo"
+ , " where"
+ ]
+
+ex14 :: Assertion
+ex14 = assertSnippet (step defaultConfig {indent = 2})
+ [ "module Foo"
+ , " ( yes"
+ , " , no"
+ , " ) where"
+ ]
+ [ "module Foo"
+ , " ( no"
+ , " , yes"
+ , " ) where"
+ ]
+
+ex15 :: Assertion
+ex15 = assertSnippet (step defaultConfig {indent = 2})
+ [ "module Foo -- Foo"
+ , "("
+ , " -- * t1 something"
+ , " t3,"
+ , " t1,"
+ , " -- * t2 something"
+ , " t2"
+ , ") where"
+ ]
+ [ "module Foo -- Foo"
+ , " ( -- * t1 something"
+ , " t1"
+ , " , t3"
+ , " -- * t2 something"
+ , " , t2"
+ , " ) where"
+ ]
+
+ex16 :: Assertion
+ex16 = assertSnippet (step defaultConfig {sort = False}) input input
+ where
+ input =
+ [ "module Foo"
+ , " ( yes"
+ , " , no"
+ , " ) where"
+ ]
diff --git a/tests/Language/Haskell/Stylish/Step/SimpleAlign/Tests.hs b/tests/Language/Haskell/Stylish/Step/SimpleAlign/Tests.hs
index a2a51fc..fa17784 100644
--- a/tests/Language/Haskell/Stylish/Step/SimpleAlign/Tests.hs
+++ b/tests/Language/Haskell/Stylish/Step/SimpleAlign/Tests.hs
@@ -1,4 +1,5 @@
--------------------------------------------------------------------------------
+{-# LANGUAGE OverloadedLists #-}
module Language.Haskell.Stylish.Step.SimpleAlign.Tests
( tests
) where
@@ -7,7 +8,7 @@ module Language.Haskell.Stylish.Step.SimpleAlign.Tests
--------------------------------------------------------------------------------
import Test.Framework (Test, testGroup)
import Test.Framework.Providers.HUnit (testCase)
-import Test.HUnit (Assertion, (@=?))
+import Test.HUnit (Assertion)
--------------------------------------------------------------------------------
@@ -27,81 +28,68 @@ tests = testGroup "Language.Haskell.Stylish.Step.SimpleAlign.Tests"
, testCase "case 07" case07
, testCase "case 08" case08
, testCase "case 09" case09
+ , testCase "case 10" case10
+ , testCase "case 11" case11
+ , testCase "case 12" case12
]
--------------------------------------------------------------------------------
case01 :: Assertion
-case01 = expected @=? testStep (step (Just 80) defaultConfig) input
- where
- input = unlines
- [ "eitherToMaybe e = case e of"
- , " Left _ -> Nothing"
- , " Right x -> Just x"
- ]
-
- expected = unlines
- [ "eitherToMaybe e = case e of"
- , " Left _ -> Nothing"
- , " Right x -> Just x"
- ]
+case01 = assertSnippet (step (Just 80) defaultConfig)
+ [ "eitherToMaybe e = case e of"
+ , " Left _ -> Nothing"
+ , " Right x -> Just x"
+ ]
+ [ "eitherToMaybe e = case e of"
+ , " Left _ -> Nothing"
+ , " Right x -> Just x"
+ ]
--------------------------------------------------------------------------------
case02 :: Assertion
-case02 = expected @=? testStep (step (Just 80) defaultConfig) input
- where
- input = unlines
- [ "eitherToMaybe (Left _) = Nothing"
- , "eitherToMaybe (Right x) = Just x"
- ]
-
- expected = unlines
- [ "eitherToMaybe (Left _) = Nothing"
- , "eitherToMaybe (Right x) = Just x"
- ]
+case02 = assertSnippet (step (Just 80) defaultConfig)
+ [ "eitherToMaybe (Left _) = Nothing"
+ , "eitherToMaybe (Right x) = Just x"
+ ]
+ [ "eitherToMaybe (Left _) = Nothing"
+ , "eitherToMaybe (Right x) = Just x"
+ ]
--------------------------------------------------------------------------------
case03 :: Assertion
-case03 = expected @=? testStep (step (Just 80) defaultConfig) input
- where
- input = unlines
- [ "heady def [] = def"
- , "heady _ (x : _) = x"
- ]
-
- expected = unlines
- [ "heady def [] = def"
- , "heady _ (x : _) = x"
- ]
+case03 = assertSnippet (step (Just 80) defaultConfig)
+ [ "heady def [] = def"
+ , "heady _ (x : _) = x"
+ ]
+ [ "heady def [] = def"
+ , "heady _ (x : _) = x"
+ ]
--------------------------------------------------------------------------------
case04 :: Assertion
-case04 = expected @=? testStep (step (Just 80) defaultConfig) input
- where
- input = unlines
- [ "data Foo = Foo"
- , " { foo :: Int"
- , " , barqux :: String"
- , " } deriving (Show)"
- ]
-
- expected = unlines
- [ "data Foo = Foo"
- , " { foo :: Int"
- , " , barqux :: String"
- , " } deriving (Show)"
- ]
+case04 = assertSnippet (step (Just 80) defaultConfig)
+ [ "data Foo = Foo"
+ , " { foo :: Int"
+ , " , barqux :: String"
+ , " } deriving (Show)"
+ ]
+ [ "data Foo = Foo"
+ , " { foo :: Int"
+ , " , barqux :: String"
+ , " } deriving (Show)"
+ ]
--------------------------------------------------------------------------------
case05 :: Assertion
-case05 = input @=? testStep (step (Just 80) defaultConfig) input
+case05 = assertSnippet (step (Just 80) defaultConfig) input input
where
-- Don't attempt to align this since a field spans multiple lines
- input = unlines
+ input =
[ "data Foo = Foo"
, " { foo :: Int"
, " , barqux"
@@ -112,78 +100,102 @@ case05 = input @=? testStep (step (Just 80) defaultConfig) input
--------------------------------------------------------------------------------
case06 :: Assertion
-case06 =
+case06 = assertSnippet
-- 22 max columns is /just/ enough to align this stuff.
- expected @=? testStep (step (Just 22) defaultConfig) input
- where
- input = unlines
- [ "data Foo = Foo"
- , " { foo :: String"
- , " , barqux :: Int"
- , " }"
- ]
-
- expected = unlines
- [ "data Foo = Foo"
- , " { foo :: String"
- , " , barqux :: Int"
- , " }"
- ]
+ (step (Just 22) defaultConfig)
+ [ "data Foo = Foo"
+ , " { foo :: String"
+ , " , barqux :: Int"
+ , " }"
+ ]
+ [ "data Foo = Foo"
+ , " { foo :: String"
+ , " , barqux :: Int"
+ , " }"
+ ]
--------------------------------------------------------------------------------
case07 :: Assertion
-case07 =
+case07 = assertSnippet
-- 21 max columns is /just NOT/ enough to align this stuff.
- expected @=? testStep (step (Just 21) defaultConfig) input
- where
- input = unlines
- [ "data Foo = Foo"
- , " { foo :: String"
- , " , barqux :: Int"
- , " }"
- ]
-
- expected = unlines
- [ "data Foo = Foo"
- , " { foo :: String"
- , " , barqux :: Int"
- , " }"
- ]
+ (step (Just 21) defaultConfig)
+ [ "data Foo = Foo"
+ , " { foo :: String"
+ , " , barqux :: Int"
+ , " }"
+ ]
+ [ "data Foo = Foo"
+ , " { foo :: String"
+ , " , barqux :: Int"
+ , " }"
+ ]
--------------------------------------------------------------------------------
case08 :: Assertion
-case08 = expected @=? testStep (step (Just 80) defaultConfig) input
- where
- input = unlines
- [ "canDrink mbAge = case mbAge of"
- , " Just age | age > 18 -> True"
- , " _ -> False"
- ]
-
- expected = unlines
- [ "canDrink mbAge = case mbAge of"
- , " Just age | age > 18 -> True"
- , " _ -> False"
- ]
+case08 = assertSnippet (step (Just 80) defaultConfig)
+ [ "canDrink mbAge = case mbAge of"
+ , " Just age | age > 18 -> True"
+ , " _ -> False"
+ ]
+ [ "canDrink mbAge = case mbAge of"
+ , " Just age | age > 18 -> True"
+ , " _ -> False"
+ ]
--------------------------------------------------------------------------------
case09 :: Assertion
-case09 =
- expected @=? testStep (step Nothing defaultConfig) input
- where
- input = unlines
- [ "data Foo = Foo"
- , " { foo :: String"
- , " , barqux :: Int"
- , " }"
- ]
+case09 = assertSnippet (step Nothing defaultConfig)
+ [ "data Foo = Foo"
+ , " { foo :: String"
+ , " , barqux :: Int"
+ , " }"
+ ]
+ [ "data Foo = Foo"
+ , " { foo :: String"
+ , " , barqux :: Int"
+ , " }"
+ ]
- expected = unlines
- [ "data Foo = Foo"
- , " { foo :: String"
- , " , barqux :: Int"
- , " }"
+
+--------------------------------------------------------------------------------
+case10 :: Assertion
+case10 = assertSnippet (step Nothing defaultConfig)
+ [ "padQual = case align' of"
+ , " Global -> True"
+ , " File -> fileAlign"
+ , " Group -> anyQual"
+ ]
+ [ "padQual = case align' of"
+ , " Global -> True"
+ , " File -> fileAlign"
+ , " Group -> anyQual"
+ ]
+
+
+--------------------------------------------------------------------------------
+case11 :: Assertion
+case11 = assertSnippet (step Nothing defaultConfig)
+ [ "data Foo = Foo"
+ , " { foo :: String"
+ , " , barqux :: !Int"
+ , " }"
+ ]
+ [ "data Foo = Foo"
+ , " { foo :: String"
+ , " , barqux :: !Int"
+ , " }"
+ ]
+
+
+--------------------------------------------------------------------------------
+case12 :: Assertion
+case12 = assertSnippet (step Nothing defaultConfig {cCases = False}) input input
+ where
+ input =
+ [ "case x of"
+ , " Just y -> 1"
+ , " Nothing -> 2"
]
diff --git a/tests/Language/Haskell/Stylish/Tests.hs b/tests/Language/Haskell/Stylish/Tests.hs
index 97eab8a..b99e620 100644
--- a/tests/Language/Haskell/Stylish/Tests.hs
+++ b/tests/Language/Haskell/Stylish/Tests.hs
@@ -49,6 +49,7 @@ case02 = withTestDirTree $ do
, " first_field: \"indent 2\""
, " field_comment: 2"
, " deriving: 2"
+ , " via: \"indent 2\""
]
actual <- format (Just $ ConfigPath "test-config.yaml") Nothing input
@@ -73,6 +74,7 @@ case03 = withTestDirTree $ do
, " first_field: \"same_line\""
, " field_comment: 2"
, " deriving: 2"
+ , " via: \"indent 2\""
]
actual <- format (Just $ ConfigPath "test-config.yaml") Nothing input
@@ -98,10 +100,8 @@ case04 = (@?= result) =<< format Nothing (Just fileLocation) input
fileLocation = "directory/File.hs"
input = "module Herp"
result = Left $
- "Language.Haskell.Stylish.Parse.parseModule: could not parse " <>
- fileLocation <>
- ": ParseFailed (SrcLoc \"<unknown>.hs\" 2 1) \"Parse error: EOF\""
-
+ fileLocation <> ": RealSrcSpan SrcSpanPoint \"directory/File.hs\" 2 1:"
+ <> " parse error (possibly incorrect indentation or mismatched brackets)\n"
--------------------------------------------------------------------------------
-- | When providing current dir including folders and files.
diff --git a/tests/Language/Haskell/Stylish/Tests/Util.hs b/tests/Language/Haskell/Stylish/Tests/Util.hs
index f43b6b5..b3d200f 100644
--- a/tests/Language/Haskell/Stylish/Tests/Util.hs
+++ b/tests/Language/Haskell/Stylish/Tests/Util.hs
@@ -1,11 +1,21 @@
+{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE TypeFamilies #-}
module Language.Haskell.Stylish.Tests.Util
( testStep
+ , testStep'
+ , Snippet (..)
+ , testSnippet
+ , assertSnippet
, withTestDirTree
+ , (@=??)
) where
--------------------------------------------------------------------------------
import Control.Exception (bracket, try)
+import Control.Monad.Writer (execWriter, tell)
+import Data.List (intercalate)
+import GHC.Exts (IsList (..))
import System.Directory (createDirectory,
getCurrentDirectory,
getTemporaryDirectory,
@@ -14,6 +24,8 @@ import System.Directory (createDirectory,
import System.FilePath ((</>))
import System.IO.Error (isAlreadyExistsError)
import System.Random (randomIO)
+import Test.HUnit (Assertion, assertFailure,
+ (@=?))
--------------------------------------------------------------------------------
@@ -23,14 +35,45 @@ import Language.Haskell.Stylish.Step
--------------------------------------------------------------------------------
testStep :: Step -> String -> String
-testStep step str = case parseModule [] Nothing str of
- Left err -> error err
- Right module' -> unlines $ stepFilter step ls module'
+testStep s str = case s of
+ Step _ step ->
+ case parseModule [] Nothing str of
+ Left err -> error err
+ Right module' -> unlines $ step ls module'
where
ls = lines str
--------------------------------------------------------------------------------
+testStep' :: Step -> Lines -> Lines
+testStep' s ls = lines $ testStep s (unlines ls)
+
+
+--------------------------------------------------------------------------------
+-- | 'Lines' that show as a normal string.
+newtype Snippet = Snippet {unSnippet :: Lines} deriving (Eq)
+
+-- Prefix with one newline since so HUnit will use a newline after `got: ` or
+-- `expected: `.
+instance Show Snippet where show = unlines . ("" :) . unSnippet
+
+instance IsList Snippet where
+ type Item Snippet = String
+ fromList = Snippet
+ toList = unSnippet
+
+
+--------------------------------------------------------------------------------
+testSnippet :: Step -> Snippet -> Snippet
+testSnippet s = Snippet . lines . testStep s . unlines . unSnippet
+
+
+--------------------------------------------------------------------------------
+assertSnippet :: Step -> Snippet -> Snippet -> Assertion
+assertSnippet step input expected = expected @=? testSnippet step input
+
+
+--------------------------------------------------------------------------------
-- | Create a temporary directory with a randomised name built from the template
-- provided
createTempDirectory :: String -> IO FilePath
@@ -59,3 +102,15 @@ withTestDirTree action = bracket
setCurrentDirectory current *>
removeDirectoryRecursive temp)
(\(_, temp) -> setCurrentDirectory temp *> action)
+
+(@=??) :: Lines -> Lines -> Assertion
+expected @=?? actual =
+ if expected == actual then pure ()
+ else assertFailure $ intercalate "\n" $ execWriter do
+ tell ["Expected:"]
+ printLines expected
+ tell ["Got:"]
+ printLines actual
+ where
+ printLines =
+ mapM_ \line -> tell [" " <> line]
diff --git a/tests/TestSuite.hs b/tests/TestSuite.hs
index d2023ed..501821b 100644
--- a/tests/TestSuite.hs
+++ b/tests/TestSuite.hs
@@ -13,6 +13,8 @@ import qualified Language.Haskell.Stylish.Config.Tests
import qualified Language.Haskell.Stylish.Parse.Tests
import qualified Language.Haskell.Stylish.Step.Data.Tests
import qualified Language.Haskell.Stylish.Step.Imports.Tests
+import qualified Language.Haskell.Stylish.Step.Imports.FelixTests
+import qualified Language.Haskell.Stylish.Step.ModuleHeader.Tests
import qualified Language.Haskell.Stylish.Step.LanguagePragmas.Tests
import qualified Language.Haskell.Stylish.Step.SimpleAlign.Tests
import qualified Language.Haskell.Stylish.Step.Squash.Tests
@@ -29,7 +31,9 @@ main = defaultMain
, Language.Haskell.Stylish.Config.Tests.tests
, Language.Haskell.Stylish.Step.Data.Tests.tests
, Language.Haskell.Stylish.Step.Imports.Tests.tests
+ , Language.Haskell.Stylish.Step.Imports.FelixTests.tests
, Language.Haskell.Stylish.Step.LanguagePragmas.Tests.tests
+ , Language.Haskell.Stylish.Step.ModuleHeader.Tests.tests
, Language.Haskell.Stylish.Step.SimpleAlign.Tests.tests
, Language.Haskell.Stylish.Step.Squash.Tests.tests
, Language.Haskell.Stylish.Step.Tabs.Tests.tests
generated by cgit v1.2.3 (git 2.39.1) at 2024-05-17 01:42:30 +0000