diff options
Diffstat (limited to 'tests/Language/Haskell/Stylish')
-rw-r--r-- | tests/Language/Haskell/Stylish/Config/Tests.hs | 30 | ||||
-rw-r--r-- | tests/Language/Haskell/Stylish/Parse/Tests.hs | 48 | ||||
-rw-r--r-- | tests/Language/Haskell/Stylish/Step/Data/Tests.hs | 887 | ||||
-rw-r--r-- | tests/Language/Haskell/Stylish/Step/Imports/FelixTests.hs | 382 | ||||
-rw-r--r-- | tests/Language/Haskell/Stylish/Step/Imports/Tests.hs | 1211 | ||||
-rw-r--r-- | tests/Language/Haskell/Stylish/Step/LanguagePragmas/Tests.hs | 293 | ||||
-rw-r--r-- | tests/Language/Haskell/Stylish/Step/ModuleHeader/Tests.hs | 313 | ||||
-rw-r--r-- | tests/Language/Haskell/Stylish/Step/SimpleAlign/Tests.hs | 338 | ||||
-rw-r--r-- | tests/Language/Haskell/Stylish/Step/Squash/Tests.hs | 137 | ||||
-rw-r--r-- | tests/Language/Haskell/Stylish/Tests.hs | 8 | ||||
-rw-r--r-- | tests/Language/Haskell/Stylish/Tests/Util.hs | 61 |
11 files changed, 2677 insertions, 1031 deletions
diff --git a/tests/Language/Haskell/Stylish/Config/Tests.hs b/tests/Language/Haskell/Stylish/Config/Tests.hs index a8b2ee2..3af6249 100644 --- a/tests/Language/Haskell/Stylish/Config/Tests.hs +++ b/tests/Language/Haskell/Stylish/Config/Tests.hs @@ -4,11 +4,14 @@ module Language.Haskell.Stylish.Config.Tests -------------------------------------------------------------------------------- -import qualified Data.Set as Set +import qualified Data.Aeson.Types as Aeson +import qualified Data.ByteString.Lazy.Char8 as BL8 +import qualified Data.Set as Set +import qualified Data.YAML.Aeson as Yaml import System.Directory -import Test.Framework (Test, testGroup) -import Test.Framework.Providers.HUnit (testCase) -import Test.HUnit (Assertion, assert) +import Test.Framework (Test, testGroup) +import Test.Framework.Providers.HUnit (testCase) +import Test.HUnit (Assertion, assert, (@?=)) -------------------------------------------------------------------------------- @@ -31,6 +34,8 @@ tests = testGroup "Language.Haskell.Stylish.Config" testSpecifiedColumns , testCase "Correctly read .stylish-haskell.yaml file with no max column number" testNoColumns + , testCase "Backwards-compatible align options" + testBoolSimpleAlign ] @@ -105,6 +110,22 @@ testNoColumns = expected = Nothing +-------------------------------------------------------------------------------- +testBoolSimpleAlign :: Assertion +testBoolSimpleAlign = do + Right val <- pure $ Yaml.decode1 $ BL8.pack config + Aeson.Success conf <- pure $ Aeson.parse parseConfig val + length (configSteps conf) @?= 1 + where + config = unlines + [ "steps:" + , " - simple_align:" + , " cases: true" + , " top_level_patterns: always" + , " records: false" + ] + + -- | Example cabal file borrowed from -- https://www.haskell.org/cabal/users-guide/developing-packages.html -- with some default-extensions added @@ -153,6 +174,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..1d50bf1 100644 --- a/tests/Language/Haskell/Stylish/Step/Data/Tests.hs +++ b/tests/Language/Haskell/Stylish/Step/Data/Tests.hs @@ -1,9 +1,11 @@ +{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE OverloadedStrings #-} module Language.Haskell.Stylish.Step.Data.Tests ( tests ) where import Language.Haskell.Stylish.Step.Data -import Language.Haskell.Stylish.Tests.Util (testStep) +import Language.Haskell.Stylish.Tests.Util (assertSnippet, testStep) import Test.Framework (Test, testGroup) import Test.Framework.Providers.HUnit (testCase) import Test.HUnit (Assertion, (@=?)) @@ -35,6 +37,39 @@ tests = testGroup "Language.Haskell.Stylish.Step.Data.Tests" , testCase "case 22" case22 , testCase "case 23" case23 , testCase "case 24" case24 + , testCase "case 25" case25 + , testCase "case 26" case26 + , testCase "case 27" case27 + , testCase "case 28" case28 + , testCase "case 29" case29 + , testCase "case 30" case30 + , testCase "case 31" case31 + , testCase "case 32" case32 + , testCase "case 33" case33 + , testCase "case 34" case34 + , testCase "case 35" case35 + , testCase "case 36" case36 + , testCase "case 37" case37 + , testCase "case 38" case38 + , testCase "case 39" case39 + , testCase "case 40" case40 + , testCase "case 41" case41 + , testCase "case 42" case42 + , testCase "case 43" case43 + , testCase "case 44" case44 + , testCase "case 45" case45 + , testCase "case 46" case46 + , testCase "case 47" case47 + , testCase "case 48" case48 + , testCase "case 49" case49 + , testCase "case 50" case50 + , testCase "case 51" case51 + , testCase "case 52" case52 + , testCase "case 53" case53 + , testCase "case 54" case54 + , testCase "case 55" case55 + , testCase "case 56" case56 + , testCase "case 57" case57 ] case00 :: Assertion @@ -165,7 +200,7 @@ case07 = expected @=? testStep (step sameSameStyle) input expected = input case08 :: Assertion -case08 = input @=? testStep (step sameSameStyle) input +case08 = expected @=? testStep (step sameSameStyle) input where input = unlines [ "module Herp where" @@ -173,6 +208,11 @@ case08 = input @=? testStep (step sameSameStyle) input , "data Phantom a =" , " Phantom" ] + expected = unlines + [ "module Herp where" + , "" + , "data Phantom a = Phantom" + ] case09 :: Assertion case09 = expected @=? testStep (step indentIndentStyle4) input @@ -333,7 +373,8 @@ case16 = expected @=? testStep (step indentIndentStyle) input , "" , "data Foo" , " = Foo" - , " { a :: Int -- ^ comment" + , " { a :: Int" + , " -- ^ comment" , " }" ] @@ -419,7 +460,70 @@ case20 = input @=? testStep (step indentIndentStyle) input ] case21 :: Assertion -case21 = expected @=? testStep (step sameSameStyle) input +case21 = assertSnippet (step sameSameStyle) + [ "data Foo a" + , " = Foo { a :: Int," + , " a2 :: String" + , " -- ^ some haddock" + , " }" + , " | Bar { b :: a } deriving (Eq, Show)" + , " deriving (ToJSON)" + ] + [ "data Foo a = Foo { a :: Int" + , " , a2 :: String" + , " -- ^ some haddock" + , " }" + , " | Bar { b :: a" + , " }" + , " deriving (Eq, Show)" + , " deriving (ToJSON)" + ] + +case22 :: Assertion +case22 = assertSnippet (step sameIndentStyle) + [ "data Foo a" + , " = Foo { a :: Int," + , " a2 :: String" + , " -- ^ some haddock" + , " }" + , " | Bar { b :: a } deriving (Eq, Show)" + , " deriving (ToJSON)" + ] + [ "data Foo a = Foo" + , " { a :: Int" + , " , a2 :: String" + , " -- ^ some haddock" + , " }" + , " | Bar" + , " { b :: a" + , " }" + , " deriving (Eq, Show)" + , " deriving (ToJSON)" + ] + +case23 :: Assertion +case23 = assertSnippet (step indentSameStyle) + [ "data Foo a" + , " = Foo { a :: Int," + , " a2 :: String" + , " -- ^ some haddock" + , " }" + , " | Bar { b :: a } deriving (Eq, Show)" + , " deriving (ToJSON)" + ] + [ "data Foo a" + , " = Foo { a :: Int" + , " , a2 :: String" + , " -- ^ some haddock" + , " }" + , " | Bar { b :: a" + , " }" + , " deriving (Eq, Show)" + , " deriving (ToJSON)" + ] + +case24 :: Assertion +case24 = expected @=? testStep (step indentIndentStyle) input where input = unlines [ "data Foo a" @@ -432,18 +536,21 @@ case21 = expected @=? testStep (step sameSameStyle) input ] expected = unlines - [ "data Foo a = Foo { a :: Int" - , " , a2 :: String" - , " -- ^ some haddock" - , " }" - , " | Bar { b :: a" - , " }" + [ "data Foo a" + , " = Foo" + , " { a :: Int" + , " , a2 :: String" + , " -- ^ some haddock" + , " }" + , " | Bar" + , " { b :: a" + , " }" , " deriving (Eq, Show)" , " deriving (ToJSON)" ] -case22 :: Assertion -case22 = expected @=? testStep (step sameIndentStyle) input +case25 :: Assertion +case25 = expected @=? testStep (step indentIndentStyle { cBreakSingleConstructors = False }) input where input = unlines [ "data Foo a" @@ -451,86 +558,736 @@ case22 = expected @=? testStep (step sameIndentStyle) input , " a2 :: String" , " -- ^ some haddock" , " }" - , " | Bar { b :: a } deriving (Eq, Show)" + , " deriving (Eq, Show)" , " deriving (ToJSON)" ] expected = unlines [ "data Foo a = Foo" - , " { a :: Int" - , " , a2 :: String" - , " -- ^ some haddock" - , " }" - , " | Bar" - , " { b :: a" - , " }" + , " { a :: Int" + , " , a2 :: String" + , " -- ^ some haddock" + , " }" , " deriving (Eq, Show)" , " deriving (ToJSON)" ] -case23 :: Assertion -case23 = expected @=? testStep (step indentSameStyle) input +case26 :: Assertion +case26 = expected @=? testStep (step indentIndentStyle) input where input = unlines - [ "data Foo a" - , " = Foo { a :: Int," - , " a2 :: String" - , " -- ^ some haddock" - , " }" - , " | Bar { b :: a } deriving (Eq, Show)" - , " deriving (ToJSON)" - ] + [ "module Herp where" + , "" + , "data Foo = Foo { a :: Int } deriving (FromJSON) via Bla Foo" + ] expected = unlines - [ "data Foo a" - , " = Foo { a :: Int" - , " , a2 :: String" - , " -- ^ some haddock" - , " }" - , " | Bar { b :: a" - , " }" - , " deriving (Eq, Show)" - , " deriving (ToJSON)" + [ "module Herp where" + , "" + , "data Foo" + , " = Foo" + , " { a :: Int" + , " }" + , " deriving (FromJSON) via Bla Foo" ] -case24 :: Assertion -case24 = expected @=? testStep (step indentIndentStyle) input +case27 :: Assertion +case27 = expected @=? testStep (step sameIndentStyle { cBreakEnums = True }) input where input = unlines - [ "data Foo a" - , " = Foo { a :: Int," - , " a2 :: String" - , " -- ^ some haddock" - , " }" - , " | Bar { b :: a } deriving (Eq, Show)" - , " deriving (ToJSON)" - ] + [ "module Herp where" + , "" + , "data Foo = Foo | Bar | Baz deriving (Eq, Show)" + ] expected = unlines - [ "data Foo a" - , " = Foo" - , " { a :: Int" - , " , a2 :: String" - , " -- ^ some haddock" - , " }" - , " | Bar" - , " { b :: a" - , " }" - , " deriving (Eq, Show)" - , " deriving (ToJSON)" + [ "module Herp where" + , "" + , "data Foo" + , " = Foo" + , " | Bar" + , " | Baz" + , " deriving (Eq, Show)" + ] + +case28 :: Assertion +case28 = expected @=? testStep (step sameIndentStyle { cBreakEnums = True }) input + where + input = unlines + [ "module Some.Types where" + , "" + , "newtype BankCode = BankCode {" + , " unBankCode :: Text" + , " }" + , " deriving stock (Generic, Eq, Show)" + , " deriving anyclass (Newtype)" + , "" + , "newtype CheckDigit = CheckDigit { unCheckDigit :: Text }" + , " deriving stock (Generic, Eq, Show)" + , " deriving anyclass (Newtype)" + , "" + , "newtype WrappedInt = WrappedInt Int" + , " deriving stock (Generic, Eq, Show)" + , " deriving anyclass (Newtype)" + , "" + , "data MandateStatus" + , " = Approved" + , " | Failed" + , " | UserCanceled" + , " | Inactive" + , " deriving stock (Generic, Show, Eq, Enum, Bounded)" + , " deriving (ToJSON, FromJSON) via SnakeCaseCapsEnumEncoding MandateStatus" + ] + + expected = unlines + [ "module Some.Types where" + , "" + , "newtype BankCode = BankCode { unBankCode :: Text }" + , " deriving stock (Eq, Generic, Show)" + , " deriving anyclass (Newtype)" + , "" + , "newtype CheckDigit = CheckDigit { unCheckDigit :: Text }" + , " deriving stock (Eq, Generic, Show)" + , " deriving anyclass (Newtype)" + , "" + , "newtype WrappedInt = WrappedInt Int" + , " deriving stock (Eq, Generic, Show)" + , " deriving anyclass (Newtype)" + , "" + , "data MandateStatus" + , " = Approved" + , " | Failed" + , " | UserCanceled" + , " | Inactive" + , " deriving stock (Bounded, Enum, Eq, Generic, Show)" + , " deriving (FromJSON, ToJSON) via SnakeCaseCapsEnumEncoding MandateStatus" + ] + +case29 :: Assertion +case29 = expected @=? testStep (step sameIndentStyle) input + where + input = unlines + [ "module Some.Types where" + , "" + , "data NonEmpty a" + , " = a :| [a]" + ] + + expected = unlines + [ "module Some.Types where" + , "" + , "data NonEmpty a = a :| [a]" + ] + +case30 :: Assertion +case30 = expected @=? testStep (step sameIndentStyle { cBreakEnums = True }) input + where + expected = input + input = unlines + [ "data ReasonCode" + , " = MissingTenantId" + , " -- Transaction errors:" + , " | TransactionDoesNotExist" + , " | TransactionAlreadyExists" + , " -- Engine errors:" + , " | EnginePersistenceError" + , " | EngineValidationError" + , " -- | Transaction was created in Info mode" + , " | RegisteredByNetworkEngine" + , " -- | Transaction was created in Routing mode" + , " | SentToNetworkEngine" + , " -- Network connection reasons:" + , " | SentToNetworkConnection" + , " | ReceivedByNetworkConnection" + , " | ValidatedByNetworkConnection" + ] + + +case31 :: Assertion +case31 = expected @=? testStep (step indentIndentStyle { cBreakEnums = True }) input + where + expected = input + input = unlines + [ "data ConfiguredLogger" + , " -- | Logs to file" + , " = LogTo FilePath" + , " -- | Logs to stdout" + , " | LogToConsole" + , " -- | No logging, discards all messages" + , " | NoLogging" + , " deriving stock (Generic, Show)" + ] + +case32 :: Assertion +case32 = expected @=? testStep (step indentIndentStyle { cBreakEnums = True }) input + where + expected = input + input = unlines + [ "data RejectionReason" + , " -- InvalidState" + , " = CancellationFailed" + , " | TotalAmountConfirmationInvalid" + , " -- InvalidApiUsage" + , " | AccessTokenNotActive" + , " | VersionNotFound" + , " -- ValidationFailed" + , " | BankAccountExists" + , " deriving stock (Eq, Generic, Show)" + , " deriving (FromJSON, ToJSON) via SnakeCaseLowercaseEnumEncoding RejectionReason" + ] + +case33 :: Assertion +case33 = expected @=? testStep (step indentIndentStyle { cBreakEnums = True, cBreakSingleConstructors = False }) input + where + input = unlines + [ "module Some.Types where" + , "" + , "newtype NonEmpty a = NonEmpty { unNonEmpty :: a }" + ] + + expected = unlines + [ "module Some.Types where" + , "" + , "newtype NonEmpty a" + , " = NonEmpty { unNonEmpty :: a }" + ] + +case34 :: Assertion +case34 = expected @=? testStep (step indentIndentStyle { cVia = Indent 2 }) input + where + input = unlines + [ "module Some.Types where" + , "" + , "newtype NonEmpty a = NonEmpty { unNonEmpty :: a }" + , " deriving (ToJSON, FromJSON) via Something Magic (NonEmpty a)" + ] + + expected = unlines + [ "module Some.Types where" + , "" + , "newtype NonEmpty a" + , " = NonEmpty { unNonEmpty :: a }" + , " deriving (FromJSON, ToJSON)" + , " via Something Magic (NonEmpty a)" + ] + +case35 :: Assertion +case35 = expected @=? testStep (step indentIndentStyle { cBreakEnums = True, cBreakSingleConstructors = False }) input + where + input = unlines + [ "module Some.Types where" + , "" + , "data Foo = Foo" + , " { _transfer :: MonetaryAmount" + , " -> TransactionId" + , " -> m (Either CreditTransferError TransactionId)" + , " }" + ] + + expected = unlines + [ "module Some.Types where" + , "" + , "data Foo = Foo" + , " { _transfer :: MonetaryAmount -> TransactionId -> m (Either CreditTransferError TransactionId)" + , " }" + ] + +case36 :: Assertion +case36 = expected @=? testStep (step indentIndentStyle { cBreakEnums = True, cBreakSingleConstructors = False }) input + where + input = unlines + [ "module Some.Types where" + , "" + , "data Foo = Foo" + , " { _transfer :: (a -> b)" + , " -> TransactionId" + , " -> m (Either CreditTransferError TransactionId)" + , " }" + ] + + expected = unlines + [ "module Some.Types where" + , "" + , "data Foo = Foo" + , " { _transfer :: (a -> b) -> TransactionId -> m (Either CreditTransferError TransactionId)" + , " }" + ] + +case37 :: Assertion +case37 = expected @=? testStep (step indentIndentStyle { cVia = Indent 2 }) input + where + input = unlines + [ "module Some.Types where" + , "" + , "newtype UndoFlowData" + , " = UndoFlowData { flowDataDetails :: FlowDataDetails }" + , " deriving stock (Generic, Eq, Show)" + , " deriving (ToJSON, FromJSON)" + , " via AddConstTextFields '[\"type0\" := \"undo\"," + , " \"type1\" := \"undo\"," + , " \"reversal_indicator\" := \"Undo\"] FlowDataDetails" + ] + + expected = unlines + [ "module Some.Types where" + , "" + , "newtype UndoFlowData" + , " = UndoFlowData { flowDataDetails :: FlowDataDetails }" + , " deriving stock (Eq, Generic, Show)" + , " deriving (FromJSON, ToJSON)" + , " via AddConstTextFields '[\"type0\" := \"undo\", \"type1\" := \"undo\", \"reversal_indicator\" := \"Undo\"] FlowDataDetails" + ] + +case38 :: Assertion +case38 = expected @=? testStep (step indentIndentStyle { cVia = Indent 2 }) input + where + input = unlines + [ "data Flat = Flat" + , " { foo :: Int" + , " , bar :: Text" + , " , baz :: Double" + , " , qux :: Bool" + , " }" + , " deriving stock (Generic, Show, Eq)" + , " deriving (FromJSON, ToJSON)" + , " via GenericEncoded" + , " '[ FieldLabelModifier :=" + , " '[ \"foo\" ==> \"nestFoo#foo\"" + , " , \"bar\" ==> \"nestBar#bar\"" + , " , \"baz\" ==> \"nestFoo#baz\"" + , " ]" + , " ]" + , " Flat" + ] + + expected = unlines + [ "data Flat" + , " = Flat" + , " { foo :: Int" + , " , bar :: Text" + , " , baz :: Double" + , " , qux :: Bool" + , " }" + , " deriving stock (Eq, Generic, Show)" + , " deriving (FromJSON, ToJSON)" + , " via GenericEncoded '[FieldLabelModifier := '[\"foo\" ==> \"nestFoo#foo\", \"bar\" ==> \"nestBar#bar\", \"baz\" ==> \"nestFoo#baz\"]] Flat" + ] + +case39 :: Assertion +case39 = expected @=? testStep (step indentIndentStyle { cVia = Indent 2 }) input + where + input = unlines + [ "data CreditTransfer = CreditTransfer" + , " { nestedCreditorInfo :: CreditorInfo" + , " }" + , " deriving stock (Show, Eq, Generic)" + , " deriving (ToJSON, FromJSON) via" + , " ( UntaggedEncoded NordeaCreditTransfer" + , " & AddConstTextFields" + , " '[ \"request_type\" ':= \"credit_transfer\"" + , " , \"provider\" ':= \"nordea\"" + , " ]" + , " & FlattenFields '[\"nested_creditor_info\"]" + , " & RenameKeys" + , " '[ \"nested_creditor_info.creditor_agent_bic\" ==> \"creditor_agent_bic\"" + , " , \"nested_creditor_info.creditor_iban\" ==> \"creditor_iban\"" + , " , \"nested_creditor_info.creditor_name\" ==> \"creditor_name\"" + , " , \"nested_creditor_info.creditor_account\" ==> \"creditor_account\"" + , " ]" + , " )" + ] + + expected = unlines + [ "data CreditTransfer" + , " = CreditTransfer" + , " { nestedCreditorInfo :: CreditorInfo" + , " }" + , " deriving stock (Eq, Generic, Show)" + , " deriving (FromJSON, ToJSON)" + , " via (UntaggedEncoded NordeaCreditTransfer & AddConstTextFields '[\"request_type\" ':= \"credit_transfer\", \"provider\" ':= \"nordea\"] & FlattenFields '[\"nested_creditor_info\"] & RenameKeys '[\"nested_creditor_info.creditor_agent_bic\" ==> \"creditor_agent_bic\", \"nested_creditor_info.creditor_iban\" ==> \"creditor_iban\", \"nested_creditor_info.creditor_name\" ==> \"creditor_name\", \"nested_creditor_info.creditor_account\" ==> \"creditor_account\"])" + ] + +case40 :: Assertion +case40 = expected @=? testStep (step indentIndentStyle { cBreakSingleConstructors = False }) input + where + input = unlines + [ "module X where" + , "" + , "data a :==> b =" + , " Arr a b" + ] + + expected = unlines + [ "module X where" + , "" + , "data a :==> b = Arr a b" + ] + +case41 :: Assertion +case41 = expected @=? testStep (step indentIndentStyle) input + where + input = expected + + expected = unlines + [ "module X where" + , "" + , "data Callback" + , " -- | Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor" + , " -- incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis" + , " -- nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat." + , " -- Duis aute irure dolor in reprehenderit in voluptate velit esse cillum dolore" + , " -- eu fugiat nulla pariatur. Excepteur sint occaecat cupidatat non proident," + , " -- sunt in culpa qui officia deserunt mollit anim id est laborum." + , " = KafkaTopic" + , " { callbackTopic :: CallbackTopic" + , " -- ^ Name of topic to send updates to" + , " , callbackFormat :: CallbackFormat" + , " -- ^ The format used to send these updates" + , " }" + , " deriving stock (Eq, Generic, Show)" + , " deriving (FromJSON, ToJSON) via IdiomaticWithDescription CallbackDesc Callback" + , " deriving (HasGen) via Generically Callback" + , " deriving (FromField) via JsonField Callback" + ] + +case42 :: Assertion +case42 = expected @=? testStep (step indentIndentStyle) input + where + input = expected + + expected = unlines + [ "module X where" + , "" + , "data SignupError" + , " = IdempotencyConflict" + , " | ValidationError Text -- TODO: might be a sumtype of possible error codes" + , " deriving stock (Eq, Generic, Show)" + ] + +case43 :: Assertion +case43 = expected @=? testStep (step indentIndentStyle { cBreakEnums = True, cBreakSingleConstructors = False }) input + where + input = expected + + expected = unlines + [ "module X where" + , "" + , "data CallbackResult" + , " -- | Callback successfully sent" + , " = Success" + , " -- | Kafka error received" + , " | KafkaIssue KafkaError" + , " deriving (Eq, Show)" + ] + +-- This test showcases a difficult to solve issue. If the comment is in a +-- deriving clause, it's very hard to guess the correct position of the entire +-- block. E.g. the deriving clause itself has the wrong position. However, if +-- we look at all deriving clauses we know where they start and end. +-- +-- This means that we've needed to make the decision to put all inline comments +-- before the deriving clause itself +case44 :: Assertion +case44 = expected @=? testStep (step indentIndentStyle { cBreakEnums = True, cBreakSingleConstructors = False, cVia = Indent 2 }) input + where + input = unlines + [ "module X where" + , "" + , " data CreditTransfer = CreditTransfer" + , " { amount :: Amount -- ^ 1 <= amount <= 999_999_999_999" + , " , date :: Day" + , " , accountNumber :: Account" + , " }" + , " deriving stock (Eq, Generic, Show)" + , " deriving (FromJSON, ToJSON) via" + , " AddConstTextFields" + , " '[\"notification_type\" ':= \"credit_transaction\"" + , " -- Note that the bcio name has \"transaction\"" + , " -- rather than \"transfer\"" + , " ]" + , " (UntaggedEncoded CreditTransfer)" + ] + expected = unlines + [ "module X where" + , "" + , "data CreditTransfer = CreditTransfer" + , " { amount :: Amount" + , " -- ^ 1 <= amount <= 999_999_999_999" + , " , date :: Day" + , " , accountNumber :: Account" + , " }" + , " -- Note that the bcio name has \"transaction\"" + , " -- rather than \"transfer\"" + , " deriving stock (Eq, Generic, Show)" + , " deriving (FromJSON, ToJSON)" + , " via AddConstTextFields '[\"notification_type\" ':= \"credit_transaction\"] (UntaggedEncoded CreditTransfer)" + ] + +case45 :: Assertion +case45 = expected @=? testStep (step indentIndentStyle { cBreakEnums = True, cBreakSingleConstructors = False, cVia = Indent 2 }) input + where + input = expected + expected = unlines + [ "module X where" + , "" + , "data CreditTransfer = CreditTransfer" + , " { amount :: Amount" + , " -- ^ 1 <= amount <= 999_999_999_999" + , " , date :: Day" + , " , accountNumber :: Account" + , " }" + , " -- Note that the bcio name has \"transaction\"" + , " -- rather than \"transfer\"" + , " deriving stock (Eq, Generic, Show)" + , " deriving (FromJSON, ToJSON)" + , " via AddConstTextFields '[\"notification_type\" ':= \"credit_transaction\"] (UntaggedEncoded CreditTransfer)" + ] + +case46 :: Assertion +case46 = expected @=? testStep (step indentIndentStyle { cBreakEnums = True, cBreakSingleConstructors = False, cVia = Indent 2 }) input + where + input = expected + expected = unlines + [ "module X where" + , "" + , "-- | A format detailing which encoding to use for the settlement events" + , "data CallbackFormat" + , " -- | The Avro schema is to be used" + , " = AvroEngineEvent" + , " deriving (Bounded, Enum, Eq, Generic, Show)" + , " deriving (FromJSON, ToJSON)" + , " via TypeTaggedWithDescription FormatDesc CallbackFormat" + , " deriving (HasGen)" + , " via EnumBounded CallbackFormat" + ] + +case47 :: Assertion +case47 = expected @=? testStep (step indentIndentStyle) input + where + input = expected + expected = unlines + [ "module X where" + , "" + , "-- | A GADT example" + , "data T a where" + , " D1 :: Int -> T String" + , " D2 :: T Bool" + , " D3 :: (a, a) -> T [a]" + ] + +case48 :: Assertion +case48 = expected @=? testStep (step indentIndentStyle) input + where + input = expected + expected = unlines + [ "module X where" + , "" + , "-- | A GADT example" + , "data T a where" + , " D1 :: Int -> T String" + , " D2 :: T Bool" + , " D3 :: forall a. (Eq a, Bounded a) => (a, a) -> T [a]" + ] + +case49 :: Assertion +case49 = expected @=? testStep (step indentIndentStyle) input + where + input = expected + expected = unlines + [ "module X where" + , "" + , "-- | A GADT example" + , "data T a where" + , " D1 :: Int -> T String" + , " D2 :: T Bool" + , " D3 :: forall a. (Eq a) => (a, a) -> T [a]" + ] + +case50 :: Assertion +case50 = expected @=? testStep (step indentIndentStyle { cCurriedContext = True }) input + where + input = expected + expected = unlines + [ "module X where" + , "" + , "-- | A GADT example" + , "data T a where" + , " D1 :: Int -> T String" + , " D2 :: T Bool" + , " D3 :: forall a. Eq a => (a, a) -> T [a]" + ] + +case51 :: Assertion +case51 = expected @=? testStep (step indentIndentStyle { cCurriedContext = True }) input + where + input = unlines + [ "module X where" + , "" + , "-- | A GADT example" + , "data T a where" + , " D1 :: Int -> T String" + , " D2 :: T Bool" + , " D3 :: forall a. (Eq a) => (a, a) -> T [a]" + ] + expected = unlines + [ "module X where" + , "" + , "-- | A GADT example" + , "data T a where" + , " D1 :: Int -> T String" + , " D2 :: T Bool" + , " D3 :: forall a. Eq a => (a, a) -> T [a]" + ] + +case52 :: Assertion +case52 = expected @=? testStep (step indentIndentStyle { cBreakSingleConstructors = False, cCurriedContext = True }) input + where + input = unlines + [ "module X where" + , "" + , "data Foo = Foo" + , " { foo :: forall a b. (Eq a, Bounded b) => a -> b -> [(a, b)]" + , " }" + ] + expected = unlines + [ "module X where" + , "" + , "data Foo = Foo" + , " { foo :: forall a b. Eq a => Bounded b => a -> b -> [(a, b)]" + , " }" + ] + +case53 :: Assertion +case53 = expected @=? testStep (step indentIndentStyle { cMaxColumns = MaxColumns 80 }) input + where + input = unlines + [ "newtype Foo m a" + , " = Foo (m a)" + , " deriving newtype (Functor, Applicative, Monad, MonadError, MonadCatch, Foldable, Monoid)" + ] + expected = unlines + [ "newtype Foo m a" + , " = Foo (m a)" + , " deriving newtype" + , " ( Applicative" + , " , Foldable" + , " , Functor" + , " , Monad" + , " , MonadCatch" + , " , MonadError" + , " , Monoid" + , " )" + ] + +case54 :: Assertion +case54 = expected @=? testStep (step indentIndentStyle { cMaxColumns = MaxColumns 80 }) input + where + input = unlines + [ "newtype Foo m a" + , " = Foo (m a)" + , " deriving newtype (Functor, Applicative, Monad)" + ] + expected = unlines + [ "newtype Foo m a" + , " = Foo (m a)" + , " deriving newtype (Applicative, Functor, Monad)" + ] + +case55 :: Assertion +case55 = expected @=? testStep (step sameSameNoSortStyle) input + where + input = unlines + [ "data Foo = Foo deriving (Z, Y, X, Bar, Abcd)" ] + expected = input + +case56 :: Assertion +case56 = assertSnippet (step defaultConfig) + [ "data Foo = Foo" + , " { -- | Comment" + , " bar :: Int" + , " , baz :: Int" + , " }" + ] + [ "data Foo = Foo" + , " { -- | Comment" + , " bar :: Int" + , " , baz :: Int" + , " }" + ] + +case57 :: Assertion +case57 = assertSnippet (step defaultConfig) + [ "data Foo = Foo" + , " { {- | A" + , " -}" + , " fooA :: Int" + , "" + , " {- | B" + , " -}" + , " , fooB :: Int" + , "" + , " {- | C" + , " -}" + , " , fooC :: Int" + , "" + , " {- | D" + , " -}" + , " , fooD :: Int" + , "" + , " {- | E" + , " -}" + , " , fooE :: Int" + , "" + , " {- | F" + , " -}" + , " , fooFooFoo :: Int" + , "" + , " {- | G" + , " -}" + , " , fooBarBar :: Int" + , " }" + ] + [ "data Foo = Foo" + , " { {- | A" + , " -}" + , " fooA :: Int" + , " {- | B" + , " -}" + , " , fooB :: Int" + , " {- | C" + , " -}" + , " , fooC :: Int" + , " {- | D" + , " -}" + , " , fooD :: Int" + , " {- | E" + , " -}" + , " , fooE :: Int" + , " {- | F" + , " -}" + , " , fooFooFoo :: Int" + , " {- | G" + , " -}" + , " , fooBarBar :: Int" + , " }" + ] + sameSameStyle :: Config -sameSameStyle = Config SameLine SameLine 2 2 +sameSameStyle = Config SameLine SameLine 2 2 False True SameLine False True NoMaxColumns sameIndentStyle :: Config -sameIndentStyle = Config SameLine (Indent 2) 2 2 +sameIndentStyle = Config SameLine (Indent 2) 2 2 False True SameLine False True NoMaxColumns indentSameStyle :: Config -indentSameStyle = Config (Indent 2) SameLine 2 2 +indentSameStyle = Config (Indent 2) SameLine 2 2 False True SameLine False True NoMaxColumns indentIndentStyle :: Config -indentIndentStyle = Config (Indent 2) (Indent 2) 2 2 +indentIndentStyle = Config (Indent 2) (Indent 2) 2 2 False True SameLine False True NoMaxColumns indentIndentStyle4 :: Config -indentIndentStyle4 = Config (Indent 4) (Indent 4) 4 4 +indentIndentStyle4 = Config (Indent 4) (Indent 4) 4 4 False True SameLine False True NoMaxColumns + +sameSameNoSortStyle :: Config +sameSameNoSortStyle = Config SameLine SameLine 2 2 False True SameLine False False NoMaxColumns 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..6889db4 100644 --- a/tests/Language/Haskell/Stylish/Step/Imports/Tests.hs +++ b/tests/Language/Haskell/Stylish/Step/Imports/Tests.hs @@ -1,13 +1,14 @@ -------------------------------------------------------------------------------- +{-# LANGUAGE OverloadedLists #-} module Language.Haskell.Stylish.Step.Imports.Tests ( tests ) where -------------------------------------------------------------------------------- -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 +16,6 @@ import Language.Haskell.Stylish.Step.Imports import Language.Haskell.Stylish.Tests.Util - -------------------------------------------------------------------------------- fromImportAlign :: ImportAlign -> Options fromImportAlign align = defaultOptions { importAlign = align } @@ -59,12 +59,15 @@ tests = testGroup "Language.Haskell.Stylish.Step.Imports.Tests" , testCase "case 25" case25 , testCase "case 26 (issue 185)" case26 , testCase "case 27" case27 + , testCase "case 28" case28 + , testCase "case 29" case29 + , testCase "case 30" case30 ] -------------------------------------------------------------------------------- -input :: String -input = unlines +input :: Snippet +input = [ "module Herp where" , "" , "import qualified Data.Map as M" @@ -83,96 +86,88 @@ input = unlines -------------------------------------------------------------------------------- case01 :: Assertion -case01 = expected @=? testStep (step (Just 80) $ fromImportAlign Global) input - where - expected = unlines - [ "module Herp where" - , "" - , "import Control.Monad" - , "import Data.List as List (concat, foldl, foldr, head, init," - , " last, length, map, null, reverse," - , " tail, (++))" - , "import Data.Map (Map, insert, lookup, (!))" - , "import qualified Data.Map as M" - , "import Only.Instances ()" - , "" - , "import Foo (Bar (..))" - , "import Herp.Derp.Internals hiding (foo)" - , "" - , "herp = putStrLn \"import Hello world\"" - ] +case01 = assertSnippet (step (Just 80) $ fromImportAlign Global) input + [ "module Herp where" + , "" + , "import Control.Monad" + , "import Data.List as List (concat, foldl, foldr, head, init," + , " last, length, map, null, reverse," + , " tail, (++))" + , "import Data.Map (Map, insert, lookup, (!))" + , "import qualified Data.Map as M" + , "import Only.Instances ()" + , "" + , "import Foo (Bar (..))" + , "import Herp.Derp.Internals hiding (foo)" + , "" + , "herp = putStrLn \"import Hello world\"" + ] -------------------------------------------------------------------------------- case02 :: Assertion -case02 = expected @=? testStep (step (Just 80) $ fromImportAlign Group) input - where - expected = unlines - [ "module Herp where" - , "" - , "import Control.Monad" - , "import Data.List as List (concat, foldl, foldr, head, init, last," - , " length, map, null, reverse, tail, (++))" - , "import Data.Map (Map, insert, lookup, (!))" - , "import qualified Data.Map as M" - , "import Only.Instances ()" - , "" - , "import Foo (Bar (..))" - , "import Herp.Derp.Internals hiding (foo)" - , "" - , "herp = putStrLn \"import Hello world\"" - ] +case02 = assertSnippet (step (Just 80) $ fromImportAlign Group) input + [ "module Herp where" + , "" + , "import Control.Monad" + , "import Data.List as List (concat, foldl, foldr, head, init, last," + , " length, map, null, reverse, tail, (++))" + , "import Data.Map (Map, insert, lookup, (!))" + , "import qualified Data.Map as M" + , "import Only.Instances ()" + , "" + , "import Foo (Bar (..))" + , "import Herp.Derp.Internals hiding (foo)" + , "" + , "herp = putStrLn \"import Hello world\"" + ] -------------------------------------------------------------------------------- case03 :: Assertion -case03 = expected @=? testStep (step (Just 80) $ fromImportAlign None) input - where - expected = unlines - [ "module Herp where" - , "" - , "import Control.Monad" - , "import Data.List as List (concat, foldl, foldr, head, init, last, length, map," - , " null, reverse, tail, (++))" - , "import Data.Map (Map, insert, lookup, (!))" - , "import qualified Data.Map as M" - , "import Only.Instances ()" - , "" - , "import Foo (Bar (..))" - , "import Herp.Derp.Internals hiding (foo)" - , "" - , "herp = putStrLn \"import Hello world\"" - ] +case03 = assertSnippet (step (Just 80) $ fromImportAlign None) input + [ "module Herp where" + , "" + , "import Control.Monad" + , "import Data.List as List (concat, foldl, foldr, head, init, last, length, map," + , " null, reverse, tail, (++))" + , "import Data.Map (Map, insert, lookup, (!))" + , "import qualified Data.Map as M" + , "import Only.Instances ()" + , "" + , "import Foo (Bar (..))" + , "import Herp.Derp.Internals hiding (foo)" + , "" + , "herp = putStrLn \"import Hello world\"" + ] -------------------------------------------------------------------------------- case04 :: Assertion -case04 = expected @=? testStep (step (Just 80) $ fromImportAlign Global) input' - where - input' = - "import Data.Aeson.Types (object, typeMismatch, FromJSON(..)," ++ +case04 = assertSnippet (step (Just 80) $ fromImportAlign Global) + [ "import Data.Aeson.Types (object, typeMismatch, FromJSON(..)," ++ "ToJSON(..), Value(..), parseEither, (.!=), (.:), (.:?), (.=))" - - expected = unlines - [ "import Data.Aeson.Types (FromJSON (..), ToJSON (..), Value (..)," - , " object, parseEither, typeMismatch, (.!=)," - , " (.:), (.:?), (.=))" - ] + ] + [ "import Data.Aeson.Types (FromJSON (..), ToJSON (..), Value (..)," + , " object, parseEither, typeMismatch, (.!=)," + , " (.:), (.:?), (.=))" + ] -------------------------------------------------------------------------------- case05 :: Assertion -case05 = input' @=? testStep (step (Just 80) $ fromImportAlign Group) input' +case05 = assertSnippet (step (Just 80) $ fromImportAlign Group) input' input' where - input' = "import Distribution.PackageDescription.Configuration " ++ - "(finalizePackageDescription)\n" + -- Putting this on a different line shouldn't really help. + input' = ["import Distribution.PackageDescription.Configuration " ++ + "(finalizePackageDescription)"] -------------------------------------------------------------------------------- case06 :: Assertion -case06 = input' @=? testStep (step (Just 80) $ fromImportAlign File) input' +case06 = assertSnippet (step (Just 80) $ fromImportAlign File) input' input' where - input' = unlines + input' = [ "import Bar.Qux" , "import Foo.Bar" ] @@ -180,442 +175,434 @@ case06 = input' @=? testStep (step (Just 80) $ fromImportAlign File) input' -------------------------------------------------------------------------------- case07 :: Assertion -case07 = expected @=? testStep (step (Just 80) $ fromImportAlign File) input' - where - input' = unlines - [ "import Bar.Qux" - , "" - , "import qualified Foo.Bar" - ] - - expected = unlines - [ "import Bar.Qux" - , "" - , "import qualified Foo.Bar" - ] +case07 = assertSnippet (step (Just 80) $ fromImportAlign File) + [ "import Bar.Qux" + , "" + , "import qualified Foo.Bar" + ] + [ "import Bar.Qux" + , "" + , "import qualified Foo.Bar" + ] -------------------------------------------------------------------------------- case08 :: Assertion -case08 = expected - @=? testStep (step (Just 80) $ Options Global WithAlias True Inline Inherit (LPConstant 4) True False) input - where - expected = unlines - [ "module Herp where" - , "" - , "import Control.Monad" - , "import Data.List as List (concat, foldl, foldr, head, init," - , " last, length, map, null, reverse, tail," - , " (++))" - , "import Data.Map (Map, insert, lookup, (!))" - , "import qualified Data.Map as M" - , "import Only.Instances ()" - , "" - , "import Foo (Bar (..))" - , "import Herp.Derp.Internals hiding (foo)" - , "" - , "herp = putStrLn \"import Hello world\"" - ] +case08 = + let + options = Options Global WithAlias True Inline Inherit (LPConstant 4) True False + in + assertSnippet (step (Just 80) options) input + [ "module Herp where" + , "" + , "import Control.Monad" + , "import Data.List as List (concat, foldl, foldr, head, init," + , " last, length, map, null, reverse, tail," + , " (++))" + , "import Data.Map (Map, insert, lookup, (!))" + , "import qualified Data.Map as M" + , "import Only.Instances ()" + , "" + , "import Foo (Bar (..))" + , "import Herp.Derp.Internals hiding (foo)" + , "" + , "herp = putStrLn \"import Hello world\"" + ] -------------------------------------------------------------------------------- case08b :: Assertion -case08b = expected - @=? testStep (step (Just 80) $ Options Global WithModuleName True Inline Inherit (LPConstant 4) True False) input - where - expected = unlines - ["module Herp where" - , "" - , "import Control.Monad" - , "import Data.List as List (concat, foldl, foldr, head, init," - , " last, length, map, null, reverse, tail, (++))" - , "import Data.Map (Map, insert, lookup, (!))" - , "import qualified Data.Map as M" - , "import Only.Instances ()" - , "" - , "import Foo (Bar (..))" - , "import Herp.Derp.Internals hiding (foo)" - , "" - , "herp = putStrLn \"import Hello world\"" - ] +case08b = + let + options = Options Global WithModuleName True Inline Inherit (LPConstant 4) True False + in + assertSnippet (step (Just 80) options) input + ["module Herp where" + , "" + , "import Control.Monad" + , "import Data.List as List (concat, foldl, foldr, head, init," + , " last, length, map, null, reverse, tail, (++))" + , "import Data.Map (Map, insert, lookup, (!))" + , "import qualified Data.Map as M" + , "import Only.Instances ()" + , "" + , "import Foo (Bar (..))" + , "import Herp.Derp.Internals hiding (foo)" + , "" + , "herp = putStrLn \"import Hello world\"" + ] -------------------------------------------------------------------------------- case09 :: Assertion -case09 = expected - @=? testStep (step (Just 80) $ Options Global WithAlias True Multiline Inherit (LPConstant 4) True False) input - where - expected = unlines - [ "module Herp where" - , "" - , "import Control.Monad" - , "import Data.List as List" - , " ( concat" - , " , foldl" - , " , foldr" - , " , head" - , " , init" - , " , last" - , " , length" - , " , map" - , " , null" - , " , reverse" - , " , tail" - , " , (++)" - , " )" - , "import Data.Map (Map, insert, lookup, (!))" - , "import qualified Data.Map as M" - , "import Only.Instances ()" - , "" - , "import Foo (Bar (..))" - , "import Herp.Derp.Internals hiding (foo)" - , "" - , "herp = putStrLn \"import Hello world\"" - ] +case09 = + let + options = Options Global WithAlias True Multiline Inherit (LPConstant 4) True False + in + assertSnippet (step (Just 80) options) input + [ "module Herp where" + , "" + , "import Control.Monad" + , "import Data.List as List" + , " ( concat" + , " , foldl" + , " , foldr" + , " , head" + , " , init" + , " , last" + , " , length" + , " , map" + , " , null" + , " , reverse" + , " , tail" + , " , (++)" + , " )" + , "import Data.Map (Map, insert, lookup, (!))" + , "import qualified Data.Map as M" + , "import Only.Instances ()" + , "" + , "import Foo (Bar (..))" + , "import Herp.Derp.Internals hiding (foo)" + , "" + , "herp = putStrLn \"import Hello world\"" + ] -------------------------------------------------------------------------------- case10 :: Assertion -case10 = expected - @=? testStep (step (Just 40) $ Options Group WithAlias True Multiline Inherit (LPConstant 4) True False) input - where - expected = unlines - [ "module Herp where" - , "" - , "import Control.Monad" - , "import Data.List as List" - , " ( concat" - , " , foldl" - , " , foldr" - , " , head" - , " , init" - , " , last" - , " , length" - , " , map" - , " , null" - , " , reverse" - , " , tail" - , " , (++)" - , " )" - , "import Data.Map" - , " ( Map" - , " , insert" - , " , lookup" - , " , (!)" - , " )" - , "import qualified Data.Map as M" - , "import Only.Instances ()" - , "" - , "import Foo (Bar (..))" - , "import Herp.Derp.Internals hiding (foo)" - , "" - , "herp = putStrLn \"import Hello world\"" - ] +case10 = + let + options = Options Group WithAlias True Multiline Inherit (LPConstant 4) True False + in + assertSnippet (step (Just 40) options) input + [ "module Herp where" + , "" + , "import Control.Monad" + , "import Data.List as List" + , " ( concat" + , " , foldl" + , " , foldr" + , " , head" + , " , init" + , " , last" + , " , length" + , " , map" + , " , null" + , " , reverse" + , " , tail" + , " , (++)" + , " )" + , "import Data.Map" + , " ( Map" + , " , insert" + , " , lookup" + , " , (!)" + , " )" + , "import qualified Data.Map as M" + , "import Only.Instances ()" + , "" + , "import Foo (Bar (..))" + , "import Herp.Derp.Internals hiding (foo)" + , "" + , "herp = putStrLn \"import Hello world\"" + ] + -------------------------------------------------------------------------------- case11 :: Assertion -case11 = expected - @=? testStep (step (Just 80) $ Options Group NewLine True Inline Inherit (LPConstant 4) True False) input - where - expected = unlines - [ "module Herp where" - , "" - , "import Control.Monad" - , "import Data.List as List" - , " (concat, foldl, foldr, head, init, last, length, map, null, reverse, tail," - , " (++))" - , "import Data.Map" - , " (Map, insert, lookup, (!))" - , "import qualified Data.Map as M" - , "import Only.Instances" - , " ()" - , "" - , "import Foo" - , " (Bar (..))" - , "import Herp.Derp.Internals hiding" - , " (foo)" - - , "" - , "herp = putStrLn \"import Hello world\"" - ] +case11 = + let + options = Options Group NewLine True Inline Inherit (LPConstant 4) True False + in + assertSnippet (step (Just 80) options) input + [ "module Herp where" + , "" + , "import Control.Monad" + , "import Data.List as List" + , " (concat, foldl, foldr, head, init, last, length, map, null, reverse, tail," + , " (++))" + , "import Data.Map" + , " (Map, insert, lookup, (!))" + , "import qualified Data.Map as M" + , "import Only.Instances" + , " ()" + , "" + , "import Foo" + , " (Bar (..))" + , "import Herp.Derp.Internals hiding" + , " (foo)" + , "" + , "herp = putStrLn \"import Hello world\"" + ] case11b :: Assertion -case11b = expected - @=? testStep (step (Just 80) $ Options Group WithModuleName True Inline Inherit (LPConstant 4) True False) input - where - expected = unlines - [ "module Herp where" - , "" - , "import Control.Monad" - , "import Data.List as List (concat, foldl, foldr, head, init, last," - , " length, map, null, reverse, tail, (++))" - , "import Data.Map (Map, insert, lookup, (!))" - , "import qualified Data.Map as M" - , "import Only.Instances ()" - , "" - , "import Foo (Bar (..))" - , "import Herp.Derp.Internals hiding (foo)" - , "" - , "herp = putStrLn \"import Hello world\"" - ] +case11b = + let + options = Options Group WithModuleName True Inline Inherit (LPConstant 4) True False + in + assertSnippet (step (Just 80) options) input + [ "module Herp where" + , "" + , "import Control.Monad" + , "import Data.List as List (concat, foldl, foldr, head, init, last," + , " length, map, null, reverse, tail, (++))" + , "import Data.Map (Map, insert, lookup, (!))" + , "import qualified Data.Map as M" + , "import Only.Instances ()" + , "" + , "import Foo (Bar (..))" + , "import Herp.Derp.Internals hiding (foo)" + , "" + , "herp = putStrLn \"import Hello world\"" + ] -------------------------------------------------------------------------------- case12 :: Assertion -case12 = expected - @=? testStep (step (Just 80) $ Options Group NewLine True Inline Inherit (LPConstant 2) True False) input' - where - input' = unlines - [ "import Data.List (map)" - ] - - expected = unlines - [ "import Data.List" - , " (map)" - ] +case12 = + let + options = Options Group NewLine True Inline Inherit (LPConstant 2) True False + in + assertSnippet (step (Just 80) options) + [ "import Data.List (map)" + ] + [ "import Data.List" + , " (map)" + ] -------------------------------------------------------------------------------- case12b :: Assertion -case12b = expected - @=? testStep (step (Just 80) $ Options Group WithModuleName True Inline Inherit (LPConstant 2) True False) input' - where - input' = unlines - [ "import Data.List (map)" - ] - - expected = input' +case12b = + let + options = Options Group WithModuleName True Inline Inherit (LPConstant 2) True False + in + assertSnippet (step (Just 80) options) + ["import Data.List (map)"] + ["import Data.List (map)"] -------------------------------------------------------------------------------- case13 :: Assertion -case13 = expected - @=? testStep (step (Just 80) $ Options None WithAlias True InlineWithBreak Inherit (LPConstant 4) True False) input' - where - input' = unlines - [ "import qualified Data.List as List (concat, foldl, foldr, head, init," - , " last, length, map, null, reverse, tail, (++))" - ] - - expected = unlines - [ "import qualified Data.List as List" - , " (concat, foldl, foldr, head, init, last, length, map, null, reverse, tail," - , " (++))" - ] - +case13 = + let + options = Options None WithAlias True InlineWithBreak Inherit (LPConstant 4) True False + in + assertSnippet (step (Just 80) options) + [ "import qualified Data.List as List (concat, foldl, foldr, head, init," + , " last, length, map, null, reverse, tail, (++))" + ] + [ "import qualified Data.List as List" + , " (concat, foldl, foldr, head, init, last, length, map, null, reverse, tail," + , " (++))" + ] --------------------------------------------------------------------------------- case13b :: Assertion -case13b = expected - @=? testStep (step (Just 80) $ Options None WithModuleName True InlineWithBreak Inherit (LPConstant 4) True False) input' - where - input' = unlines - [ "import qualified Data.List as List (concat, foldl, foldr, head, init," - , " last, length, map, null, reverse, tail, (++))" - ] - - expected = unlines - [ "import qualified Data.List as List" - , " (concat, foldl, foldr, head, init, last, length, map, null, reverse, tail," - , " (++))" - ] +case13b = + let + options = Options None WithModuleName True InlineWithBreak Inherit (LPConstant 4) True False + in + assertSnippet (step (Just 80) options) + [ "import qualified Data.List as List (concat, foldl, foldr, head, init," + , " last, length, map, null, reverse, tail, (++))" + ] + [ "import qualified Data.List as List" + , " (concat, foldl, foldr, head, init, last, length, map, null, reverse, tail," + , " (++))" + ] -------------------------------------------------------------------------------- case14 :: Assertion -case14 = expected - @=? testStep - (step (Just 80) $ Options None WithAlias True InlineWithBreak Inherit (LPConstant 10) True False) expected - where - expected = unlines - [ "import qualified Data.List as List (concat, map, null, reverse, tail, (++))" - ] +case14 = + let + options = Options None WithAlias True InlineWithBreak Inherit (LPConstant 10) True False + in + assertSnippet (step (Just 80) options) + [ "import qualified Data.List as List (concat, map, null, reverse, tail, (++))" + ] + [ "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' - where - expected = unlines - [ "import Data.Acid (AcidState)" - , "import qualified Data.Acid as Acid" - , " ( closeAcidState" - , " , createCheckpoint" - , " , openLocalStateFrom" - , " )" - , "import Data.Default.Class (Default (def))" - , "" - , "import qualified Herp.Derp.Internal.Types.Foobar as Internal (bar, foo)" - ] - - input' = unlines - [ "import Data.Acid (AcidState)" - , "import qualified Data.Acid as Acid (closeAcidState, createCheckpoint, openLocalStateFrom)" - , "import Data.Default.Class (Default (def))" - , "" - , "import qualified Herp.Derp.Internal.Types.Foobar as Internal (foo, bar)" - ] +case15 = + let + options = Options None AfterAlias True Multiline Inherit (LPConstant 4) True False + in + assertSnippet (step (Just 80) options) + [ "import Data.Acid (AcidState)" + , "import qualified Data.Acid as Acid (closeAcidState, createCheckpoint, openLocalStateFrom)" + , "import Data.Default.Class (Default (def))" + , "" + , "import qualified Herp.Derp.Internal.Types.Foobar as Internal (foo, bar)" + ] + [ "import Data.Acid (AcidState)" + , "import qualified Data.Acid as Acid" + , " ( closeAcidState" + , " , createCheckpoint" + , " , openLocalStateFrom" + , " )" + , "import Data.Default.Class (Default (def))" + , "" + , "import qualified Herp.Derp.Internal.Types.Foobar as Internal (bar, foo)" + ] -------------------------------------------------------------------------------- case16 :: Assertion -case16 = expected - @=? testStep (step (Just 80) $ Options None AfterAlias True Multiline Inherit (LPConstant 4) False False) input' - where - expected = unlines - [ "import Data.Acid (AcidState)" - , "import Data.Default.Class (Default(def))" - , "" - , "import Data.Maybe (Maybe(Just, Nothing))" - , "" - , "import Data.Foo (Foo(Bar, Foo), Goo(Goo))" - ] - - input' = unlines - [ "import Data.Acid (AcidState)" - , "import Data.Default.Class (Default(def))" - , "" - , "import Data.Maybe (Maybe (Just, Nothing))" - , "" - , "import Data.Foo (Foo (Foo,Bar), Goo(Goo))" - ] +case16 = + let + options = Options None AfterAlias True Multiline Inherit (LPConstant 4) False False + in + assertSnippet (step (Just 80) options) + [ "import Data.Acid (AcidState)" + , "import Data.Default.Class (Default(def))" + , "" + , "import Data.Maybe (Maybe (Just, Nothing))" + , "" + , "import Data.Foo (Foo (Foo,Bar), Goo(Goo))" + ] + [ "import Data.Acid (AcidState)" + , "import Data.Default.Class (Default(def))" + , "" + , "import Data.Maybe (Maybe(Just, Nothing))" + , "" + , "import Data.Foo (Foo(Bar, Foo), Goo(Goo))" + ] -------------------------------------------------------------------------------- case17 :: Assertion -case17 = expected - @=? testStep (step (Just 80) $ Options None AfterAlias True Multiline Inherit (LPConstant 4) True False) input' - where - expected = unlines - [ "import Control.Applicative (Applicative (pure, (<*>)))" - , "" - , "import Data.Identity (Identity (Identity, runIdentity))" - ] - - input' = unlines - [ "import Control.Applicative (Applicative ((<*>),pure))" - , "" - , "import Data.Identity (Identity (runIdentity,Identity))" - ] +case17 = + let + options = Options None AfterAlias True Multiline Inherit (LPConstant 4) True False + in + assertSnippet (step (Just 80) options) + [ "import Control.Applicative (Applicative ((<*>),pure))" + , "" + , "import Data.Identity (Identity (runIdentity,Identity))" + ] + [ "import Control.Applicative (Applicative (pure, (<*>)))" + , "" + , "import Data.Identity (Identity (Identity, runIdentity))" + ] -------------------------------------------------------------------------------- case18 :: Assertion -case18 = expected @=? testStep - (step (Just 40) $ Options None AfterAlias True InlineToMultiline Inherit (LPConstant 4) True False) input' - where - expected = unlines - ---------------------------------------- - [ "import Data.Foo as Foo (Bar, Baz, Foo)" - , "" - , "import Data.Identity" - , " (Identity (Identity, runIdentity))" - , "" - , "import Data.Acid as Acid" - , " ( closeAcidState" - , " , createCheckpoint" - , " , openLocalStateFrom" - , " )" - ] - - input' = unlines - [ "import Data.Foo as Foo (Bar, Baz, Foo)" - , "" - , "import Data.Identity (Identity (Identity, runIdentity))" - , "" - , "import Data.Acid as Acid (closeAcidState, createCheckpoint, openLocalStateFrom)" - ] +case18 = + let + options = Options None AfterAlias True InlineToMultiline Inherit (LPConstant 4) True False + in + assertSnippet (step (Just 40) options) + [ "import Data.Foo as Foo (Bar, Baz, Foo)" + , "" + , "import Data.Identity (Identity (Identity, runIdentity))" + , "" + , "import Data.Acid as Acid (closeAcidState, createCheckpoint, openLocalStateFrom)" + ] + ---------------------------------------- + [ "import Data.Foo as Foo (Bar, Baz, Foo)" + , "" + , "import Data.Identity" + , " (Identity (Identity, runIdentity))" + , "" + , "import Data.Acid as Acid" + , " ( closeAcidState" + , " , createCheckpoint" + , " , openLocalStateFrom" + , " )" + ] -------------------------------------------------------------------------------- case19 :: Assertion -case19 = expected @=? testStep - (step (Just 40) $ Options Global NewLine True InlineWithBreak RightAfter (LPConstant 17) True False) case19input - where - expected = unlines - ---------------------------------------- - [ "import Prelude ()" - , "import Prelude.Compat hiding" - , " (foldMap)" - , "" - , "import Data.List" - , " (foldl', intercalate," - , " intersperse)" - ] - +case19 = + let + options = Options Global NewLine True InlineWithBreak RightAfter (LPConstant 17) True False + in + assertSnippet (step (Just 40) options) case19input + ---------------------------------------- + [ "import Prelude ()" + , "import Prelude.Compat hiding" + , " (foldMap)" + , "" + , "import Data.List" + , " (foldl', intercalate," + , " intersperse)" + ] case19b :: Assertion -case19b = expected @=? testStep - (step (Just 40) $ Options File NewLine True InlineWithBreak RightAfter (LPConstant 17) True False) case19input - where - expected = unlines - ---------------------------------------- - [ "import Prelude ()" - , "import Prelude.Compat hiding" - , " (foldMap)" - , "" - , "import Data.List" - , " (foldl', intercalate," - , " intersperse)" - ] - +case19b = + let + options = Options File NewLine True InlineWithBreak RightAfter (LPConstant 17) True False + in + assertSnippet (step (Just 40) options) case19input + ---------------------------------------- + [ "import Prelude ()" + , "import Prelude.Compat hiding (foldMap)" + , "" + , "import Data.List" + , " (foldl', intercalate," + , " intersperse)" + ] case19c :: Assertion -case19c = expected @=? testStep - (step (Just 40) $ Options File NewLine True InlineWithBreak RightAfter LPModuleName True False) case19input - where - expected = unlines - ---------------------------------------- - [ "import Prelude ()" - , "import Prelude.Compat hiding" - , " (foldMap)" - , "" - , "import Data.List" - , " (foldl', intercalate," - , " intersperse)" - ] - +case19c = + let + options = Options File NewLine True InlineWithBreak RightAfter LPModuleName True False + in + assertSnippet (step (Just 40) options) case19input + ---------------------------------------- + [ "import Prelude ()" + , "import Prelude.Compat hiding (foldMap)" + , "" + , "import Data.List" + , " (foldl', intercalate," + , " intersperse)" + ] case19d :: Assertion -case19d = expected @=? testStep - (step (Just 40) $ Options Global NewLine True InlineWithBreak RightAfter LPModuleName True False) case19input - where - expected = unlines - ---------------------------------------- - [ "import Prelude ()" - , "import Prelude.Compat hiding" - , " (foldMap)" - , "" - , "import Data.List" - , " (foldl', intercalate," - , " intersperse)" - ] - +case19d = + let + options = Options Global NewLine True InlineWithBreak RightAfter LPModuleName True False + in + assertSnippet (step (Just 40) options) case19input + ---------------------------------------- + [ "import Prelude ()" + , "import Prelude.Compat hiding" + , " (foldMap)" + , "" + , "import Data.List" + , " (foldl', intercalate," + , " intersperse)" + ] -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" @@ -625,191 +612,233 @@ case20 = expected -------------------------------------------------------------------------------- case21 :: Assertion -case21 = expected - @=? testStep (step (Just 80) defaultOptions) input' - where - expected = unlines - [ "{-# LANGUAGE ExplicitNamespaces #-}" - , "import X1 (A, B, C)" - , "import X2 (A, B, C)" - , "import X3 (A (..))" - , "import X4 (A (..))" - , "import X5 (A (..))" - , "import X6 (A (a, b, c), B (m, n, o))" - , "import X7 (a, b, c)" - , "import X8 (type (+), (+))" - , "import X9 hiding (x, y, z)" - ] - input' = unlines - [ "{-# LANGUAGE ExplicitNamespaces #-}" - , "import X1 (A, B, A, C, A, B, A)" - , "import X2 (C(), B(), A())" - , "import X3 (A(..))" - , "import X4 (A, A(..))" - , "import X5 (A(..), A(x))" - , "import X6 (A(a,b), B(m,n), A(c), B(o))" - , "import X7 (a, b, a, c)" - , "import X8 (type (+), (+))" - , "import X9 hiding (x, y, z, x)" - ] +case21 = + assertSnippet (step (Just 80) defaultOptions) + [ "{-# LANGUAGE ExplicitNamespaces #-}" + , "import X1 (A, B, A, C, A, B, A)" + , "import X2 (C(), B(), A())" + , "import X3 (A(..))" + , "import X4 (A, A(..))" + , "import X5 (A(..), A(x))" + , "import X6 (A(a,b), B(m,n), A(c), B(o))" + , "import X7 (a, b, a, c)" + , "import X8 (type (+), (+))" + , "import X9 hiding (x, y, z, x)" + ] + [ "{-# LANGUAGE ExplicitNamespaces #-}" + , "import X1 (A, B, C)" + , "import X2 (A, B, C)" + , "import X3 (A (..))" + , "import X4 (A (..))" + , "import X5 (A (..))" + , "import X6 (A (a, b, c), B (m, n, o))" + , "import X7 (a, b, c)" + , "import X8 (type (+), (+))" + , "import X9 hiding (x, y, z)" + ] -------------------------------------------------------------------------------- case22 :: Assertion -case22 = expected - @=? testStep (step (Just 80) defaultOptions) input' - where - expected = unlines - [ "{-# LANGUAGE PackageImports #-}" - , "import A" - , "import \"blah\" A" - , "import \"foo\" A" - , "import qualified \"foo\" A as X" - , "import \"foo\" B (shortName, someLongName, someLongerName," - , " theLongestNameYet)" - ] - input' = unlines - [ "{-# LANGUAGE PackageImports #-}" - , "import A" - , "import \"foo\" A" - , "import \"blah\" A" - , "import qualified \"foo\" A as X" - -- this import fits into 80 chats without "foo", - -- but doesn't fit when "foo" is included into the calculation - , "import \"foo\" B (someLongName, someLongerName, " ++ - "theLongestNameYet, shortName)" - ] +case22 = assertSnippet (step (Just 80) defaultOptions) + [ "{-# LANGUAGE PackageImports #-}" + , "import A" + , "import \"foo\" A" + , "import \"blah\" A" + , "import qualified \"foo\" A as X" + -- this import fits into 80 chats without "foo", + -- but doesn't fit when "foo" is included into the calculation + , "import \"foo\" B (someLongName, someLongerName, " ++ + "theLongestNameYet, shortName)" + ] + [ "{-# LANGUAGE PackageImports #-}" + , "import A" + , "import \"blah\" A" + , "import \"foo\" A" + , "import qualified \"foo\" A as X" + , "import \"foo\" B (shortName, someLongName, someLongerName," + , " theLongestNameYet)" + ] -------------------------------------------------------------------------------- case23 :: Assertion -case23 = expected - @=? testStep (step (Just 40) $ Options None AfterAlias False Inline Inherit (LPConstant 4) True True) input' - where - expected = unlines - [ "import Data.Acid ( AcidState )" - , "import Data.Default.Class ( Default (def) )" - , "" - , "import Data.Monoid ( (<>) )" - , "" - , "import Data.ALongName.Foo ( Boo, Foo," - , " Goo )" - ] - - input' = unlines - [ "import Data.Acid (AcidState)" - , "import Data.Default.Class (Default(def))" - , "" - , "import Data.Monoid ((<>) )" - , "" - , "import Data.ALongName.Foo (Foo, Goo, Boo)" - ] +case23 = + let + options = Options None AfterAlias False Inline Inherit (LPConstant 4) True True + in + assertSnippet (step (Just 40) options) + [ "import Data.Acid (AcidState)" + , "import Data.Default.Class (Default(def))" + , "" + , "import Data.Monoid ((<>) )" + , "" + , "import Data.ALongName.Foo (Foo, Goo, Boo)" + ] + ---------------------------------------- + [ "import Data.Acid ( AcidState )" + , "import Data.Default.Class ( Default (def) )" + , "" + , "import Data.Monoid ( (<>) )" + , "" + , "import Data.ALongName.Foo ( Boo, Foo," + , " Goo )" + ] -------------------------------------------------------------------------------- case23b :: Assertion -case23b = expected - @=? testStep (step (Just 40) $ Options None WithModuleName False Inline Inherit (LPConstant 4) True True) input' - where - expected = unlines - [ "import Data.Acid ( AcidState )" - , "import Data.Default.Class" - , " ( Default (def) )" - , "" - , "import Data.Monoid ( (<>) )" - , "" - , "import Data.ALongName.Foo ( Boo, Foo," - , " Goo )" - ] - - input' = unlines - [ "import Data.Acid (AcidState)" - , "import Data.Default.Class (Default(def))" - , "" - , "import Data.Monoid ((<>) )" - , "" - , "import Data.ALongName.Foo (Foo, Goo, Boo)" - ] +case23b = + let + options = Options None WithModuleName False Inline Inherit (LPConstant 4) True True + in + assertSnippet (step (Just 40) options) + [ "import Data.Acid (AcidState)" + , "import Data.Default.Class (Default(def))" + , "" + , "import Data.Monoid ((<>) )" + , "" + , "import Data.ALongName.Foo (Foo, Goo, Boo)" + ] + ---------------------------------------- + [ "import Data.Acid ( AcidState )" + , "import Data.Default.Class" + , " ( Default (def) )" + , "" + , "import Data.Monoid ( (<>) )" + , "" + , "import Data.ALongName.Foo ( Boo, Foo," + , " Goo )" + ] -------------------------------------------------------------------------------- case24 :: Assertion -case24 = expected - @=? testStep (step (Just 40) $ Options None AfterAlias False InlineWithBreak Inherit (LPConstant 4) True True) input' - where - expected = unlines - [ "import Data.Acid ( AcidState )" - , "import Data.Default.Class" - , " ( Default (def) )" - , "" - , "import Data.ALongName.Foo" - , " ( BooReallyLong, FooReallyLong," - , " GooReallyLong )" - ] - - input' = unlines - [ "import Data.Acid (AcidState)" - , "import Data.Default.Class (Default(def))" - , "" - , "import Data.ALongName.Foo (FooReallyLong, " ++ - "GooReallyLong, BooReallyLong)" - ] +case24 = + let + options = Options None AfterAlias False InlineWithBreak Inherit (LPConstant 4) True True + in + assertSnippet (step (Just 40) options) + [ "import Data.Acid (AcidState)" + , "import Data.Default.Class (Default(def))" + , "" + , "import Data.ALongName.Foo (FooReallyLong, " ++ + "GooReallyLong, BooReallyLong)" + ] + ---------------------------------------- + [ "import Data.Acid ( AcidState )" + , "import Data.Default.Class" + , " ( Default (def) )" + , "" + , "import Data.ALongName.Foo" + , " ( BooReallyLong, FooReallyLong," + , " GooReallyLong )" + ] -------------------------------------------------------------------------------- case25 :: Assertion -case25 = expected - @=? testStep (step (Just 80) $ Options Group AfterAlias False Multiline Inherit (LPConstant 4) False False) input' - where - expected = unlines - [ "import Data.Acid (AcidState)" - , "import Data.Default.Class (Default(def))" - , "" - , "import Data.Maybe (Maybe(Just, Nothing))" - , "import qualified Data.Maybe.Extra (Maybe(Just, Nothing))" - , "" - , "import Data.Foo (Foo(Bar, Foo), Goo(Goo))" - ] - input' = unlines - [ "import Data.Acid (AcidState)" - , "import Data.Default.Class (Default(def))" - , "" - , "import Data.Maybe (Maybe (Just, Nothing))" - , "import qualified Data.Maybe.Extra (Maybe(Just, Nothing))" - , "" - , "import Data.Foo (Foo (Foo,Bar), Goo(Goo))" - ] +case25 = + let + options = Options Group AfterAlias False Multiline Inherit (LPConstant 4) False False + in + assertSnippet (step (Just 80) options) + [ "import Data.Acid (AcidState)" + , "import Data.Default.Class (Default(def))" + , "" + , "import Data.Maybe (Maybe (Just, Nothing))" + , "import qualified Data.Maybe.Extra (Maybe(Just, Nothing))" + , "" + , "import Data.Foo (Foo (Foo,Bar), Goo(Goo))" + ] + [ "import Data.Acid (AcidState)" + , "import Data.Default.Class (Default(def))" + , "" + , "import Data.Maybe (Maybe(Just, Nothing))" + , "import qualified Data.Maybe.Extra (Maybe(Just, Nothing))" + , "" + , "import Data.Foo (Foo(Bar, Foo), Goo(Goo))" + ] -------------------------------------------------------------------------------- case26 :: Assertion -case26 = expected - @=? testStep (step (Just 80) options ) input' +case26 = + assertSnippet (step (Just 80) options) + ["import Data.List"] + ["import Data.List"] where options = defaultOptions { listAlign = NewLine, longListAlign = Multiline } - input' = unlines - [ "import Data.List" - ] - expected = unlines - [ "import Data.List" - ] -------------------------------------------------------------------------------- case27 :: Assertion -case27 = expected @=? testStep (step Nothing $ fromImportAlign Global) input - where - expected = unlines - [ "module Herp where" - , "" - , "import Control.Monad" - , "import Data.List as List (concat, foldl, foldr, head, init, last, length, map, null, reverse, tail, (++))" - , "import Data.Map (Map, insert, lookup, (!))" - , "import qualified Data.Map as M" - , "import Only.Instances ()" - , "" - , "import Foo (Bar (..))" - , "import Herp.Derp.Internals hiding (foo)" - , "" - , "herp = putStrLn \"import Hello world\"" - ] +case27 = assertSnippet (step Nothing $ fromImportAlign Global) input + [ "module Herp where" + , "" + , "import Control.Monad" + , "import Data.List as List (concat, foldl, foldr, head, init, last, length, map, null, reverse, tail, (++))" + , "import Data.Map (Map, insert, lookup, (!))" + , "import qualified Data.Map as M" + , "import Only.Instances ()" + , "" + , "import Foo (Bar (..))" + , "import Herp.Derp.Internals hiding (foo)" + , "" + , "herp = putStrLn \"import Hello world\"" + ] + + +-------------------------------------------------------------------------------- +case28 :: Assertion +case28 = assertSnippet (step (Just 80) $ fromImportAlign Global) + [ "import Data.Default.Class (Default(def))" + , "import qualified Data.Aeson as JSON" + , "import qualified Data.Aeson as JSON" + , "import Control.Monad" + , "import Control.Monad" + , "" + , "import Data.Maybe (Maybe (Just, Nothing))" + , "import qualified Data.Maybe.Extra (Maybe(Just, Nothing))" + , "" + , "import Data.Foo (Foo (Foo,Bar), Goo(Goo))" + , "import Data.Foo (Foo (Foo,Bar))" + , "import Data.Set (empty, intersect)" + , "import Data.Set (empty, nub)" + ] + [ "import Control.Monad" + , "import qualified Data.Aeson as JSON" + , "import Data.Default.Class (Default (def))" + , "" + , "import Data.Maybe (Maybe (Just, Nothing))" + , "import qualified Data.Maybe.Extra (Maybe (Just, Nothing))" + , "" + , "import Data.Foo (Foo (Bar, Foo), Goo (Goo))" + , "import Data.Set (empty, intersect, nub)" + ] + + +-------------------------------------------------------------------------------- +case29 :: Assertion +case29 = assertSnippet (step Nothing $ fromImportAlign Group) + -- Check that "Group" mode recognizes groups with multi-line imports + [ "import Foo (foo)" + , "import BarBar ( bar" + , " , kek)" + , "import Abcd ()" + , "" + , "import A (A)" + ] + [ "import Abcd ()" + , "import BarBar (bar, kek)" + , "import Foo (foo)" + , "" + , "import A (A)" + ] + + +-------------------------------------------------------------------------------- +case30 :: Assertion +case30 = assertSnippet (step Nothing defaultOptions {separateLists = False}) + ["import Data.Monoid (Monoid (..))"] + ["import Data.Monoid (Monoid(..))"] 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..002be7c --- /dev/null +++ b/tests/Language/Haskell/Stylish/Step/ModuleHeader/Tests.hs @@ -0,0 +1,313 @@ +{-# 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 + , testCase "Repects separate_lists" ex17 + ] + +-------------------------------------------------------------------------------- +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" + ] + +ex17 :: Assertion +ex17 = assertSnippet (step defaultConfig {separateLists = False}) + [ "module Foo" + , " ( Bar (..)" + , " ) where" + ] + [ "module Foo" + , " ( Bar(..)" + , " ) where" + ] diff --git a/tests/Language/Haskell/Stylish/Step/SimpleAlign/Tests.hs b/tests/Language/Haskell/Stylish/Step/SimpleAlign/Tests.hs index a2a51fc..e30f0ba 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,74 @@ 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 + , testCase "case 13" case13 + , testCase "case 13b" case13b + , testCase "case 14" case14 + , testCase "case 15" case15 + , testCase "case 16" case16 + , testCase "case 17" case17 ] -------------------------------------------------------------------------------- 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 +106,200 @@ 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 +case09 = assertSnippet (step Nothing defaultConfig) + [ "data Foo = Foo" + , " { foo :: String" + , " , barqux :: Int" + , " }" + ] + [ "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 = Never }) input input where - input = unlines - [ "data Foo = Foo" - , " { foo :: String" - , " , barqux :: Int" - , " }" + input = + [ "case x of" + , " Just y -> 1" + , " Nothing -> 2" ] - expected = unlines - [ "data Foo = Foo" - , " { foo :: String" - , " , barqux :: Int" - , " }" - ] + +-------------------------------------------------------------------------------- +case13 :: Assertion +case13 = assertSnippet (step Nothing defaultConfig) + [ "cond n = if" + , " | n < 10, x <- 1 -> x" + , " | otherwise -> 2" + ] + [ "cond n = if" + , " | n < 10, x <- 1 -> x" + , " | otherwise -> 2" + ] + +case13b :: Assertion +case13b = assertSnippet (step Nothing defaultConfig {cMultiWayIf = Never}) + [ "cond n = if" + , " | n < 10, x <- 1 -> x" + , " | otherwise -> 2" + ] + [ "cond n = if" + , " | n < 10, x <- 1 -> x" + , " | otherwise -> 2" + ] + + +-------------------------------------------------------------------------------- +case14 :: Assertion +case14 = assertSnippet (step (Just 80) defaultConfig { cCases = Adjacent }) + [ "catch e = case e of" + , " Left GoodError -> 1" + , " Left BadError -> 2" + , " -- otherwise" + , " Right [] -> 0" + , " Right (x:_) -> x" + ] + [ "catch e = case e of" + , " Left GoodError -> 1" + , " Left BadError -> 2" + , " -- otherwise" + , " Right [] -> 0" + , " Right (x:_) -> x" + ] + + +-------------------------------------------------------------------------------- +case15 :: Assertion +case15 = assertSnippet (step (Just 80) defaultConfig { cTopLevelPatterns = Adjacent }) + [ "catch (Left GoodError) = 1" + , "catch (Left BadError) = 2" + , "-- otherwise" + , "catch (Right []) = 0" + , "catch (Right (x:_)) = x" + ] + [ "catch (Left GoodError) = 1" + , "catch (Left BadError) = 2" + , "-- otherwise" + , "catch (Right []) = 0" + , "catch (Right (x:_)) = x" + ] + + +-------------------------------------------------------------------------------- +case16 :: Assertion +case16 = assertSnippet (step (Just 80) defaultConfig { cRecords = Adjacent }) + [ "data Foo = Foo" + , " { foo :: Int" + , " , foo2 :: String" + , " -- a comment" + , " , barqux :: String" + , " , baz :: String" + , " , baz2 :: Bool" + , " } deriving (Show)" + ] + [ "data Foo = Foo" + , " { foo :: Int" + , " , foo2 :: String" + , " -- a comment" + , " , barqux :: String" + , " , baz :: String" + , " , baz2 :: Bool" + , " } deriving (Show)" + ] + + +-------------------------------------------------------------------------------- +case17 :: Assertion +case17 = assertSnippet (step Nothing defaultConfig { cMultiWayIf = Adjacent }) + [ "cond n = if" + , " | n < 10, x <- 1 -> x" + , " -- comment" + , " | otherwise -> 2" + ] + [ "cond n = if" + , " | n < 10, x <- 1 -> x" + , " -- comment" + , " | otherwise -> 2" + ] diff --git a/tests/Language/Haskell/Stylish/Step/Squash/Tests.hs b/tests/Language/Haskell/Stylish/Step/Squash/Tests.hs index a785d9a..9139507 100644 --- a/tests/Language/Haskell/Stylish/Step/Squash/Tests.hs +++ b/tests/Language/Haskell/Stylish/Step/Squash/Tests.hs @@ -1,13 +1,14 @@ -------------------------------------------------------------------------------- +{-# LANGUAGE OverloadedLists #-} module Language.Haskell.Stylish.Step.Squash.Tests ( tests ) where -------------------------------------------------------------------------------- -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) -------------------------------------------------------------------------------- @@ -28,94 +29,74 @@ tests = testGroup "Language.Haskell.Stylish.Step.SimpleSquash.Tests" -------------------------------------------------------------------------------- case01 :: Assertion -case01 = expected @=? testStep step input - where - input = unlines - [ "data Foo = Foo" - , " { foo :: Int" - , " , barqux :: String" - , " } deriving (Show)" - ] - - expected = unlines - [ "data Foo = Foo" - , " { foo :: Int" - , " , barqux :: String" - , " } deriving (Show)" - ] +case01 = assertSnippet step + [ "data Foo = Foo" + , " { foo :: Int" + , " , barqux :: String" + , " } deriving (Show)" + ] + [ "data Foo = Foo" + , " { foo :: Int" + , " , barqux :: String" + , " } deriving (Show)" + ] -------------------------------------------------------------------------------- case02 :: Assertion -case02 = expected @=? testStep step input - where - input = unlines - [ "data Foo = Foo" - , " { fooqux" - , " , bar :: String" - , " } deriving (Show)" - ] - - expected = unlines - [ "data Foo = Foo" - , " { fooqux" - , " , bar :: String" - , " } deriving (Show)" - ] +case02 = assertSnippet step + [ "data Foo = Foo" + , " { fooqux" + , " , bar :: String" + , " } deriving (Show)" + ] + [ "data Foo = Foo" + , " { fooqux" + , " , bar :: String" + , " } deriving (Show)" + ] -------------------------------------------------------------------------------- case03 :: Assertion -case03 = expected @=? testStep step input - where - input = unlines - [ "maybe y0 f mx =" - , " case mx of" - , " Nothing -> y0" - , " Just x -> f x" - ] - - expected = unlines - [ "maybe y0 f mx =" - , " case mx of" - , " Nothing -> y0" - , " Just x -> f x" - ] +case03 = assertSnippet step + [ "maybe y0 f mx =" + , " case mx of" + , " Nothing -> y0" + , " Just x -> f x" + ] + [ "maybe y0 f mx =" + , " case mx of" + , " Nothing -> y0" + , " Just x -> f x" + ] -------------------------------------------------------------------------------- case04 :: Assertion -case04 = expected @=? testStep step input - where - input = unlines - [ "maybe y0 f mx =" - , " case mx of" - , " Nothing ->" - , " y0" - , " Just x ->" - , " f x" - ] - - expected = unlines - [ "maybe y0 f mx =" - , " case mx of" - , " Nothing ->" - , " y0" - , " Just x ->" - , " f x" - ] +case04 = assertSnippet step + [ "maybe y0 f mx =" + , " case mx of" + , " Nothing ->" + , " y0" + , " Just x ->" + , " f x" + ] + [ "maybe y0 f mx =" + , " case mx of" + , " Nothing ->" + , " y0" + , " Just x ->" + , " f x" + ] -------------------------------------------------------------------------------- case05 :: Assertion -case05 = expected @=? testStep step input - where - input = unlines - [ "maybe y0 _ Nothing = y" - , "maybe _ f (Just x) = f x" - ] - - expected = unlines - [ "maybe y0 _ Nothing = y" - , "maybe _ f (Just x) = f x" - ] +case05 = assertSnippet step + [ "maybe y0 _ Nothing = y" + , "maybe _ f (Just x) = f x" + ] + [ "maybe y0 _ Nothing = y" + , "maybe _ f (Just x) = f x" + ] 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] |