diff options
author | Jasper Van der Jeugt <m@jaspervdj.be> | 2016-02-01 10:56:54 +0100 |
---|---|---|
committer | Jasper Van der Jeugt <m@jaspervdj.be> | 2016-02-01 11:00:39 +0100 |
commit | bf2138aa25af19c1d9993a8d68d0f5795b09dad1 (patch) | |
tree | 7b8f78796c5a1500af6d103dea4440f54c237d0b | |
parent | 38ac6e72fd40de80d9f705a3fb6238f7312111bb (diff) | |
parent | 82ec3e1c458f01206c0230d4db1855c4fb6c64d8 (diff) | |
download | stylish-haskell-bf2138aa25af19c1d9993a8d68d0f5795b09dad1.tar.gz |
Merge branch 'master' of https://github.com/JOndra91/stylish-haskell into JOndra91-master
-rw-r--r-- | .gitignore | 26 | ||||
-rw-r--r-- | data/stylish-haskell.yaml | 77 | ||||
-rw-r--r-- | src/Language/Haskell/Stylish.hs | 1 | ||||
-rw-r--r-- | src/Language/Haskell/Stylish/Config.hs | 55 | ||||
-rw-r--r-- | src/Language/Haskell/Stylish/Step/Imports.hs | 201 | ||||
-rw-r--r-- | src/Language/Haskell/Stylish/Step/LanguagePragmas.hs | 50 | ||||
-rw-r--r-- | src/Language/Haskell/Stylish/Util.hs | 71 | ||||
-rw-r--r-- | tests/Language/Haskell/Stylish/Step/Imports/Tests.hs | 306 | ||||
-rw-r--r-- | tests/Language/Haskell/Stylish/Step/LanguagePragmas/Tests.hs | 51 |
9 files changed, 711 insertions, 127 deletions
@@ -1,18 +1,20 @@ -.stack-work -dist -cabal-dev -*.o -*.hi +*.aux *.chi *.chs.h -*.dyn_o *.dyn_hi +*.dyn_o +*.hi +*.hp +*.o +*.prof +.cabal-sandbox/ +.cabal-sandbox/ .hpc .hsenv -.cabal-sandbox/ -cabal.sandbox.config -cabal.config -*.prof -*.aux -*.hp +.stack-work .stack-work/ +cabal-dev +cabal.config +cabal.sandbox.config +cabal.sandbox.config +dist diff --git a/data/stylish-haskell.yaml b/data/stylish-haskell.yaml index 8ceb732..86baae3 100644 --- a/data/stylish-haskell.yaml +++ b/data/stylish-haskell.yaml @@ -33,6 +33,73 @@ steps: # Default: global. align: global + # Folowing options affect only import list alignment. + # + # List align has following options: + # + # - after alias: Import list is aligned with end of import including + # 'as' and 'hiding' keywords. + # + # > import qualified Data.List as List (concat, foldl, foldr, head, + # > init, last, length) + # + # - with alias: Import list is aligned with start of alias or hiding. + # + # > import qualified Data.List as List (concat, foldl, foldr, head, + # > init, last, length) + # + # - new line: Import list starts always on new line. + # + # > import qualified Data.List as List + # > (concat, foldl, foldr, head, init, last, length) + # + # Default: after alias + list_align: after alias + + # Long list align style takes effect when import is too long. This is + # determined by 'columns' setting. + # + # - inline: This option will put as much specs on same line as possible. + # + # - new line: Import list will start on new line. + # + # - new line-multiline: Import list will start on new line when it's + # short enough to fit to single line. Otherwise it'll be multiline. + # + # - multiline: One line per import list entry. + # Type with contructor list acts like single import. + # + # > import qualified Data.Map as M + # > ( empty + # > , singleton + # > , ... + # > , delete + # > ) + # + # Default: inline + long_list_align: inline + + # List padding determines indentation of import list on lines after import. + # This option affects 'list_align' and 'long_list_align'. + list_padding: 4 + + # Separate lists option affects formating of import list for type + # or class. The only difference is single space between type and list + # of constructors, selectors and class functions. + # + # - true: There is single space between Foldable type and list of it's + # functions. + # + # > import Data.Foldable (Foldable (fold, foldl, foldMap)) + # + # - false: There is no space between Foldable type and list of it's + # functions. + # + # > import Data.Foldable (Foldable(fold, foldl, foldMap)) + # + # Default: true + separate_lists: true + # Language pragmas - language_pragmas: # We can generate different styles of language pragma lists. @@ -47,6 +114,16 @@ steps: # Default: vertical. style: vertical + # Align affects alignment of closing pragma brackets. + # + # - true: Brackets are aligned in same collumn. + # + # - false: Brackets are not aligned together. There is only one space + # between actual import and closing bracket. + # + # Default: true + align: true + # stylish-haskell can detect redundancy of some language pragmas. If this # is set to true, it will remove those redundant pragmas. Default: true. remove_redundant: true diff --git a/src/Language/Haskell/Stylish.hs b/src/Language/Haskell/Stylish.hs index 7a52aa2..b8620ae 100644 --- a/src/Language/Haskell/Stylish.hs +++ b/src/Language/Haskell/Stylish.hs @@ -53,6 +53,7 @@ imports = Imports.step -------------------------------------------------------------------------------- languagePragmas :: Int -- ^ columns -> LanguagePragmas.Style + -> Bool -- ^ Pad to same length in vertical mode? -> Bool -- ^ remove redundant? -> Step languagePragmas = LanguagePragmas.step diff --git a/src/Language/Haskell/Stylish/Config.hs b/src/Language/Haskell/Stylish/Config.hs index 0304ae5..271a461 100644 --- a/src/Language/Haskell/Stylish/Config.hs +++ b/src/Language/Haskell/Stylish/Config.hs @@ -10,23 +10,25 @@ module Language.Haskell.Stylish.Config -------------------------------------------------------------------------------- -import Control.Applicative (pure, (<$>), (<*>)) -import Control.Monad (forM, mzero) -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.List (inits, intercalate) -import Data.Map (Map) -import qualified Data.Map as M -import Data.Yaml (decodeEither) +import Control.Applicative (pure, (<$>), + (<*>)) +import Control.Monad (forM, mzero) +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.List (inits, + intercalate) +import Data.Map (Map) +import qualified Data.Map as M +import Data.Yaml (decodeEither) import System.Directory -import System.FilePath (joinPath, splitPath, - (</>)) +import System.FilePath (joinPath, + splitPath, + (</>)) -------------------------------------------------------------------------------- -import Paths_stylish_haskell (getDataFileName) import Language.Haskell.Stylish.Step import qualified Language.Haskell.Stylish.Step.Imports as Imports import qualified Language.Haskell.Stylish.Step.LanguagePragmas as LanguagePragmas @@ -35,6 +37,7 @@ import qualified Language.Haskell.Stylish.Step.Tabs as Tabs import qualified Language.Haskell.Stylish.Step.TrailingWhitespace as TrailingWhitespace import qualified Language.Haskell.Stylish.Step.UnicodeSyntax as UnicodeSyntax import Language.Haskell.Stylish.Verbose +import Paths_stylish_haskell (getDataFileName) -------------------------------------------------------------------------------- @@ -161,7 +164,14 @@ parseEnum strs _ (Just k) = case lookup k strs of parseImports :: Config -> A.Object -> A.Parser Step parseImports config o = Imports.step <$> pure (configColumns config) - <*> (o A..:? "align" >>= parseEnum aligns Imports.Global) + <*> (Imports.Align + <$> (o A..:? "align" >>= parseEnum aligns Imports.Global) + <*> (o A..:? "list_align" >>= parseEnum listAligns Imports.AfterAlias) + <*> (o A..:? "long_list_align" + >>= parseEnum longListAligns Imports.Inline) + <*> (maybe 4 (max 1) <$> o A..:? "list_padding") + -- ^ Padding have to be at least 1. Default is 4. + <*> o A..:? "separate_lists" A..!= True) where aligns = [ ("global", Imports.Global) @@ -170,18 +180,33 @@ parseImports config o = Imports.step , ("none", Imports.None) ] + listAligns = + [ ("new line", Imports.NewLine) + , ("with alias", Imports.WithAlias) + , ("after alias", Imports.AfterAlias) + ] + + longListAligns = + [ ("inline", Imports.Inline) + , ("new line", Imports.InlineWithBreak) + , ("new line-multiline", Imports.InlineToMultiline) + , ("multiline", Imports.Multiline) + ] + -------------------------------------------------------------------------------- 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..:? "remove_redundant" A..!= True where styles = [ ("vertical", LanguagePragmas.Vertical) , ("compact", LanguagePragmas.Compact) - , ("compact_line", LanguagePragmas.CompactLine)] + , ("compact_line", LanguagePragmas.CompactLine) + ] -------------------------------------------------------------------------------- diff --git a/src/Language/Haskell/Stylish/Step/Imports.hs b/src/Language/Haskell/Stylish/Step/Imports.hs index b58a8e3..14bb818 100644 --- a/src/Language/Haskell/Stylish/Step/Imports.hs +++ b/src/Language/Haskell/Stylish/Step/Imports.hs @@ -1,13 +1,19 @@ +{-# LANGUAGE RecordWildCards #-} -------------------------------------------------------------------------------- module Language.Haskell.Stylish.Step.Imports ( Align (..) + , ImportAlign (..) + , ListAlign (..) + , LongListAlign (..) , step ) where -------------------------------------------------------------------------------- + import Control.Arrow ((&&&)) -import Data.Char (isAlpha, toLower) +import Data.Char (toLower) +import Data.Functor ((<$>)) import Data.List (intercalate, sortBy) import Data.Maybe (isJust, maybeToList) import Data.Ord (comparing) @@ -20,15 +26,35 @@ import Language.Haskell.Stylish.Editor import Language.Haskell.Stylish.Step import Language.Haskell.Stylish.Util - -------------------------------------------------------------------------------- -data Align +data Align = Align + { importAlign :: ImportAlign + , listAlign :: ListAlign + , longListAlign :: LongListAlign + , listPadding :: Int + , separateLists :: Bool + } + deriving (Eq, Show) + +data ImportAlign = Global | File | Group | None deriving (Eq, Show) +data ListAlign + = NewLine + | WithAlias + | AfterAlias + deriving (Eq, Show) + +data LongListAlign + = Inline + | InlineWithBreak + | InlineToMultiline + | Multiline + deriving (Eq, Show) -------------------------------------------------------------------------------- imports :: H.Module l -> [H.ImportDecl l] @@ -58,26 +84,34 @@ compareImports = comparing (map toLower . importName &&& H.importQualified) compareImportSpecs :: H.ImportSpec l -> H.ImportSpec l -> Ordering compareImportSpecs = comparing key where - key :: H.ImportSpec l -> (Int, Int, String) - key (H.IVar _ x) = let n = nameToString x in (1, operator n, n) - key (H.IAbs _ _ x) = (0, 0, nameToString x) - key (H.IThingAll _ x) = (0, 0, nameToString x) - key (H.IThingWith _ x _) = (0, 0, nameToString x) - - operator [] = 0 -- But this should not happen - operator (x : _) = if isAlpha x then 0 else 1 + key :: H.ImportSpec l -> (Int, Bool, String) + key (H.IVar _ x) = (1, isOperator x, nameToString x) + key (H.IAbs _ _ x) = (0, False, nameToString x) + key (H.IThingAll _ x) = (0, False, nameToString x) + key (H.IThingWith _ x _) = (0, False, nameToString x) -------------------------------------------------------------------------------- -- | Sort the input spec list inside an 'H.ImportDecl' sortImportSpecs :: H.ImportDecl l -> H.ImportDecl l -sortImportSpecs imp = imp {H.importSpecs = fmap sort $ H.importSpecs imp} +sortImportSpecs imp = imp {H.importSpecs = sort' <$> H.importSpecs imp} where - sort (H.ImportSpecList l h specs) = H.ImportSpecList l h $ + sort' (H.ImportSpecList l h specs) = H.ImportSpecList l h $ sortBy compareImportSpecs specs -------------------------------------------------------------------------------- +-- | Order of imports in sublist is: +-- Constructors, accessors/methods, operators. +compareImportSubSpecs :: H.CName l -> H.CName l -> Ordering +compareImportSubSpecs = comparing key + where + key :: H.CName l -> (Int, Bool, String) + key (H.ConName _ x) = (0, False, nameToString x) + key (H.VarName _ x) = (1, isOperator x, nameToString x) + + +-------------------------------------------------------------------------------- -- | By default, haskell-src-exts pretty-prints -- -- > import Foo (Bar(..)) @@ -87,38 +121,100 @@ sortImportSpecs imp = imp {H.importSpecs = fmap sort $ H.importSpecs imp} -- > import Foo (Bar (..)) -- -- instead. -prettyImportSpec :: H.ImportSpec l -> String -prettyImportSpec (H.IThingAll _ n) = H.prettyPrint n ++ " (..)" -prettyImportSpec (H.IThingWith _ n cns) = H.prettyPrint n ++ " (" ++ - intercalate ", " (map H.prettyPrint cns) ++ ")" -prettyImportSpec x = H.prettyPrint x +prettyImportSpec :: (Ord l) => Bool -> H.ImportSpec l -> String +prettyImportSpec separate = prettyImportSpec' + where + prettyImportSpec' (H.IThingAll _ n) = H.prettyPrint n ++ sep "(..)" + prettyImportSpec' (H.IThingWith _ n cns) = H.prettyPrint n + ++ sep "(" + ++ intercalate ", " + (map H.prettyPrint $ sortBy compareImportSubSpecs cns) + ++ ")" + prettyImportSpec' x = H.prettyPrint x + + sep = if separate then (' ' :) else id -------------------------------------------------------------------------------- -prettyImport :: Int -> Bool -> Bool -> Int -> H.ImportDecl l -> [String] -prettyImport columns padQualified padName longest imp = - wrap columns base (length base + 2) $ - (if hiding then ("hiding" :) else id) $ - case importSpecs of - Nothing -> [] -- Import everything - Just [] -> ["()"] -- Instance only imports - Just is -> - withInit (++ ",") $ - withHead ("(" ++) $ - withLast (++ ")") $ - map prettyImportSpec $ - is +prettyImport :: (Ord l, Show l) => + Int -> Align -> Bool -> Bool -> Int -> H.ImportDecl l -> [String] +prettyImport columns Align{..} padQualified padName longest imp = + case longListAlign of + Inline -> inlineWrap + InlineWithBreak -> longListWrapper inlineWrap inlineWithBreakWrap + InlineToMultiline -> longListWrapper inlineWrap inlineToMultilineWrap + Multiline -> longListWrapper inlineWrap multilineWrap where - base = unwords $ concat - [ ["import"] - , qualified - , (fmap show $ maybeToList $ H.importPkg imp) - , [(if hasExtras && padName then padRight longest else id) - (importName imp)] - , ["as " ++ as | H.ModuleName _ as <- maybeToList $ H.importAs imp] - ] - - (hiding, importSpecs) = case H.importSpecs imp of + longListWrapper shortWrap longWrap + | listAlign == NewLine + || length shortWrap > 1 + || length (head shortWrap) > columns + = longWrap + | otherwise = shortWrap + + inlineWrap = inlineWrapper + $ mapSpecs + $ withInit (++ ",") + . withHead ("(" ++) + . withLast (++ ")") + + inlineWrapper = case listAlign of + NewLine -> (paddedNoSpecBase :) . wrapRest columns listPadding + WithAlias -> wrap columns paddedBase (inlineBaseLength + 1) + -- Add 1 extra space to ensure same padding as in original code. + AfterAlias -> withTail (' ' :) + . wrap columns paddedBase (afterAliasBaseLength + 1) + + inlineWithBreakWrap = paddedNoSpecBase : wrapRest columns listPadding + ( mapSpecs + $ withInit (++ ",") + . withHead ("(" ++) + . withLast (++ ")")) + + inlineToMultilineWrap + | length inlineWithBreakWrap > 2 + || any ((> columns) . length) (tail inlineWithBreakWrap) + = multilineWrap + | otherwise = inlineWithBreakWrap + + -- 'wrapRest 0' ensures that every item of spec list is on new line. + multilineWrap = paddedNoSpecBase : wrapRest 0 listPadding + ( mapSpecs + ( withHead ("( " ++) + . withTail (", " ++)) + ++ [")"]) + + paddedBase = base $ padImport $ importName imp + + paddedNoSpecBase = base $ padImportNoSpec $ importName imp + + padImport = if hasExtras && padName + then padRight longest + else id + + padImportNoSpec = if (isJust (H.importAs imp) || hasHiding) && padName + then padRight longest + else id + + base' baseName importAs hasHiding' = unwords $ concat $ filter (not . null) + [ ["import"] + , qualified + , show <$> maybeToList (H.importPkg imp) + , [baseName] + , importAs + , hasHiding' + ] + + base baseName = base' baseName + ["as " ++ as | H.ModuleName _ as <- maybeToList $ H.importAs imp] + ["hiding" | hasHiding] + + inlineBaseLength = length $ base' (padImport $ importName imp) [] [] + + afterAliasBaseLength = length $ base' (padImport $ importName imp) + ["as " ++ as | H.ModuleName _ as <- maybeToList $ H.importAs imp] [] + + (hasHiding, importSpecs) = case H.importSpecs imp of Just (H.ImportSpecList _ h l) -> (h, Just l) _ -> (False, Nothing) @@ -129,21 +225,29 @@ prettyImport columns padQualified padName longest imp = | padQualified = [" "] | otherwise = [] + mapSpecs f = case importSpecs of + Nothing -> [] -- Import everything + Just [] -> ["()"] -- Instance only imports + Just is -> f $ map (prettyImportSpec separateLists) is + -------------------------------------------------------------------------------- -prettyImportGroup :: Int -> Align -> Bool -> Int -> [H.ImportDecl LineBlock] +prettyImportGroup :: Int -> Align -> Bool -> Int + -> [H.ImportDecl LineBlock] -> Lines prettyImportGroup columns align fileAlign longest imps = - concatMap (prettyImport columns padQual padName longest') $ + concatMap (prettyImport columns align padQual padName longest') $ sortBy compareImports imps where - longest' = case align of + align' = importAlign align + + longest' = case align' of Group -> longestImport imps _ -> longest - padName = align /= None + padName = align' /= None - padQual = case align of + padQual = case align' of Global -> True File -> fileAlign Group -> any H.importQualified imps @@ -157,16 +261,17 @@ step columns = makeStep "Imports" . step' columns -------------------------------------------------------------------------------- step' :: Int -> Align -> Lines -> Module -> Lines -step' columns align ls (module', _) = flip applyChanges ls +step' columns align ls (module', _) = applyChanges [ change block $ const $ prettyImportGroup columns align fileAlign longest importGroup | (block, importGroup) <- groups ] + ls where imps = map sortImportSpecs $ imports $ fmap linesFromSrcSpan module' longest = longestImport imps groups = groupAdjacent [(H.ann i, i) | i <- imps] - fileAlign = case align of + fileAlign = case importAlign align of File -> any H.importQualified imps _ -> False diff --git a/src/Language/Haskell/Stylish/Step/LanguagePragmas.hs b/src/Language/Haskell/Stylish/Step/LanguagePragmas.hs index 209b2f2..0239736 100644 --- a/src/Language/Haskell/Stylish/Step/LanguagePragmas.hs +++ b/src/Language/Haskell/Stylish/Step/LanguagePragmas.hs @@ -42,11 +42,15 @@ firstLocation = minimum . map (blockStart . fst) -------------------------------------------------------------------------------- -verticalPragmas :: Int -> [String] -> Lines -verticalPragmas longest pragmas' = - [ "{-# LANGUAGE " ++ padRight longest pragma ++ " #-}" +verticalPragmas :: Int -> Bool -> [String] -> Lines +verticalPragmas longest align pragmas' = + [ "{-# LANGUAGE " ++ pad pragma ++ " #-}" | pragma <- pragmas' ] + where + pad + | align = padRight longest + | otherwise = id -------------------------------------------------------------------------------- @@ -56,17 +60,23 @@ compactPragmas columns pragmas' = wrap columns "{-# LANGUAGE" 13 $ -------------------------------------------------------------------------------- -compactLinePragmas :: Int -> [String] -> Lines -compactLinePragmas _ [] = [] -compactLinePragmas columns pragmas' = - let maxWidth = columns - 16 - longest = maximum $ map length prags - prags = map truncateComma $ wrap maxWidth "" 1 $ - map (++ ",") (init pragmas') ++ [last pragmas'] - in map (wrapLanguage . padRight longest) prags +compactLinePragmas :: Int -> Bool -> [String] -> Lines +compactLinePragmas _ _ [] = [] +compactLinePragmas columns align pragmas' = map (wrapLanguage . pad) prags where wrapLanguage ps = "{-# LANGUAGE" ++ 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'] + -------------------------------------------------------------------------------- truncateComma :: String -> String @@ -77,10 +87,10 @@ truncateComma xs -------------------------------------------------------------------------------- -prettyPragmas :: Int -> Int -> Style -> [String] -> Lines -prettyPragmas _ longest Vertical = verticalPragmas longest -prettyPragmas columns _ Compact = compactPragmas columns -prettyPragmas columns _ CompactLine = compactLinePragmas columns +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 -------------------------------------------------------------------------------- @@ -100,13 +110,13 @@ filterRedundant isRedundant' = snd . foldr filterRedundant' (S.empty, []) known' = xs' `S.union` known -------------------------------------------------------------------------------- -step :: Int -> Style -> Bool -> Step -step columns style = makeStep "LanguagePragmas" . step' columns style +step :: Int -> Style -> Bool -> Bool -> Step +step = (((makeStep "LanguagePragmas" .) .) .) . step' -------------------------------------------------------------------------------- -step' :: Int -> Style -> Bool -> Lines -> Module -> Lines -step' columns style removeRedundant ls (module', _) +step' :: Int -> Style -> Bool -> Bool -> Lines -> Module -> Lines +step' columns style align removeRedundant ls (module', _) | null pragmas' = ls | otherwise = applyChanges changes ls where @@ -118,7 +128,7 @@ step' columns style removeRedundant ls (module', _) longest = maximum $ map length $ snd =<< pragmas' groups = [(b, concat pgs) | (b, pgs) <- groupAdjacent pragmas'] changes = - [ change b (const $ prettyPragmas columns longest style pg) + [ change b (const $ prettyPragmas columns longest align style pg) | (b, pg) <- filterRedundant isRedundant' groups ] diff --git a/src/Language/Haskell/Stylish/Util.hs b/src/Language/Haskell/Stylish/Util.hs index 004c3f1..ed5de91 100644 --- a/src/Language/Haskell/Stylish/Util.hs +++ b/src/Language/Haskell/Stylish/Util.hs @@ -1,23 +1,27 @@ -------------------------------------------------------------------------------- module Language.Haskell.Stylish.Util ( nameToString + , isOperator , indent , padRight , everything , infoPoints , wrap + , wrapRest , withHead - , withLast , withInit + , withTail + , withLast ) where -------------------------------------------------------------------------------- import Control.Arrow ((&&&), (>>>)) +import Data.Char (isAlpha) import Data.Data (Data) import qualified Data.Generics as G -import Data.Maybe (maybeToList) +import Data.Maybe (fromMaybe, listToMaybe, maybeToList) import Data.Typeable (cast) import qualified Language.Haskell.Exts.Annotated as H @@ -33,8 +37,19 @@ nameToString (H.Symbol _ str) = str -------------------------------------------------------------------------------- +isOperator :: H.Name l -> Bool +isOperator = fromMaybe False + . (fmap (not . isAlpha) . listToMaybe) + . nameToString + +-------------------------------------------------------------------------------- indent :: Int -> String -> String -indent len str = replicate len ' ' ++ str +indent len = (indentPrefix len ++) + + +-------------------------------------------------------------------------------- +indentPrefix :: Int -> String +indentPrefix = (`replicate` ' ') -------------------------------------------------------------------------------- @@ -58,21 +73,34 @@ wrap :: Int -- ^ Maximum line width -> Int -- ^ Indentation -> [String] -- ^ Strings to add/wrap -> Lines -- ^ Resulting lines -wrap maxWidth leading ind strs = - let (ls, curr, _) = foldl step ([], leading, length leading) strs - in ls ++ [curr] +wrap maxWidth leading ind = wrap' leading where - -- TODO: In order to optimize this, use a difference list instead of a - -- regular list for 'ls'. - step (ls, curr, width) str - | nextLine = (ls ++ [curr], indent ind str, ind + len) - | otherwise = (ls, curr ++ " " ++ str, width') - where - -- Put it on the next line if it would make the current line too long, - -- AND if it doesn't make the next line too long. - nextLine = width' > maxWidth && ind + len <= maxWidth - len = length str - width' = width + 1 + len + wrap' ss [] = [ss] + wrap' ss (str:strs) + | overflows ss str = + ss : wrapRest maxWidth ind (str:strs) + | otherwise = wrap' (ss ++ " " ++ str) strs + + overflows ss str = length ss > maxWidth || + ((length ss + length str) >= maxWidth && ind + length str <= maxWidth) + + +-------------------------------------------------------------------------------- +wrapRest :: Int + -> Int + -> [String] + -> Lines +wrapRest maxWidth ind = reverse . wrapRest' [] "" + where + wrapRest' ls ss [] + | null ss = ls + | otherwise = ss:ls + wrapRest' ls ss (str:strs) + | null ss = wrapRest' ls (indent ind str) strs + | overflows ss str = wrapRest' (ss:ls) "" (str:strs) + | otherwise = wrapRest' ls (ss ++ " " ++ str) strs + + overflows ss str = (length ss + length str + 1) >= maxWidth -------------------------------------------------------------------------------- @@ -84,12 +112,17 @@ withHead f (x : xs) = f x : xs -------------------------------------------------------------------------------- withLast :: (a -> a) -> [a] -> [a] withLast _ [] = [] -withLast f (x : []) = [f x] +withLast f [x] = [f x] withLast f (x : xs) = x : withLast f xs -------------------------------------------------------------------------------- withInit :: (a -> a) -> [a] -> [a] withInit _ [] = [] -withInit _ (x : []) = [x] +withInit _ [x] = [x] withInit f (x : xs) = f x : withInit f xs + +-------------------------------------------------------------------------------- +withTail :: (a -> a) -> [a] -> [a] +withTail _ [] = [] +withTail f (x : xs) = x : map f xs diff --git a/tests/Language/Haskell/Stylish/Step/Imports/Tests.hs b/tests/Language/Haskell/Stylish/Step/Imports/Tests.hs index c62fe0f..4ed0bd6 100644 --- a/tests/Language/Haskell/Stylish/Step/Imports/Tests.hs +++ b/tests/Language/Haskell/Stylish/Step/Imports/Tests.hs @@ -16,6 +16,15 @@ import Language.Haskell.Stylish.Tests.Util -------------------------------------------------------------------------------- +defaultAlign :: Align +defaultAlign = Align Global AfterAlias Inline 4 True + + +-------------------------------------------------------------------------------- +fromImportAlign :: ImportAlign -> Align +fromImportAlign align = defaultAlign { importAlign = align } + +-------------------------------------------------------------------------------- tests :: Test tests = testGroup "Language.Haskell.Stylish.Step.Imports.Tests" [ testCase "case 01" case01 @@ -25,6 +34,17 @@ tests = testGroup "Language.Haskell.Stylish.Step.Imports.Tests" , 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 ] @@ -37,6 +57,8 @@ input = unlines , "import Control.Monad" , "import Only.Instances()" , "import Data.Map (lookup, (!), insert, Map)" + , "import Data.List as List (concat, foldl, foldr, head, init, last,\ + \ length, map, null, reverse, tail, (++))" , "" , "import Herp.Derp.Internals hiding (foo)" , "import Foo (Bar (..))" @@ -47,12 +69,15 @@ input = unlines -------------------------------------------------------------------------------- case01 :: Assertion -case01 = expected @=? testStep (step 80 Global) input +case01 = expected @=? testStep (step 80 $ fromImportAlign Global) input where expected = unlines [ "module Herp where" , "" , "import Control.Monad" + , "import Data.List as List (concat, foldl, foldr, head, init," + , " last, length, map, null, reverse," + , " tail, (++))" , "import Data.Map (Map, insert, lookup, (!))" , "import qualified Data.Map as M" , "import Only.Instances ()" @@ -66,12 +91,14 @@ case01 = expected @=? testStep (step 80 Global) input -------------------------------------------------------------------------------- case02 :: Assertion -case02 = expected @=? testStep (step 80 Group) input +case02 = expected @=? testStep (step 80 $ fromImportAlign Group) input where expected = unlines [ "module Herp where" , "" , "import Control.Monad" + , "import Data.List as List (concat, foldl, foldr, head, init, last," + , " length, map, null, reverse, tail, (++))" , "import Data.Map (Map, insert, lookup, (!))" , "import qualified Data.Map as M" , "import Only.Instances ()" @@ -85,12 +112,14 @@ case02 = expected @=? testStep (step 80 Group) input -------------------------------------------------------------------------------- case03 :: Assertion -case03 = expected @=? testStep (step 80 None) input +case03 = expected @=? testStep (step 80 $ fromImportAlign None) input where expected = unlines [ "module Herp where" , "" , "import Control.Monad" + , "import Data.List as List (concat, foldl, foldr, head, init, last, length, map," + , " null, reverse, tail, (++))" , "import Data.Map (Map, insert, lookup, (!))" , "import qualified Data.Map as M" , "import Only.Instances ()" @@ -104,7 +133,7 @@ case03 = expected @=? testStep (step 80 None) input -------------------------------------------------------------------------------- case04 :: Assertion -case04 = expected @=? testStep (step 80 Global) input' +case04 = expected @=? testStep (step 80 $ fromImportAlign Global) input' where input' = "import Data.Aeson.Types (object, typeMismatch, FromJSON(..)," ++ @@ -119,7 +148,7 @@ case04 = expected @=? testStep (step 80 Global) input' -------------------------------------------------------------------------------- case05 :: Assertion -case05 = input' @=? testStep (step 80 Group) input' +case05 = input' @=? testStep (step 80 $ fromImportAlign Group) input' where input' = "import Distribution.PackageDescription.Configuration " ++ "(finalizePackageDescription)\n" @@ -127,7 +156,7 @@ case05 = input' @=? testStep (step 80 Group) input' -------------------------------------------------------------------------------- case06 :: Assertion -case06 = input' @=? testStep (step 80 File) input' +case06 = input' @=? testStep (step 80 $ fromImportAlign File) input' where input' = unlines [ "import Bar.Qux" @@ -137,7 +166,7 @@ case06 = input' @=? testStep (step 80 File) input' -------------------------------------------------------------------------------- case07 :: Assertion -case07 = expected @=? testStep (step 80 File) input' +case07 = expected @=? testStep (step 80 $ fromImportAlign File) input' where input' = unlines [ "import Bar.Qux" @@ -150,3 +179,266 @@ case07 = expected @=? testStep (step 80 File) input' , "" , "import qualified Foo.Bar" ] + + +-------------------------------------------------------------------------------- +case08 :: Assertion +case08 = expected + @=? testStep (step 80 $ Align Global WithAlias Inline 4 True) input + where + expected = unlines + [ "module Herp where" + , "" + , "import Control.Monad" + , "import Data.List as List (concat, foldl, foldr, head, init," + , " last, length, map, null, reverse, tail," + , " (++))" + , "import Data.Map (Map, insert, lookup, (!))" + , "import qualified Data.Map as M" + , "import Only.Instances ()" + , "" + , "import Foo (Bar (..))" + , "import Herp.Derp.Internals hiding (foo)" + , "" + , "herp = putStrLn \"import Hello world\"" + ] + + +-------------------------------------------------------------------------------- +case09 :: Assertion +case09 = expected + @=? testStep (step 80 $ Align Global WithAlias Multiline 4 True) input + where + expected = unlines + [ "module Herp where" + , "" + , "import Control.Monad" + , "import Data.List as List" + , " ( concat" + , " , foldl" + , " , foldr" + , " , head" + , " , init" + , " , last" + , " , length" + , " , map" + , " , null" + , " , reverse" + , " , tail" + , " , (++)" + , " )" + , "import Data.Map (Map, insert, lookup, (!))" + , "import qualified Data.Map as M" + , "import Only.Instances ()" + , "" + , "import Foo (Bar (..))" + , "import Herp.Derp.Internals hiding (foo)" + , "" + , "herp = putStrLn \"import Hello world\"" + ] + + +-------------------------------------------------------------------------------- +case10 :: Assertion +case10 = expected + @=? testStep (step 40 $ Align Group WithAlias Multiline 4 True) input + where + expected = unlines + [ "module Herp where" + , "" + , "import Control.Monad" + , "import Data.List as List" + , " ( concat" + , " , foldl" + , " , foldr" + , " , head" + , " , init" + , " , last" + , " , length" + , " , map" + , " , null" + , " , reverse" + , " , tail" + , " , (++)" + , " )" + , "import Data.Map" + , " ( Map" + , " , insert" + , " , lookup" + , " , (!)" + , " )" + , "import qualified Data.Map as M" + , "import Only.Instances ()" + , "" + , "import Foo (Bar (..))" + , "import Herp.Derp.Internals hiding (foo)" + , "" + , "herp = putStrLn \"import Hello world\"" + ] + + +-------------------------------------------------------------------------------- +case11 :: Assertion +case11 = expected + @=? testStep (step 80 $ Align Group NewLine Inline 4 True) input + where + expected = unlines + [ "module Herp where" + , "" + , "import Control.Monad" + , "import Data.List as List" + , " (concat, foldl, foldr, head, init, last, length, map, null, reverse, tail," + , " (++))" + , "import Data.Map" + , " (Map, insert, lookup, (!))" + , "import qualified Data.Map as M" + , "import Only.Instances" + , " ()" + , "" + , "import Foo" + , " (Bar (..))" + , "import Herp.Derp.Internals hiding" + , " (foo)" + + , "" + , "herp = putStrLn \"import Hello world\"" + ] + + +-------------------------------------------------------------------------------- +case12 :: Assertion +case12 = expected + @=? testStep (step 80 $ Align Group NewLine Inline 2 True) input' + where + input' = unlines + [ "import Data.List (map)" + ] + + expected = unlines + [ "import Data.List" + , " (map)" + ] + + +-------------------------------------------------------------------------------- +case13 :: Assertion +case13 = expected + @=? testStep (step 80 $ Align None WithAlias InlineWithBreak 4 True) input' + where + input' = unlines + [ "import qualified Data.List as List (concat, foldl, foldr, head, init," + , " last, length, map, null, reverse, tail, (++))" + ] + + expected = unlines + [ "import qualified Data.List as List" + , " (concat, foldl, foldr, head, init, last, length, map, null, reverse, tail," + , " (++))" + ] + + +-------------------------------------------------------------------------------- +case14 :: Assertion +case14 = expected + @=? testStep + (step 80 $ Align None WithAlias InlineWithBreak 10 True) expected + where + expected = unlines + [ "import qualified Data.List as List (concat, map, null, reverse, tail, (++))" + ] + + +-------------------------------------------------------------------------------- +case15 :: Assertion +case15 = expected + @=? testStep (step 80 $ Align None AfterAlias Multiline 4 True) input' + where + expected = unlines + [ "import Data.Acid (AcidState)" + , "import qualified Data.Acid as Acid" + , " ( closeAcidState" + , " , createCheckpoint" + , " , openLocalStateFrom" + , " )" + , "import Data.Default.Class (Default (def))" + , "" + , "import qualified Herp.Derp.Internal.Types.Foobar as Internal (bar, foo)" + ] + + input' = unlines + [ "import Data.Acid (AcidState)" + , "import qualified Data.Acid as Acid (closeAcidState, createCheckpoint, openLocalStateFrom)" + , "import Data.Default.Class (Default (def))" + , "" + , "import qualified Herp.Derp.Internal.Types.Foobar as Internal (foo, bar)" + ] + + +-------------------------------------------------------------------------------- +case16 :: Assertion +case16 = expected + @=? testStep (step 80 $ Align None AfterAlias Multiline 4 False) input' + where + expected = unlines + [ "import Data.Acid (AcidState)" + , "import Data.Default.Class (Default(def))" + , "" + , "import Data.Maybe (Maybe(Just, Nothing))" + , "" + , "import Data.Foo (Foo(Bar, Foo), Goo(Goo))" + ] + + input' = unlines + [ "import Data.Acid (AcidState)" + , "import Data.Default.Class (Default(def))" + , "" + , "import Data.Maybe (Maybe (Just, Nothing))" + , "" + , "import Data.Foo (Foo (Foo,Bar), Goo(Goo))" + ] + + +-------------------------------------------------------------------------------- +case17 :: Assertion +case17 = expected + @=? testStep (step 80 $ Align None AfterAlias Multiline 4 True) input' + where + expected = unlines + [ "import Control.Applicative (Applicative (pure, (<*>)))" + , "" + , "import Data.Identity (Identity (Identity, runIdentity))" + ] + + input' = unlines + [ "import Control.Applicative (Applicative ((<*>),pure))" + , "" + , "import Data.Identity (Identity (runIdentity,Identity))" + ] + + +-------------------------------------------------------------------------------- +case18 :: Assertion +case18 = expected @=? testStep + (step 40 $ Align None AfterAlias InlineToMultiline 4 True) input' + where + expected = unlines + ---------------------------------------- + [ "import Data.Foo as Foo (Bar, Baz, Foo)" + , "" + , "import Data.Identity" + , " (Identity (Identity, runIdentity))" + , "" + , "import Data.Acid as Acid" + , " ( closeAcidState" + , " , createCheckpoint" + , " , openLocalStateFrom" + , " )" + ] + + input' = unlines + [ "import Data.Foo as Foo (Bar, Baz, Foo)" + , "" + , "import Data.Identity (Identity (Identity, runIdentity))" + , "" + , "import Data.Acid as Acid (closeAcidState, createCheckpoint, openLocalStateFrom)" + ] diff --git a/tests/Language/Haskell/Stylish/Step/LanguagePragmas/Tests.hs b/tests/Language/Haskell/Stylish/Step/LanguagePragmas/Tests.hs index 3cfabef..fe889e4 100644 --- a/tests/Language/Haskell/Stylish/Step/LanguagePragmas/Tests.hs +++ b/tests/Language/Haskell/Stylish/Step/LanguagePragmas/Tests.hs @@ -24,12 +24,14 @@ tests = testGroup "Language.Haskell.Stylish.Step.LanguagePragmas.Tests" , testCase "case 04" case04 , testCase "case 05" case05 , testCase "case 06" case06 + , testCase "case 07" case07 + , testCase "case 08" case08 ] -------------------------------------------------------------------------------- case01 :: Assertion -case01 = expected @=? testStep (step 80 Vertical False) input +case01 = expected @=? testStep (step 80 Vertical True False) input where input = unlines [ "{-# LANGUAGE ViewPatterns #-}" @@ -48,7 +50,7 @@ case01 = expected @=? testStep (step 80 Vertical False) input -------------------------------------------------------------------------------- case02 :: Assertion -case02 = expected @=? testStep (step 80 Vertical True) input +case02 = expected @=? testStep (step 80 Vertical True True) input where input = unlines [ "{-# LANGUAGE BangPatterns #-}" @@ -64,7 +66,7 @@ case02 = expected @=? testStep (step 80 Vertical True) input -------------------------------------------------------------------------------- case03 :: Assertion -case03 = expected @=? testStep (step 80 Vertical True) input +case03 = expected @=? testStep (step 80 Vertical True True) input where input = unlines [ "{-# LANGUAGE BangPatterns #-}" @@ -80,7 +82,7 @@ case03 = expected @=? testStep (step 80 Vertical True) input -------------------------------------------------------------------------------- case04 :: Assertion -case04 = expected @=? testStep (step 80 Compact False) input +case04 = expected @=? testStep (step 80 Compact True False) input where input = unlines [ "{-# LANGUAGE TypeOperators, StandaloneDeriving, DeriveDataTypeable," @@ -97,7 +99,7 @@ case04 = expected @=? testStep (step 80 Compact False) input -------------------------------------------------------------------------------- case05 :: Assertion -case05 = expected @=? testStep (step 80 Vertical False) input +case05 = expected @=? testStep (step 80 Vertical True False) input where input = unlines [ "{-# LANGUAGE CPP #-}" @@ -115,8 +117,10 @@ case05 = expected @=? testStep (step 80 Vertical False) input , "#endif" ] + +-------------------------------------------------------------------------------- case06 :: Assertion -case06 = expected @=? testStep (step 80 CompactLine False) input +case06 = expected @=? testStep (step 80 CompactLine True False) input where input = unlines [ "{-# LANGUAGE TypeOperators, StandaloneDeriving, DeriveDataTypeable," @@ -128,3 +132,38 @@ case06 = expected @=? testStep (step 80 CompactLine False) input "TemplateHaskell #-}" , "{-# LANGUAGE TypeOperators, ViewPatterns #-}" ] + +-------------------------------------------------------------------------------- +case07 :: Assertion +case07 = expected @=? testStep (step 80 Vertical False False) 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" + ] + + +-------------------------------------------------------------------------------- +case08 :: Assertion +case08 = expected @=? testStep (step 80 CompactLine False False) input + where + input = unlines + [ "{-# LANGUAGE TypeOperators, StandaloneDeriving, DeriveDataTypeable," + , " TemplateHaskell #-}" + , "{-# LANGUAGE TemplateHaskell, ViewPatterns #-}" + ] + expected = unlines + [ "{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving, " ++ + "TemplateHaskell #-}" + , "{-# LANGUAGE TypeOperators, ViewPatterns #-}" + ] |