summaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
authorSean Whitton <spwhitton@spwhitton.name>2019-11-01 20:12:37 -0700
committerSean Whitton <spwhitton@spwhitton.name>2019-11-01 20:12:37 -0700
commitdd0c17ac6c5c34b09b4e79a0fa753745bacfe122 (patch)
tree0d8bf06c82c718504b1398471d9adbbd7dd45aa1
parent15eafc587c41e041194d1c4c84b2b94410a06756 (diff)
parentb67a6ae12f8107b2d1714659f8a121274d5833f9 (diff)
downloadstylish-haskell-dd0c17ac6c5c34b09b4e79a0fa753745bacfe122.tar.gz
Merge tag 'v0.9.4.3'
v0.9.4.3
-rw-r--r--.circleci/config.yml6
-rwxr-xr-x.circleci/release.sh11
-rw-r--r--CHANGELOG23
-rw-r--r--README.markdown11
-rw-r--r--data/stylish-haskell.yaml18
-rw-r--r--lib/Language/Haskell/Stylish/Config.hs50
-rw-r--r--lib/Language/Haskell/Stylish/Config/Cabal.hs92
-rw-r--r--lib/Language/Haskell/Stylish/Config/Internal.hs15
-rw-r--r--lib/Language/Haskell/Stylish/Step/Imports.hs10
-rw-r--r--lib/Language/Haskell/Stylish/Step/TrailingWhitespace.hs7
-rw-r--r--stack.yaml8
-rw-r--r--stylish-haskell.cabal21
-rw-r--r--tests/Language/Haskell/Stylish/Config/Tests.hs142
-rw-r--r--tests/Language/Haskell/Stylish/Step/Imports/Tests.hs114
-rw-r--r--tests/Language/Haskell/Stylish/Step/TrailingWhitespace/Tests.hs6
-rw-r--r--tests/TestSuite.hs2
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 .
diff --git a/CHANGELOG b/CHANGELOG
index 0bf78c4..6eca483 100644
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -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
diff --git a/stack.yaml b/stack.yaml
index 7a5f68c..2d7969b 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -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