diff options
Diffstat (limited to 'tests/Language/Haskell/Stylish')
| -rw-r--r-- | tests/Language/Haskell/Stylish/Config/Tests.hs | 135 | ||||
| -rw-r--r-- | tests/Language/Haskell/Stylish/Step/Data/Tests.hs | 536 | ||||
| -rw-r--r-- | tests/Language/Haskell/Stylish/Step/Imports/Tests.hs | 89 | ||||
| -rw-r--r-- | tests/Language/Haskell/Stylish/Step/LanguagePragmas/Tests.hs | 59 | ||||
| -rw-r--r-- | tests/Language/Haskell/Stylish/Step/SimpleAlign/Tests.hs | 37 | ||||
| -rw-r--r-- | tests/Language/Haskell/Stylish/Step/UnicodeSyntax/Tests.hs | 19 | ||||
| -rw-r--r-- | tests/Language/Haskell/Stylish/Tests.hs | 144 | ||||
| -rw-r--r-- | tests/Language/Haskell/Stylish/Tests/Util.hs | 44 |
8 files changed, 971 insertions, 92 deletions
diff --git a/tests/Language/Haskell/Stylish/Config/Tests.hs b/tests/Language/Haskell/Stylish/Config/Tests.hs index f62b571..a8b2ee2 100644 --- a/tests/Language/Haskell/Stylish/Config/Tests.hs +++ b/tests/Language/Haskell/Stylish/Config/Tests.hs @@ -4,17 +4,17 @@ module Language.Haskell.Stylish.Config.Tests -------------------------------------------------------------------------------- -import Control.Exception hiding (assert) import qualified Data.Set as Set import System.Directory -import System.FilePath ((</>)) -import System.IO.Error -import System.Random import Test.Framework (Test, testGroup) import Test.Framework.Providers.HUnit (testCase) import Test.HUnit (Assertion, assert) + + -------------------------------------------------------------------------------- import Language.Haskell.Stylish.Config +import Language.Haskell.Stylish.Tests.Util + -------------------------------------------------------------------------------- tests :: Test @@ -25,38 +25,20 @@ tests = testGroup "Language.Haskell.Stylish.Config" testExtensionsFromDotStylish , testCase "Extensions extracted correctly from .stylish-haskell.yaml and .cabal files" testExtensionsFromBoth + , testCase "Correctly read .stylish-haskell.yaml file with default max column number" + testDefaultColumns + , testCase "Correctly read .stylish-haskell.yaml file with specified max column number" + testSpecifiedColumns + , testCase "Correctly read .stylish-haskell.yaml file with no max column number" + testNoColumns ] --------------------------------------------------------------------------------- --- | Create a temporary directory with a randomised name built from the template provided -createTempDirectory :: String -> IO FilePath -createTempDirectory template = do - tmpRootDir <- getTemporaryDirectory - dirId <- randomIO :: IO Word - findTempName tmpRootDir dirId - where - findTempName :: FilePath -> Word -> IO FilePath - findTempName tmpRootDir x = do - let dirpath = tmpRootDir </> template ++ show x - r <- try $ createDirectory dirpath - case r of - Right _ -> return dirpath - Left e | isAlreadyExistsError e -> findTempName tmpRootDir (x+1) - | otherwise -> ioError e - --- | Perform an action inside a temporary directory tree and purge the tree afterwords -withTestDirTree :: IO a -> IO a -withTestDirTree action = bracket - ((,) <$> getCurrentDirectory <*> createTempDirectory "stylish_haskell") - (\(current, temp) -> - setCurrentDirectory current *> - removeDirectoryRecursive temp) - (\(_, temp) -> setCurrentDirectory temp *> action) +-------------------------------------------------------------------------------- -- | Put an example config files (.cabal/.stylish-haskell.yaml/both) -- into the current directory and extract extensions from it. -createFilesAndGetExtensions :: [(FilePath, String)] -> IO Extensions -createFilesAndGetExtensions files = withTestDirTree $ do +createFilesAndGetConfig :: [(FilePath, String)] -> IO Config +createFilesAndGetConfig files = withTestDirTree $ do mapM_ (\(k, v) -> writeFile k v) files -- create an empty directory and change into it createDirectory "src" @@ -64,34 +46,65 @@ createFilesAndGetExtensions files = withTestDirTree $ do -- from that directory read the config file and extract extensions -- to make sure the search for .cabal file works config <- loadConfig (const (pure ())) Nothing - pure $ configLanguageExtensions config + pure config + -------------------------------------------------------------------------------- testExtensionsFromDotCabal :: Assertion testExtensionsFromDotCabal = - assert $ (expected ==) . Set.fromList <$> - createFilesAndGetExtensions [("test.cabal", dotCabal True)] + assert $ (expected ==) . Set.fromList . configLanguageExtensions <$> + createFilesAndGetConfig [("test.cabal", dotCabal True)] where expected = Set.fromList ["ScopedTypeVariables", "DataKinds"] + -------------------------------------------------------------------------------- testExtensionsFromDotStylish :: Assertion testExtensionsFromDotStylish = - assert $ (expected ==) . Set.fromList <$> - createFilesAndGetExtensions [(".stylish-haskell.yaml", dotStylish)] + assert $ (expected ==) . Set.fromList . configLanguageExtensions <$> + createFilesAndGetConfig [(".stylish-haskell.yaml", dotStylish)] where expected = Set.fromList ["TemplateHaskell", "QuasiQuotes"] + -------------------------------------------------------------------------------- testExtensionsFromBoth :: Assertion testExtensionsFromBoth = - assert $ (expected ==) . Set.fromList <$> - createFilesAndGetExtensions [ ("test.cabal", dotCabal True) - , (".stylish-haskell.yaml", dotStylish)] + assert $ (expected ==) . Set.fromList . configLanguageExtensions <$> + createFilesAndGetConfig [ ("test.cabal", dotCabal True) + , (".stylish-haskell.yaml", dotStylish)] where expected = Set.fromList ["ScopedTypeVariables", "DataKinds", "TemplateHaskell", "QuasiQuotes"] + +-------------------------------------------------------------------------------- +testSpecifiedColumns :: Assertion +testSpecifiedColumns = + assert $ (expected ==) . configColumns <$> + createFilesAndGetConfig [(".stylish-haskell.yaml", dotStylish)] + where + expected = Just 110 + + +-------------------------------------------------------------------------------- +testDefaultColumns :: Assertion +testDefaultColumns = + assert $ (expected ==) . configColumns <$> + createFilesAndGetConfig [(".stylish-haskell.yaml", dotStylish2)] + where + expected = Just 80 + + +-------------------------------------------------------------------------------- +testNoColumns :: Assertion +testNoColumns = + assert $ (expected ==) . configColumns <$> + createFilesAndGetConfig [(".stylish-haskell.yaml", dotStylish3)] + where + expected = Nothing + + -- | Example cabal file borrowed from -- https://www.haskell.org/cabal/users-guide/developing-packages.html -- with some default-extensions added @@ -135,8 +148,52 @@ dotStylish = unlines $ , " align: false" , " remove_redundant: true" , " - trailing_whitespace: {}" + , " - records:" + , " equals: \"same_line\"" + , " first_field: \"indent 2\"" + , " field_comment: 2" + , " deriving: 4" , "columns: 110" , "language_extensions:" , " - TemplateHaskell" , " - QuasiQuotes" ] + +-- | Example .stylish-haskell.yaml +dotStylish2 :: String +dotStylish2 = unlines $ + [ "steps:" + , " - imports:" + , " align: none" + , " list_align: after_alias" + , " long_list_align: inline" + , " separate_lists: true" + , " - language_pragmas:" + , " style: vertical" + , " align: false" + , " remove_redundant: true" + , " - trailing_whitespace: {}" + , "language_extensions:" + , " - TemplateHaskell" + , " - QuasiQuotes" + ] + +-- | Example .stylish-haskell.yaml +dotStylish3 :: String +dotStylish3 = unlines $ + [ "steps:" + , " - imports:" + , " align: none" + , " list_align: after_alias" + , " long_list_align: inline" + , " separate_lists: true" + , " - language_pragmas:" + , " style: vertical" + , " align: false" + , " remove_redundant: true" + , " - trailing_whitespace: {}" + , "columns: null" + , "language_extensions:" + , " - TemplateHaskell" + , " - QuasiQuotes" + ] diff --git a/tests/Language/Haskell/Stylish/Step/Data/Tests.hs b/tests/Language/Haskell/Stylish/Step/Data/Tests.hs new file mode 100644 index 0000000..b43e6dc --- /dev/null +++ b/tests/Language/Haskell/Stylish/Step/Data/Tests.hs @@ -0,0 +1,536 @@ +module Language.Haskell.Stylish.Step.Data.Tests + ( tests + ) where + +import Language.Haskell.Stylish.Step.Data +import Language.Haskell.Stylish.Tests.Util (testStep) +import Test.Framework (Test, testGroup) +import Test.Framework.Providers.HUnit (testCase) +import Test.HUnit (Assertion, (@=?)) + +tests :: Test +tests = testGroup "Language.Haskell.Stylish.Step.Data.Tests" + [ testCase "case 00" case00 + , testCase "case 01" case01 + , testCase "case 02" case02 + , testCase "case 03" case03 + , testCase "case 04" case04 + , testCase "case 05" case05 + , testCase "case 06" case06 + , 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 14" case14 + , testCase "case 15" case15 + , testCase "case 16" case16 + , testCase "case 17" case17 + , testCase "case 18" case18 + , testCase "case 19" case19 + , testCase "case 20 (issue 262)" case20 + , testCase "case 21" case21 + , testCase "case 22" case22 + , testCase "case 23" case23 + , testCase "case 24" case24 + ] + +case00 :: Assertion +case00 = expected @=? testStep (step sameSameStyle) input + where + input = unlines + [ "module Herp where" + , "" + , "data Foo" + ] + + expected = input + +case01 :: Assertion +case01 = expected @=? testStep (step indentIndentStyle) input + where + input = unlines + [ "module Herp where" + , "" + , "data Foo = Foo { a :: Int }" + ] + + expected = unlines + [ "module Herp where" + , "" + , "data Foo" + , " = Foo" + , " { a :: Int" + , " }" + ] + +case02 :: Assertion +case02 = expected @=? testStep (step indentIndentStyle) input + where + input = unlines + [ "module Herp where" + , "" + , "data Foo = Foo { a :: Int, a2 :: String }" + ] + expected = unlines + [ "module Herp where" + , "" + , "data Foo" + , " = Foo" + , " { a :: Int" + , " , a2 :: String" + , " }" + ] + +case03 :: Assertion +case03 = expected @=? testStep (step indentIndentStyle) input + where + input = unlines + [ "module Herp where" + , "" + , "data Foo a = Foo { a :: a, a2 :: String }" + ] + expected = unlines + [ "module Herp where" + , "" + , "data Foo a" + , " = Foo" + , " { a :: a" + , " , a2 :: String" + , " }" + ] + +case04 :: Assertion +case04 = expected @=? testStep (step indentIndentStyle) input + where + input = unlines + [ "module Herp where" + , "" + , "data Foo a = Foo { a :: a, a2 :: String } | Bar { b :: a }" + ] + expected = unlines + [ "module Herp where" + , "" + , "data Foo a" + , " = Foo" + , " { a :: a" + , " , a2 :: String" + , " }" + , " | Bar" + , " { b :: a" + , " }" + ] + +case05 :: Assertion +case05 = expected @=? testStep (step indentIndentStyle) input + where + input = unlines + [ "module Herp where" + , "" + , "data Foo = Foo {" + , " a :: Int" + , " , a2 :: String" + , " }" + ] + expected = unlines + [ "module Herp where" + , "" + , "data Foo" + , " = Foo" + , " { a :: Int" + , " , a2 :: String" + , " }" + ] + +case06 :: Assertion +case06 = expected @=? testStep (step sameSameStyle) input + where + input = unlines + [ "module Herp where" + , "" + , "data Foo = Foo Int String" + ] + expected = input + +case07 :: Assertion +case07 = expected @=? testStep (step sameSameStyle) input + where + input = unlines + [ "module Herp where" + , "" + , "data Phantom a = Phantom" + ] + expected = input + +case08 :: Assertion +case08 = input @=? testStep (step sameSameStyle) input + where + input = unlines + [ "module Herp where" + , "" + , "data Phantom a =" + , " Phantom" + ] + +case09 :: Assertion +case09 = expected @=? testStep (step indentIndentStyle4) input + where + input = unlines + [ "module Herp where" + , "" + , "data Foo a b = Foo { a :: a, a2 :: String } | Bar { b :: a, c:: b }" + ] + expected = unlines + [ "module Herp where" + , "" + , "data Foo a b" + , " = Foo" + , " { a :: a" + , " , a2 :: String" + , " }" + , " | Bar" + , " { b :: a" + , " , c :: b" + , " }" + ] + +case10 :: Assertion +case10 = expected @=? testStep (step indentIndentStyle) input + where + input = unlines + [ "module Herp where" + , "" + , "data Foo = Foo { a :: Int } deriving (Eq, Generic) deriving (Show)" + ] + + expected = unlines + [ "module Herp where" + , "" + , "data Foo" + , " = Foo" + , " { a :: Int" + , " }" + , " deriving (Eq, Generic)" + , " deriving (Show)" + ] + +case11 :: Assertion +case11 = expected @=? testStep (step indentIndentStyle) input + where + input = unlines + [ "{-# LANGUAGE DerivingStrategies #-}" + , "module Herp where" + , "" + , "data Foo = Foo { a :: Int } deriving stock (Show)" + ] + + expected = unlines + [ "{-# LANGUAGE DerivingStrategies #-}" + , "module Herp where" + , "" + , "data Foo" + , " = Foo" + , " { a :: Int" + , " }" + , " deriving stock (Show)" + ] + +case12 :: Assertion +case12 = expected @=? testStep (step indentIndentStyle4) input + where + input = unlines + [ "module Herp where" + , "" + , "data Point = Point { pointX, pointY :: Double , pointName :: String} deriving (Show)" + ] + + expected = unlines + [ "module Herp where" + , "" + , "data Point" + , " = Point" + , " { pointX, pointY :: Double" + , " , pointName :: String" + , " }" + , " deriving (Show)" + ] + +case13 :: Assertion +case13 = expected @=? testStep (step indentIndentStyle) input + where + input = unlines + [ "module Herp where" + , "" + , "-- this is a comment" + , "data Foo = Foo { a :: Int }" + ] + expected = unlines + [ "module Herp where" + , "" + , "-- this is a comment" + , "data Foo" + , " = Foo" + , " { a :: Int" + , " }" + ] + +case14 :: Assertion +case14 = expected @=? testStep (step indentIndentStyle) input + where + input = unlines + [ "module Herp where" + , "" + , "{- this is" + , " a comment -}" + , "data Foo = Foo { a :: Int }" + ] + expected = unlines + [ "module Herp where" + , "" + , "{- this is" + , " a comment -}" + , "data Foo" + , " = Foo" + , " { a :: Int" + , " }" + ] + +case15 :: Assertion +case15 = expected @=? testStep (step indentIndentStyle) input + where + input = unlines + [ "module Herp where" + , "" + , "data Foo a = Foo" + , " { a :: a, -- comment" + , " a2 :: String" + , " }" + ] + expected = unlines + [ "module Herp where" + , "" + , "data Foo a" + , " = Foo" + , " { a :: a -- comment" + , " , a2 :: String" + , " }" + ] + +case16 :: Assertion +case16 = expected @=? testStep (step indentIndentStyle) input + where + input = unlines + [ "module Herp where" + , "" + , "data Foo = Foo {" + , " a :: Int -- ^ comment" + , " }" + ] + expected = unlines + [ "module Herp where" + , "" + , "data Foo" + , " = Foo" + , " { a :: Int -- ^ comment" + , " }" + ] + +case17 :: Assertion +case17 = expected @=? testStep (step indentIndentStyle) input + where + input = unlines + [ "module Herp where" + , "" + , "data Foo a = Foo" + , " { a :: a," + , "-- comment" + , " a2 :: String" + , " }" + ] + expected = unlines + [ "module Herp where" + , "" + , "data Foo a" + , " = Foo" + , " { a :: a" + , " -- comment" + , " , a2 :: String" + , " }" + ] + +case18 :: Assertion +case18 = expected @=? testStep (step indentIndentStyle) input + where + input = unlines + [ "module Herp where" + , "" + , "data Foo a = Foo" + , " { a :: a," + , "-- ^ comment" + , " a2 :: String" + , " }" + ] + expected = unlines + [ "module Herp where" + , "" + , "data Foo a" + , " = Foo" + , " { a :: a" + , " -- ^ comment" + , " , a2 :: String" + , " }" + ] + +case19 :: Assertion +case19 = expected @=? testStep (step indentIndentStyle) input + where + input = unlines + [ "module Herp where" + , "" + , "data Foo a = Foo" + , " { firstName, lastName :: String," + , "-- ^ names" + , " age :: Int" + , " }" + ] + expected = unlines + [ "module Herp where" + , "" + , "data Foo a" + , " = Foo" + , " { firstName, lastName :: String" + , " -- ^ names" + , " , age :: Int" + , " }" + ] + +-- | Should not break Enums (data without records) formatting +-- +-- See https://github.com/jaspervdj/stylish-haskell/issues/262 +case20 :: Assertion +case20 = input @=? testStep (step indentIndentStyle) input + where + input = unlines + [ "module Herp where" + , "" + , "data Tag = Title | Text deriving (Eq, Show)" + ] + +case21 :: Assertion +case21 = expected @=? testStep (step sameSameStyle) input + where + input = unlines + [ "data Foo a" + , " = Foo { a :: Int," + , " a2 :: String" + , " -- ^ some haddock" + , " }" + , " | Bar { b :: a } deriving (Eq, Show)" + , " deriving (ToJSON)" + ] + + expected = unlines + [ "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 + where + input = unlines + [ "data Foo a" + , " = Foo { a :: Int," + , " a2 :: String" + , " -- ^ some haddock" + , " }" + , " | Bar { b :: a } deriving (Eq, Show)" + , " deriving (ToJSON)" + ] + + expected = unlines + [ "data Foo a = Foo" + , " { a :: Int" + , " , a2 :: String" + , " -- ^ some haddock" + , " }" + , " | Bar" + , " { b :: a" + , " }" + , " deriving (Eq, Show)" + , " deriving (ToJSON)" + ] + +case23 :: Assertion +case23 = expected @=? testStep (step indentSameStyle) input + where + input = unlines + [ "data Foo a" + , " = Foo { a :: Int," + , " a2 :: String" + , " -- ^ some haddock" + , " }" + , " | Bar { b :: a } deriving (Eq, Show)" + , " deriving (ToJSON)" + ] + + expected = unlines + [ "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" + , " = Foo { a :: Int," + , " a2 :: String" + , " -- ^ some haddock" + , " }" + , " | Bar { b :: a } deriving (Eq, Show)" + , " deriving (ToJSON)" + ] + + expected = unlines + [ "data Foo a" + , " = Foo" + , " { a :: Int" + , " , a2 :: String" + , " -- ^ some haddock" + , " }" + , " | Bar" + , " { b :: a" + , " }" + , " deriving (Eq, Show)" + , " deriving (ToJSON)" + ] + +sameSameStyle :: Config +sameSameStyle = Config SameLine SameLine 2 2 + +sameIndentStyle :: Config +sameIndentStyle = Config SameLine (Indent 2) 2 2 + +indentSameStyle :: Config +indentSameStyle = Config (Indent 2) SameLine 2 2 + +indentIndentStyle :: Config +indentIndentStyle = Config (Indent 2) (Indent 2) 2 2 + +indentIndentStyle4 :: Config +indentIndentStyle4 = Config (Indent 4) (Indent 4) 4 4 diff --git a/tests/Language/Haskell/Stylish/Step/Imports/Tests.hs b/tests/Language/Haskell/Stylish/Step/Imports/Tests.hs index 760018a..22031d4 100644 --- a/tests/Language/Haskell/Stylish/Step/Imports/Tests.hs +++ b/tests/Language/Haskell/Stylish/Step/Imports/Tests.hs @@ -58,6 +58,7 @@ tests = testGroup "Language.Haskell.Stylish.Step.Imports.Tests" , testCase "case 24" case24 , testCase "case 25" case25 , testCase "case 26 (issue 185)" case26 + , testCase "case 27" case27 ] @@ -82,7 +83,7 @@ input = unlines -------------------------------------------------------------------------------- case01 :: Assertion -case01 = expected @=? testStep (step 80 $ fromImportAlign Global) input +case01 = expected @=? testStep (step (Just 80) $ fromImportAlign Global) input where expected = unlines [ "module Herp where" @@ -104,7 +105,7 @@ case01 = expected @=? testStep (step 80 $ fromImportAlign Global) input -------------------------------------------------------------------------------- case02 :: Assertion -case02 = expected @=? testStep (step 80 $ fromImportAlign Group) input +case02 = expected @=? testStep (step (Just 80) $ fromImportAlign Group) input where expected = unlines [ "module Herp where" @@ -125,7 +126,7 @@ case02 = expected @=? testStep (step 80 $ fromImportAlign Group) input -------------------------------------------------------------------------------- case03 :: Assertion -case03 = expected @=? testStep (step 80 $ fromImportAlign None) input +case03 = expected @=? testStep (step (Just 80) $ fromImportAlign None) input where expected = unlines [ "module Herp where" @@ -146,7 +147,7 @@ case03 = expected @=? testStep (step 80 $ fromImportAlign None) input -------------------------------------------------------------------------------- case04 :: Assertion -case04 = expected @=? testStep (step 80 $ fromImportAlign Global) input' +case04 = expected @=? testStep (step (Just 80) $ fromImportAlign Global) input' where input' = "import Data.Aeson.Types (object, typeMismatch, FromJSON(..)," ++ @@ -161,7 +162,7 @@ case04 = expected @=? testStep (step 80 $ fromImportAlign Global) input' -------------------------------------------------------------------------------- case05 :: Assertion -case05 = input' @=? testStep (step 80 $ fromImportAlign Group) input' +case05 = input' @=? testStep (step (Just 80) $ fromImportAlign Group) input' where input' = "import Distribution.PackageDescription.Configuration " ++ "(finalizePackageDescription)\n" @@ -169,7 +170,7 @@ case05 = input' @=? testStep (step 80 $ fromImportAlign Group) input' -------------------------------------------------------------------------------- case06 :: Assertion -case06 = input' @=? testStep (step 80 $ fromImportAlign File) input' +case06 = input' @=? testStep (step (Just 80) $ fromImportAlign File) input' where input' = unlines [ "import Bar.Qux" @@ -179,7 +180,7 @@ case06 = input' @=? testStep (step 80 $ fromImportAlign File) input' -------------------------------------------------------------------------------- case07 :: Assertion -case07 = expected @=? testStep (step 80 $ fromImportAlign File) input' +case07 = expected @=? testStep (step (Just 80) $ fromImportAlign File) input' where input' = unlines [ "import Bar.Qux" @@ -197,7 +198,7 @@ case07 = expected @=? testStep (step 80 $ fromImportAlign File) input' -------------------------------------------------------------------------------- case08 :: Assertion case08 = expected - @=? testStep (step 80 $ Options Global WithAlias True Inline Inherit (LPConstant 4) True False) input + @=? testStep (step (Just 80) $ Options Global WithAlias True Inline Inherit (LPConstant 4) True False) input where expected = unlines [ "module Herp where" @@ -220,7 +221,7 @@ case08 = expected -------------------------------------------------------------------------------- case08b :: Assertion case08b = expected - @=? testStep (step 80 $ Options Global WithModuleName True Inline Inherit (LPConstant 4) True False) input + @=? testStep (step (Just 80) $ Options Global WithModuleName True Inline Inherit (LPConstant 4) True False) input where expected = unlines ["module Herp where" @@ -242,7 +243,7 @@ case08b = expected -------------------------------------------------------------------------------- case09 :: Assertion case09 = expected - @=? testStep (step 80 $ Options Global WithAlias True Multiline Inherit (LPConstant 4) True False) input + @=? testStep (step (Just 80) $ Options Global WithAlias True Multiline Inherit (LPConstant 4) True False) input where expected = unlines [ "module Herp where" @@ -276,7 +277,7 @@ case09 = expected -------------------------------------------------------------------------------- case10 :: Assertion case10 = expected - @=? testStep (step 40 $ Options Group WithAlias True Multiline Inherit (LPConstant 4) True False) input + @=? testStep (step (Just 40) $ Options Group WithAlias True Multiline Inherit (LPConstant 4) True False) input where expected = unlines [ "module Herp where" @@ -315,7 +316,7 @@ case10 = expected -------------------------------------------------------------------------------- case11 :: Assertion case11 = expected - @=? testStep (step 80 $ Options Group NewLine True Inline Inherit (LPConstant 4) True False) input + @=? testStep (step (Just 80) $ Options Group NewLine True Inline Inherit (LPConstant 4) True False) input where expected = unlines [ "module Herp where" @@ -342,7 +343,7 @@ case11 = expected case11b :: Assertion case11b = expected - @=? testStep (step 80 $ Options Group WithModuleName True Inline Inherit (LPConstant 4) True False) input + @=? testStep (step (Just 80) $ Options Group WithModuleName True Inline Inherit (LPConstant 4) True False) input where expected = unlines [ "module Herp where" @@ -364,7 +365,7 @@ case11b = expected -------------------------------------------------------------------------------- case12 :: Assertion case12 = expected - @=? testStep (step 80 $ Options Group NewLine True Inline Inherit (LPConstant 2) True False) input' + @=? testStep (step (Just 80) $ Options Group NewLine True Inline Inherit (LPConstant 2) True False) input' where input' = unlines [ "import Data.List (map)" @@ -379,7 +380,7 @@ case12 = expected -------------------------------------------------------------------------------- case12b :: Assertion case12b = expected - @=? testStep (step 80 $ Options Group WithModuleName True Inline Inherit (LPConstant 2) True False) input' + @=? testStep (step (Just 80) $ Options Group WithModuleName True Inline Inherit (LPConstant 2) True False) input' where input' = unlines [ "import Data.List (map)" @@ -391,7 +392,7 @@ case12b = expected -------------------------------------------------------------------------------- case13 :: Assertion case13 = expected - @=? testStep (step 80 $ Options None WithAlias True InlineWithBreak Inherit (LPConstant 4) True False) input' + @=? 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," @@ -408,7 +409,7 @@ case13 = expected -------------------------------------------------------------------------------- case13b :: Assertion case13b = expected - @=? testStep (step 80 $ Options None WithModuleName True InlineWithBreak Inherit (LPConstant 4) True False) input' + @=? 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," @@ -426,7 +427,7 @@ case13b = expected case14 :: Assertion case14 = expected @=? testStep - (step 80 $ Options None WithAlias True InlineWithBreak Inherit (LPConstant 10) True False) expected + (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, (++))" @@ -436,7 +437,7 @@ case14 = expected -------------------------------------------------------------------------------- case15 :: Assertion case15 = expected - @=? testStep (step 80 $ Options None AfterAlias True Multiline Inherit (LPConstant 4) True False) input' + @=? testStep (step (Just 80) $ Options None AfterAlias True Multiline Inherit (LPConstant 4) True False) input' where expected = unlines [ "import Data.Acid (AcidState)" @@ -462,7 +463,7 @@ case15 = expected -------------------------------------------------------------------------------- case16 :: Assertion case16 = expected - @=? testStep (step 80 $ Options None AfterAlias True Multiline Inherit (LPConstant 4) False False) input' + @=? testStep (step (Just 80) $ Options None AfterAlias True Multiline Inherit (LPConstant 4) False False) input' where expected = unlines [ "import Data.Acid (AcidState)" @@ -486,7 +487,7 @@ case16 = expected -------------------------------------------------------------------------------- case17 :: Assertion case17 = expected - @=? testStep (step 80 $ Options None AfterAlias True Multiline Inherit (LPConstant 4) True False) input' + @=? testStep (step (Just 80) $ Options None AfterAlias True Multiline Inherit (LPConstant 4) True False) input' where expected = unlines [ "import Control.Applicative (Applicative (pure, (<*>)))" @@ -504,7 +505,7 @@ case17 = expected -------------------------------------------------------------------------------- case18 :: Assertion case18 = expected @=? testStep - (step 40 $ Options None AfterAlias True InlineToMultiline Inherit (LPConstant 4) True False) input' + (step (Just 40) $ Options None AfterAlias True InlineToMultiline Inherit (LPConstant 4) True False) input' where expected = unlines ---------------------------------------- @@ -532,7 +533,7 @@ case18 = expected @=? testStep -------------------------------------------------------------------------------- case19 :: Assertion case19 = expected @=? testStep - (step 40 $ Options Global NewLine True InlineWithBreak RightAfter (LPConstant 17) True False) case19input + (step (Just 40) $ Options Global NewLine True InlineWithBreak RightAfter (LPConstant 17) True False) case19input where expected = unlines ---------------------------------------- @@ -548,7 +549,7 @@ case19 = expected @=? testStep case19b :: Assertion case19b = expected @=? testStep - (step 40 $ Options File NewLine True InlineWithBreak RightAfter (LPConstant 17) True False) case19input + (step (Just 40) $ Options File NewLine True InlineWithBreak RightAfter (LPConstant 17) True False) case19input where expected = unlines ---------------------------------------- @@ -564,7 +565,7 @@ case19b = expected @=? testStep case19c :: Assertion case19c = expected @=? testStep - (step 40 $ Options File NewLine True InlineWithBreak RightAfter LPModuleName True False) case19input + (step (Just 40) $ Options File NewLine True InlineWithBreak RightAfter LPModuleName True False) case19input where expected = unlines ---------------------------------------- @@ -580,7 +581,7 @@ case19c = expected @=? testStep case19d :: Assertion case19d = expected @=? testStep - (step 40 $ Options Global NewLine True InlineWithBreak RightAfter LPModuleName True False) case19input + (step (Just 40) $ Options Global NewLine True InlineWithBreak RightAfter LPModuleName True False) case19input where expected = unlines ---------------------------------------- @@ -606,7 +607,7 @@ case19input = unlines -------------------------------------------------------------------------------- case20 :: Assertion case20 = expected - @=? testStep (step 80 defaultOptions) input' + @=? testStep (step (Just 80) defaultOptions) input' where expected = unlines [ "import {-# SOURCE #-} Data.ByteString as BS" @@ -625,7 +626,7 @@ case20 = expected -------------------------------------------------------------------------------- case21 :: Assertion case21 = expected - @=? testStep (step 80 defaultOptions) input' + @=? testStep (step (Just 80) defaultOptions) input' where expected = unlines [ "{-# LANGUAGE ExplicitNamespaces #-}" @@ -656,7 +657,7 @@ case21 = expected -------------------------------------------------------------------------------- case22 :: Assertion case22 = expected - @=? testStep (step 80 defaultOptions) input' + @=? testStep (step (Just 80) defaultOptions) input' where expected = unlines [ "{-# LANGUAGE PackageImports #-}" @@ -683,7 +684,7 @@ case22 = expected -------------------------------------------------------------------------------- case23 :: Assertion case23 = expected - @=? testStep (step 40 $ Options None AfterAlias False Inline Inherit (LPConstant 4) True True) input' + @=? testStep (step (Just 40) $ Options None AfterAlias False Inline Inherit (LPConstant 4) True True) input' where expected = unlines [ "import Data.Acid ( AcidState )" @@ -708,7 +709,7 @@ case23 = expected -------------------------------------------------------------------------------- case23b :: Assertion case23b = expected - @=? testStep (step 40 $ Options None WithModuleName False Inline Inherit (LPConstant 4) True True) input' + @=? testStep (step (Just 40) $ Options None WithModuleName False Inline Inherit (LPConstant 4) True True) input' where expected = unlines [ "import Data.Acid ( AcidState )" @@ -734,7 +735,7 @@ case23b = expected -------------------------------------------------------------------------------- case24 :: Assertion case24 = expected - @=? testStep (step 40 $ Options None AfterAlias False InlineWithBreak Inherit (LPConstant 4) True True) input' + @=? testStep (step (Just 40) $ Options None AfterAlias False InlineWithBreak Inherit (LPConstant 4) True True) input' where expected = unlines [ "import Data.Acid ( AcidState )" @@ -758,7 +759,7 @@ case24 = expected -------------------------------------------------------------------------------- case25 :: Assertion case25 = expected - @=? testStep (step 80 $ Options Group AfterAlias False Multiline Inherit (LPConstant 4) False False) input' + @=? testStep (step (Just 80) $ Options Group AfterAlias False Multiline Inherit (LPConstant 4) False False) input' where expected = unlines [ "import Data.Acid (AcidState)" @@ -783,7 +784,7 @@ case25 = expected -------------------------------------------------------------------------------- case26 :: Assertion case26 = expected - @=? testStep (step 80 options ) input' + @=? testStep (step (Just 80) options ) input' where options = defaultOptions { listAlign = NewLine, longListAlign = Multiline } input' = unlines @@ -792,3 +793,23 @@ case26 = expected 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\"" + ] diff --git a/tests/Language/Haskell/Stylish/Step/LanguagePragmas/Tests.hs b/tests/Language/Haskell/Stylish/Step/LanguagePragmas/Tests.hs index 2d74813..0ede803 100644 --- a/tests/Language/Haskell/Stylish/Step/LanguagePragmas/Tests.hs +++ b/tests/Language/Haskell/Stylish/Step/LanguagePragmas/Tests.hs @@ -28,12 +28,16 @@ tests = testGroup "Language.Haskell.Stylish.Step.LanguagePragmas.Tests" , testCase "case 08" case08 , testCase "case 09" case09 , testCase "case 10" case10 + , testCase "case 11" case11 + , testCase "case 12" case12 ] +lANG :: String +lANG = "LANGUAGE" -------------------------------------------------------------------------------- case01 :: Assertion -case01 = expected @=? testStep (step 80 Vertical True False) input +case01 = expected @=? testStep (step (Just 80) Vertical True False lANG) input where input = unlines [ "{-# LANGUAGE ViewPatterns #-}" @@ -52,7 +56,7 @@ case01 = expected @=? testStep (step 80 Vertical True False) input -------------------------------------------------------------------------------- case02 :: Assertion -case02 = expected @=? testStep (step 80 Vertical True True) input +case02 = expected @=? testStep (step (Just 80) Vertical True True lANG) input where input = unlines [ "{-# LANGUAGE BangPatterns #-}" @@ -68,7 +72,7 @@ case02 = expected @=? testStep (step 80 Vertical True True) input -------------------------------------------------------------------------------- case03 :: Assertion -case03 = expected @=? testStep (step 80 Vertical True True) input +case03 = expected @=? testStep (step (Just 80) Vertical True True lANG) input where input = unlines [ "{-# LANGUAGE BangPatterns #-}" @@ -84,7 +88,7 @@ case03 = expected @=? testStep (step 80 Vertical True True) input -------------------------------------------------------------------------------- case04 :: Assertion -case04 = expected @=? testStep (step 80 Compact True False) input +case04 = expected @=? testStep (step (Just 80) Compact True False lANG) input where input = unlines [ "{-# LANGUAGE TypeOperators, StandaloneDeriving, DeriveDataTypeable," @@ -101,7 +105,7 @@ case04 = expected @=? testStep (step 80 Compact True False) input -------------------------------------------------------------------------------- case05 :: Assertion -case05 = expected @=? testStep (step 80 Vertical True False) input +case05 = expected @=? testStep (step (Just 80) Vertical True False lANG) input where input = unlines [ "{-# LANGUAGE CPP #-}" @@ -122,7 +126,7 @@ case05 = expected @=? testStep (step 80 Vertical True False) input -------------------------------------------------------------------------------- case06 :: Assertion -case06 = expected @=? testStep (step 80 CompactLine True False) input +case06 = expected @=? testStep (step (Just 80) CompactLine True False lANG) input where input = unlines [ "{-# LANGUAGE TypeOperators, StandaloneDeriving, DeriveDataTypeable," @@ -137,7 +141,7 @@ case06 = expected @=? testStep (step 80 CompactLine True False) input -------------------------------------------------------------------------------- case07 :: Assertion -case07 = expected @=? testStep (step 80 Vertical False False) input +case07 = expected @=? testStep (step (Just 80) Vertical False False lANG) input where input = unlines [ "{-# LANGUAGE ViewPatterns #-}" @@ -157,7 +161,7 @@ case07 = expected @=? testStep (step 80 Vertical False False) input -------------------------------------------------------------------------------- case08 :: Assertion -case08 = expected @=? testStep (step 80 CompactLine False False) input +case08 = expected @=? testStep (step (Just 80) CompactLine False False lANG) input where input = unlines [ "{-# LANGUAGE TypeOperators, StandaloneDeriving, DeriveDataTypeable," @@ -173,7 +177,7 @@ case08 = expected @=? testStep (step 80 CompactLine False False) input -------------------------------------------------------------------------------- case09 :: Assertion -case09 = expected @=? testStep (step 80 Compact True False) input +case09 = expected @=? testStep (step (Just 80) Compact True False lANG) input where input = unlines [ "{-# LANGUAGE DefaultSignatures, FlexibleInstances, LambdaCase, " ++ @@ -187,7 +191,7 @@ case09 = expected @=? testStep (step 80 Compact True False) input -------------------------------------------------------------------------------- case10 :: Assertion -case10 = expected @=? testStep (step 80 Compact True False) input +case10 = expected @=? testStep (step (Just 80) Compact True False lANG) input where input = unlines [ "{-# LANGUAGE NondecreasingIndentation, ScopedTypeVariables," @@ -197,3 +201,38 @@ case10 = expected @=? testStep (step 80 Compact True False) input [ "{-# 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" + ] + + 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" + ] + + expected = unlines + [ "{-# language NoImplicitPrelude, OverloadedStrings, ScopedTypeVariables, TemplateHaskell, ViewPatterns #-}" + , "module Main where" + ] diff --git a/tests/Language/Haskell/Stylish/Step/SimpleAlign/Tests.hs b/tests/Language/Haskell/Stylish/Step/SimpleAlign/Tests.hs index b8afab4..a2a51fc 100644 --- a/tests/Language/Haskell/Stylish/Step/SimpleAlign/Tests.hs +++ b/tests/Language/Haskell/Stylish/Step/SimpleAlign/Tests.hs @@ -26,12 +26,13 @@ tests = testGroup "Language.Haskell.Stylish.Step.SimpleAlign.Tests" , testCase "case 06" case06 , testCase "case 07" case07 , testCase "case 08" case08 + , testCase "case 09" case09 ] -------------------------------------------------------------------------------- case01 :: Assertion -case01 = expected @=? testStep (step 80 defaultConfig) input +case01 = expected @=? testStep (step (Just 80) defaultConfig) input where input = unlines [ "eitherToMaybe e = case e of" @@ -48,7 +49,7 @@ case01 = expected @=? testStep (step 80 defaultConfig) input -------------------------------------------------------------------------------- case02 :: Assertion -case02 = expected @=? testStep (step 80 defaultConfig) input +case02 = expected @=? testStep (step (Just 80) defaultConfig) input where input = unlines [ "eitherToMaybe (Left _) = Nothing" @@ -63,7 +64,7 @@ case02 = expected @=? testStep (step 80 defaultConfig) input -------------------------------------------------------------------------------- case03 :: Assertion -case03 = expected @=? testStep (step 80 defaultConfig) input +case03 = expected @=? testStep (step (Just 80) defaultConfig) input where input = unlines [ "heady def [] = def" @@ -78,7 +79,7 @@ case03 = expected @=? testStep (step 80 defaultConfig) input -------------------------------------------------------------------------------- case04 :: Assertion -case04 = expected @=? testStep (step 80 defaultConfig) input +case04 = expected @=? testStep (step (Just 80) defaultConfig) input where input = unlines [ "data Foo = Foo" @@ -97,7 +98,7 @@ case04 = expected @=? testStep (step 80 defaultConfig) input -------------------------------------------------------------------------------- case05 :: Assertion -case05 = input @=? testStep (step 80 defaultConfig) input +case05 = input @=? testStep (step (Just 80) defaultConfig) input where -- Don't attempt to align this since a field spans multiple lines input = unlines @@ -113,7 +114,7 @@ case05 = input @=? testStep (step 80 defaultConfig) input case06 :: Assertion case06 = -- 22 max columns is /just/ enough to align this stuff. - expected @=? testStep (step 22 defaultConfig) input + expected @=? testStep (step (Just 22) defaultConfig) input where input = unlines [ "data Foo = Foo" @@ -134,7 +135,7 @@ case06 = case07 :: Assertion case07 = -- 21 max columns is /just NOT/ enough to align this stuff. - expected @=? testStep (step 21 defaultConfig) input + expected @=? testStep (step (Just 21) defaultConfig) input where input = unlines [ "data Foo = Foo" @@ -153,7 +154,7 @@ case07 = -------------------------------------------------------------------------------- case08 :: Assertion -case08 = expected @=? testStep (step 80 defaultConfig) input +case08 = expected @=? testStep (step (Just 80) defaultConfig) input where input = unlines [ "canDrink mbAge = case mbAge of" @@ -166,3 +167,23 @@ case08 = expected @=? testStep (step 80 defaultConfig) input , " Just age | age > 18 -> True" , " _ -> False" ] + + +-------------------------------------------------------------------------------- +case09 :: Assertion +case09 = + expected @=? testStep (step Nothing defaultConfig) input + where + input = unlines + [ "data Foo = Foo" + , " { foo :: String" + , " , barqux :: Int" + , " }" + ] + + expected = unlines + [ "data Foo = Foo" + , " { foo :: String" + , " , barqux :: Int" + , " }" + ] diff --git a/tests/Language/Haskell/Stylish/Step/UnicodeSyntax/Tests.hs b/tests/Language/Haskell/Stylish/Step/UnicodeSyntax/Tests.hs index 9652350..e2ba34f 100644 --- a/tests/Language/Haskell/Stylish/Step/UnicodeSyntax/Tests.hs +++ b/tests/Language/Haskell/Stylish/Step/UnicodeSyntax/Tests.hs @@ -19,12 +19,13 @@ import Language.Haskell.Stylish.Tests.Util tests :: Test tests = testGroup "Language.Haskell.Stylish.Step.UnicodeSyntax.Tests" [ testCase "case 01" case01 + , testCase "case 02" case02 ] -------------------------------------------------------------------------------- case01 :: Assertion -case01 = expected @=? testStep (step True) input +case01 = expected @=? testStep (step True "LANGUAGE") input where input = unlines [ "sort :: Ord a => [a] -> [a]" @@ -36,3 +37,19 @@ case01 = expected @=? testStep (step True) input , "sort ∷ Ord a ⇒ [a] → [a]" , "sort _ = []" ] + + +-------------------------------------------------------------------------------- +case02 :: Assertion +case02 = expected @=? testStep (step True "LaNgUaGe") input + where + input = unlines + [ "sort :: Ord a => [a] -> [a]" + , "sort _ = []" + ] + + expected = unlines + [ "{-# LaNgUaGe UnicodeSyntax #-}" + , "sort ∷ Ord a ⇒ [a] → [a]" + , "sort _ = []" + ]
\ No newline at end of file diff --git a/tests/Language/Haskell/Stylish/Tests.hs b/tests/Language/Haskell/Stylish/Tests.hs new file mode 100644 index 0000000..97eab8a --- /dev/null +++ b/tests/Language/Haskell/Stylish/Tests.hs @@ -0,0 +1,144 @@ +-------------------------------------------------------------------------------- +module Language.Haskell.Stylish.Tests + ( tests + ) where + + +-------------------------------------------------------------------------------- +import Data.List (sort) +import System.Directory (createDirectory) +import System.FilePath (normalise, (</>)) +import Test.Framework (Test, testGroup) +import Test.Framework.Providers.HUnit (testCase) +import Test.HUnit (Assertion, (@?=)) + + +-------------------------------------------------------------------------------- +import Language.Haskell.Stylish +import Language.Haskell.Stylish.Tests.Util + + +-------------------------------------------------------------------------------- +tests :: Test +tests = testGroup "Language.Haskell.Stylish.Tests" + [ testCase "case 01" case01 + , testCase "case 02" case02 + , testCase "case 03" case03 + , testCase "case 04" case04 + , testCase "case 05" case05 + , testCase "case 06" case06 + , testCase "case 07" case07 + ] + + +-------------------------------------------------------------------------------- +case01 :: Assertion +case01 = (@?= result) =<< format Nothing Nothing input + where + input = "module Herp where\ndata Foo = Bar | Baz { baz :: Int }" + result = Right $ lines input + + +-------------------------------------------------------------------------------- +case02 :: Assertion +case02 = withTestDirTree $ do + writeFile "test-config.yaml" $ unlines + [ "steps:" + , " - records:" + , " equals: \"indent 2\"" + , " first_field: \"indent 2\"" + , " field_comment: 2" + , " deriving: 2" + ] + + actual <- format (Just $ ConfigPath "test-config.yaml") Nothing input + actual @?= result + where + input = "module Herp where\ndata Foo = Bar | Baz { baz :: Int }" + result = Right [ "module Herp where" + , "data Foo" + , " = Bar" + , " | Baz" + , " { baz :: Int" + , " }" + ] + +-------------------------------------------------------------------------------- +case03 :: Assertion +case03 = withTestDirTree $ do + writeFile "test-config.yaml" $ unlines + [ "steps:" + , " - records:" + , " equals: \"same_line\"" + , " first_field: \"same_line\"" + , " field_comment: 2" + , " deriving: 2" + ] + + actual <- format (Just $ ConfigPath "test-config.yaml") Nothing input + actual @?= result + where + input = unlines [ "module Herp where" + , "data Foo" + , " = Bar" + , " | Baz" + , " { baz :: Int" + , " }" + ] + result = Right [ "module Herp where" + , "data Foo = Bar" + , " | Baz { baz :: Int" + , " }" + ] + +-------------------------------------------------------------------------------- +case04 :: Assertion +case04 = (@?= result) =<< format Nothing (Just fileLocation) input + where + 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\"" + + +-------------------------------------------------------------------------------- +-- | When providing current dir including folders and files. +case05 :: Assertion +case05 = withTestDirTree $ do + createDirectory aDir >> writeFile c fileCont + mapM_ (flip writeFile fileCont) fs + result <- findHaskellFiles False input + sort result @?= (sort $ map normalise expected) + where + input = c : fs + fs = ["b.hs", "a.hs"] + c = aDir </> "c.hs" + aDir = "aDir" + expected = ["a.hs", "b.hs", c] + fileCont = "" + + +-------------------------------------------------------------------------------- +-- | When the input item is not file, do not recurse it. +case06 :: Assertion +case06 = withTestDirTree $ do + mapM_ (flip writeFile "") input + result <- findHaskellFiles False input + result @?= expected + where + input = ["b.hs"] + expected = map normalise input + + +-------------------------------------------------------------------------------- +-- | Empty input should result in empty output. +case07 :: Assertion +case07 = withTestDirTree $ do + mapM_ (flip writeFile "") input + result <- findHaskellFiles False input + result @?= expected + where + input = [] + expected = input diff --git a/tests/Language/Haskell/Stylish/Tests/Util.hs b/tests/Language/Haskell/Stylish/Tests/Util.hs index 40b5629..f43b6b5 100644 --- a/tests/Language/Haskell/Stylish/Tests/Util.hs +++ b/tests/Language/Haskell/Stylish/Tests/Util.hs @@ -1,9 +1,22 @@ module Language.Haskell.Stylish.Tests.Util ( testStep + , withTestDirTree ) where -------------------------------------------------------------------------------- +import Control.Exception (bracket, try) +import System.Directory (createDirectory, + getCurrentDirectory, + getTemporaryDirectory, + removeDirectoryRecursive, + setCurrentDirectory) +import System.FilePath ((</>)) +import System.IO.Error (isAlreadyExistsError) +import System.Random (randomIO) + + +-------------------------------------------------------------------------------- import Language.Haskell.Stylish.Parse import Language.Haskell.Stylish.Step @@ -15,3 +28,34 @@ testStep step str = case parseModule [] Nothing str of Right module' -> unlines $ stepFilter step ls module' where ls = lines str + + +-------------------------------------------------------------------------------- +-- | Create a temporary directory with a randomised name built from the template +-- provided +createTempDirectory :: String -> IO FilePath +createTempDirectory template = do + tmpRootDir <- getTemporaryDirectory + dirId <- randomIO :: IO Word + findTempName tmpRootDir dirId + where + findTempName :: FilePath -> Word -> IO FilePath + findTempName tmpRootDir x = do + let dirpath = tmpRootDir </> template ++ show x + r <- try $ createDirectory dirpath + case r of + Right _ -> return dirpath + Left e | isAlreadyExistsError e -> findTempName tmpRootDir (x+1) + | otherwise -> ioError e + + +-------------------------------------------------------------------------------- +-- | Perform an action inside a temporary directory tree and purge the tree +-- afterwards +withTestDirTree :: IO a -> IO a +withTestDirTree action = bracket + ((,) <$> getCurrentDirectory <*> createTempDirectory "stylish_haskell") + (\(current, temp) -> + setCurrentDirectory current *> + removeDirectoryRecursive temp) + (\(_, temp) -> setCurrentDirectory temp *> action) |