From 9e34f3e162a89f0df56132daf6caf1154ea180c8 Mon Sep 17 00:00:00 2001 From: Flavio Corpa Date: Wed, 20 Nov 2019 19:21:51 +0100 Subject: Make language extension prefix configurable --- data/stylish-haskell.yaml | 5 +++ lib/Language/Haskell/Stylish.hs | 2 + lib/Language/Haskell/Stylish/Config.hs | 28 +++++++++--- lib/Language/Haskell/Stylish/Editor.hs | 11 ++--- .../Haskell/Stylish/Step/LanguagePragmas.hs | 50 ++++++++++------------ lib/Language/Haskell/Stylish/Step/UnicodeSyntax.hs | 14 +++--- stack.yaml | 2 +- stack.yaml.lock | 26 +++++++++++ .../Haskell/Stylish/Step/LanguagePragmas/Tests.hs | 42 +++++++++++++----- .../Haskell/Stylish/Step/UnicodeSyntax/Tests.hs | 19 +++++++- 10 files changed, 140 insertions(+), 59 deletions(-) create mode 100644 stack.yaml.lock diff --git a/data/stylish-haskell.yaml b/data/stylish-haskell.yaml index 401d384..5200299 100644 --- a/data/stylish-haskell.yaml +++ b/data/stylish-haskell.yaml @@ -203,6 +203,11 @@ steps: # is set to true, it will remove those redundant pragmas. Default: true. remove_redundant: true + # Language prefix to be used for pragma declaration, this allows you to + # use other options non case-sensitive like "language" or "Language". + # If a non correct String is provided, it will default to: LANGUAGE. + language_prefix: LANGUAGE + # Replace tabs by spaces. This is disabled by default. # - tabs: # # Number of spaces to use for each tab. Default: 8, as specified by the diff --git a/lib/Language/Haskell/Stylish.hs b/lib/Language/Haskell/Stylish.hs index 46543ec..7d7fb98 100644 --- a/lib/Language/Haskell/Stylish.hs +++ b/lib/Language/Haskell/Stylish.hs @@ -58,6 +58,7 @@ languagePragmas :: Int -- ^ columns -> LanguagePragmas.Style -> Bool -- ^ Pad to same length in vertical mode? -> Bool -- ^ remove redundant? + -> String -- ^ language prefix -> Step languagePragmas = LanguagePragmas.step @@ -75,6 +76,7 @@ trailingWhitespace = TrailingWhitespace.step -------------------------------------------------------------------------------- unicodeSyntax :: Bool -- ^ add language pragma? + -> String -- ^ language prefix -> Step unicodeSyntax = UnicodeSyntax.step diff --git a/lib/Language/Haskell/Stylish/Config.hs b/lib/Language/Haskell/Stylish/Config.hs index 8f43131..e4adaf5 100644 --- a/lib/Language/Haskell/Stylish/Config.hs +++ b/lib/Language/Haskell/Stylish/Config.hs @@ -16,6 +16,7 @@ import Data.Aeson (FromJSON (..) import qualified Data.Aeson as A import qualified Data.Aeson.Types as A import qualified Data.ByteString as B +import Data.Char (toLower) import qualified Data.FileEmbed as FileEmbed import Data.List (intercalate, nub) @@ -80,12 +81,10 @@ configFilePath verbose Nothing = do current <- getCurrentDirectory configPath <- getXdgDirectory XdgConfig "stylish-haskell" home <- getHomeDirectory - mbConfig <- search verbose $ + search verbose $ [d configFileName | d <- ancestors current] ++ [configPath "config.yaml", home configFileName] - return mbConfig - search :: Verbose -> [FilePath] -> IO (Maybe FilePath) search _ [] = return Nothing search verbose (f : fs) = do @@ -200,9 +199,9 @@ parseImports config o = Imports.step -- Note that padding has to be at least 1. Default is 4. <*> (o A..:? "empty_list_align" >>= parseEnum emptyListAligns (def Imports.emptyListAlign)) - <*> o A..:? "list_padding" A..!= (def Imports.listPadding) - <*> o A..:? "separate_lists" A..!= (def Imports.separateLists) - <*> o A..:? "space_surround" A..!= (def Imports.spaceSurround)) + <*> o A..:? "list_padding" A..!= def Imports.listPadding + <*> o A..:? "separate_lists" A..!= def Imports.separateLists + <*> o A..:? "space_surround" A..!= def Imports.spaceSurround) where def f = f Imports.defaultOptions @@ -237,8 +236,9 @@ parseLanguagePragmas :: Config -> A.Object -> A.Parser Step parseLanguagePragmas config o = LanguagePragmas.step <$> pure (configColumns config) <*> (o A..:? "style" >>= parseEnum styles LanguagePragmas.Vertical) - <*> o A..:? "align" A..!= True + <*> o A..:? "align" A..!= True <*> o A..:? "remove_redundant" A..!= True + <*> mkLanguage o where styles = [ ("vertical", LanguagePragmas.Vertical) @@ -247,6 +247,19 @@ parseLanguagePragmas config o = LanguagePragmas.step ] +-------------------------------------------------------------------------------- +-- | Utilities for validating language prefixes +mkLanguage :: A.Object -> A.Parser String +mkLanguage o = do + lang <- o A..:? "language_prefix" + maybe (pure "LANGUAGE") validate lang + where + validate :: String -> A.Parser String + validate s + | fmap toLower s == "language" = pure s + | otherwise = fail "please provide a valid language prefix" + + -------------------------------------------------------------------------------- parseTabs :: Config -> A.Object -> A.Parser Step parseTabs _ o = Tabs.step @@ -262,3 +275,4 @@ parseTrailingWhitespace _ _ = return TrailingWhitespace.step parseUnicodeSyntax :: Config -> A.Object -> A.Parser Step parseUnicodeSyntax _ o = UnicodeSyntax.step <$> o A..:? "add_language_pragma" A..!= True + <*> mkLanguage o diff --git a/lib/Language/Haskell/Stylish/Editor.hs b/lib/Language/Haskell/Stylish/Editor.hs index cad7e68..f71d1f6 100644 --- a/lib/Language/Haskell/Stylish/Editor.hs +++ b/lib/Language/Haskell/Stylish/Editor.hs @@ -1,3 +1,5 @@ +{-# language LambdaCase #-} + -------------------------------------------------------------------------------- -- | This module provides you with a line-based editor. It's main feature is -- that you can specify multiple changes at the same time, e.g.: @@ -19,8 +21,7 @@ module Language.Haskell.Stylish.Editor -------------------------------------------------------------------------------- -import Data.List (intercalate, sortBy) -import Data.Ord (comparing) +import Data.List (intercalate, sortOn) -------------------------------------------------------------------------------- @@ -31,7 +32,7 @@ import Language.Haskell.Stylish.Block -- | Changes the lines indicated by the 'Block' into the given 'Lines' data Change a = Change { changeBlock :: Block a - , changeLines :: ([a] -> [a]) + , changeLines :: [a] -> [a] } @@ -49,7 +50,7 @@ applyChanges changes0 intercalate ", " (map printBlock blocks) | otherwise = go 1 changes1 where - changes1 = sortBy (comparing (blockStart . changeBlock)) changes0 + changes1 = sortOn (blockStart . changeBlock) changes0 blocks = map changeBlock changes1 printBlock b = show (blockStart b) ++ "-" ++ show (blockEnd b) @@ -87,7 +88,7 @@ change = Change -------------------------------------------------------------------------------- -- | Change a single line for some other lines changeLine :: Int -> (a -> [a]) -> Change a -changeLine start f = change (Block start start) $ \xs -> case xs of +changeLine start f = change (Block start start) $ \case [] -> [] (x : _) -> f x diff --git a/lib/Language/Haskell/Stylish/Step/LanguagePragmas.hs b/lib/Language/Haskell/Stylish/Step/LanguagePragmas.hs index cdedfa8..34d05dc 100644 --- a/lib/Language/Haskell/Stylish/Step/LanguagePragmas.hs +++ b/lib/Language/Haskell/Stylish/Step/LanguagePragmas.hs @@ -2,7 +2,6 @@ module Language.Haskell.Stylish.Step.LanguagePragmas ( Style (..) , step - -- * Utilities , addLanguagePragma ) where @@ -42,9 +41,9 @@ firstLocation = minimum . map (blockStart . fst) -------------------------------------------------------------------------------- -verticalPragmas :: Int -> Bool -> [String] -> Lines -verticalPragmas longest align pragmas' = - [ "{-# LANGUAGE " ++ pad pragma ++ " #-}" +verticalPragmas :: String -> Int -> Bool -> [String] -> Lines +verticalPragmas lg longest align pragmas' = + [ "{-# " ++ lg ++ " " ++ pad pragma ++ " #-}" | pragma <- pragmas' ] where @@ -54,26 +53,22 @@ verticalPragmas longest align pragmas' = -------------------------------------------------------------------------------- -compactPragmas :: Int -> [String] -> Lines -compactPragmas columns pragmas' = wrap columns "{-# LANGUAGE" 13 $ +compactPragmas :: String -> Int -> [String] -> Lines +compactPragmas lg columns pragmas' = wrap columns ("{-# " ++ lg) 13 $ map (++ ",") (init pragmas') ++ [last pragmas' ++ " #-}"] -------------------------------------------------------------------------------- -compactLinePragmas :: Int -> Bool -> [String] -> Lines -compactLinePragmas _ _ [] = [] -compactLinePragmas columns align pragmas' = map (wrapLanguage . pad) prags +compactLinePragmas :: String -> Int -> Bool -> [String] -> Lines +compactLinePragmas _ _ _ [] = [] +compactLinePragmas lg columns align pragmas' = map (wrapLanguage . pad) prags where - wrapLanguage ps = "{-# LANGUAGE" ++ ps ++ " #-}" - + wrapLanguage ps = "{-# " ++ lg ++ ps ++ " #-}" maxWidth = columns - 16 - longest = maximum $ map length prags - pad | align = padRight longest | otherwise = id - prags = map truncateComma $ wrap maxWidth "" 1 $ map (++ ",") (init pragmas') ++ [last pragmas'] @@ -87,10 +82,10 @@ truncateComma xs -------------------------------------------------------------------------------- -prettyPragmas :: Int -> Int -> Bool -> Style -> [String] -> Lines -prettyPragmas _ longest align Vertical = verticalPragmas longest align -prettyPragmas cols _ _ Compact = compactPragmas cols -prettyPragmas cols _ align CompactLine = compactLinePragmas cols align +prettyPragmas :: String -> Int -> Int -> Bool -> Style -> [String] -> Lines +prettyPragmas lp _ longest align Vertical = verticalPragmas lp longest align +prettyPragmas lp cols _ _ Compact = compactPragmas lp cols +prettyPragmas lp cols _ align CompactLine = compactLinePragmas lp cols align -------------------------------------------------------------------------------- @@ -110,35 +105,34 @@ filterRedundant isRedundant' = snd . foldr filterRedundant' (S.empty, []) known' = xs' `S.union` known -------------------------------------------------------------------------------- -step :: Int -> Style -> Bool -> Bool -> Step -step = (((makeStep "LanguagePragmas" .) .) .) . step' +step :: Int -> Style -> Bool -> Bool -> String -> Step +step = ((((makeStep "LanguagePragmas" .) .) .) .) . step' -------------------------------------------------------------------------------- -step' :: Int -> Style -> Bool -> Bool -> Lines -> Module -> Lines -step' columns style align removeRedundant ls (module', _) +step' :: Int -> Style -> Bool -> Bool -> String -> Lines -> Module -> Lines +step' columns style align removeRedundant lngPrefix ls (module', _) | null pragmas' = ls | otherwise = applyChanges changes ls where isRedundant' | removeRedundant = isRedundant module' | otherwise = const False - pragmas' = pragmas $ fmap linesFromSrcSpan module' longest = maximum $ map length $ snd =<< pragmas' groups = [(b, concat pgs) | (b, pgs) <- groupAdjacent pragmas'] changes = - [ change b (const $ prettyPragmas columns longest align style pg) + [ change b (const $ prettyPragmas lngPrefix columns longest align style pg) | (b, pg) <- filterRedundant isRedundant' groups ] -------------------------------------------------------------------------------- -- | Add a LANGUAGE pragma to a module if it is not present already. -addLanguagePragma :: String -> H.Module H.SrcSpanInfo -> [Change String] -addLanguagePragma prag modu +addLanguagePragma :: String -> String -> H.Module H.SrcSpanInfo -> [Change String] +addLanguagePragma lg prag modu | prag `elem` present = [] - | otherwise = [insert line ["{-# LANGUAGE " ++ prag ++ " #-}"]] + | otherwise = [insert line ["{-# " ++ lg ++ " " ++ prag ++ " #-}"]] where pragmas' = pragmas (fmap linesFromSrcSpan modu) present = concatMap snd pragmas' @@ -158,7 +152,7 @@ isRedundant _ _ = False -- | Check if the ViewPatterns language pragma is redundant. isRedundantViewPatterns :: H.Module H.SrcSpanInfo -> Bool isRedundantViewPatterns m = null - [() | H.PViewPat _ _ _ <- everything m :: [H.Pat H.SrcSpanInfo]] + [() | H.PViewPat {} <- everything m :: [H.Pat H.SrcSpanInfo]] -------------------------------------------------------------------------------- diff --git a/lib/Language/Haskell/Stylish/Step/UnicodeSyntax.hs b/lib/Language/Haskell/Stylish/Step/UnicodeSyntax.hs index 01e29e8..266e8e5 100644 --- a/lib/Language/Haskell/Stylish/Step/UnicodeSyntax.hs +++ b/lib/Language/Haskell/Stylish/Step/UnicodeSyntax.hs @@ -39,12 +39,12 @@ replaceAll :: [(Int, [(Int, String)])] -> [Change String] replaceAll = map changeLine' where changeLine' (r, ns) = changeLine r $ \str -> return $ - flip applyChanges str + applyChanges [ change (Block c ec) (const repl) | (c, needle) <- sort ns , let ec = c + length needle - 1 , repl <- maybeToList $ M.lookup needle unicodeReplacements - ] + ] str -------------------------------------------------------------------------------- @@ -104,15 +104,15 @@ between (startRow, startCol) (endRow, endCol) needle = -------------------------------------------------------------------------------- -step :: Bool -> Step -step = makeStep "UnicodeSyntax" . step' +step :: Bool -> String -> Step +step = (makeStep "UnicodeSyntax" .) . step' -------------------------------------------------------------------------------- -step' :: Bool -> Lines -> Module -> Lines -step' alp ls (module', _) = applyChanges changes ls +step' :: Bool -> String -> Lines -> Module -> Lines +step' alp lg ls (module', _) = applyChanges changes ls where - changes = (if alp then addLanguagePragma "UnicodeSyntax" module' else []) ++ + changes = (if alp then addLanguagePragma lg "UnicodeSyntax" module' else []) ++ replaceAll perLine perLine = sort $ groupPerLine $ typeSigs module' ls ++ diff --git a/stack.yaml b/stack.yaml index 410dcfa..6256c7a 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,4 +1,4 @@ -resolver: lts-14.6 +resolver: lts-14.13 packages: - '.' diff --git a/stack.yaml.lock b/stack.yaml.lock new file mode 100644 index 0000000..d3b719d --- /dev/null +++ b/stack.yaml.lock @@ -0,0 +1,26 @@ +# This file was autogenerated by Stack. +# You should not edit this file by hand. +# For more information, please see the documentation at: +# https://docs.haskellstack.org/en/stable/lock_files + +packages: +- completed: + hackage: Cabal-3.0.0.0@sha256:1ba37b8d80e89213b17db7b8b9ea0108da55ca65f8c0cbb7433881a284c5cf67,26027 + pantry-tree: + size: 71616 + sha256: 4f16f0a65304ab22f01cb7f6d25db2f15a168f4cefacde7864cb1e02eb3ea867 + original: + hackage: Cabal-3.0.0.0 +- completed: + hackage: haskell-src-exts-1.22.0@sha256:f558923a9c8f57402c33a8cc871b934027a5c65414404c87239f6cbd7357d54e,4541 + pantry-tree: + size: 96940 + sha256: 597b6f48bd409a4d0da013c4e356945c42e0d098966035d3aa68cd4a3ccd66c9 + original: + hackage: haskell-src-exts-1.22.0 +snapshots: +- completed: + size: 525876 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/14/13.yaml + sha256: 4a0e79eb194c937cc2a1852ff84d983c63ac348dc6bad5f38d20cab697036eef + original: lts-14.13 diff --git a/tests/Language/Haskell/Stylish/Step/LanguagePragmas/Tests.hs b/tests/Language/Haskell/Stylish/Step/LanguagePragmas/Tests.hs index 2d74813..7afbdfc 100644 --- a/tests/Language/Haskell/Stylish/Step/LanguagePragmas/Tests.hs +++ b/tests/Language/Haskell/Stylish/Step/LanguagePragmas/Tests.hs @@ -28,12 +28,15 @@ tests = testGroup "Language.Haskell.Stylish.Step.LanguagePragmas.Tests" , testCase "case 08" case08 , testCase "case 09" case09 , testCase "case 10" case10 + , testCase "case 11" case11 ] +lANG :: String +lANG = "LANGUAGE" -------------------------------------------------------------------------------- case01 :: Assertion -case01 = expected @=? testStep (step 80 Vertical True False) input +case01 = expected @=? testStep (step 80 Vertical True False lANG) input where input = unlines [ "{-# LANGUAGE ViewPatterns #-}" @@ -52,7 +55,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 80 Vertical True True lANG) input where input = unlines [ "{-# LANGUAGE BangPatterns #-}" @@ -68,7 +71,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 80 Vertical True True lANG) input where input = unlines [ "{-# LANGUAGE BangPatterns #-}" @@ -84,7 +87,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 80 Compact True False lANG) input where input = unlines [ "{-# LANGUAGE TypeOperators, StandaloneDeriving, DeriveDataTypeable," @@ -101,7 +104,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 80 Vertical True False lANG) input where input = unlines [ "{-# LANGUAGE CPP #-}" @@ -122,7 +125,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 80 CompactLine True False lANG) input where input = unlines [ "{-# LANGUAGE TypeOperators, StandaloneDeriving, DeriveDataTypeable," @@ -137,7 +140,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 80 Vertical False False lANG) input where input = unlines [ "{-# LANGUAGE ViewPatterns #-}" @@ -157,7 +160,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 80 CompactLine False False lANG) input where input = unlines [ "{-# LANGUAGE TypeOperators, StandaloneDeriving, DeriveDataTypeable," @@ -173,7 +176,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 80 Compact True False lANG) input where input = unlines [ "{-# LANGUAGE DefaultSignatures, FlexibleInstances, LambdaCase, " ++ @@ -187,7 +190,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 80 Compact True False lANG) input where input = unlines [ "{-# LANGUAGE NondecreasingIndentation, ScopedTypeVariables," @@ -197,3 +200,22 @@ case10 = expected @=? testStep (step 80 Compact True False) input [ "{-# LANGUAGE NondecreasingIndentation, ScopedTypeVariables, " ++ "TypeApplications #-}" ] + +-------------------------------------------------------------------------------- +case11 :: Assertion +case11 = expected @=? testStep (step 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" + ] 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 -- cgit v1.2.3 From 975752b2c82b3c6e0cc5a26729062eb2291286f2 Mon Sep 17 00:00:00 2001 From: Jose Fernando García Parreño <53873599+rakestto@users.noreply.github.com> Date: Wed, 27 Nov 2019 16:13:49 +0100 Subject: New logo by @rakestto --- README.markdown | 50 ++++++++++++++------------------- assets/Logo/PNG/1.5x/Recurso 4hdpi.png | Bin 0 -> 31195 bytes assets/Logo/PNG/1.5x/Recurso 5hdpi.png | Bin 0 -> 6850 bytes assets/Logo/PNG/1.5x/Recurso 6hdpi.png | Bin 0 -> 6799 bytes assets/Logo/PNG/1x/Recurso 4mdpi.png | Bin 0 -> 19503 bytes assets/Logo/PNG/1x/Recurso 5mdpi.png | Bin 0 -> 4398 bytes assets/Logo/PNG/1x/Recurso 6mdpi.png | Bin 0 -> 4380 bytes assets/Logo/PNG/2x/Recurso 4xhdpi.png | Bin 0 -> 44632 bytes assets/Logo/PNG/2x/Recurso 5xhdpi.png | Bin 0 -> 9461 bytes assets/Logo/PNG/2x/Recurso 6xhdpi.png | Bin 0 -> 9442 bytes assets/Logo/PNG/3x/Recurso 4xxhdpi.png | Bin 0 -> 74358 bytes assets/Logo/PNG/3x/Recurso 5xxhdpi.png | Bin 0 -> 15531 bytes assets/Logo/PNG/3x/Recurso 6xxhdpi.png | Bin 0 -> 15656 bytes assets/Logo/SVG/PinkLogo.svg | 1 + assets/Logo/SVG/RoundedLogo.svg | 1 + assets/Logo/SVG/WhiteLogo.svg | 1 + 16 files changed, 24 insertions(+), 29 deletions(-) create mode 100644 assets/Logo/PNG/1.5x/Recurso 4hdpi.png create mode 100644 assets/Logo/PNG/1.5x/Recurso 5hdpi.png create mode 100644 assets/Logo/PNG/1.5x/Recurso 6hdpi.png create mode 100644 assets/Logo/PNG/1x/Recurso 4mdpi.png create mode 100644 assets/Logo/PNG/1x/Recurso 5mdpi.png create mode 100644 assets/Logo/PNG/1x/Recurso 6mdpi.png create mode 100644 assets/Logo/PNG/2x/Recurso 4xhdpi.png create mode 100644 assets/Logo/PNG/2x/Recurso 5xhdpi.png create mode 100644 assets/Logo/PNG/2x/Recurso 6xhdpi.png create mode 100644 assets/Logo/PNG/3x/Recurso 4xxhdpi.png create mode 100644 assets/Logo/PNG/3x/Recurso 5xxhdpi.png create mode 100644 assets/Logo/PNG/3x/Recurso 6xxhdpi.png create mode 100644 assets/Logo/SVG/PinkLogo.svg create mode 100644 assets/Logo/SVG/RoundedLogo.svg create mode 100644 assets/Logo/SVG/WhiteLogo.svg diff --git a/README.markdown b/README.markdown index 97c8507..870a40c 100644 --- a/README.markdown +++ b/README.markdown @@ -1,10 +1,10 @@ -stylish-haskell -=============== +## stylish-haskell + + [![Build Status](https://img.shields.io/circleci/project/github/jaspervdj/stylish-haskell.svg)](https://circleci.com/gh/jaspervdj/stylish-haskell) -Introduction ------------- +## Introduction A simple Haskell code prettifier. The goal is not to format all of the code in a file, since I find those kind of tools often "get in the way". However, @@ -12,18 +12,17 @@ manually cleaning up import statements etc. gets tedious very quickly. This tool tries to help where necessary without getting in the way. -Installation ------------- +## Installation You can install it using `stack install stylish-haskell` or `cabal install stylish-haskell`. You can also install it using your package manager: - * Debian 9 or later: `apt-get install stylish-haskell` - * Ubuntu 16.10 or later: `apt-get install stylish-haskell` - * Arch Linux: `pacman -S stylish-haskell` -Features --------- +- Debian 9 or later: `apt-get install stylish-haskell` +- Ubuntu 16.10 or later: `apt-get install stylish-haskell` +- Arch Linux: `pacman -S stylish-haskell` + +## Features - Aligns and sorts `import` statements - Groups and wraps `{-# LANGUAGE #-}` pragmas, can remove (some) redundant @@ -39,8 +38,7 @@ Feature requests are welcome! Use the [issue tracker] for that. [issue tracker]: https://github.com/jaspervdj/stylish-haskell/issues -Example -------- +## Example Turns: @@ -84,8 +82,8 @@ data Point = Point , pointName :: String } deriving (Show) ``` -Configuration -------------- + +## Configuration The tool is customizable to some extent. It tries to find a config file in the following order: @@ -107,8 +105,7 @@ Use `stylish-haskell --defaults > .stylish-haskell.yaml` to dump a well-documented default configuration to a file, this way you can get started quickly. -VIM integration ---------------- +## VIM integration Since it works as a filter it is pretty easy to integrate this with VIM. @@ -136,14 +133,13 @@ autocmd FileType haskell let b:autoformat_autoindent=0 There are also plugins that run stylish-haskell automatically when you save a Haskell file: -* [vim-stylish-haskell] -* [vim-stylishask] +- [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 ------------------ +## Emacs integration [haskell-mode] for Emacs supports `stylish-haskell`. For configuration, see [the “Using external formatters” section][haskell-mode/format] of the @@ -152,8 +148,7 @@ haskell-mode manual. [haskell-mode]: https://github.com/haskell/haskell-mode [haskell-mode/format]: http://haskell.github.io/haskell-mode/manual/latest/Autoformating.html -Atom integration ----------------- +## Atom integration [ide-haskell] for Atom supports `stylish-haskell`. @@ -162,15 +157,13 @@ Atom integration [ide-haskell]: https://atom.io/packages/ide-haskell [atom-beautify]: Https://atom.io/packages/atom-beautify -Visual Studio Code integration ------------------------------- +## Visual Studio Code integration [stylish-haskell-vscode] for VSCode supports `stylish-haskell`. [stylish-haskell-vscode]: https://github.com/vigoo/stylish-haskell-vscode -Using with Continuous Integration ---------------------------------- +## Using with Continuous Integration You can quickly grab the latest binary and run `stylish-haskell` like so: @@ -178,8 +171,7 @@ You can quickly grab the latest binary and run `stylish-haskell` like so: Where the `.` can be replaced with the arguments you pass to `stylish-haskell`. -Credits -------- +## Credits Written and maintained by Jasper Van der Jeugt. diff --git a/assets/Logo/PNG/1.5x/Recurso 4hdpi.png b/assets/Logo/PNG/1.5x/Recurso 4hdpi.png new file mode 100644 index 0000000..30c7a37 Binary files /dev/null and b/assets/Logo/PNG/1.5x/Recurso 4hdpi.png differ diff --git a/assets/Logo/PNG/1.5x/Recurso 5hdpi.png b/assets/Logo/PNG/1.5x/Recurso 5hdpi.png new file mode 100644 index 0000000..c73f840 Binary files /dev/null and b/assets/Logo/PNG/1.5x/Recurso 5hdpi.png differ diff --git a/assets/Logo/PNG/1.5x/Recurso 6hdpi.png b/assets/Logo/PNG/1.5x/Recurso 6hdpi.png new file mode 100644 index 0000000..f574889 Binary files /dev/null and b/assets/Logo/PNG/1.5x/Recurso 6hdpi.png differ diff --git a/assets/Logo/PNG/1x/Recurso 4mdpi.png b/assets/Logo/PNG/1x/Recurso 4mdpi.png new file mode 100644 index 0000000..cf35dd8 Binary files /dev/null and b/assets/Logo/PNG/1x/Recurso 4mdpi.png differ diff --git a/assets/Logo/PNG/1x/Recurso 5mdpi.png b/assets/Logo/PNG/1x/Recurso 5mdpi.png new file mode 100644 index 0000000..4d84ff3 Binary files /dev/null and b/assets/Logo/PNG/1x/Recurso 5mdpi.png differ diff --git a/assets/Logo/PNG/1x/Recurso 6mdpi.png b/assets/Logo/PNG/1x/Recurso 6mdpi.png new file mode 100644 index 0000000..e4a4767 Binary files /dev/null and b/assets/Logo/PNG/1x/Recurso 6mdpi.png differ diff --git a/assets/Logo/PNG/2x/Recurso 4xhdpi.png b/assets/Logo/PNG/2x/Recurso 4xhdpi.png new file mode 100644 index 0000000..114929e Binary files /dev/null and b/assets/Logo/PNG/2x/Recurso 4xhdpi.png differ diff --git a/assets/Logo/PNG/2x/Recurso 5xhdpi.png b/assets/Logo/PNG/2x/Recurso 5xhdpi.png new file mode 100644 index 0000000..ec1a2f4 Binary files /dev/null and b/assets/Logo/PNG/2x/Recurso 5xhdpi.png differ diff --git a/assets/Logo/PNG/2x/Recurso 6xhdpi.png b/assets/Logo/PNG/2x/Recurso 6xhdpi.png new file mode 100644 index 0000000..4b6353e Binary files /dev/null and b/assets/Logo/PNG/2x/Recurso 6xhdpi.png differ diff --git a/assets/Logo/PNG/3x/Recurso 4xxhdpi.png b/assets/Logo/PNG/3x/Recurso 4xxhdpi.png new file mode 100644 index 0000000..61c667e Binary files /dev/null and b/assets/Logo/PNG/3x/Recurso 4xxhdpi.png differ diff --git a/assets/Logo/PNG/3x/Recurso 5xxhdpi.png b/assets/Logo/PNG/3x/Recurso 5xxhdpi.png new file mode 100644 index 0000000..c877ce4 Binary files /dev/null and b/assets/Logo/PNG/3x/Recurso 5xxhdpi.png differ diff --git a/assets/Logo/PNG/3x/Recurso 6xxhdpi.png b/assets/Logo/PNG/3x/Recurso 6xxhdpi.png new file mode 100644 index 0000000..eb9fa18 Binary files /dev/null and b/assets/Logo/PNG/3x/Recurso 6xxhdpi.png differ diff --git a/assets/Logo/SVG/PinkLogo.svg b/assets/Logo/SVG/PinkLogo.svg new file mode 100644 index 0000000..6ff8d9d --- /dev/null +++ b/assets/Logo/SVG/PinkLogo.svg @@ -0,0 +1 @@ +Recurso 8 \ No newline at end of file diff --git a/assets/Logo/SVG/RoundedLogo.svg b/assets/Logo/SVG/RoundedLogo.svg new file mode 100644 index 0000000..bf2fcd7 --- /dev/null +++ b/assets/Logo/SVG/RoundedLogo.svg @@ -0,0 +1 @@ +Recurso 7 \ No newline at end of file diff --git a/assets/Logo/SVG/WhiteLogo.svg b/assets/Logo/SVG/WhiteLogo.svg new file mode 100644 index 0000000..ebb2d69 --- /dev/null +++ b/assets/Logo/SVG/WhiteLogo.svg @@ -0,0 +1 @@ +Recurso 6 \ No newline at end of file -- cgit v1.2.3 From b9e70a32e65f31a3ff435535cf3fa476f41751f2 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Tue, 3 Dec 2019 10:26:57 -0700 Subject: Add Debian's manpage for stylish-haskell to this repo Closes: #250 --- LICENSE | 1 + doc/stylish-haskell.1.adoc | 54 ++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 55 insertions(+) create mode 100644 doc/stylish-haskell.1.adoc diff --git a/LICENSE b/LICENSE index 1a37f45..386d3b9 100644 --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,5 @@ Copyright (c) 2012, Jasper Van der Jeugt +Copyright (c) 2016, 2018 Sean Whitton All rights reserved. diff --git a/doc/stylish-haskell.1.adoc b/doc/stylish-haskell.1.adoc new file mode 100644 index 0000000..65c2b6c --- /dev/null +++ b/doc/stylish-haskell.1.adoc @@ -0,0 +1,54 @@ += stylish-haskell(1) + +== NAME + +stylish-haskell - simple Haskell code prettifier + +== SYNOPSIS + +*stylish-haskell* [_-c_|_--config=FILE_] [_-v|--verbose_] +[_-i_|_--inplace_] [--no-utf8] [_FILES_]... + +*stylish-haskell* _-d_|_--defaults_ + +*stylish-haskell* _-?_|_--help_ + +*stylish-haskell* _--version_ + +== DESCRIPTION + +*stylish-haskell* performs automatic formatting on the Haskell code in +the files passed on the command line or piped via STDIN. It outputs to +STDOUT unless *-i* is specified. + +STDIN is assumed to be encoded UTF-8, unless the *--no-utf8* option is +used. + +=== OPTIONS + +*-c*, *--config=FILE*:: + Override the default configuration file. + +*-v*, *--verbose*:: + Turn on verbose output. + +*-i*, *--inplace*:: + Prettify and overwrite the given files in place. + +*-d*, *--defaults*:: + Dump default config and exit. + +*-?*, *--help*:: + Output help text and exit. + +*--version*:: + Output version information and exit. + +*--no-utf8*:: + Don't assume that STDIN is encoded UTF-8, and don't force UTF-8 output. + +== AUTHOR + +This manual page was originally written by Sean Whitton +<\spwhitton@spwhitton.name> for the Debian GNU/Linux system (but may be +used by others). -- cgit v1.2.3 From ba5456a9f2c16524ea93c0b038dafc1af8aaaf0e Mon Sep 17 00:00:00 2001 From: Chris Martin Date: Thu, 9 Jan 2020 15:31:28 -0700 Subject: Bump haskell-src-exts to 1.23 --- stack.yaml | 4 ++-- stack.yaml.lock | 16 ++++++++-------- stylish-haskell.cabal | 6 +++--- 3 files changed, 13 insertions(+), 13 deletions(-) diff --git a/stack.yaml b/stack.yaml index 6256c7a..8d4c89b 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,7 +1,7 @@ -resolver: lts-14.13 +resolver: lts-14.20 packages: - '.' extra-deps: - 'Cabal-3.0.0.0' -- 'haskell-src-exts-1.22.0' +- 'haskell-src-exts-1.23.0' diff --git a/stack.yaml.lock b/stack.yaml.lock index d3b719d..129406d 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -12,15 +12,15 @@ packages: original: hackage: Cabal-3.0.0.0 - completed: - hackage: haskell-src-exts-1.22.0@sha256:f558923a9c8f57402c33a8cc871b934027a5c65414404c87239f6cbd7357d54e,4541 + hackage: haskell-src-exts-1.23.0@sha256:1bb9f7e97d569e56973133cb075fdcc1bfd11f90d94b035b5cf44814bb39a73d,4541 pantry-tree: - size: 96940 - sha256: 597b6f48bd409a4d0da013c4e356945c42e0d098966035d3aa68cd4a3ccd66c9 + size: 97804 + sha256: 8e5bc885533431db9bf75e9609f6b80b56ab0c289a903d701f8628e78322afd0 original: - hackage: haskell-src-exts-1.22.0 + hackage: haskell-src-exts-1.23.0 snapshots: - completed: - size: 525876 - url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/14/13.yaml - sha256: 4a0e79eb194c937cc2a1852ff84d983c63ac348dc6bad5f38d20cab697036eef - original: lts-14.13 + size: 524154 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/14/20.yaml + sha256: 2f5099f69ddb6abfe64400fe1e6a604e8e628f55e6837211cd70a81eb0a8fa4d + original: lts-14.20 diff --git a/stylish-haskell.cabal b/stylish-haskell.cabal index a0b1479..116d889 100644 --- a/stylish-haskell.cabal +++ b/stylish-haskell.cabal @@ -59,7 +59,7 @@ Library directory >= 1.2.3 && < 1.4, filepath >= 1.1 && < 1.5, file-embed >= 0.0.10 && < 0.1, - haskell-src-exts >= 1.18 && < 1.23, + haskell-src-exts >= 1.18 && < 1.24, mtl >= 2.0 && < 2.3, semigroups >= 0.18 && < 0.20, syb >= 0.3 && < 0.8, @@ -83,7 +83,7 @@ Executable stylish-haskell directory >= 1.2.3 && < 1.4, filepath >= 1.1 && < 1.5, file-embed >= 0.0.10 && < 0.1, - haskell-src-exts >= 1.18 && < 1.23, + haskell-src-exts >= 1.18 && < 1.24, mtl >= 2.0 && < 2.3, syb >= 0.3 && < 0.8, yaml >= 0.8.11 && < 0.12 @@ -137,7 +137,7 @@ Test-suite stylish-haskell-tests directory >= 1.2.3 && < 1.4, filepath >= 1.1 && < 1.5, file-embed >= 0.0.10 && < 0.1, - haskell-src-exts >= 1.18 && < 1.23, + haskell-src-exts >= 1.18 && < 1.24, mtl >= 2.0 && < 2.3, syb >= 0.3 && < 0.8, yaml >= 0.8.11 && < 0.12 -- cgit v1.2.3 From 1a869950eba47e30ebe84e118f404ef9a62e9cc6 Mon Sep 17 00:00:00 2001 From: Chris Martin Date: Sat, 18 Jan 2020 08:49:58 -0700 Subject: Allow setting "columns: null" to disable all wrapping --- data/stylish-haskell.yaml | 6 +- lib/Language/Haskell/Stylish.hs | 6 +- lib/Language/Haskell/Stylish/Align.hs | 13 +++- lib/Language/Haskell/Stylish/Config.hs | 6 +- lib/Language/Haskell/Stylish/Step/Imports.hs | 27 ++++--- .../Haskell/Stylish/Step/LanguagePragmas.hs | 16 ++-- lib/Language/Haskell/Stylish/Step/SimpleAlign.hs | 2 +- lib/Language/Haskell/Stylish/Util.hs | 46 +++++++++++ tests/Language/Haskell/Stylish/Config/Tests.hs | 89 +++++++++++++++++++--- .../Language/Haskell/Stylish/Step/Imports/Tests.hs | 89 +++++++++++++--------- .../Haskell/Stylish/Step/LanguagePragmas/Tests.hs | 39 +++++++--- .../Haskell/Stylish/Step/SimpleAlign/Tests.hs | 37 +++++++-- 12 files changed, 282 insertions(+), 94 deletions(-) diff --git a/data/stylish-haskell.yaml b/data/stylish-haskell.yaml index 5200299..2a17cb5 100644 --- a/data/stylish-haskell.yaml +++ b/data/stylish-haskell.yaml @@ -223,7 +223,11 @@ steps: # - squash: {} # A common setting is the number of columns (parts of) code will be wrapped -# to. Different steps take this into account. Default: 80. +# to. Different steps take this into account. +# +# Set this to null to disable all line wrapping. +# +# Default: 80. columns: 80 # By default, line endings are converted according to the OS. You can override diff --git a/lib/Language/Haskell/Stylish.hs b/lib/Language/Haskell/Stylish.hs index 7d7fb98..a40a7d2 100644 --- a/lib/Language/Haskell/Stylish.hs +++ b/lib/Language/Haskell/Stylish.hs @@ -40,21 +40,21 @@ import Paths_stylish_haskell (version) -------------------------------------------------------------------------------- -simpleAlign :: Int -- ^ Columns +simpleAlign :: Maybe Int -- ^ Columns -> SimpleAlign.Config -> Step simpleAlign = SimpleAlign.step -------------------------------------------------------------------------------- -imports :: Int -- ^ columns +imports :: Maybe Int -- ^ columns -> Imports.Options -> Step imports = Imports.step -------------------------------------------------------------------------------- -languagePragmas :: Int -- ^ columns +languagePragmas :: Maybe Int -- ^ columns -> LanguagePragmas.Style -> Bool -- ^ Pad to same length in vertical mode? -> Bool -- ^ remove redundant? diff --git a/lib/Language/Haskell/Stylish/Align.hs b/lib/Language/Haskell/Stylish/Align.hs index 53549b9..1f28d7a 100644 --- a/lib/Language/Haskell/Stylish/Align.hs +++ b/lib/Language/Haskell/Stylish/Align.hs @@ -55,16 +55,21 @@ data Alignable a = Alignable -------------------------------------------------------------------------------- -- | Create changes that perform the alignment. align - :: Int -- ^ Max columns + :: Maybe Int -- ^ Max columns -> [Alignable H.SrcSpan] -- ^ Alignables -> [Change String] -- ^ Changes performing the alignment. align _ [] = [] align maxColumns alignment -- Do not make any change if we would go past the maximum number of columns. - | longestLeft + longestRight > maxColumns = [] - | not (fixable alignment) = [] - | otherwise = map align' alignment + | exceedsColumns (longestLeft + longestRight) = [] + | not (fixable alignment) = [] + | otherwise = map align' alignment where + exceedsColumns i = case maxColumns of + Nothing -> False -- No number exceeds a maximum column count of + -- Nothing, because there is no limit to exceed. + Just c -> i > c + -- The longest thing in the left column. longestLeft = maximum $ map (H.srcSpanEndColumn . aLeft) alignment diff --git a/lib/Language/Haskell/Stylish/Config.hs b/lib/Language/Haskell/Stylish/Config.hs index e4adaf5..725a465 100644 --- a/lib/Language/Haskell/Stylish/Config.hs +++ b/lib/Language/Haskell/Stylish/Config.hs @@ -52,7 +52,7 @@ type Extensions = [String] -------------------------------------------------------------------------------- data Config = Config { configSteps :: [Step] - , configColumns :: Int + , configColumns :: Maybe Int , configLanguageExtensions :: [String] , configNewline :: IO.Newline , configCabal :: Bool @@ -119,7 +119,7 @@ parseConfig (A.Object o) = do -- First load the config without the actual steps config <- Config <$> pure [] - <*> (o A..:? "columns" A..!= 80) + <*> (o A..:! "columns" A..!= Just 80) <*> (o A..:? "language_extensions" A..!= []) <*> (o A..:? "newline" >>= parseEnum newlines IO.nativeNewline) <*> (o A..:? "cabal" A..!= True) @@ -253,7 +253,7 @@ mkLanguage :: A.Object -> A.Parser String mkLanguage o = do lang <- o A..:? "language_prefix" maybe (pure "LANGUAGE") validate lang - where + where validate :: String -> A.Parser String validate s | fmap toLower s == "language" = pure s diff --git a/lib/Language/Haskell/Stylish/Step/Imports.hs b/lib/Language/Haskell/Stylish/Step/Imports.hs index 4ceb802..7cb78d4 100644 --- a/lib/Language/Haskell/Stylish/Step/Imports.hs +++ b/lib/Language/Haskell/Stylish/Step/Imports.hs @@ -258,7 +258,7 @@ prettyImportSpec separate = prettyImportSpec' -------------------------------------------------------------------------------- prettyImport :: (Ord l, Show l) => - Int -> Options -> Bool -> Bool -> Int -> H.ImportDecl l -> [String] + Maybe Int -> Options -> Bool -> Bool -> Int -> H.ImportDecl l -> [String] prettyImport columns Options{..} padQualified padName longest imp | (void `fmap` H.importSpecs imp) == emptyImportSpec = emptyWrap | otherwise = case longListAlign of @@ -277,7 +277,7 @@ prettyImport columns Options{..} padQualified padName longest imp longListWrapper shortWrap longWrap | listAlign == NewLine || length shortWrap > 1 - || length (head shortWrap) > columns + || exceedsColumns (length (head shortWrap)) = longWrap | otherwise = shortWrap @@ -292,14 +292,14 @@ prettyImport columns Options{..} padQualified padName longest imp . withLast (++ (maybeSpace ++ ")")) inlineWrapper = case listAlign of - NewLine -> (paddedNoSpecBase :) . wrapRest columns listPadding' - WithModuleName -> wrap columns paddedBase (withModuleNameBaseLength + 4) - WithAlias -> wrap columns paddedBase (inlineBaseLength + 1) + NewLine -> (paddedNoSpecBase :) . wrapRestMaybe columns listPadding' + WithModuleName -> wrapMaybe columns paddedBase (withModuleNameBaseLength + 4) + WithAlias -> wrapMaybe columns paddedBase (inlineBaseLength + 1) -- Add 1 extra space to ensure same padding as in original code. AfterAlias -> withTail ((' ' : maybeSpace) ++) - . wrap columns paddedBase (afterAliasBaseLength + 1) + . wrapMaybe columns paddedBase (afterAliasBaseLength + 1) - inlineWithBreakWrap = paddedNoSpecBase : wrapRest columns listPadding' + inlineWithBreakWrap = paddedNoSpecBase : wrapRestMaybe columns listPadding' ( mapSpecs $ withInit (++ ",") . withHead (("(" ++ maybeSpace) ++) @@ -307,7 +307,7 @@ prettyImport columns Options{..} padQualified padName longest imp inlineToMultilineWrap | length inlineWithBreakWrap > 2 - || any ((> columns) . length) (tail inlineWithBreakWrap) + || any (exceedsColumns . length) (tail inlineWithBreakWrap) = multilineWrap | otherwise = inlineWithBreakWrap @@ -389,9 +389,14 @@ prettyImport columns Options{..} padQualified padName longest imp True -> " " False -> "" + exceedsColumns i = case columns of + Nothing -> False -- No number exceeds a maximum column count of + -- Nothing, because there is no limit to exceed. + Just c -> i > c + -------------------------------------------------------------------------------- -prettyImportGroup :: Int -> Options -> Bool -> Int +prettyImportGroup :: Maybe Int -> Options -> Bool -> Int -> [H.ImportDecl LineBlock] -> Lines prettyImportGroup columns align fileAlign longest imps = @@ -415,12 +420,12 @@ prettyImportGroup columns align fileAlign longest imps = -------------------------------------------------------------------------------- -step :: Int -> Options -> Step +step :: Maybe Int -> Options -> Step step columns = makeStep "Imports" . step' columns -------------------------------------------------------------------------------- -step' :: Int -> Options -> Lines -> Module -> Lines +step' :: Maybe Int -> Options -> Lines -> Module -> Lines step' columns align ls (module', _) = applyChanges [ change block $ const $ prettyImportGroup columns align fileAlign longest importGroup diff --git a/lib/Language/Haskell/Stylish/Step/LanguagePragmas.hs b/lib/Language/Haskell/Stylish/Step/LanguagePragmas.hs index 34d05dc..c9d461f 100644 --- a/lib/Language/Haskell/Stylish/Step/LanguagePragmas.hs +++ b/lib/Language/Haskell/Stylish/Step/LanguagePragmas.hs @@ -53,23 +53,23 @@ verticalPragmas lg longest align pragmas' = -------------------------------------------------------------------------------- -compactPragmas :: String -> Int -> [String] -> Lines -compactPragmas lg columns pragmas' = wrap columns ("{-# " ++ lg) 13 $ +compactPragmas :: String -> Maybe Int -> [String] -> Lines +compactPragmas lg columns pragmas' = wrapMaybe columns ("{-# " ++ lg) 13 $ map (++ ",") (init pragmas') ++ [last pragmas' ++ " #-}"] -------------------------------------------------------------------------------- -compactLinePragmas :: String -> Int -> Bool -> [String] -> Lines +compactLinePragmas :: String -> Maybe Int -> Bool -> [String] -> Lines compactLinePragmas _ _ _ [] = [] compactLinePragmas lg columns align pragmas' = map (wrapLanguage . pad) prags where wrapLanguage ps = "{-# " ++ lg ++ ps ++ " #-}" - maxWidth = columns - 16 + maxWidth = fmap (\c -> c - 16) columns longest = maximum $ map length prags pad | align = padRight longest | otherwise = id - prags = map truncateComma $ wrap maxWidth "" 1 $ + prags = map truncateComma $ wrapMaybe maxWidth "" 1 $ map (++ ",") (init pragmas') ++ [last pragmas'] @@ -82,7 +82,7 @@ truncateComma xs -------------------------------------------------------------------------------- -prettyPragmas :: String -> Int -> Int -> Bool -> Style -> [String] -> Lines +prettyPragmas :: String -> Maybe Int -> Int -> Bool -> Style -> [String] -> Lines prettyPragmas lp _ longest align Vertical = verticalPragmas lp longest align prettyPragmas lp cols _ _ Compact = compactPragmas lp cols prettyPragmas lp cols _ align CompactLine = compactLinePragmas lp cols align @@ -105,12 +105,12 @@ filterRedundant isRedundant' = snd . foldr filterRedundant' (S.empty, []) known' = xs' `S.union` known -------------------------------------------------------------------------------- -step :: Int -> Style -> Bool -> Bool -> String -> Step +step :: Maybe Int -> Style -> Bool -> Bool -> String -> Step step = ((((makeStep "LanguagePragmas" .) .) .) .) . step' -------------------------------------------------------------------------------- -step' :: Int -> Style -> Bool -> Bool -> String -> Lines -> Module -> Lines +step' :: Maybe Int -> Style -> Bool -> Bool -> String -> Lines -> Module -> Lines step' columns style align removeRedundant lngPrefix ls (module', _) | null pragmas' = ls | otherwise = applyChanges changes ls diff --git a/lib/Language/Haskell/Stylish/Step/SimpleAlign.hs b/lib/Language/Haskell/Stylish/Step/SimpleAlign.hs index 924d6c5..5e61123 100644 --- a/lib/Language/Haskell/Stylish/Step/SimpleAlign.hs +++ b/lib/Language/Haskell/Stylish/Step/SimpleAlign.hs @@ -108,7 +108,7 @@ fieldDeclToAlignable (H.FieldDecl ann names ty) = Just $ Alignable -------------------------------------------------------------------------------- -step :: Int -> Config -> Step +step :: Maybe Int -> Config -> Step step maxColumns config = makeStep "Cases" $ \ls (module', _) -> let module'' = fmap H.srcInfoSpan module' changes search toAlign = diff --git a/lib/Language/Haskell/Stylish/Util.hs b/lib/Language/Haskell/Stylish/Util.hs index c634043..9883f4b 100644 --- a/lib/Language/Haskell/Stylish/Util.hs +++ b/lib/Language/Haskell/Stylish/Util.hs @@ -10,6 +10,8 @@ module Language.Haskell.Stylish.Util , trimRight , wrap , wrapRest + , wrapMaybe + , wrapRestMaybe , withHead , withInit @@ -98,6 +100,27 @@ wrap maxWidth leading ind = wrap' leading ((length ss + length str) >= maxWidth && ind + length str <= maxWidth) +-------------------------------------------------------------------------------- +wrapMaybe :: Maybe Int -- ^ Maximum line width (maybe) + -> String -- ^ Leading string + -> Int -- ^ Indentation + -> [String] -- ^ Strings to add/wrap + -> Lines -- ^ Resulting lines +wrapMaybe (Just maxWidth) = wrap maxWidth +wrapMaybe Nothing = noWrap + + +-------------------------------------------------------------------------------- +noWrap :: String -- ^ Leading string + -> Int -- ^ Indentation + -> [String] -- ^ Strings to add + -> Lines -- ^ Resulting lines +noWrap leading _ind = noWrap' leading + where + noWrap' ss [] = [ss] + noWrap' ss (str:strs) = noWrap' (ss ++ " " ++ str) strs + + -------------------------------------------------------------------------------- wrapRest :: Int -> Int @@ -116,6 +139,29 @@ wrapRest maxWidth ind = reverse . wrapRest' [] "" overflows ss str = (length ss + length str + 1) >= maxWidth +-------------------------------------------------------------------------------- +wrapRestMaybe :: Maybe Int + -> Int + -> [String] + -> Lines +wrapRestMaybe (Just maxWidth) = wrapRest maxWidth +wrapRestMaybe Nothing = noWrapRest + + +-------------------------------------------------------------------------------- +noWrapRest :: Int + -> [String] + -> Lines +noWrapRest ind = reverse . noWrapRest' [] "" + where + noWrapRest' ls ss [] + | null ss = ls + | otherwise = ss:ls + noWrapRest' ls ss (str:strs) + | null ss = noWrapRest' ls (indent ind str) strs + | otherwise = noWrapRest' ls (ss ++ " " ++ str) strs + + -------------------------------------------------------------------------------- withHead :: (a -> a) -> [a] -> [a] withHead _ [] = [] diff --git a/tests/Language/Haskell/Stylish/Config/Tests.hs b/tests/Language/Haskell/Stylish/Config/Tests.hs index f62b571..ebaef54 100644 --- a/tests/Language/Haskell/Stylish/Config/Tests.hs +++ b/tests/Language/Haskell/Stylish/Config/Tests.hs @@ -25,6 +25,12 @@ 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 ] -------------------------------------------------------------------------------- @@ -55,8 +61,8 @@ withTestDirTree action = bracket -- | 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 +70,58 @@ 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 @@ -140,3 +170,42 @@ dotStylish = unlines $ , " - 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/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 7afbdfc..0ede803 100644 --- a/tests/Language/Haskell/Stylish/Step/LanguagePragmas/Tests.hs +++ b/tests/Language/Haskell/Stylish/Step/LanguagePragmas/Tests.hs @@ -29,6 +29,7 @@ tests = testGroup "Language.Haskell.Stylish.Step.LanguagePragmas.Tests" , testCase "case 09" case09 , testCase "case 10" case10 , testCase "case 11" case11 + , testCase "case 12" case12 ] lANG :: String @@ -36,7 +37,7 @@ lANG = "LANGUAGE" -------------------------------------------------------------------------------- case01 :: Assertion -case01 = expected @=? testStep (step 80 Vertical True False lANG) input +case01 = expected @=? testStep (step (Just 80) Vertical True False lANG) input where input = unlines [ "{-# LANGUAGE ViewPatterns #-}" @@ -55,7 +56,7 @@ case01 = expected @=? testStep (step 80 Vertical True False lANG) input -------------------------------------------------------------------------------- case02 :: Assertion -case02 = expected @=? testStep (step 80 Vertical True True lANG) input +case02 = expected @=? testStep (step (Just 80) Vertical True True lANG) input where input = unlines [ "{-# LANGUAGE BangPatterns #-}" @@ -71,7 +72,7 @@ case02 = expected @=? testStep (step 80 Vertical True True lANG) input -------------------------------------------------------------------------------- case03 :: Assertion -case03 = expected @=? testStep (step 80 Vertical True True lANG) input +case03 = expected @=? testStep (step (Just 80) Vertical True True lANG) input where input = unlines [ "{-# LANGUAGE BangPatterns #-}" @@ -87,7 +88,7 @@ case03 = expected @=? testStep (step 80 Vertical True True lANG) input -------------------------------------------------------------------------------- case04 :: Assertion -case04 = expected @=? testStep (step 80 Compact True False lANG) input +case04 = expected @=? testStep (step (Just 80) Compact True False lANG) input where input = unlines [ "{-# LANGUAGE TypeOperators, StandaloneDeriving, DeriveDataTypeable," @@ -104,7 +105,7 @@ case04 = expected @=? testStep (step 80 Compact True False lANG) input -------------------------------------------------------------------------------- case05 :: Assertion -case05 = expected @=? testStep (step 80 Vertical True False lANG) input +case05 = expected @=? testStep (step (Just 80) Vertical True False lANG) input where input = unlines [ "{-# LANGUAGE CPP #-}" @@ -125,7 +126,7 @@ case05 = expected @=? testStep (step 80 Vertical True False lANG) input -------------------------------------------------------------------------------- case06 :: Assertion -case06 = expected @=? testStep (step 80 CompactLine True False lANG) input +case06 = expected @=? testStep (step (Just 80) CompactLine True False lANG) input where input = unlines [ "{-# LANGUAGE TypeOperators, StandaloneDeriving, DeriveDataTypeable," @@ -140,7 +141,7 @@ case06 = expected @=? testStep (step 80 CompactLine True False lANG) input -------------------------------------------------------------------------------- case07 :: Assertion -case07 = expected @=? testStep (step 80 Vertical False False lANG) input +case07 = expected @=? testStep (step (Just 80) Vertical False False lANG) input where input = unlines [ "{-# LANGUAGE ViewPatterns #-}" @@ -160,7 +161,7 @@ case07 = expected @=? testStep (step 80 Vertical False False lANG) input -------------------------------------------------------------------------------- case08 :: Assertion -case08 = expected @=? testStep (step 80 CompactLine False False lANG) input +case08 = expected @=? testStep (step (Just 80) CompactLine False False lANG) input where input = unlines [ "{-# LANGUAGE TypeOperators, StandaloneDeriving, DeriveDataTypeable," @@ -176,7 +177,7 @@ case08 = expected @=? testStep (step 80 CompactLine False False lANG) input -------------------------------------------------------------------------------- case09 :: Assertion -case09 = expected @=? testStep (step 80 Compact True False lANG) input +case09 = expected @=? testStep (step (Just 80) Compact True False lANG) input where input = unlines [ "{-# LANGUAGE DefaultSignatures, FlexibleInstances, LambdaCase, " ++ @@ -190,7 +191,7 @@ case09 = expected @=? testStep (step 80 Compact True False lANG) input -------------------------------------------------------------------------------- case10 :: Assertion -case10 = expected @=? testStep (step 80 Compact True False lANG) input +case10 = expected @=? testStep (step (Just 80) Compact True False lANG) input where input = unlines [ "{-# LANGUAGE NondecreasingIndentation, ScopedTypeVariables," @@ -203,7 +204,7 @@ case10 = expected @=? testStep (step 80 Compact True False lANG) input -------------------------------------------------------------------------------- case11 :: Assertion -case11 = expected @=? testStep (step 80 Vertical False False "language") input +case11 = expected @=? testStep (step (Just 80) Vertical False False "language") input where input = unlines [ "{-# LANGUAGE ViewPatterns #-}" @@ -219,3 +220,19 @@ case11 = expected @=? testStep (step 80 Vertical False False "language") input , "{-# 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" + , " }" + ] -- cgit v1.2.3 From 8065c3c074719bd13db67b5ec74db560609a4e64 Mon Sep 17 00:00:00 2001 From: Łukasz Gołębiewski Date: Thu, 23 Jan 2020 17:43:04 +0100 Subject: Support for records formatting (#256) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * Initial test describing simplest scenario for Data step Co-authored-by: Łukasz Gołębiewski * [sanity-check] Delete data defs * Extract changeDecl Co-authored-by: Łukasz Gołębiewski * First green test :-) * Cover case where there are more then one field in data type declaration Co-authored-by: Łukasz Gołębiewski * Add case03 where a type variable is present * Add case04 - multiple declarations * Make case04 pass * Extend tests with case05 Co-authored-by: Łukasz Gołębiewski * Add pending case06 Co-authored-by: Łukasz Gołębiewski * Fix case 06 Co-authored-by: Łukasz Gołębiewski * Add case07 Co-authored-by: Łukasz Gołębiewski * Add second phantom case * Add records to config * Make indent size configurable for records Co-authored-by: Paweł Szulc * Fix warnings in Data.hs * Process derivings during record formatting Co-authored-by: Paweł Szulc * Do not format when context is present Co-authored-by: Paweł Szulc * Add case 11 - deriving with DerivingStrategies * Bugfix: do not remove empty data declarations Co-authored-by: Paweł Szulc * Update README example with ability to format records * Add case12 (Point) * Fix case 12 * Factor out processName * Apply hlint suggestions * Extract constructors helper function * Make 'indent' global * Remove unused Stylish.records method * Fix Config formatting in Config.hs * Extract processConstructor function Co-authored-by: Łukasz Gołębiewski * Refactor datas function Co-authored-by: Łukasz Gołębiewski * Include comments with AST. Two tests are still failing... * Fix cases 15 and 16 * Do not format records when comments within Co-authored-by: Łukasz Gołębiewski * Clean-up Data.hs * Refactor Data.hs Co-authored-by: Pawel Szulc --- README.markdown | 5 +- data/stylish-haskell.yaml | 6 + lib/Language/Haskell/Stylish/Config.hs | 9 + lib/Language/Haskell/Stylish/Step/Data.hs | 66 ++++ stylish-haskell.cabal | 3 + tests/Language/Haskell/Stylish/Config/Tests.hs | 2 + tests/Language/Haskell/Stylish/Step/Data/Tests.hs | 368 ++++++++++++++++++++++ tests/TestSuite.hs | 2 + 8 files changed, 457 insertions(+), 4 deletions(-) create mode 100644 lib/Language/Haskell/Stylish/Step/Data.hs create mode 100644 tests/Language/Haskell/Stylish/Step/Data/Tests.hs diff --git a/README.markdown b/README.markdown index 870a40c..54451cc 100644 --- a/README.markdown +++ b/README.markdown @@ -56,10 +56,7 @@ import System.Directory (doesFileExist) import qualified Data.Map as M import Data.Map ((!), keys, Map) -data Point = Point - { pointX, pointY :: Double - , pointName :: String - } deriving (Show) +data Point = Point { pointX, pointY :: Double , pointName :: String} deriving (Show) ``` into: diff --git a/data/stylish-haskell.yaml b/data/stylish-haskell.yaml index 2a17cb5..209d613 100644 --- a/data/stylish-haskell.yaml +++ b/data/stylish-haskell.yaml @@ -15,6 +15,9 @@ steps: # # true. # add_language_pragma: true + # Format record definitions + - records: {} + # Align the right hand side of some elements. This is quite conservative # and only applies to statements where each element occupies a single # line. All default to true. @@ -222,6 +225,9 @@ steps: # simple_align but is a bit less conservative. # - squash: {} +# A common indentation setting. Different steps take this into account. +indent: 4 + # A common setting is the number of columns (parts of) code will be wrapped # to. Different steps take this into account. # diff --git a/lib/Language/Haskell/Stylish/Config.hs b/lib/Language/Haskell/Stylish/Config.hs index 725a465..bd15867 100644 --- a/lib/Language/Haskell/Stylish/Config.hs +++ b/lib/Language/Haskell/Stylish/Config.hs @@ -35,6 +35,7 @@ import qualified System.IO as IO (Newline 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.Data as Data import qualified Language.Haskell.Stylish.Step.Imports as Imports import qualified Language.Haskell.Stylish.Step.LanguagePragmas as LanguagePragmas import qualified Language.Haskell.Stylish.Step.SimpleAlign as SimpleAlign @@ -52,6 +53,7 @@ type Extensions = [String] -------------------------------------------------------------------------------- data Config = Config { configSteps :: [Step] + , configIndent :: Int , configColumns :: Maybe Int , configLanguageExtensions :: [String] , configNewline :: IO.Newline @@ -119,6 +121,7 @@ parseConfig (A.Object o) = do -- First load the config without the actual steps config <- Config <$> pure [] + <*> (o A..:? "indent" A..!= 4) <*> (o A..:! "columns" A..!= Just 80) <*> (o A..:? "language_extensions" A..!= []) <*> (o A..:? "newline" >>= parseEnum newlines IO.nativeNewline) @@ -141,6 +144,7 @@ parseConfig _ = mzero catalog :: Map String (Config -> A.Object -> A.Parser Step) catalog = M.fromList [ ("imports", parseImports) + , ("records", parseRecords) , ("language_pragmas", parseLanguagePragmas) , ("simple_align", parseSimpleAlign) , ("squash", parseSquash) @@ -180,6 +184,11 @@ parseSimpleAlign c o = SimpleAlign.step where withDef f k = fromMaybe (f SimpleAlign.defaultConfig) <$> (o A..:? k) +-------------------------------------------------------------------------------- +parseRecords :: Config -> A.Object -> A.Parser Step +parseRecords c _ = Data.step + <$> pure (configIndent c) + -------------------------------------------------------------------------------- parseSquash :: Config -> A.Object -> A.Parser Step diff --git a/lib/Language/Haskell/Stylish/Step/Data.hs b/lib/Language/Haskell/Stylish/Step/Data.hs new file mode 100644 index 0000000..9acd22b --- /dev/null +++ b/lib/Language/Haskell/Stylish/Step/Data.hs @@ -0,0 +1,66 @@ +module Language.Haskell.Stylish.Step.Data where + +import Data.List (find, intercalate) +import Data.Maybe (maybeToList) +import qualified Language.Haskell.Exts as H +import Language.Haskell.Exts.Comments +import Language.Haskell.Stylish.Block +import Language.Haskell.Stylish.Editor +import Language.Haskell.Stylish.Step +import Language.Haskell.Stylish.Util +import Prelude hiding (init) + +datas :: H.Module l -> [H.Decl l] +datas (H.Module _ _ _ _ decls) = decls +datas _ = [] + +type ChangeLine = Change String + +step :: Int -> Step +step indentSize = makeStep "Data" (step' indentSize) + +step' :: Int -> Lines -> Module -> Lines +step' indentSize ls (module', allComments) = applyChanges changes ls + where + datas' = datas $ fmap linesFromSrcSpan module' + changes = datas' >>= maybeToList . changeDecl allComments indentSize + +findComment :: LineBlock -> [Comment] -> Maybe Comment +findComment lb = find commentOnLine + where + commentOnLine (Comment _ (H.SrcSpan _ start _ end _) _) = + blockStart lb == start && blockEnd lb == end + +commentsWithin :: LineBlock -> [Comment] -> [Comment] +commentsWithin lb = filter within + where + within (Comment _ (H.SrcSpan _ start _ end _) _) = + start >= blockStart lb && end <= blockEnd lb + +changeDecl :: [Comment] -> Int -> H.Decl LineBlock -> Maybe ChangeLine +changeDecl _ _ (H.DataDecl _ (H.DataType _) Nothing _ [] _) = Nothing +changeDecl allComments indentSize (H.DataDecl block (H.DataType _) Nothing dhead decls derivings) + | null $ commentsWithin block allComments = Just $ change block (const $ concat newLines) + | otherwise = Nothing + where + newLines = fmap constructors zipped ++ [fmap (indented . H.prettyPrint) derivings] + zipped = zip decls ([1..] ::[Int]) + constructors (decl, 1) = processConstructor allComments typeConstructor indentSize decl + constructors (decl, _) = processConstructor allComments (indented "| ") indentSize decl + typeConstructor = "data " <> H.prettyPrint dhead <> " = " + indented = indent indentSize +changeDecl _ _ _ = Nothing + +processConstructor :: [Comment] -> String -> Int -> H.QualConDecl LineBlock -> [String] +processConstructor allComments init indentSize (H.QualConDecl _ _ _ (H.RecDecl _ dname fields)) = do + init <> H.prettyPrint dname : n1 : ns ++ [indented "}"] + where + n1 = processName "{ " ( extractField $ head fields) + ns = fmap (processName ", " . extractField) (tail fields) + processName prefix (fnames, _type, Nothing) = + indented prefix <> intercalate ", " (fmap H.prettyPrint fnames) <> " :: " <> H.prettyPrint _type + processName prefix (fnames, _type, (Just (Comment _ _ c))) = + indented prefix <> intercalate ", " (fmap H.prettyPrint fnames) <> " :: " <> H.prettyPrint _type <> " --" <> c + extractField (H.FieldDecl lb names _type) = (names, _type, findComment lb allComments) + indented = indent indentSize +processConstructor _ init _ decl = [init <> trimLeft (H.prettyPrint decl)] diff --git a/stylish-haskell.cabal b/stylish-haskell.cabal index 116d889..de12c11 100644 --- a/stylish-haskell.cabal +++ b/stylish-haskell.cabal @@ -29,6 +29,7 @@ Library Exposed-modules: Language.Haskell.Stylish + Language.Haskell.Stylish.Step.Data Language.Haskell.Stylish.Step.Imports Language.Haskell.Stylish.Step.LanguagePragmas Language.Haskell.Stylish.Step.SimpleAlign @@ -107,6 +108,8 @@ Test-suite stylish-haskell-tests Language.Haskell.Stylish.Step Language.Haskell.Stylish.Step.Imports Language.Haskell.Stylish.Step.Imports.Tests + Language.Haskell.Stylish.Step.Data + Language.Haskell.Stylish.Step.Data.Tests Language.Haskell.Stylish.Step.LanguagePragmas Language.Haskell.Stylish.Step.LanguagePragmas.Tests Language.Haskell.Stylish.Step.SimpleAlign diff --git a/tests/Language/Haskell/Stylish/Config/Tests.hs b/tests/Language/Haskell/Stylish/Config/Tests.hs index ebaef54..f8869ce 100644 --- a/tests/Language/Haskell/Stylish/Config/Tests.hs +++ b/tests/Language/Haskell/Stylish/Config/Tests.hs @@ -165,6 +165,8 @@ dotStylish = unlines $ , " align: false" , " remove_redundant: true" , " - trailing_whitespace: {}" + , " - records: {}" + , "indent: 2" , "columns: 110" , "language_extensions:" , " - TemplateHaskell" 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..b152819 --- /dev/null +++ b/tests/Language/Haskell/Stylish/Step/Data/Tests.hs @@ -0,0 +1,368 @@ +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 + ] + +case00 :: Assertion +case00 = expected @=? testStep (step 2) input + where + input = unlines + [ "module Herp where" + , "" + , "data Foo" + ] + + expected = input + +case01 :: Assertion +case01 = expected @=? testStep (step 2) 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 2) 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 2) 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 2) 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 2) 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 2) input + where + input = unlines + [ "module Herp where" + , "" + , "data Foo = Foo Int String" + ] + expected = input + +case07 :: Assertion +case07 = expected @=? testStep (step 2) input + where + input = unlines + [ "module Herp where" + , "" + , "data Phantom a = Phantom" + ] + expected = input + +case08 :: Assertion +case08 = expected @=? testStep (step 2) input + where + input = unlines + [ "module Herp where" + , "" + , "data Phantom a =" + , " Phantom" + ] + expected = unlines + [ "module Herp where" + , "" + , "data Phantom a = Phantom" + ] + +case09 :: Assertion +case09 = expected @=? testStep (step 4) 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 2) 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 2) 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 4) 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 2) 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 2) 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 2) input + where + input = unlines + [ "module Herp where" + , "" + , "data Foo = Foo {" + , " a :: Int -- ^ comment" + , " }" + ] + expected = unlines + [ "module Herp where" + , "" + , "data Foo = Foo {" + , " a :: Int -- ^ comment" + , " }" + ] + +case16 :: Assertion +case16 = expected @=? testStep (step 2) 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" + , " }" + ] + +case17 :: Assertion +case17 = expected @=? testStep (step 2) 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 2) 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" + , " }" + ] diff --git a/tests/TestSuite.hs b/tests/TestSuite.hs index b5bec90..a6f51ea 100644 --- a/tests/TestSuite.hs +++ b/tests/TestSuite.hs @@ -11,6 +11,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.Data.Tests import qualified Language.Haskell.Stylish.Step.Imports.Tests import qualified Language.Haskell.Stylish.Step.LanguagePragmas.Tests import qualified Language.Haskell.Stylish.Step.SimpleAlign.Tests @@ -25,6 +26,7 @@ main :: IO () main = defaultMain [ Language.Haskell.Stylish.Parse.Tests.tests , Language.Haskell.Stylish.Config.Tests.tests + , Language.Haskell.Stylish.Step.Data.Tests.tests , Language.Haskell.Stylish.Step.Imports.Tests.tests , Language.Haskell.Stylish.Step.LanguagePragmas.Tests.tests , Language.Haskell.Stylish.Step.SimpleAlign.Tests.tests -- cgit v1.2.3 From 5eb4902883d9d3937641d6a2c6249993242bf098 Mon Sep 17 00:00:00 2001 From: Pawel Szulc Date: Fri, 24 Jan 2020 21:30:55 +0100 Subject: Fix records with comments (#257) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * Format records where comments are in the same line as the field name * Fix records format, records with comments will now be formatted * Fix formatting of comments below Co-authored-by: Łukasz Gołębiewski --- lib/Language/Haskell/Stylish/Step/Data.hs | 32 ++++++----- tests/Language/Haskell/Stylish/Step/Data/Tests.hs | 65 +++++++++++++++-------- 2 files changed, 64 insertions(+), 33 deletions(-) diff --git a/lib/Language/Haskell/Stylish/Step/Data.hs b/lib/Language/Haskell/Stylish/Step/Data.hs index 9acd22b..94aaf22 100644 --- a/lib/Language/Haskell/Stylish/Step/Data.hs +++ b/lib/Language/Haskell/Stylish/Step/Data.hs @@ -25,12 +25,18 @@ step' indentSize ls (module', allComments) = applyChanges changes ls datas' = datas $ fmap linesFromSrcSpan module' changes = datas' >>= maybeToList . changeDecl allComments indentSize -findComment :: LineBlock -> [Comment] -> Maybe Comment -findComment lb = find commentOnLine +findCommentOnLine :: LineBlock -> [Comment] -> Maybe Comment +findCommentOnLine lb = find commentOnLine where commentOnLine (Comment _ (H.SrcSpan _ start _ end _) _) = blockStart lb == start && blockEnd lb == end +findCommentBelowLine :: LineBlock -> [Comment] -> Maybe Comment +findCommentBelowLine lb = find commentOnLine + where + commentOnLine (Comment _ (H.SrcSpan _ start _ end _) _) = + blockStart lb == start - 1 && blockEnd lb == end - 1 + commentsWithin :: LineBlock -> [Comment] -> [Comment] commentsWithin lb = filter within where @@ -39,9 +45,8 @@ commentsWithin lb = filter within changeDecl :: [Comment] -> Int -> H.Decl LineBlock -> Maybe ChangeLine changeDecl _ _ (H.DataDecl _ (H.DataType _) Nothing _ [] _) = Nothing -changeDecl allComments indentSize (H.DataDecl block (H.DataType _) Nothing dhead decls derivings) - | null $ commentsWithin block allComments = Just $ change block (const $ concat newLines) - | otherwise = Nothing +changeDecl allComments indentSize (H.DataDecl block (H.DataType _) Nothing dhead decls derivings) = + Just $ change block (const $ concat newLines) where newLines = fmap constructors zipped ++ [fmap (indented . H.prettyPrint) derivings] zipped = zip decls ([1..] ::[Int]) @@ -53,14 +58,17 @@ changeDecl _ _ _ = Nothing processConstructor :: [Comment] -> String -> Int -> H.QualConDecl LineBlock -> [String] processConstructor allComments init indentSize (H.QualConDecl _ _ _ (H.RecDecl _ dname fields)) = do - init <> H.prettyPrint dname : n1 : ns ++ [indented "}"] + init <> H.prettyPrint dname : n1 ++ ns ++ [indented "}"] where n1 = processName "{ " ( extractField $ head fields) - ns = fmap (processName ", " . extractField) (tail fields) - processName prefix (fnames, _type, Nothing) = - indented prefix <> intercalate ", " (fmap H.prettyPrint fnames) <> " :: " <> H.prettyPrint _type - processName prefix (fnames, _type, (Just (Comment _ _ c))) = - indented prefix <> intercalate ", " (fmap H.prettyPrint fnames) <> " :: " <> H.prettyPrint _type <> " --" <> c - extractField (H.FieldDecl lb names _type) = (names, _type, findComment lb allComments) + ns = tail fields >>= (processName ", " . extractField) + processName prefix (fnames, _type, lineComment, commentBelowLine) = + [indented prefix <> intercalate ", " (fmap H.prettyPrint fnames) <> " :: " <> H.prettyPrint _type <> addLineComment lineComment] ++ addCommentBelow commentBelowLine + addLineComment (Just (Comment _ _ c)) = " --" <> c + addLineComment Nothing = "" + addCommentBelow Nothing = [] + addCommentBelow (Just (Comment _ _ c)) = [indented "--" <> c] + extractField (H.FieldDecl lb names _type) = + (names, _type, findCommentOnLine lb allComments, findCommentBelowLine lb allComments) indented = indent indentSize processConstructor _ init _ decl = [init <> trimLeft (H.prettyPrint decl)] diff --git a/tests/Language/Haskell/Stylish/Step/Data/Tests.hs b/tests/Language/Haskell/Stylish/Step/Data/Tests.hs index b152819..712ffae 100644 --- a/tests/Language/Haskell/Stylish/Step/Data/Tests.hs +++ b/tests/Language/Haskell/Stylish/Step/Data/Tests.hs @@ -29,6 +29,7 @@ tests = testGroup "Language.Haskell.Stylish.Step.Data.Tests" , testCase "case 16" case16 , testCase "case 17" case17 , testCase "case 18" case18 + , testCase "case 19" case19 ] case00 :: Assertion @@ -287,6 +288,26 @@ case14 = expected @=? testStep (step 2) input case15 :: Assertion case15 = expected @=? testStep (step 2) 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 2) input where input = unlines [ "module Herp where" @@ -298,20 +319,20 @@ case15 = expected @=? testStep (step 2) input expected = unlines [ "module Herp where" , "" - , "data Foo = Foo {" - , " a :: Int -- ^ comment" + , "data Foo = Foo" + , " { a :: Int -- ^ comment" , " }" ] -case16 :: Assertion -case16 = expected @=? testStep (step 2) input +case17 :: Assertion +case17 = expected @=? testStep (step 2) input where input = unlines [ "module Herp where" , "" , "data Foo a = Foo" , " { a :: a," - , "-- ^ comment" + , "-- comment" , " a2 :: String" , " }" ] @@ -319,20 +340,21 @@ case16 = expected @=? testStep (step 2) input [ "module Herp where" , "" , "data Foo a = Foo" - , " { a :: a," - , "-- ^ comment" - , " a2 :: String" + , " { a :: a" + , " -- comment" + , " , a2 :: String" , " }" ] -case17 :: Assertion -case17 = expected @=? testStep (step 2) input +case18 :: Assertion +case18 = expected @=? testStep (step 2) input where input = unlines [ "module Herp where" , "" , "data Foo a = Foo" - , " { a :: a, -- comment" + , " { a :: a," + , "-- ^ comment" , " a2 :: String" , " }" ] @@ -340,29 +362,30 @@ case17 = expected @=? testStep (step 2) input [ "module Herp where" , "" , "data Foo a = Foo" - , " { a :: a, -- comment" - , " a2 :: String" + , " { a :: a" + , " -- ^ comment" + , " , a2 :: String" , " }" ] -case18 :: Assertion -case18 = expected @=? testStep (step 2) input +case19 :: Assertion +case19 = expected @=? testStep (step 2) input where input = unlines [ "module Herp where" , "" , "data Foo a = Foo" - , " { a :: a," - , "-- comment " - , " a2 :: String" + , " { firstName, lastName :: String," + , "-- ^ names" + , " age :: Int" , " }" ] expected = unlines [ "module Herp where" , "" , "data Foo a = Foo" - , " { a :: a," - , "-- comment " - , " a2 :: String" + , " { firstName, lastName :: String" + , " -- ^ names" + , " , age :: Int" , " }" ] -- cgit v1.2.3 From b501e5c92dac8b89ff0c1f962a4be4ecbc261e97 Mon Sep 17 00:00:00 2001 From: Łukasz Gołębiewski Date: Sun, 26 Jan 2020 11:36:49 +0000 Subject: Expose "format" function in Sylish.hs (#259) * Expose "format" function in Sylish.hs It's going to be needed for the haskell-ide integration * Update tests/Language/Haskell/StylishSpec.hs Co-Authored-By: Jasper Van der Jeugt * Remove empty line Co-authored-by: Jasper Van der Jeugt --- lib/Language/Haskell/Stylish.hs | 12 +++++++++ stylish-haskell.cabal | 1 + testdata/test-config.yaml | 3 +++ tests/Language/Haskell/StylishSpec.hs | 51 +++++++++++++++++++++++++++++++++++ tests/TestSuite.hs | 4 ++- 5 files changed, 70 insertions(+), 1 deletion(-) create mode 100644 testdata/test-config.yaml create mode 100644 tests/Language/Haskell/StylishSpec.hs diff --git a/lib/Language/Haskell/Stylish.hs b/lib/Language/Haskell/Stylish.hs index a40a7d2..4f6aa1f 100644 --- a/lib/Language/Haskell/Stylish.hs +++ b/lib/Language/Haskell/Stylish.hs @@ -16,6 +16,8 @@ module Language.Haskell.Stylish -- * Misc , module Language.Haskell.Stylish.Verbose , version + , format + , ConfigPath(..) , Lines , Step ) where @@ -91,3 +93,13 @@ runStep exts mfp ls step = runSteps :: Extensions -> Maybe FilePath -> [Step] -> Lines -> Either String Lines runSteps exts mfp steps ls = foldM (runStep exts mfp) ls steps + +newtype ConfigPath = ConfigPath { unConfigPath :: FilePath } + +-- |Formats given contents optionally using the config provided as first param. +-- The second file path is the location from which the contents were read. +-- If provided, it's going to be printed out in the error message. +format :: Maybe ConfigPath -> Maybe FilePath -> String -> IO (Either String Lines) +format maybeConfigPath maybeFilePath contents = do + conf <- loadConfig (makeVerbose True) (fmap unConfigPath maybeConfigPath) + pure $ runSteps (configLanguageExtensions conf) maybeFilePath (configSteps conf) $ lines contents diff --git a/stylish-haskell.cabal b/stylish-haskell.cabal index de12c11..1f509a1 100644 --- a/stylish-haskell.cabal +++ b/stylish-haskell.cabal @@ -96,6 +96,7 @@ Test-suite stylish-haskell-tests Type: exitcode-stdio-1.0 Other-modules: + Language.Haskell.StylishSpec Language.Haskell.Stylish.Align Language.Haskell.Stylish.Block Language.Haskell.Stylish.Config diff --git a/testdata/test-config.yaml b/testdata/test-config.yaml new file mode 100644 index 0000000..b81fdc2 --- /dev/null +++ b/testdata/test-config.yaml @@ -0,0 +1,3 @@ +steps: + - records: {} +indent: 2 diff --git a/tests/Language/Haskell/StylishSpec.hs b/tests/Language/Haskell/StylishSpec.hs new file mode 100644 index 0000000..77a23b1 --- /dev/null +++ b/tests/Language/Haskell/StylishSpec.hs @@ -0,0 +1,51 @@ +module Language.Haskell.StylishSpec where + +-------------------------------------------------------------------------------- +import Test.Framework (Test, testGroup) +import Test.Framework.Providers.HUnit (testCase) +import Test.HUnit (Assertion, (@?=)) + +-------------------------------------------------------------------------------- +import Language.Haskell.Stylish + +-------------------------------------------------------------------------------- +import System.IO.Unsafe +-------------------------------------------------------------------------------- +tests :: Test +tests = testGroup "Language.Haskell.Stylish.Step.Tabs.Tests" + [ testCase "case 01" case01 + , testCase "case 02" case02 + , testCase "case 03" case03 + ] + +-------------------------------------------------------------------------------- +case01 :: Assertion +case01 = (@?=) result (unsafePerformIO $ format Nothing Nothing input) + where + input = "module Herp where\n data Foo = Bar | Baz" + result = Right [ "module Herp where" + , "data Foo = Bar" + , " | Baz" + ] + +case02 :: Assertion +case02 = (@?=) result (unsafePerformIO $ format (Just configLocation) Nothing input) + where + configLocation = ConfigPath "testdata/test-config.yaml" + input = "module Herp where\n data Foo = Bar | Baz" + result = Right [ "module Herp where" + , "data Foo = Bar" + , " | Baz" + ] + +case03 :: Assertion +case03 = do + actual <- format Nothing (Just fileLocation) input + actual @?= result + where + fileLocation = "directory/File.hs" + input = "module Herp" + result = Left $ + "Language.Haskell.Stylish.Parse.parseModule: could not parse " <> + fileLocation <> + ": ParseFailed (SrcLoc \".hs\" 2 1) \"Parse error: EOF\"" diff --git a/tests/TestSuite.hs b/tests/TestSuite.hs index a6f51ea..1138323 100644 --- a/tests/TestSuite.hs +++ b/tests/TestSuite.hs @@ -19,12 +19,14 @@ import qualified Language.Haskell.Stylish.Step.Squash.Tests import qualified Language.Haskell.Stylish.Step.Tabs.Tests import qualified Language.Haskell.Stylish.Step.TrailingWhitespace.Tests import qualified Language.Haskell.Stylish.Step.UnicodeSyntax.Tests +import qualified Language.Haskell.StylishSpec -------------------------------------------------------------------------------- main :: IO () main = defaultMain - [ Language.Haskell.Stylish.Parse.Tests.tests + [ Language.Haskell.StylishSpec.tests + , Language.Haskell.Stylish.Parse.Tests.tests , Language.Haskell.Stylish.Config.Tests.tests , Language.Haskell.Stylish.Step.Data.Tests.tests , Language.Haskell.Stylish.Step.Imports.Tests.tests -- cgit v1.2.3 From 7b39c565e5e9c7493c256504e5a0a8c436ee97d6 Mon Sep 17 00:00:00 2001 From: Łukasz Gołębiewski Date: Sun, 26 Jan 2020 12:09:16 +0000 Subject: Fixes cabal warning about missing module (#260) --- stylish-haskell.cabal | 1 + 1 file changed, 1 insertion(+) diff --git a/stylish-haskell.cabal b/stylish-haskell.cabal index 1f509a1..495e3b4 100644 --- a/stylish-haskell.cabal +++ b/stylish-haskell.cabal @@ -96,6 +96,7 @@ Test-suite stylish-haskell-tests Type: exitcode-stdio-1.0 Other-modules: + Language.Haskell.Stylish Language.Haskell.StylishSpec Language.Haskell.Stylish.Align Language.Haskell.Stylish.Block -- cgit v1.2.3 From bb91eb75602153a36927768ccd2f915dc43922f5 Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Sun, 26 Jan 2020 13:57:22 +0000 Subject: Small test tweaks * Use `withTestDirTree` in StylishSpec * Move StylishSpec module --- stylish-haskell.cabal | 3 +- testdata/test-config.yaml | 3 -- tests/Language/Haskell/Stylish/Config/Tests.hs | 41 +++++----------- tests/Language/Haskell/Stylish/Tests.hs | 66 ++++++++++++++++++++++++++ tests/Language/Haskell/Stylish/Tests/Util.hs | 44 +++++++++++++++++ tests/Language/Haskell/StylishSpec.hs | 51 -------------------- tests/TestSuite.hs | 6 +-- 7 files changed, 127 insertions(+), 87 deletions(-) delete mode 100644 testdata/test-config.yaml create mode 100644 tests/Language/Haskell/Stylish/Tests.hs delete mode 100644 tests/Language/Haskell/StylishSpec.hs diff --git a/stylish-haskell.cabal b/stylish-haskell.cabal index 495e3b4..0ec6bc3 100644 --- a/stylish-haskell.cabal +++ b/stylish-haskell.cabal @@ -97,7 +97,6 @@ Test-suite stylish-haskell-tests Other-modules: Language.Haskell.Stylish - Language.Haskell.StylishSpec Language.Haskell.Stylish.Align Language.Haskell.Stylish.Block Language.Haskell.Stylish.Config @@ -124,9 +123,11 @@ Test-suite stylish-haskell-tests Language.Haskell.Stylish.Step.TrailingWhitespace.Tests Language.Haskell.Stylish.Step.UnicodeSyntax Language.Haskell.Stylish.Step.UnicodeSyntax.Tests + Language.Haskell.Stylish.Tests Language.Haskell.Stylish.Tests.Util Language.Haskell.Stylish.Util Language.Haskell.Stylish.Verbose + Paths_stylish_haskell Build-depends: HUnit >= 1.2 && < 1.7, diff --git a/testdata/test-config.yaml b/testdata/test-config.yaml deleted file mode 100644 index b81fdc2..0000000 --- a/testdata/test-config.yaml +++ /dev/null @@ -1,3 +0,0 @@ -steps: - - records: {} -indent: 2 diff --git a/tests/Language/Haskell/Stylish/Config/Tests.hs b/tests/Language/Haskell/Stylish/Config/Tests.hs index f8869ce..464ebb7 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 @@ -32,33 +32,9 @@ tests = testGroup "Language.Haskell.Stylish.Config" , 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. createFilesAndGetConfig :: [(FilePath, String)] -> IO Config @@ -72,6 +48,7 @@ createFilesAndGetConfig files = withTestDirTree $ do config <- loadConfig (const (pure ())) Nothing pure config + -------------------------------------------------------------------------------- testExtensionsFromDotCabal :: Assertion testExtensionsFromDotCabal = @@ -80,6 +57,7 @@ testExtensionsFromDotCabal = where expected = Set.fromList ["ScopedTypeVariables", "DataKinds"] + -------------------------------------------------------------------------------- testExtensionsFromDotStylish :: Assertion testExtensionsFromDotStylish = @@ -88,6 +66,7 @@ testExtensionsFromDotStylish = where expected = Set.fromList ["TemplateHaskell", "QuasiQuotes"] + -------------------------------------------------------------------------------- testExtensionsFromBoth :: Assertion testExtensionsFromBoth = @@ -98,6 +77,7 @@ testExtensionsFromBoth = expected = Set.fromList ["ScopedTypeVariables", "DataKinds", "TemplateHaskell", "QuasiQuotes"] + -------------------------------------------------------------------------------- testSpecifiedColumns :: Assertion testSpecifiedColumns = @@ -106,6 +86,7 @@ testSpecifiedColumns = where expected = Just 110 + -------------------------------------------------------------------------------- testDefaultColumns :: Assertion testDefaultColumns = @@ -114,6 +95,7 @@ testDefaultColumns = where expected = Just 80 + -------------------------------------------------------------------------------- testNoColumns :: Assertion testNoColumns = @@ -122,6 +104,7 @@ testNoColumns = where expected = Nothing + -- | Example cabal file borrowed from -- https://www.haskell.org/cabal/users-guide/developing-packages.html -- with some default-extensions added diff --git a/tests/Language/Haskell/Stylish/Tests.hs b/tests/Language/Haskell/Stylish/Tests.hs new file mode 100644 index 0000000..3a27ce7 --- /dev/null +++ b/tests/Language/Haskell/Stylish/Tests.hs @@ -0,0 +1,66 @@ +-------------------------------------------------------------------------------- +module Language.Haskell.Stylish.Tests + ( tests + ) where + + +-------------------------------------------------------------------------------- +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.Step.Tabs.Tests" + [ testCase "case 01" case01 + , testCase "case 02" case02 + , testCase "case 03" case03 + ] + + +-------------------------------------------------------------------------------- +case01 :: Assertion +case01 = (@?= result) =<< format Nothing Nothing input + where + input = "module Herp where\n data Foo = Bar | Baz" + result = Right [ "module Herp where" + , "data Foo = Bar" + , " | Baz" + ] + + +-------------------------------------------------------------------------------- +case02 :: Assertion +case02 = withTestDirTree $ do + writeFile "test-config.yaml" $ unlines + [ "steps:" + , " - records: {}" + , "indent: 2" + ] + + actual <- format (Just $ ConfigPath "test-config.yaml") Nothing input + actual @?= result + where + input = "module Herp where\n data Foo = Bar | Baz" + result = Right [ "module Herp where" + , "data Foo = Bar" + , " | Baz" + ] + + +-------------------------------------------------------------------------------- +case03 :: Assertion +case03 = (@?= 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 \".hs\" 2 1) \"Parse error: EOF\"" 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,8 +1,21 @@ 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) diff --git a/tests/Language/Haskell/StylishSpec.hs b/tests/Language/Haskell/StylishSpec.hs deleted file mode 100644 index 77a23b1..0000000 --- a/tests/Language/Haskell/StylishSpec.hs +++ /dev/null @@ -1,51 +0,0 @@ -module Language.Haskell.StylishSpec where - --------------------------------------------------------------------------------- -import Test.Framework (Test, testGroup) -import Test.Framework.Providers.HUnit (testCase) -import Test.HUnit (Assertion, (@?=)) - --------------------------------------------------------------------------------- -import Language.Haskell.Stylish - --------------------------------------------------------------------------------- -import System.IO.Unsafe --------------------------------------------------------------------------------- -tests :: Test -tests = testGroup "Language.Haskell.Stylish.Step.Tabs.Tests" - [ testCase "case 01" case01 - , testCase "case 02" case02 - , testCase "case 03" case03 - ] - --------------------------------------------------------------------------------- -case01 :: Assertion -case01 = (@?=) result (unsafePerformIO $ format Nothing Nothing input) - where - input = "module Herp where\n data Foo = Bar | Baz" - result = Right [ "module Herp where" - , "data Foo = Bar" - , " | Baz" - ] - -case02 :: Assertion -case02 = (@?=) result (unsafePerformIO $ format (Just configLocation) Nothing input) - where - configLocation = ConfigPath "testdata/test-config.yaml" - input = "module Herp where\n data Foo = Bar | Baz" - result = Right [ "module Herp where" - , "data Foo = Bar" - , " | Baz" - ] - -case03 :: Assertion -case03 = do - actual <- format Nothing (Just fileLocation) input - actual @?= result - where - fileLocation = "directory/File.hs" - input = "module Herp" - result = Left $ - "Language.Haskell.Stylish.Parse.parseModule: could not parse " <> - fileLocation <> - ": ParseFailed (SrcLoc \".hs\" 2 1) \"Parse error: EOF\"" diff --git a/tests/TestSuite.hs b/tests/TestSuite.hs index 1138323..d2023ed 100644 --- a/tests/TestSuite.hs +++ b/tests/TestSuite.hs @@ -19,14 +19,13 @@ import qualified Language.Haskell.Stylish.Step.Squash.Tests import qualified Language.Haskell.Stylish.Step.Tabs.Tests import qualified Language.Haskell.Stylish.Step.TrailingWhitespace.Tests import qualified Language.Haskell.Stylish.Step.UnicodeSyntax.Tests -import qualified Language.Haskell.StylishSpec +import qualified Language.Haskell.Stylish.Tests -------------------------------------------------------------------------------- main :: IO () main = defaultMain - [ Language.Haskell.StylishSpec.tests - , Language.Haskell.Stylish.Parse.Tests.tests + [ Language.Haskell.Stylish.Parse.Tests.tests , Language.Haskell.Stylish.Config.Tests.tests , Language.Haskell.Stylish.Step.Data.Tests.tests , Language.Haskell.Stylish.Step.Imports.Tests.tests @@ -36,4 +35,5 @@ main = defaultMain , Language.Haskell.Stylish.Step.Tabs.Tests.tests , Language.Haskell.Stylish.Step.TrailingWhitespace.Tests.tests , Language.Haskell.Stylish.Step.UnicodeSyntax.Tests.tests + , Language.Haskell.Stylish.Tests.tests ] -- cgit v1.2.3 From 498d676c1e06af966c814e01967fc3ece1fd9225 Mon Sep 17 00:00:00 2001 From: vijayphoenix Date: Sun, 26 Jan 2020 14:01:31 +0000 Subject: Switch to HsYAML library --- .gitignore | 1 + lib/Language/Haskell/Stylish/Config.hs | 10 +++++----- stack.yaml | 2 ++ stack.yaml.lock | 14 ++++++++++++++ stylish-haskell.cabal | 9 ++++++--- 5 files changed, 28 insertions(+), 8 deletions(-) diff --git a/.gitignore b/.gitignore index 9072568..738ffe6 100644 --- a/.gitignore +++ b/.gitignore @@ -18,3 +18,4 @@ cabal.config cabal.sandbox.config cabal.sandbox.config dist +/dist-newstyle/ diff --git a/lib/Language/Haskell/Stylish/Config.hs b/lib/Language/Haskell/Stylish/Config.hs index bd15867..ba9cb31 100644 --- a/lib/Language/Haskell/Stylish/Config.hs +++ b/lib/Language/Haskell/Stylish/Config.hs @@ -16,6 +16,7 @@ import Data.Aeson (FromJSON (..) import qualified Data.Aeson as A import qualified Data.Aeson.Types as A import qualified Data.ByteString as B +import Data.ByteString.Lazy (fromStrict) import Data.Char (toLower) import qualified Data.FileEmbed as FileEmbed import Data.List (intercalate, @@ -23,8 +24,8 @@ import Data.List (intercalate, import Data.Map (Map) import qualified Data.Map as M import Data.Maybe (fromMaybe) -import Data.Yaml (decodeEither', - prettyPrintParseException) +import Data.YAML (prettyPosWithSource) +import Data.YAML.Aeson (decode1Strict) import System.Directory import System.FilePath (()) import qualified System.IO as IO (Newline (..), @@ -101,9 +102,8 @@ loadConfig verbose userSpecified = do mbFp <- configFilePath verbose userSpecified verbose $ "Loading configuration at " ++ fromMaybe "" mbFp bytes <- maybe (return defaultConfigBytes) B.readFile mbFp - case decodeEither' bytes of - Left err -> error $ - "Language.Haskell.Stylish.Config.loadConfig: " ++ prettyPrintParseException err + case decode1Strict bytes of + Left (pos, err) -> error $ prettyPosWithSource pos (fromStrict bytes) ("Language.Haskell.Stylish.Config.loadConfig: " ++ err) Right config -> do cabalLanguageExtensions <- if configCabal config then map show <$> Cabal.findLanguageExtensions verbose diff --git a/stack.yaml b/stack.yaml index 8d4c89b..b7c37af 100644 --- a/stack.yaml +++ b/stack.yaml @@ -5,3 +5,5 @@ packages: extra-deps: - 'Cabal-3.0.0.0' - 'haskell-src-exts-1.23.0' +- 'HsYAML-0.2.1.0' +- 'HsYAML-aeson-0.2.0.0' diff --git a/stack.yaml.lock b/stack.yaml.lock index 129406d..bc43b4e 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -18,6 +18,20 @@ packages: sha256: 8e5bc885533431db9bf75e9609f6b80b56ab0c289a903d701f8628e78322afd0 original: hackage: haskell-src-exts-1.23.0 +- completed: + hackage: HsYAML-0.2.1.0@sha256:e4677daeba57f7a1e9a709a1f3022fe937336c91513e893166bd1f023f530d68,5311 + pantry-tree: + size: 1340 + sha256: 21f61bf9cad31674126b106071dd9b852e408796aeffc90eec1792f784107eff + original: + hackage: HsYAML-0.2.1.0 +- completed: + hackage: HsYAML-aeson-0.2.0.0@sha256:04796abfc01cffded83f37a10e6edba4f0c0a15d45bef44fc5bb4313d9c87757,1791 + pantry-tree: + size: 234 + sha256: 67cc9ba17c79e71d3abdb465a3ee2825477856fff3b8b7d543cbbbefdae9a9d9 + original: + hackage: HsYAML-aeson-0.2.0.0 snapshots: - completed: size: 524154 diff --git a/stylish-haskell.cabal b/stylish-haskell.cabal index 0ec6bc3..ac16054 100644 --- a/stylish-haskell.cabal +++ b/stylish-haskell.cabal @@ -64,7 +64,8 @@ Library mtl >= 2.0 && < 2.3, semigroups >= 0.18 && < 0.20, syb >= 0.3 && < 0.8, - yaml >= 0.8.11 && < 0.12 + HsYAML-aeson >=0.2.0 && < 0.3, + HsYAML >=0.2.0 && < 0.3 Executable stylish-haskell Ghc-options: -Wall @@ -87,7 +88,8 @@ Executable stylish-haskell haskell-src-exts >= 1.18 && < 1.24, mtl >= 2.0 && < 2.3, syb >= 0.3 && < 0.8, - yaml >= 0.8.11 && < 0.12 + HsYAML-aeson >=0.2.0 && < 0.3, + HsYAML >=0.2.0 && < 0.3 Test-suite stylish-haskell-tests Ghc-options: -Wall @@ -146,7 +148,8 @@ Test-suite stylish-haskell-tests haskell-src-exts >= 1.18 && < 1.24, mtl >= 2.0 && < 2.3, syb >= 0.3 && < 0.8, - yaml >= 0.8.11 && < 0.12 + HsYAML-aeson >=0.2.0 && < 0.3, + HsYAML >=0.2.0 && < 0.3 Source-repository head Type: git -- cgit v1.2.3 From d2594404a89839edc3ac44ea1fed3f99c2aade68 Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Sun, 26 Jan 2020 14:11:43 +0000 Subject: Bump version to 0.10.0.0 --- CHANGELOG | 10 ++++++++++ stylish-haskell.cabal | 2 +- 2 files changed, 11 insertions(+), 1 deletion(-) diff --git a/CHANGELOG b/CHANGELOG index 3187ced..eca598d 100644 --- a/CHANGELOG +++ b/CHANGELOG @@ -1,5 +1,15 @@ # CHANGELOG +- 0.10.0.0 (2020-01-26) + * Switch to HsYAML library (by vijayphoenix) + * Expose `format` from main library (by Łukasz Gołębiewski) + * Support record formatting (by Łukasz Gołębiewski and Pawel Szulc) + * Allow setting `columns` to `null` to disable all wrapping (by Chris + Martin) + * Bump `haskell-src-exts` to 1.23 + * New logo (by Jose Fernando García Parreño) + * Make language extension prefix configurable (by Flavio Corpa) + - 0.9.4.4 (2019-11-03) * Bump `haskell-src-exts` to 1.22 diff --git a/stylish-haskell.cabal b/stylish-haskell.cabal index ac16054..b3f2975 100644 --- a/stylish-haskell.cabal +++ b/stylish-haskell.cabal @@ -1,5 +1,5 @@ Name: stylish-haskell -Version: 0.9.4.4 +Version: 0.10.0.0 Synopsis: Haskell code prettifier Homepage: https://github.com/jaspervdj/stylish-haskell License: BSD3 -- cgit v1.2.3 From 41dcda2a34b5f12f3fa91480bfe2aaeb4afa90e5 Mon Sep 17 00:00:00 2001 From: Maxim Koltsov Date: Sun, 2 Feb 2020 15:18:24 +0300 Subject: Disable formatting of data types without records (#265) --- lib/Language/Haskell/Stylish/Step/Data.hs | 10 ++++++++-- tests/Language/Haskell/Stylish/Step/Data/Tests.hs | 20 ++++++++++++++------ tests/Language/Haskell/Stylish/Tests.hs | 8 ++++++-- 3 files changed, 28 insertions(+), 10 deletions(-) diff --git a/lib/Language/Haskell/Stylish/Step/Data.hs b/lib/Language/Haskell/Stylish/Step/Data.hs index 94aaf22..681c7c8 100644 --- a/lib/Language/Haskell/Stylish/Step/Data.hs +++ b/lib/Language/Haskell/Stylish/Step/Data.hs @@ -45,9 +45,15 @@ commentsWithin lb = filter within changeDecl :: [Comment] -> Int -> H.Decl LineBlock -> Maybe ChangeLine changeDecl _ _ (H.DataDecl _ (H.DataType _) Nothing _ [] _) = Nothing -changeDecl allComments indentSize (H.DataDecl block (H.DataType _) Nothing dhead decls derivings) = - Just $ change block (const $ concat newLines) +changeDecl allComments indentSize (H.DataDecl block (H.DataType _) Nothing dhead decls derivings) + | hasRecordFields = Just $ change block (const $ concat newLines) + | otherwise = Nothing where + hasRecordFields = any + (\qual -> case qual of + (H.QualConDecl _ _ _ (H.RecDecl {})) -> True + _ -> False) + decls newLines = fmap constructors zipped ++ [fmap (indented . H.prettyPrint) derivings] zipped = zip decls ([1..] ::[Int]) constructors (decl, 1) = processConstructor allComments typeConstructor indentSize decl diff --git a/tests/Language/Haskell/Stylish/Step/Data/Tests.hs b/tests/Language/Haskell/Stylish/Step/Data/Tests.hs index 712ffae..ff5ca3b 100644 --- a/tests/Language/Haskell/Stylish/Step/Data/Tests.hs +++ b/tests/Language/Haskell/Stylish/Step/Data/Tests.hs @@ -30,6 +30,7 @@ tests = testGroup "Language.Haskell.Stylish.Step.Data.Tests" , testCase "case 17" case17 , testCase "case 18" case18 , testCase "case 19" case19 + , testCase "case 20 (issue 262)" case20 ] case00 :: Assertion @@ -155,7 +156,7 @@ case07 = expected @=? testStep (step 2) input expected = input case08 :: Assertion -case08 = expected @=? testStep (step 2) input +case08 = input @=? testStep (step 2) input where input = unlines [ "module Herp where" @@ -163,11 +164,6 @@ case08 = expected @=? testStep (step 2) input , "data Phantom a =" , " Phantom" ] - expected = unlines - [ "module Herp where" - , "" - , "data Phantom a = Phantom" - ] case09 :: Assertion case09 = expected @=? testStep (step 4) input @@ -389,3 +385,15 @@ case19 = expected @=? testStep (step 2) input , " , age :: Int" , " }" ] + +-- | Should not break Enums (data without records) formating +-- +-- See https://github.com/jaspervdj/stylish-haskell/issues/262 +case20 :: Assertion +case20 = input @=? testStep (step 2) input + where + input = unlines + [ "module Herp where" + , "" + , "data Tag = Title | Text deriving (Eq, Show)" + ] diff --git a/tests/Language/Haskell/Stylish/Tests.hs b/tests/Language/Haskell/Stylish/Tests.hs index 3a27ce7..59ca92b 100644 --- a/tests/Language/Haskell/Stylish/Tests.hs +++ b/tests/Language/Haskell/Stylish/Tests.hs @@ -28,10 +28,12 @@ tests = testGroup "Language.Haskell.Stylish.Step.Tabs.Tests" case01 :: Assertion case01 = (@?= result) =<< format Nothing Nothing input where - input = "module Herp where\n data Foo = Bar | Baz" + input = "module Herp where\ndata Foo = Bar | Baz { baz :: Int }" result = Right [ "module Herp where" , "data Foo = Bar" , " | Baz" + , " { baz :: Int" + , " }" ] @@ -47,10 +49,12 @@ case02 = withTestDirTree $ do actual <- format (Just $ ConfigPath "test-config.yaml") Nothing input actual @?= result where - input = "module Herp where\n data Foo = Bar | Baz" + input = "module Herp where\ndata Foo = Bar | Baz { baz :: Int }" result = Right [ "module Herp where" , "data Foo = Bar" , " | Baz" + , " { baz :: Int" + , " }" ] -- cgit v1.2.3 From ab85690eb35dec46c8eb80a930337249f34b9f80 Mon Sep 17 00:00:00 2001 From: Akos Marton Date: Sat, 15 Feb 2020 12:24:11 +0100 Subject: Add -r flag to recursively find Haskell files --- lib/Language/Haskell/Stylish.hs | 42 ++++++++++++++++++++++++++++- src/Main.hs | 30 ++++++++++++++------- tests/Language/Haskell/Stylish/Tests.hs | 47 +++++++++++++++++++++++++++++++++ 3 files changed, 109 insertions(+), 10 deletions(-) diff --git a/lib/Language/Haskell/Stylish.hs b/lib/Language/Haskell/Stylish.hs index 4f6aa1f..c50db4d 100644 --- a/lib/Language/Haskell/Stylish.hs +++ b/lib/Language/Haskell/Stylish.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE LambdaCase #-} -------------------------------------------------------------------------------- module Language.Haskell.Stylish ( -- * Run @@ -10,6 +11,7 @@ module Language.Haskell.Stylish , trailingWhitespace , unicodeSyntax -- ** Helpers + , findHaskellFiles , stepName -- * Config , module Language.Haskell.Stylish.Config @@ -25,7 +27,11 @@ module Language.Haskell.Stylish -------------------------------------------------------------------------------- import Control.Monad (foldM) - +import System.Directory (doesDirectoryExist, + doesFileExist, + listDirectory) +import System.FilePath (takeExtension, + ()) -------------------------------------------------------------------------------- import Language.Haskell.Stylish.Config @@ -103,3 +109,37 @@ format :: Maybe ConfigPath -> Maybe FilePath -> String -> IO (Either String Line format maybeConfigPath maybeFilePath contents = do conf <- loadConfig (makeVerbose True) (fmap unConfigPath maybeConfigPath) pure $ runSteps (configLanguageExtensions conf) maybeFilePath (configSteps conf) $ lines contents + + +-------------------------------------------------------------------------------- +-- | Searches Haskell source files in any given folder recursively. +findHaskellFiles :: Bool -> [FilePath] -> IO [FilePath] +findHaskellFiles v fs = mapM (findFilesR v) fs >>= return . concat + + +-------------------------------------------------------------------------------- +findFilesR :: Bool -> FilePath -> IO [FilePath] +findFilesR _ [] = return [] +findFilesR v path = do + doesFileExist path >>= \case + True -> return [path] + _ -> doesDirectoryExist path >>= \case + True -> findFilesRecursive path >>= + return . filter (\x -> takeExtension x == ".hs") + False -> do + makeVerbose v ("Input folder does not exists: " <> path) + findFilesR v [] + where + findFilesRecursive :: FilePath -> IO [FilePath] + findFilesRecursive = listDirectoryFiles findFilesRecursive + + listDirectoryFiles :: (FilePath -> IO [FilePath]) + -> FilePath -> IO [FilePath] + listDirectoryFiles go topdir = do + ps <- listDirectory topdir >>= + mapM (\x -> do + let dir = topdir x + doesDirectoryExist dir >>= \case + True -> go dir + False -> return [dir]) + return $ concat ps diff --git a/src/Main.hs b/src/Main.hs index e71c795..b1ca2d5 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -21,13 +21,14 @@ import Language.Haskell.Stylish -------------------------------------------------------------------------------- data StylishArgs = StylishArgs - { saVersion :: Bool - , saConfig :: Maybe FilePath - , saVerbose :: Bool - , saDefaults :: Bool - , saInPlace :: Bool - , saNoUtf8 :: Bool - , saFiles :: [FilePath] + { saVersion :: Bool + , saConfig :: Maybe FilePath + , saRecursive :: Bool + , saVerbose :: Bool + , saDefaults :: Bool + , saInPlace :: Bool + , saNoUtf8 :: Bool + , saFiles :: [FilePath] } deriving (Show) @@ -44,6 +45,11 @@ parseStylishArgs = StylishArgs OA.long "config" <> OA.short 'c' <> OA.hidden) + <*> OA.switch ( + OA.help "Recursive file search" <> + OA.long "recursive" <> + OA.short 'r' <> + OA.hidden) <*> OA.switch ( OA.help "Run in verbose mode" <> OA.long "verbose" <> @@ -99,14 +105,20 @@ stylishHaskell sa = do else do conf <- loadConfig verbose' (saConfig sa) + filesR <- case (saRecursive sa) of + True -> findHaskellFiles (saVerbose sa) (saFiles sa) + _ -> return $ saFiles sa let steps = configSteps conf forM_ steps $ \s -> verbose' $ "Enabled " ++ stepName s ++ " step" verbose' $ "Extra language extensions: " ++ show (configLanguageExtensions conf) - mapM_ (file sa conf) files' + mapM_ (file sa conf) $ files' filesR where verbose' = makeVerbose (saVerbose sa) - files' = if null (saFiles sa) then [Nothing] else map Just (saFiles sa) + files' x = case (saRecursive sa, null x) of + (True,True) -> [] -- No file to format and recursive enabled. + (_,True) -> [Nothing] -- Involving IO.stdin. + (_,False) -> map Just x -- Process available files. -------------------------------------------------------------------------------- diff --git a/tests/Language/Haskell/Stylish/Tests.hs b/tests/Language/Haskell/Stylish/Tests.hs index 59ca92b..e7faa9b 100644 --- a/tests/Language/Haskell/Stylish/Tests.hs +++ b/tests/Language/Haskell/Stylish/Tests.hs @@ -5,6 +5,9 @@ module Language.Haskell.Stylish.Tests -------------------------------------------------------------------------------- +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, (@?=)) @@ -21,6 +24,9 @@ tests = testGroup "Language.Haskell.Stylish.Step.Tabs.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 ] @@ -68,3 +74,44 @@ case03 = (@?= result) =<< format Nothing (Just fileLocation) input "Language.Haskell.Stylish.Parse.parseModule: could not parse " <> fileLocation <> ": ParseFailed (SrcLoc \".hs\" 2 1) \"Parse error: EOF\"" + + +-------------------------------------------------------------------------------- +-- | When providing current dir including folders and files. +case04 :: Assertion +case04 = 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. +case05 :: Assertion +case05 = 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. +case06 :: Assertion +case06 = withTestDirTree $ do + mapM_ (flip writeFile "") input + result <- findHaskellFiles False input + result @?= expected + where + input = [] + expected = input -- cgit v1.2.3 From b8a731eb948b98019b8663c6fc653d2c930df2b1 Mon Sep 17 00:00:00 2001 From: Maxim Koltsov Date: Mon, 17 Feb 2020 19:32:01 +0100 Subject: Introduce nicer style for records (#266) --- README.markdown | 56 ++++ data/stylish-haskell.yaml | 32 ++- lib/Language/Haskell/Stylish/Config.hs | 25 +- lib/Language/Haskell/Stylish/Step/Data.hs | 88 ++++-- stylish-haskell.cabal | 2 + tests/Language/Haskell/Stylish/Config/Tests.hs | 7 +- tests/Language/Haskell/Stylish/Step/Data/Tests.hs | 311 ++++++++++++++++------ tests/Language/Haskell/Stylish/Tests.hs | 67 +++-- 8 files changed, 449 insertions(+), 139 deletions(-) diff --git a/README.markdown b/README.markdown index 54451cc..e420417 100644 --- a/README.markdown +++ b/README.markdown @@ -33,6 +33,7 @@ You can also install it using your package manager: - Replaces tabs by four spaces (turned off by default) - Replaces some ASCII sequences by their Unicode equivalents (turned off by default) +- Format data constructors and fields in records. Feature requests are welcome! Use the [issue tracker] for that. @@ -102,6 +103,61 @@ Use `stylish-haskell --defaults > .stylish-haskell.yaml` to dump a well-documented default configuration to a file, this way you can get started quickly. +## Record formatting + +Basically, stylish-haskell supports 4 different styles of records, controlled by `records` +in the config file. + +Here's an example of all four styles: + +```haskell +-- equals: "indent 2", "first_field": "indent 2" +data Foo a + = Foo + { a :: Int + , a2 :: String + -- ^ some haddock + } + | Bar + { b :: a + } + deriving (Eq, Show) + deriving (ToJSON) via Bar Foo + +-- equals: "same_line", "first_field": "indent 2" +data Foo a = Foo + { a :: Int + , a2 :: String + -- ^ some haddock + } + | Bar + { b :: a + } + deriving (Eq, Show) + deriving (ToJSON) via Bar Foo + +-- equals: "same_line", "first_field": "same_line" +data Foo a = Foo { a :: Int + , a2 :: String + -- ^ some haddock + } + | Bar { b :: a + } + deriving (Eq, Show) + deriving (ToJSON) via Bar Foo + +-- equals: "indent 2", first_field: "same_line" +data Foo a + = Foo { a :: Int + , a2 :: String + -- ^ some haddock + } + | Bar { b :: a + } + deriving (Eq, Show) + deriving (ToJSON) via Bar Foo +``` + ## VIM integration Since it works as a filter it is pretty easy to integrate this with VIM. diff --git a/data/stylish-haskell.yaml b/data/stylish-haskell.yaml index 209d613..d7de260 100644 --- a/data/stylish-haskell.yaml +++ b/data/stylish-haskell.yaml @@ -15,8 +15,33 @@ steps: # # true. # add_language_pragma: true - # Format record definitions - - records: {} + # Format record definitions. This is disabled by default. + # + # You can control the layout of record fields. The only rules that can't be configured + # are these: + # + # - "|" is always aligned with "=" + # - "," in fields is always aligned with "{" + # - "}" is likewise always aligned with "{" + # + # - records: + # # How to format equals sign between type constructor and data constructor. + # # Possible values: + # # - "same_line" -- leave "=" AND data constructor on the same line as the type constructor. + # # - "indent N" -- insert a new line and N spaces from the beginning of the next line. + # equals: "indent 2" + # + # # How to format first field of each record constructor. + # # Possible values: + # # - "same_line" -- "{" and first field goes on the same line as the data constructor. + # # - "indent N" -- insert a new line and N spaces from the beginning of the data constructor + # first_field: "indent 2" + # + # # How many spaces to insert between the column with "," and the beginning of the comment in the next line. + # field_comment: 2 + # + # # How many spaces to insert before "deriving" clause. Deriving clauses are always on separate lines. + # deriving: 2 # Align the right hand side of some elements. This is quite conservative # and only applies to statements where each element occupies a single @@ -225,9 +250,6 @@ steps: # simple_align but is a bit less conservative. # - squash: {} -# A common indentation setting. Different steps take this into account. -indent: 4 - # A common setting is the number of columns (parts of) code will be wrapped # to. Different steps take this into account. # diff --git a/lib/Language/Haskell/Stylish/Config.hs b/lib/Language/Haskell/Stylish/Config.hs index ba9cb31..475a5e3 100644 --- a/lib/Language/Haskell/Stylish/Config.hs +++ b/lib/Language/Haskell/Stylish/Config.hs @@ -24,12 +24,14 @@ import Data.List (intercalate, import Data.Map (Map) import qualified Data.Map as M import Data.Maybe (fromMaybe) +import qualified Data.Text as T import Data.YAML (prettyPosWithSource) import Data.YAML.Aeson (decode1Strict) import System.Directory import System.FilePath (()) import qualified System.IO as IO (Newline (..), nativeNewline) +import Text.Read (readMaybe) -------------------------------------------------------------------------------- @@ -54,7 +56,6 @@ type Extensions = [String] -------------------------------------------------------------------------------- data Config = Config { configSteps :: [Step] - , configIndent :: Int , configColumns :: Maybe Int , configLanguageExtensions :: [String] , configNewline :: IO.Newline @@ -121,7 +122,6 @@ parseConfig (A.Object o) = do -- First load the config without the actual steps config <- Config <$> pure [] - <*> (o A..:? "indent" A..!= 4) <*> (o A..:! "columns" A..!= Just 80) <*> (o A..:? "language_extensions" A..!= []) <*> (o A..:? "newline" >>= parseEnum newlines IO.nativeNewline) @@ -186,8 +186,25 @@ parseSimpleAlign c o = SimpleAlign.step -------------------------------------------------------------------------------- parseRecords :: Config -> A.Object -> A.Parser Step -parseRecords c _ = Data.step - <$> pure (configIndent c) +parseRecords _ o = Data.step + <$> (Data.Config + <$> (o A..: "equals" >>= parseIndent) + <*> (o A..: "first_field" >>= parseIndent) + <*> (o A..: "field_comment") + <*> (o A..: "deriving")) + + +parseIndent :: A.Value -> A.Parser Data.Indent +parseIndent = A.withText "Indent" $ \t -> + if t == "same_line" + then return Data.SameLine + else + if "indent " `T.isPrefixOf` t + then + case readMaybe (T.unpack $ T.drop 7 t) of + Just n -> return $ Data.Indent n + Nothing -> fail $ "Indent: not a number" <> T.unpack (T.drop 7 t) + else fail $ "can't parse indent setting: " <> T.unpack t -------------------------------------------------------------------------------- diff --git a/lib/Language/Haskell/Stylish/Step/Data.hs b/lib/Language/Haskell/Stylish/Step/Data.hs index 681c7c8..1f7732b 100644 --- a/lib/Language/Haskell/Stylish/Step/Data.hs +++ b/lib/Language/Haskell/Stylish/Step/Data.hs @@ -1,7 +1,9 @@ +{-# LANGUAGE RecordWildCards #-} + module Language.Haskell.Stylish.Step.Data where import Data.List (find, intercalate) -import Data.Maybe (maybeToList) +import Data.Maybe (fromMaybe, maybeToList) import qualified Language.Haskell.Exts as H import Language.Haskell.Exts.Comments import Language.Haskell.Stylish.Block @@ -10,20 +12,36 @@ import Language.Haskell.Stylish.Step import Language.Haskell.Stylish.Util import Prelude hiding (init) +data Indent + = SameLine + | Indent !Int + deriving (Show) + +data Config = Config + { cEquals :: !Indent + -- ^ Indent between type constructor and @=@ sign (measured from column 0) + , cFirstField :: !Indent + -- ^ Indent between data constructor and @{@ line (measured from column with data constructor name) + , cFieldComment :: !Int + -- ^ Indent between column with @{@ and start of field line comment (this line has @cFieldComment = 2@) + , cDeriving :: !Int + -- ^ Indent before @deriving@ lines (measured from column 0) + } deriving (Show) + datas :: H.Module l -> [H.Decl l] datas (H.Module _ _ _ _ decls) = decls datas _ = [] type ChangeLine = Change String -step :: Int -> Step -step indentSize = makeStep "Data" (step' indentSize) +step :: Config -> Step +step cfg = makeStep "Data" (step' cfg) -step' :: Int -> Lines -> Module -> Lines -step' indentSize ls (module', allComments) = applyChanges changes ls +step' :: Config -> Lines -> Module -> Lines +step' cfg ls (module', allComments) = applyChanges changes ls where datas' = datas $ fmap linesFromSrcSpan module' - changes = datas' >>= maybeToList . changeDecl allComments indentSize + changes = datas' >>= maybeToList . changeDecl allComments cfg findCommentOnLine :: LineBlock -> [Comment] -> Maybe Comment findCommentOnLine lb = find commentOnLine @@ -43,9 +61,9 @@ commentsWithin lb = filter within within (Comment _ (H.SrcSpan _ start _ end _) _) = start >= blockStart lb && end <= blockEnd lb -changeDecl :: [Comment] -> Int -> H.Decl LineBlock -> Maybe ChangeLine +changeDecl :: [Comment] -> Config -> H.Decl LineBlock -> Maybe ChangeLine changeDecl _ _ (H.DataDecl _ (H.DataType _) Nothing _ [] _) = Nothing -changeDecl allComments indentSize (H.DataDecl block (H.DataType _) Nothing dhead decls derivings) +changeDecl allComments cfg@Config{..} (H.DataDecl block (H.DataType _) Nothing dhead decls derivings) | hasRecordFields = Just $ change block (const $ concat newLines) | otherwise = Nothing where @@ -54,27 +72,55 @@ changeDecl allComments indentSize (H.DataDecl block (H.DataType _) Nothing dhead (H.QualConDecl _ _ _ (H.RecDecl {})) -> True _ -> False) decls - newLines = fmap constructors zipped ++ [fmap (indented . H.prettyPrint) derivings] + + typeConstructor = "data " <> H.prettyPrint dhead + + -- In any case set @pipeIndent@ such that @|@ is aligned with @=@. + (firstLine, firstLineInit, pipeIndent) = + case cEquals of + SameLine -> (Nothing, typeConstructor <> " = ", length typeConstructor + 1) + Indent n -> (Just [[typeConstructor]], indent n "= ", n) + + newLines = fromMaybe [] firstLine ++ fmap constructors zipped <> [fmap (indent cDeriving . H.prettyPrint) derivings] zipped = zip decls ([1..] ::[Int]) - constructors (decl, 1) = processConstructor allComments typeConstructor indentSize decl - constructors (decl, _) = processConstructor allComments (indented "| ") indentSize decl - typeConstructor = "data " <> H.prettyPrint dhead <> " = " - indented = indent indentSize + + constructors (decl, 1) = processConstructor allComments firstLineInit cfg decl + constructors (decl, _) = processConstructor allComments (indent pipeIndent "| ") cfg decl changeDecl _ _ _ = Nothing -processConstructor :: [Comment] -> String -> Int -> H.QualConDecl LineBlock -> [String] -processConstructor allComments init indentSize (H.QualConDecl _ _ _ (H.RecDecl _ dname fields)) = do - init <> H.prettyPrint dname : n1 ++ ns ++ [indented "}"] +processConstructor :: [Comment] -> String -> Config -> H.QualConDecl LineBlock -> [String] +processConstructor allComments init Config{..} (H.QualConDecl _ _ _ (H.RecDecl _ dname (f:fs))) = do + fromMaybe [] firstLine <> n1 <> ns <> [indent fieldIndent "}"] where - n1 = processName "{ " ( extractField $ head fields) - ns = tail fields >>= (processName ", " . extractField) + n1 = processName firstLinePrefix (extractField f) + ns = fs >>= processName (indent fieldIndent ", ") . extractField + + -- Set @fieldIndent@ such that @,@ is aligned with @{@. + (firstLine, firstLinePrefix, fieldIndent) = + case cFirstField of + SameLine -> + ( Nothing + , init <> H.prettyPrint dname <> " { " + , length init + length (H.prettyPrint dname) + 1 + ) + Indent n -> + ( Just [init <> H.prettyPrint dname] + , indent (length init + n) "{ " + , length init + n + ) + processName prefix (fnames, _type, lineComment, commentBelowLine) = - [indented prefix <> intercalate ", " (fmap H.prettyPrint fnames) <> " :: " <> H.prettyPrint _type <> addLineComment lineComment] ++ addCommentBelow commentBelowLine + [prefix <> intercalate ", " (fmap H.prettyPrint fnames) <> " :: " <> H.prettyPrint _type <> addLineComment lineComment + ] ++ addCommentBelow commentBelowLine + addLineComment (Just (Comment _ _ c)) = " --" <> c addLineComment Nothing = "" + + -- Field comment indent is measured from the column with @{@, hence adding of @fieldIndent@ here. addCommentBelow Nothing = [] - addCommentBelow (Just (Comment _ _ c)) = [indented "--" <> c] + addCommentBelow (Just (Comment _ _ c)) = [indent (fieldIndent + cFieldComment) "--" <> c] + extractField (H.FieldDecl lb names _type) = (names, _type, findCommentOnLine lb allComments, findCommentBelowLine lb allComments) - indented = indent indentSize + processConstructor _ init _ decl = [init <> trimLeft (H.prettyPrint decl)] diff --git a/stylish-haskell.cabal b/stylish-haskell.cabal index b3f2975..6bad961 100644 --- a/stylish-haskell.cabal +++ b/stylish-haskell.cabal @@ -64,6 +64,7 @@ Library mtl >= 2.0 && < 2.3, semigroups >= 0.18 && < 0.20, syb >= 0.3 && < 0.8, + text >= 1.2 && < 1.3, HsYAML-aeson >=0.2.0 && < 0.3, HsYAML >=0.2.0 && < 0.3 @@ -148,6 +149,7 @@ Test-suite stylish-haskell-tests haskell-src-exts >= 1.18 && < 1.24, mtl >= 2.0 && < 2.3, syb >= 0.3 && < 0.8, + text >= 1.2 && < 1.3, HsYAML-aeson >=0.2.0 && < 0.3, HsYAML >=0.2.0 && < 0.3 diff --git a/tests/Language/Haskell/Stylish/Config/Tests.hs b/tests/Language/Haskell/Stylish/Config/Tests.hs index 464ebb7..a8b2ee2 100644 --- a/tests/Language/Haskell/Stylish/Config/Tests.hs +++ b/tests/Language/Haskell/Stylish/Config/Tests.hs @@ -148,8 +148,11 @@ dotStylish = unlines $ , " align: false" , " remove_redundant: true" , " - trailing_whitespace: {}" - , " - records: {}" - , "indent: 2" + , " - records:" + , " equals: \"same_line\"" + , " first_field: \"indent 2\"" + , " field_comment: 2" + , " deriving: 4" , "columns: 110" , "language_extensions:" , " - TemplateHaskell" diff --git a/tests/Language/Haskell/Stylish/Step/Data/Tests.hs b/tests/Language/Haskell/Stylish/Step/Data/Tests.hs index ff5ca3b..1e7f254 100644 --- a/tests/Language/Haskell/Stylish/Step/Data/Tests.hs +++ b/tests/Language/Haskell/Stylish/Step/Data/Tests.hs @@ -31,10 +31,14 @@ tests = testGroup "Language.Haskell.Stylish.Step.Data.Tests" , 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 2) input +case00 = expected @=? testStep (step sameSameStyle) input where input = unlines [ "module Herp where" @@ -45,7 +49,7 @@ case00 = expected @=? testStep (step 2) input expected = input case01 :: Assertion -case01 = expected @=? testStep (step 2) input +case01 = expected @=? testStep (step indentIndentStyle) input where input = unlines [ "module Herp where" @@ -56,13 +60,14 @@ case01 = expected @=? testStep (step 2) input expected = unlines [ "module Herp where" , "" - , "data Foo = Foo" - , " { a :: Int" - , " }" + , "data Foo" + , " = Foo" + , " { a :: Int" + , " }" ] case02 :: Assertion -case02 = expected @=? testStep (step 2) input +case02 = expected @=? testStep (step indentIndentStyle) input where input = unlines [ "module Herp where" @@ -72,14 +77,15 @@ case02 = expected @=? testStep (step 2) input expected = unlines [ "module Herp where" , "" - , "data Foo = Foo" - , " { a :: Int" - , " , a2 :: String" - , " }" + , "data Foo" + , " = Foo" + , " { a :: Int" + , " , a2 :: String" + , " }" ] case03 :: Assertion -case03 = expected @=? testStep (step 2) input +case03 = expected @=? testStep (step indentIndentStyle) input where input = unlines [ "module Herp where" @@ -89,14 +95,15 @@ case03 = expected @=? testStep (step 2) input expected = unlines [ "module Herp where" , "" - , "data Foo a = Foo" - , " { a :: a" - , " , a2 :: String" - , " }" + , "data Foo a" + , " = Foo" + , " { a :: a" + , " , a2 :: String" + , " }" ] case04 :: Assertion -case04 = expected @=? testStep (step 2) input +case04 = expected @=? testStep (step indentIndentStyle) input where input = unlines [ "module Herp where" @@ -106,17 +113,18 @@ case04 = expected @=? testStep (step 2) input expected = unlines [ "module Herp where" , "" - , "data Foo a = Foo" - , " { a :: a" - , " , a2 :: String" - , " }" + , "data Foo a" + , " = Foo" + , " { a :: a" + , " , a2 :: String" + , " }" , " | Bar" - , " { b :: a" - , " }" + , " { b :: a" + , " }" ] case05 :: Assertion -case05 = expected @=? testStep (step 2) input +case05 = expected @=? testStep (step indentIndentStyle) input where input = unlines [ "module Herp where" @@ -129,14 +137,15 @@ case05 = expected @=? testStep (step 2) input expected = unlines [ "module Herp where" , "" - , "data Foo = Foo" - , " { a :: Int" - , " , a2 :: String" - , " }" + , "data Foo" + , " = Foo" + , " { a :: Int" + , " , a2 :: String" + , " }" ] case06 :: Assertion -case06 = expected @=? testStep (step 2) input +case06 = expected @=? testStep (step sameSameStyle) input where input = unlines [ "module Herp where" @@ -146,7 +155,7 @@ case06 = expected @=? testStep (step 2) input expected = input case07 :: Assertion -case07 = expected @=? testStep (step 2) input +case07 = expected @=? testStep (step sameSameStyle) input where input = unlines [ "module Herp where" @@ -156,7 +165,7 @@ case07 = expected @=? testStep (step 2) input expected = input case08 :: Assertion -case08 = input @=? testStep (step 2) input +case08 = input @=? testStep (step sameSameStyle) input where input = unlines [ "module Herp where" @@ -166,7 +175,7 @@ case08 = input @=? testStep (step 2) input ] case09 :: Assertion -case09 = expected @=? testStep (step 4) input +case09 = expected @=? testStep (step indentIndentStyle4) input where input = unlines [ "module Herp where" @@ -176,18 +185,19 @@ case09 = expected @=? testStep (step 4) input expected = unlines [ "module Herp where" , "" - , "data Foo a b = Foo" - , " { a :: a" - , " , a2 :: String" - , " }" + , "data Foo a b" + , " = Foo" + , " { a :: a" + , " , a2 :: String" + , " }" , " | Bar" - , " { b :: a" - , " , c :: b" - , " }" + , " { b :: a" + , " , c :: b" + , " }" ] case10 :: Assertion -case10 = expected @=? testStep (step 2) input +case10 = expected @=? testStep (step indentIndentStyle) input where input = unlines [ "module Herp where" @@ -198,15 +208,16 @@ case10 = expected @=? testStep (step 2) input expected = unlines [ "module Herp where" , "" - , "data Foo = Foo" - , " { a :: Int" - , " }" + , "data Foo" + , " = Foo" + , " { a :: Int" + , " }" , " deriving (Eq, Generic)" , " deriving (Show)" ] case11 :: Assertion -case11 = expected @=? testStep (step 2) input +case11 = expected @=? testStep (step indentIndentStyle) input where input = unlines [ "{-# LANGUAGE DerivingStrategies #-}" @@ -219,14 +230,15 @@ case11 = expected @=? testStep (step 2) input [ "{-# LANGUAGE DerivingStrategies #-}" , "module Herp where" , "" - , "data Foo = Foo" - , " { a :: Int" - , " }" + , "data Foo" + , " = Foo" + , " { a :: Int" + , " }" , " deriving stock (Show)" ] case12 :: Assertion -case12 = expected @=? testStep (step 4) input +case12 = expected @=? testStep (step indentIndentStyle4) input where input = unlines [ "module Herp where" @@ -237,15 +249,16 @@ case12 = expected @=? testStep (step 4) input expected = unlines [ "module Herp where" , "" - , "data Point = Point" - , " { pointX, pointY :: Double" - , " , pointName :: String" - , " }" + , "data Point" + , " = Point" + , " { pointX, pointY :: Double" + , " , pointName :: String" + , " }" , " deriving (Show)" ] case13 :: Assertion -case13 = expected @=? testStep (step 2) input +case13 = expected @=? testStep (step indentIndentStyle) input where input = unlines [ "module Herp where" @@ -257,13 +270,14 @@ case13 = expected @=? testStep (step 2) input [ "module Herp where" , "" , "-- this is a comment" - , "data Foo = Foo" - , " { a :: Int" - , " }" + , "data Foo" + , " = Foo" + , " { a :: Int" + , " }" ] case14 :: Assertion -case14 = expected @=? testStep (step 2) input +case14 = expected @=? testStep (step indentIndentStyle) input where input = unlines [ "module Herp where" @@ -277,13 +291,14 @@ case14 = expected @=? testStep (step 2) input , "" , "{- this is" , " a comment -}" - , "data Foo = Foo" - , " { a :: Int" - , " }" + , "data Foo" + , " = Foo" + , " { a :: Int" + , " }" ] case15 :: Assertion -case15 = expected @=? testStep (step 2) input +case15 = expected @=? testStep (step indentIndentStyle) input where input = unlines [ "module Herp where" @@ -296,14 +311,15 @@ case15 = expected @=? testStep (step 2) input expected = unlines [ "module Herp where" , "" - , "data Foo a = Foo" - , " { a :: a -- comment" - , " , a2 :: String" - , " }" + , "data Foo a" + , " = Foo" + , " { a :: a -- comment" + , " , a2 :: String" + , " }" ] case16 :: Assertion -case16 = expected @=? testStep (step 2) input +case16 = expected @=? testStep (step indentIndentStyle) input where input = unlines [ "module Herp where" @@ -315,13 +331,14 @@ case16 = expected @=? testStep (step 2) input expected = unlines [ "module Herp where" , "" - , "data Foo = Foo" - , " { a :: Int -- ^ comment" - , " }" + , "data Foo" + , " = Foo" + , " { a :: Int -- ^ comment" + , " }" ] case17 :: Assertion -case17 = expected @=? testStep (step 2) input +case17 = expected @=? testStep (step indentIndentStyle) input where input = unlines [ "module Herp where" @@ -335,15 +352,16 @@ case17 = expected @=? testStep (step 2) input expected = unlines [ "module Herp where" , "" - , "data Foo a = Foo" - , " { a :: a" - , " -- comment" - , " , a2 :: String" - , " }" + , "data Foo a" + , " = Foo" + , " { a :: a" + , " -- comment" + , " , a2 :: String" + , " }" ] case18 :: Assertion -case18 = expected @=? testStep (step 2) input +case18 = expected @=? testStep (step indentIndentStyle) input where input = unlines [ "module Herp where" @@ -357,15 +375,16 @@ case18 = expected @=? testStep (step 2) input expected = unlines [ "module Herp where" , "" - , "data Foo a = Foo" - , " { a :: a" - , " -- ^ comment" - , " , a2 :: String" - , " }" + , "data Foo a" + , " = Foo" + , " { a :: a" + , " -- ^ comment" + , " , a2 :: String" + , " }" ] case19 :: Assertion -case19 = expected @=? testStep (step 2) input +case19 = expected @=? testStep (step indentIndentStyle) input where input = unlines [ "module Herp where" @@ -379,21 +398,139 @@ case19 = expected @=? testStep (step 2) input expected = unlines [ "module Herp where" , "" - , "data Foo a = Foo" - , " { firstName, lastName :: String" - , " -- ^ names" - , " , age :: Int" - , " }" + , "data Foo a" + , " = Foo" + , " { firstName, lastName :: String" + , " -- ^ names" + , " , age :: Int" + , " }" ] -- | Should not break Enums (data without records) formating -- -- See https://github.com/jaspervdj/stylish-haskell/issues/262 case20 :: Assertion -case20 = input @=? testStep (step 2) input +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/Tests.hs b/tests/Language/Haskell/Stylish/Tests.hs index e7faa9b..97eab8a 100644 --- a/tests/Language/Haskell/Stylish/Tests.hs +++ b/tests/Language/Haskell/Stylish/Tests.hs @@ -20,13 +20,14 @@ import Language.Haskell.Stylish.Tests.Util -------------------------------------------------------------------------------- tests :: Test -tests = testGroup "Language.Haskell.Stylish.Step.Tabs.Tests" +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 ] @@ -35,12 +36,7 @@ case01 :: Assertion case01 = (@?= result) =<< format Nothing Nothing input where input = "module Herp where\ndata Foo = Bar | Baz { baz :: Int }" - result = Right [ "module Herp where" - , "data Foo = Bar" - , " | Baz" - , " { baz :: Int" - , " }" - ] + result = Right $ lines input -------------------------------------------------------------------------------- @@ -48,8 +44,11 @@ case02 :: Assertion case02 = withTestDirTree $ do writeFile "test-config.yaml" $ unlines [ "steps:" - , " - records: {}" - , "indent: 2" + , " - records:" + , " equals: \"indent 2\"" + , " first_field: \"indent 2\"" + , " field_comment: 2" + , " deriving: 2" ] actual <- format (Just $ ConfigPath "test-config.yaml") Nothing input @@ -57,16 +56,44 @@ case02 = withTestDirTree $ do where input = "module Herp where\ndata Foo = Bar | Baz { baz :: Int }" result = Right [ "module Herp where" - , "data Foo = Bar" + , "data Foo" + , " = Bar" , " | Baz" - , " { baz :: Int" - , " }" + , " { baz :: Int" + , " }" ] - -------------------------------------------------------------------------------- case03 :: Assertion -case03 = (@?= result) =<< format Nothing (Just fileLocation) input +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" @@ -78,8 +105,8 @@ case03 = (@?= result) =<< format Nothing (Just fileLocation) input -------------------------------------------------------------------------------- -- | When providing current dir including folders and files. -case04 :: Assertion -case04 = withTestDirTree $ do +case05 :: Assertion +case05 = withTestDirTree $ do createDirectory aDir >> writeFile c fileCont mapM_ (flip writeFile fileCont) fs result <- findHaskellFiles False input @@ -95,8 +122,8 @@ case04 = withTestDirTree $ do -------------------------------------------------------------------------------- -- | When the input item is not file, do not recurse it. -case05 :: Assertion -case05 = withTestDirTree $ do +case06 :: Assertion +case06 = withTestDirTree $ do mapM_ (flip writeFile "") input result <- findHaskellFiles False input result @?= expected @@ -107,8 +134,8 @@ case05 = withTestDirTree $ do -------------------------------------------------------------------------------- -- | Empty input should result in empty output. -case06 :: Assertion -case06 = withTestDirTree $ do +case07 :: Assertion +case07 = withTestDirTree $ do mapM_ (flip writeFile "") input result <- findHaskellFiles False input result @?= expected -- cgit v1.2.3 From 648b75d1c6851911b83bf9c981e8ad1932d5f75d Mon Sep 17 00:00:00 2001 From: Felix Yan Date: Wed, 19 Feb 2020 05:29:29 +0800 Subject: Correct a typo in Step/Data/Tests.hs (#272) --- tests/Language/Haskell/Stylish/Step/Data/Tests.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/Language/Haskell/Stylish/Step/Data/Tests.hs b/tests/Language/Haskell/Stylish/Step/Data/Tests.hs index 1e7f254..b43e6dc 100644 --- a/tests/Language/Haskell/Stylish/Step/Data/Tests.hs +++ b/tests/Language/Haskell/Stylish/Step/Data/Tests.hs @@ -406,7 +406,7 @@ case19 = expected @=? testStep (step indentIndentStyle) input , " }" ] --- | Should not break Enums (data without records) formating +-- | Should not break Enums (data without records) formatting -- -- See https://github.com/jaspervdj/stylish-haskell/issues/262 case20 :: Assertion -- cgit v1.2.3 From 3621bf3aa5312fef61220e1760d9988307209c6a Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Mon, 24 Feb 2020 15:18:27 +0100 Subject: Bump version to 0.11.0.0 --- CHANGELOG | 6 ++++++ stylish-haskell.cabal | 2 +- 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/CHANGELOG b/CHANGELOG index eca598d..fe2cc55 100644 --- a/CHANGELOG +++ b/CHANGELOG @@ -1,5 +1,11 @@ # CHANGELOG +- 0.11.0.0 (2020-02-24) + * Disable record formatting by default + * Allow more customization for record formatting (by Maxim Koltsov) + * Disable formatting of data types without records (by Maxim Koltsov) + * Add `-r` flag to recursively find Haskell files (by Akos Marton) + - 0.10.0.0 (2020-01-26) * Switch to HsYAML library (by vijayphoenix) * Expose `format` from main library (by Łukasz Gołębiewski) diff --git a/stylish-haskell.cabal b/stylish-haskell.cabal index 6bad961..8e9dffd 100644 --- a/stylish-haskell.cabal +++ b/stylish-haskell.cabal @@ -1,5 +1,5 @@ Name: stylish-haskell -Version: 0.10.0.0 +Version: 0.11.0.0 Synopsis: Haskell code prettifier Homepage: https://github.com/jaspervdj/stylish-haskell License: BSD3 -- cgit v1.2.3