diff options
author | Sean Whitton <spwhitton@spwhitton.name> | 2019-11-01 20:12:37 -0700 |
---|---|---|
committer | Sean Whitton <spwhitton@spwhitton.name> | 2019-11-01 20:12:37 -0700 |
commit | dd0c17ac6c5c34b09b4e79a0fa753745bacfe122 (patch) | |
tree | 0d8bf06c82c718504b1398471d9adbbd7dd45aa1 | |
parent | 15eafc587c41e041194d1c4c84b2b94410a06756 (diff) | |
parent | b67a6ae12f8107b2d1714659f8a121274d5833f9 (diff) |
Merge tag 'v0.9.4.3'
v0.9.4.3
-rw-r--r-- | .circleci/config.yml | 6 | ||||
-rwxr-xr-x | .circleci/release.sh | 11 | ||||
-rw-r--r-- | CHANGELOG | 23 | ||||
-rw-r--r-- | README.markdown | 11 | ||||
-rw-r--r-- | data/stylish-haskell.yaml | 18 | ||||
-rw-r--r-- | lib/Language/Haskell/Stylish/Config.hs | 50 | ||||
-rw-r--r-- | lib/Language/Haskell/Stylish/Config/Cabal.hs | 92 | ||||
-rw-r--r-- | lib/Language/Haskell/Stylish/Config/Internal.hs | 15 | ||||
-rw-r--r-- | lib/Language/Haskell/Stylish/Step/Imports.hs | 10 | ||||
-rw-r--r-- | lib/Language/Haskell/Stylish/Step/TrailingWhitespace.hs | 7 | ||||
-rw-r--r-- | stack.yaml | 8 | ||||
-rw-r--r-- | stylish-haskell.cabal | 21 | ||||
-rw-r--r-- | tests/Language/Haskell/Stylish/Config/Tests.hs | 142 | ||||
-rw-r--r-- | tests/Language/Haskell/Stylish/Step/Imports/Tests.hs | 114 | ||||
-rw-r--r-- | tests/Language/Haskell/Stylish/Step/TrailingWhitespace/Tests.hs | 6 | ||||
-rw-r--r-- | tests/TestSuite.hs | 2 |
16 files changed, 488 insertions, 48 deletions
diff --git a/.circleci/config.yml b/.circleci/config.yml index e6a538c..e1e9020 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -12,17 +12,17 @@ workflows: jobs: build: docker: - - image: 'fpco/stack-build:latest' + - image: 'haskell:8.6' steps: - checkout - restore_cache: - key: 'v2-stylish-haskell-{{ arch }}-{{ .Branch }}' + key: 'v3-stylish-haskell-{{ arch }}-{{ .Branch }}' - run: name: 'Build, install and test' command: 'stack build --test --copy-bins --jobs=1' - save_cache: - key: 'v2-stylish-haskell-{{ arch }}-{{ .Branch }}-{{ .Revision }}' + key: 'v3-stylish-haskell-{{ arch }}-{{ .Branch }}-{{ .Revision }}' paths: - '~/.stack-work' - '~/.stack' diff --git a/.circleci/release.sh b/.circleci/release.sh index 5586d24..a55247f 100755 --- a/.circleci/release.sh +++ b/.circleci/release.sh @@ -19,14 +19,15 @@ if [[ -z "$TAG" ]]; then fi # Install ghr -GHR_VERSION="v0.5.4" -wget --quiet \ - "https://github.com/tcnksm/ghr/releases/download/${GHR_VERSION}/ghr_${GHR_VERSION}_linux_386.zip" -unzip ghr_${GHR_VERSION}_linux_386.zip +GHR_VERSION="v0.13.0" +curl --silent -L -O \ + "https://github.com/tcnksm/ghr/releases/download/${GHR_VERSION}/ghr_${GHR_VERSION}_linux_386.tar.gz" +tar xf ghr_${GHR_VERSION}_linux_386.tar.gz +mv ghr_${GHR_VERSION}_linux_386/ghr . # Install upx UPX_VERSION="3.94" -wget --quiet \ +curl --silent -L -O \ "https://github.com/upx/upx/releases/download/v${UPX_VERSION}/upx-${UPX_VERSION}-amd64_linux.tar.xz" tar xf upx-${UPX_VERSION}-amd64_linux.tar.xz mv upx-${UPX_VERSION}-amd64_linux/upx . @@ -1,5 +1,28 @@ # CHANGELOG +- 0.9.4.3 (2019-10-29) + * Bump release script + * Bump `Cabal` to 3.0 + +- 0.9.4.2 (2019-10-29) + * Bump release script + +- 0.9.4.1 (2019-10-29) + * Bump release script + +- 0.9.4.0 (2019-10-29) + * Read language extensions from `.cabal` file (by Georgy Lukyanov) + +- 0.9.3.1 (2019-10-08) + * Fix CircleCI configuration + +- 0.9.3.0 (2019-10-08) + * Bump `optparse-applicative` to 0.15 + * Don't remove page breaks in the trailing whitespace step (by Chris + Perivolaropoulos) + * Add `with_module_name` option to `list_align` for import styling (by + Rupert Horlick) + - 0.9.2.2 (2019-06-12) * Bump `semigroups` to 0.19 * Bump `haskell-src-exts` to 1.21 diff --git a/README.markdown b/README.markdown index a3406c6..8f56ea6 100644 --- a/README.markdown +++ b/README.markdown @@ -112,7 +112,8 @@ Or you can define `formatprg` and then use `gq`. -Alternatively, [vim-autoformat] supports stylish-haskell. To have it automatically reformat the files on save, add to your vimrc: +Alternatively, [vim-autoformat] supports stylish-haskell. To have it +automatically reformat the files on save, add to your vimrc: ```vim autocmd BufWrite *.hs :Autoformat @@ -120,12 +121,14 @@ autocmd BufWrite *.hs :Autoformat autocmd FileType haskell let b:autoformat_autoindent=0 ``` -[vim-autoformat]: https://github.com/Chiel92/vim-autoformat +There are also plugins that run stylish-haskell automatically when you save a +Haskell file: -There is also the [vim-stylish-haskell] plugin, which runs stylish-haskell -automatically when you save a Haskell file. +* [vim-stylish-haskell] +* [vim-stylishask] [vim-stylish-haskell]: https://github.com/nbouscal/vim-stylish-haskell +[vim-stylishask]: https://github.com/alx741/vim-stylishask Emacs integration ----------------- diff --git a/data/stylish-haskell.yaml b/data/stylish-haskell.yaml index 6d43499..401d384 100644 --- a/data/stylish-haskell.yaml +++ b/data/stylish-haskell.yaml @@ -56,6 +56,18 @@ steps: # > import qualified Data.List as List (concat, foldl, foldr, head, # > init, last, length) # + # - with_module_name: Import list is aligned `list_padding` spaces after + # the module name. + # + # > import qualified Data.List as List (concat, foldl, foldr, head, + # init, last, length) + # + # This is mainly intended for use with `pad_module_names: false`. + # + # > import qualified Data.List as List (concat, foldl, foldr, head, + # init, last, length, scanl, scanr, take, drop, + # sort, nub) + # # - new_line: Import list starts always on new line. # # > import qualified Data.List as List @@ -229,3 +241,9 @@ newline: native # language_extensions: # - TemplateHaskell # - QuasiQuotes + +# Attempt to find the cabal file in ancestors of the current directory, and +# parse options (currently only language extensions) from that. +# +# Default: true +cabal: true diff --git a/lib/Language/Haskell/Stylish/Config.hs b/lib/Language/Haskell/Stylish/Config.hs index ad30498..8f43131 100644 --- a/lib/Language/Haskell/Stylish/Config.hs +++ b/lib/Language/Haskell/Stylish/Config.hs @@ -17,22 +17,22 @@ import qualified Data.Aeson as A import qualified Data.Aeson.Types as A import qualified Data.ByteString as B import qualified Data.FileEmbed as FileEmbed -import Data.List (inits, - intercalate) +import Data.List (intercalate, + nub) import Data.Map (Map) import qualified Data.Map as M import Data.Maybe (fromMaybe) import Data.Yaml (decodeEither', prettyPrintParseException) import System.Directory -import System.FilePath (joinPath, - splitPath, - (</>)) +import System.FilePath ((</>)) import qualified System.IO as IO (Newline (..), nativeNewline) -------------------------------------------------------------------------------- +import qualified Language.Haskell.Stylish.Config.Cabal as Cabal +import Language.Haskell.Stylish.Config.Internal import Language.Haskell.Stylish.Step import qualified Language.Haskell.Stylish.Step.Imports as Imports import qualified Language.Haskell.Stylish.Step.LanguagePragmas as LanguagePragmas @@ -54,6 +54,7 @@ data Config = Config , configColumns :: Int , configLanguageExtensions :: [String] , configNewline :: IO.Newline + , configCabal :: Bool } @@ -79,24 +80,19 @@ configFilePath verbose Nothing = do current <- getCurrentDirectory configPath <- getXdgDirectory XdgConfig "stylish-haskell" home <- getHomeDirectory - mbConfig <- search $ + mbConfig <- search verbose $ [d </> configFileName | d <- ancestors current] ++ [configPath </> "config.yaml", home </> configFileName] return mbConfig - where - -- All ancestors of a dir (including that dir) - ancestors :: FilePath -> [FilePath] - ancestors = init . map joinPath . reverse . inits . splitPath - - search :: [FilePath] -> IO (Maybe FilePath) - search [] = return Nothing - search (f : fs) = do - -- TODO Maybe catch an error here, dir might be unreadable - exists <- doesFileExist f - verbose $ f ++ if exists then " exists" else " does not exist" - if exists then return (Just f) else search fs +search :: Verbose -> [FilePath] -> IO (Maybe FilePath) +search _ [] = return Nothing +search verbose (f : fs) = do + -- TODO Maybe catch an error here, dir might be unreadable + exists <- doesFileExist f + verbose $ f ++ if exists then " exists" else " does not exist" + if exists then return (Just f) else search verbose fs -------------------------------------------------------------------------------- loadConfig :: Verbose -> Maybe FilePath -> IO Config @@ -107,7 +103,15 @@ loadConfig verbose userSpecified = do case decodeEither' bytes of Left err -> error $ "Language.Haskell.Stylish.Config.loadConfig: " ++ prettyPrintParseException err - Right config -> return config + Right config -> do + cabalLanguageExtensions <- if configCabal config + then map show <$> Cabal.findLanguageExtensions verbose + else pure [] + + return $ config + { configLanguageExtensions = nub $ + configLanguageExtensions config ++ cabalLanguageExtensions + } -------------------------------------------------------------------------------- @@ -119,6 +123,7 @@ parseConfig (A.Object o) = do <*> (o A..:? "columns" A..!= 80) <*> (o A..:? "language_extensions" A..!= []) <*> (o A..:? "newline" >>= parseEnum newlines IO.nativeNewline) + <*> (o A..:? "cabal" A..!= True) -- Then fill in the steps based on the partial config we already have stepValues <- o A..: "steps" :: A.Parser [A.Value] @@ -209,9 +214,10 @@ parseImports config o = Imports.step ] listAligns = - [ ("new_line", Imports.NewLine) - , ("with_alias", Imports.WithAlias) - , ("after_alias", Imports.AfterAlias) + [ ("new_line", Imports.NewLine) + , ("with_module_name", Imports.WithModuleName) + , ("with_alias", Imports.WithAlias) + , ("after_alias", Imports.AfterAlias) ] longListAligns = diff --git a/lib/Language/Haskell/Stylish/Config/Cabal.hs b/lib/Language/Haskell/Stylish/Config/Cabal.hs new file mode 100644 index 0000000..0160af4 --- /dev/null +++ b/lib/Language/Haskell/Stylish/Config/Cabal.hs @@ -0,0 +1,92 @@ +-------------------------------------------------------------------------------- +module Language.Haskell.Stylish.Config.Cabal + ( findLanguageExtensions + ) where + + +-------------------------------------------------------------------------------- +import Data.Either (isRight) +import Data.List (nub) +import Data.Maybe (maybeToList) +import qualified Distribution.PackageDescription as Cabal +import qualified Distribution.PackageDescription.Parsec as Cabal +import qualified Distribution.Simple.Utils as Cabal +import qualified Distribution.Types.CondTree as Cabal +import qualified Distribution.Verbosity as Cabal +import qualified Language.Haskell.Extension as Language +import Language.Haskell.Stylish.Verbose +import System.Directory (getCurrentDirectory) + + +-------------------------------------------------------------------------------- +import Language.Haskell.Stylish.Config.Internal + + +-------------------------------------------------------------------------------- +findLanguageExtensions :: Verbose -> IO [Language.KnownExtension] +findLanguageExtensions verbose = + findCabalFile verbose >>= + maybe (pure []) (readDefaultLanguageExtensions verbose) + + +-------------------------------------------------------------------------------- +-- | Find the closest .cabal file, possibly going up the directory structure. +findCabalFile :: Verbose -> IO (Maybe FilePath) +findCabalFile verbose = do + potentialProjectRoots <- ancestors <$> getCurrentDirectory + potentialCabalFile <- filter isRight <$> + traverse Cabal.findPackageDesc potentialProjectRoots + case potentialCabalFile of + [Right cabalFile] -> return (Just cabalFile) + _ -> do + verbose $ ".cabal file not found, directories searched: " <> + show potentialProjectRoots + verbose $ "Stylish Haskell will work basing on LANGUAGE pragmas in source files." + return Nothing + + +-------------------------------------------------------------------------------- +-- | Extract @default-extensions@ fields from a @.cabal@ file +readDefaultLanguageExtensions :: Verbose -> FilePath -> IO [Language.KnownExtension] +readDefaultLanguageExtensions verbose cabalFile = do + verbose $ "Parsing " <> cabalFile <> "..." + packageDescription <- Cabal.readGenericPackageDescription Cabal.silent cabalFile + let library :: [Cabal.Library] + library = maybeToList $ fst . Cabal.ignoreConditions <$> + Cabal.condLibrary packageDescription + + subLibraries :: [Cabal.Library] + subLibraries = fst . Cabal.ignoreConditions . snd <$> + Cabal.condSubLibraries packageDescription + + executables :: [Cabal.Executable] + executables = fst . Cabal.ignoreConditions . snd <$> + Cabal.condExecutables packageDescription + + testSuites :: [Cabal.TestSuite] + testSuites = fst . Cabal.ignoreConditions . snd <$> + Cabal.condTestSuites packageDescription + + benchmarks :: [Cabal.Benchmark] + benchmarks = fst . Cabal.ignoreConditions . snd <$> + Cabal.condBenchmarks packageDescription + + gatherBuildInfos :: [Cabal.BuildInfo] + gatherBuildInfos = map Cabal.libBuildInfo library <> + map Cabal.libBuildInfo subLibraries <> + map Cabal.buildInfo executables <> + map Cabal.testBuildInfo testSuites <> + map Cabal.benchmarkBuildInfo benchmarks + + defaultExtensions :: [Language.KnownExtension] + defaultExtensions = map fromEnabled . filter isEnabled $ + concatMap Cabal.defaultExtensions gatherBuildInfos + where isEnabled (Language.EnableExtension _) = True + isEnabled _ = False + + fromEnabled (Language.EnableExtension x) = x + fromEnabled x = + error $ "Language.Haskell.Stylish.Config.readLanguageExtensions: " <> + "invalid LANGUAGE pragma: " <> show x + verbose $ "Gathered default-extensions: " <> show defaultExtensions + pure $ nub defaultExtensions diff --git a/lib/Language/Haskell/Stylish/Config/Internal.hs b/lib/Language/Haskell/Stylish/Config/Internal.hs new file mode 100644 index 0000000..b6160f9 --- /dev/null +++ b/lib/Language/Haskell/Stylish/Config/Internal.hs @@ -0,0 +1,15 @@ +-------------------------------------------------------------------------------- +module Language.Haskell.Stylish.Config.Internal + ( ancestors + ) where + + +-------------------------------------------------------------------------------- +import Data.List (inits) +import System.FilePath (joinPath, splitPath) + + +-------------------------------------------------------------------------------- +-- All ancestors of a dir (including that dir) +ancestors :: FilePath -> [FilePath] +ancestors = map joinPath . reverse . dropWhile null . inits . splitPath diff --git a/lib/Language/Haskell/Stylish/Step/Imports.hs b/lib/Language/Haskell/Stylish/Step/Imports.hs index fc035a2..4ceb802 100644 --- a/lib/Language/Haskell/Stylish/Step/Imports.hs +++ b/lib/Language/Haskell/Stylish/Step/Imports.hs @@ -72,6 +72,7 @@ data ImportAlign data ListAlign = NewLine + | WithModuleName | WithAlias | AfterAlias deriving (Eq, Show) @@ -291,10 +292,11 @@ prettyImport columns Options{..} padQualified padName longest imp . withLast (++ (maybeSpace ++ ")")) inlineWrapper = case listAlign of - NewLine -> (paddedNoSpecBase :) . wrapRest columns listPadding' - WithAlias -> wrap columns paddedBase (inlineBaseLength + 1) + NewLine -> (paddedNoSpecBase :) . wrapRest columns listPadding' + WithModuleName -> wrap columns paddedBase (withModuleNameBaseLength + 4) + WithAlias -> wrap columns paddedBase (inlineBaseLength + 1) -- Add 1 extra space to ensure same padding as in original code. - AfterAlias -> withTail ((' ' : maybeSpace) ++) + AfterAlias -> withTail ((' ' : maybeSpace) ++) . wrap columns paddedBase (afterAliasBaseLength + 1) inlineWithBreakWrap = paddedNoSpecBase : wrapRest columns listPadding' @@ -349,6 +351,8 @@ prettyImport columns Options{..} padQualified padName longest imp inlineBaseLength = length $ base' (padImport $ compoundImportName imp) [] [] + withModuleNameBaseLength = length $ base' "" [] [] + afterAliasBaseLength = length $ base' (padImport $ compoundImportName imp) ["as " ++ as | H.ModuleName _ as <- maybeToList $ H.importAs imp] [] diff --git a/lib/Language/Haskell/Stylish/Step/TrailingWhitespace.hs b/lib/Language/Haskell/Stylish/Step/TrailingWhitespace.hs index dbc594c..e41bace 100644 --- a/lib/Language/Haskell/Stylish/Step/TrailingWhitespace.hs +++ b/lib/Language/Haskell/Stylish/Step/TrailingWhitespace.hs @@ -19,4 +19,9 @@ dropTrailingWhitespace = reverse . dropWhile isSpace . reverse -------------------------------------------------------------------------------- step :: Step -step = makeStep "TrailingWhitespace" $ \ls _ -> map dropTrailingWhitespace ls +step = makeStep "TrailingWhitespace" $ \ls _ -> map dropTrailingWhitespace' ls + where + dropTrailingWhitespace' l = case l of + -- Preserve page breaks + "\12" -> l + _ -> dropTrailingWhitespace l @@ -1,4 +1,6 @@ -resolver: lts-13.19 - +resolver: lts-14.6 packages: - - '.' +- '.' + +extra-deps: +- 'Cabal-3.0.0.0' diff --git a/stylish-haskell.cabal b/stylish-haskell.cabal index 1890a4b..52da455 100644 --- a/stylish-haskell.cabal +++ b/stylish-haskell.cabal @@ -1,5 +1,5 @@ Name: stylish-haskell -Version: 0.9.2.2 +Version: 0.9.4.3 Synopsis: Haskell code prettifier Homepage: https://github.com/jaspervdj/stylish-haskell License: BSD3 @@ -41,6 +41,8 @@ Library Language.Haskell.Stylish.Align Language.Haskell.Stylish.Block Language.Haskell.Stylish.Config + Language.Haskell.Stylish.Config.Cabal + Language.Haskell.Stylish.Config.Internal Language.Haskell.Stylish.Editor Language.Haskell.Stylish.Parse Language.Haskell.Stylish.Step @@ -52,6 +54,7 @@ Library aeson >= 0.6 && < 1.5, base >= 4.8 && < 5, bytestring >= 0.9 && < 0.11, + Cabal >= 2.4 && < 3.1, containers >= 0.3 && < 0.7, directory >= 1.2.3 && < 1.4, filepath >= 1.1 && < 1.5, @@ -70,11 +73,12 @@ Executable stylish-haskell Build-depends: stylish-haskell, strict >= 0.3 && < 0.4, - optparse-applicative >= 0.12 && < 0.15, + optparse-applicative >= 0.12 && < 0.16, -- Copied from regular dependencies... aeson >= 0.6 && < 1.5, base >= 4.8 && < 5, bytestring >= 0.9 && < 0.11, + Cabal >= 2.4 && < 3.1, containers >= 0.3 && < 0.7, directory >= 1.2.3 && < 1.4, filepath >= 1.1 && < 1.5, @@ -94,18 +98,21 @@ Test-suite stylish-haskell-tests Language.Haskell.Stylish.Align Language.Haskell.Stylish.Block Language.Haskell.Stylish.Config + Language.Haskell.Stylish.Config.Cabal + Language.Haskell.Stylish.Config.Internal + Language.Haskell.Stylish.Config.Tests Language.Haskell.Stylish.Editor Language.Haskell.Stylish.Parse Language.Haskell.Stylish.Parse.Tests Language.Haskell.Stylish.Step - Language.Haskell.Stylish.Step.SimpleAlign - Language.Haskell.Stylish.Step.SimpleAlign.Tests - Language.Haskell.Stylish.Step.Squash - Language.Haskell.Stylish.Step.Squash.Tests Language.Haskell.Stylish.Step.Imports Language.Haskell.Stylish.Step.Imports.Tests Language.Haskell.Stylish.Step.LanguagePragmas Language.Haskell.Stylish.Step.LanguagePragmas.Tests + Language.Haskell.Stylish.Step.SimpleAlign + Language.Haskell.Stylish.Step.SimpleAlign.Tests + Language.Haskell.Stylish.Step.Squash + Language.Haskell.Stylish.Step.Squash.Tests Language.Haskell.Stylish.Step.Tabs Language.Haskell.Stylish.Step.Tabs.Tests Language.Haskell.Stylish.Step.TrailingWhitespace @@ -120,10 +127,12 @@ Test-suite stylish-haskell-tests HUnit >= 1.2 && < 1.7, test-framework >= 0.4 && < 0.9, test-framework-hunit >= 0.2 && < 0.4, + random >= 1.1, -- Copied from regular dependencies... aeson >= 0.6 && < 1.5, base >= 4.8 && < 5, bytestring >= 0.9 && < 0.11, + Cabal >= 2.4 && < 3.1, containers >= 0.3 && < 0.7, directory >= 1.2.3 && < 1.4, filepath >= 1.1 && < 1.5, diff --git a/tests/Language/Haskell/Stylish/Config/Tests.hs b/tests/Language/Haskell/Stylish/Config/Tests.hs new file mode 100644 index 0000000..f62b571 --- /dev/null +++ b/tests/Language/Haskell/Stylish/Config/Tests.hs @@ -0,0 +1,142 @@ +module Language.Haskell.Stylish.Config.Tests + ( tests + ) where + + +-------------------------------------------------------------------------------- +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 + +-------------------------------------------------------------------------------- +tests :: Test +tests = testGroup "Language.Haskell.Stylish.Config" + [ testCase "Extensions extracted correctly from .cabal file" + testExtensionsFromDotCabal + , testCase "Extensions extracted correctly from .stylish-haskell.yaml file" + testExtensionsFromDotStylish + , testCase "Extensions extracted correctly from .stylish-haskell.yaml and .cabal files" + testExtensionsFromBoth + ] +-------------------------------------------------------------------------------- + +-- | 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 + mapM_ (\(k, v) -> writeFile k v) files + -- create an empty directory and change into it + createDirectory "src" + setCurrentDirectory "src" + -- 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 + +-------------------------------------------------------------------------------- +testExtensionsFromDotCabal :: Assertion +testExtensionsFromDotCabal = + assert $ (expected ==) . Set.fromList <$> + createFilesAndGetExtensions [("test.cabal", dotCabal True)] + where + expected = Set.fromList ["ScopedTypeVariables", "DataKinds"] + +-------------------------------------------------------------------------------- +testExtensionsFromDotStylish :: Assertion +testExtensionsFromDotStylish = + assert $ (expected ==) . Set.fromList <$> + createFilesAndGetExtensions [(".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)] + where + expected = Set.fromList + ["ScopedTypeVariables", "DataKinds", "TemplateHaskell", "QuasiQuotes"] + +-- | Example cabal file borrowed from +-- https://www.haskell.org/cabal/users-guide/developing-packages.html +-- with some default-extensions added +dotCabal :: Bool -> String +dotCabal includeExtensions = unlines $ + [ "name: TestPackage" + , "version: 0.0" + , "synopsis: Package with library and two programs" + , "license: BSD3" + , "author: Angela Author" + , "build-type: Simple" + , "cabal-version: >= 1.2" + , "" + , "library" + , " build-depends: HUnit" + , " exposed-modules: A, B, C" + ] ++ + [if includeExtensions then " default-extensions: ScopedTypeVariables" + else ""] + ++ + [ "" + , "executable program1" + , " main-is: Main.hs" + , " hs-source-dirs: prog1" + , " other-modules: A, B" + ] ++ + [if includeExtensions then " default-extensions: DataKinds" + else ""] + +-- | Example .stylish-haskell.yaml +dotStylish :: String +dotStylish = 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: 110" + , "language_extensions:" + , " - TemplateHaskell" + , " - QuasiQuotes" + ] diff --git a/tests/Language/Haskell/Stylish/Step/Imports/Tests.hs b/tests/Language/Haskell/Stylish/Step/Imports/Tests.hs index 67c7c5a..760018a 100644 --- a/tests/Language/Haskell/Stylish/Step/Imports/Tests.hs +++ b/tests/Language/Haskell/Stylish/Step/Imports/Tests.hs @@ -32,11 +32,15 @@ tests = testGroup "Language.Haskell.Stylish.Step.Imports.Tests" , testCase "case 06" case06 , testCase "case 07" case07 , testCase "case 08" case08 + , testCase "case 08b" case08b , testCase "case 09" case09 , testCase "case 10" case10 , testCase "case 11" case11 + , testCase "case 11b" case11b , testCase "case 12" case12 + , testCase "case 12b" case12b , testCase "case 13" case13 + , testCase "case 13b" case13b , testCase "case 14" case14 , testCase "case 15" case15 , testCase "case 16" case16 @@ -50,6 +54,7 @@ tests = testGroup "Language.Haskell.Stylish.Step.Imports.Tests" , testCase "case 21" case21 , testCase "case 22" case22 , testCase "case 23" case23 + , testCase "case 23b" case23b , testCase "case 24" case24 , testCase "case 25" case25 , testCase "case 26 (issue 185)" case26 @@ -213,6 +218,28 @@ case08 = expected -------------------------------------------------------------------------------- +case08b :: Assertion +case08b = expected + @=? testStep (step 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\"" + ] + + +-------------------------------------------------------------------------------- case09 :: Assertion case09 = expected @=? testStep (step 80 $ Options Global WithAlias True Multiline Inherit (LPConstant 4) True False) input @@ -313,6 +340,27 @@ case11 = expected ] +case11b :: Assertion +case11b = expected + @=? testStep (step 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\"" + ] + + -------------------------------------------------------------------------------- case12 :: Assertion case12 = expected @@ -329,6 +377,18 @@ case12 = expected -------------------------------------------------------------------------------- +case12b :: Assertion +case12b = expected + @=? testStep (step 80 $ Options Group WithModuleName True Inline Inherit (LPConstant 2) True False) input' + where + input' = unlines + [ "import Data.List (map)" + ] + + expected = input' + + +-------------------------------------------------------------------------------- case13 :: Assertion case13 = expected @=? testStep (step 80 $ Options None WithAlias True InlineWithBreak Inherit (LPConstant 4) True False) input' @@ -346,6 +406,23 @@ case13 = expected -------------------------------------------------------------------------------- +case13b :: Assertion +case13b = expected + @=? testStep (step 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," + , " (++))" + ] + + +-------------------------------------------------------------------------------- case14 :: Assertion case14 = expected @=? testStep @@ -451,6 +528,7 @@ case18 = expected @=? testStep , "import Data.Acid as Acid (closeAcidState, createCheckpoint, openLocalStateFrom)" ] + -------------------------------------------------------------------------------- case19 :: Assertion case19 = expected @=? testStep @@ -467,6 +545,7 @@ case19 = expected @=? testStep , " intersperse)" ] + case19b :: Assertion case19b = expected @=? testStep (step 40 $ Options File NewLine True InlineWithBreak RightAfter (LPConstant 17) True False) case19input @@ -482,6 +561,7 @@ case19b = expected @=? testStep , " intersperse)" ] + case19c :: Assertion case19c = expected @=? testStep (step 40 $ Options File NewLine True InlineWithBreak RightAfter LPModuleName True False) case19input @@ -497,6 +577,7 @@ case19c = expected @=? testStep , " intersperse)" ] + case19d :: Assertion case19d = expected @=? testStep (step 40 $ Options Global NewLine True InlineWithBreak RightAfter LPModuleName True False) case19input @@ -512,6 +593,7 @@ case19d = expected @=? testStep , " intersperse)" ] + case19input :: String case19input = unlines [ "import Prelude.Compat hiding (foldMap)" @@ -520,6 +602,7 @@ case19input = unlines , "import Data.List (foldl', intercalate, intersperse)" ] + -------------------------------------------------------------------------------- case20 :: Assertion case20 = expected @@ -538,6 +621,7 @@ case20 = expected , "import Data.Set (empty)" ] + -------------------------------------------------------------------------------- case21 :: Assertion case21 = expected @@ -568,6 +652,7 @@ case21 = expected , "import X9 hiding (x, y, z, x)" ] + -------------------------------------------------------------------------------- case22 :: Assertion case22 = expected @@ -594,6 +679,7 @@ case22 = expected "theLongestNameYet, shortName)" ] + -------------------------------------------------------------------------------- case23 :: Assertion case23 = expected @@ -618,6 +704,33 @@ case23 = expected , "import Data.ALongName.Foo (Foo, Goo, Boo)" ] + +-------------------------------------------------------------------------------- +case23b :: Assertion +case23b = expected + @=? testStep (step 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)" + ] + + -------------------------------------------------------------------------------- case24 :: Assertion case24 = expected @@ -641,6 +754,7 @@ case24 = expected "GooReallyLong, BooReallyLong)" ] + -------------------------------------------------------------------------------- case25 :: Assertion case25 = expected diff --git a/tests/Language/Haskell/Stylish/Step/TrailingWhitespace/Tests.hs b/tests/Language/Haskell/Stylish/Step/TrailingWhitespace/Tests.hs index 1394edb..0593c0a 100644 --- a/tests/Language/Haskell/Stylish/Step/TrailingWhitespace/Tests.hs +++ b/tests/Language/Haskell/Stylish/Step/TrailingWhitespace/Tests.hs @@ -28,12 +28,16 @@ case01 = expected @=? testStep step input where input = unlines [ "module Main where" - , " " + , " \t" , "data Foo = Bar | Qux\t " + , "\12" -- page break + , " \12" -- malformed page break ] expected = unlines [ "module Main where" , "" , "data Foo = Bar | Qux" + , "\12" -- page break + , "" ] diff --git a/tests/TestSuite.hs b/tests/TestSuite.hs index 27963a0..b5bec90 100644 --- a/tests/TestSuite.hs +++ b/tests/TestSuite.hs @@ -9,6 +9,7 @@ import Test.Framework (default -------------------------------------------------------------------------------- +import qualified Language.Haskell.Stylish.Config.Tests import qualified Language.Haskell.Stylish.Parse.Tests import qualified Language.Haskell.Stylish.Step.Imports.Tests import qualified Language.Haskell.Stylish.Step.LanguagePragmas.Tests @@ -23,6 +24,7 @@ import qualified Language.Haskell.Stylish.Step.UnicodeSyntax.Tests main :: IO () main = defaultMain [ Language.Haskell.Stylish.Parse.Tests.tests + , Language.Haskell.Stylish.Config.Tests.tests , Language.Haskell.Stylish.Step.Imports.Tests.tests , Language.Haskell.Stylish.Step.LanguagePragmas.Tests.tests , Language.Haskell.Stylish.Step.SimpleAlign.Tests.tests |