Skip to content

Commit 9f1e714

Browse files
jaspervdj1Computer1
jaspervdj
and
1Computer1
committed
Add new option for aligning groups of adjacent items
Co-authored-by: 1computer1 <onecomputer00@gmail.com>
1 parent eab7669 commit 9f1e714

File tree

8 files changed

+230
-94
lines changed

8 files changed

+230
-94
lines changed

‎.gitignore‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -17,5 +17,6 @@ cabal-dev
1717
cabal.config
1818
cabal.sandbox.config
1919
cabal.sandbox.config
20+
cabal.project.local
2021
dist
2122
/dist-newstyle/

‎data/stylish-haskell.yaml‎

Lines changed: 10 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -89,12 +89,17 @@ steps:
8989

9090
# Align the right hand side of some elements. This is quite conservative
9191
# and only applies to statements where each element occupies a single
92-
# line. All default to true.
92+
# line.
93+
# Possible values:
94+
# - always - Always align statements.
95+
# - adjacent - Align statements that are on adjacent lines in groups.
96+
# - never - Never align statements.
97+
# All default to always.
9398
- simple_align:
94-
cases: true
95-
top_level_patterns: true
96-
records: true
97-
multi_way_if: true
99+
cases: always
100+
top_level_patterns: always
101+
records: always
102+
multi_way_if: always
98103

99104
# Import cleanup
100105
- imports:

‎lib/Language/Haskell/Stylish/Config.hs‎

Lines changed: 22 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,5 @@
11
--------------------------------------------------------------------------------
2-
{-# LANGUAGE BlockArguments #-}
2+
{-# LANGUAGE BlockArguments #-}
33
{-# LANGUAGE LambdaCase #-}
44
{-# LANGUAGE OverloadedStrings #-}
55
{-# LANGUAGE TemplateHaskell #-}
@@ -10,10 +10,12 @@ module Language.Haskell.Stylish.Config
1010
, defaultConfigBytes
1111
, configFilePath
1212
, loadConfig
13+
, parseConfig
1314
) where
1415

1516

1617
--------------------------------------------------------------------------------
18+
import Control.Applicative ((<|>))
1719
import Control.Monad (forM, mzero)
1820
import Data.Aeson (FromJSON (..))
1921
import qualified Data.Aeson as A
@@ -43,8 +45,8 @@ import Language.Haskell.Stylish.Config.Internal
4345
import Language.Haskell.Stylish.Step
4446
import qualified Language.Haskell.Stylish.Step.Data as Data
4547
import qualified Language.Haskell.Stylish.Step.Imports as Imports
46-
import qualified Language.Haskell.Stylish.Step.ModuleHeader as ModuleHeader
4748
import qualified Language.Haskell.Stylish.Step.LanguagePragmas as LanguagePragmas
49+
import qualified Language.Haskell.Stylish.Step.ModuleHeader as ModuleHeader
4850
import qualified Language.Haskell.Stylish.Step.SimpleAlign as SimpleAlign
4951
import qualified Language.Haskell.Stylish.Step.Squash as Squash
5052
import qualified Language.Haskell.Stylish.Step.Tabs as Tabs
@@ -74,7 +76,7 @@ data ExitCodeBehavior
7476
deriving (Eq)
7577

7678
instance Show ExitCodeBehavior where
77-
show NormalExitBehavior = "normal"
79+
show NormalExitBehavior = "normal"
7880
show ErrorOnFormatExitBehavior = "error_on_format"
7981

8082
--------------------------------------------------------------------------------
@@ -206,12 +208,22 @@ parseSimpleAlign :: Config -> A.Object -> A.Parser Step
206208
parseSimpleAlign c o = SimpleAlign.step
207209
<$> pure (configColumns c)
208210
<*> (SimpleAlign.Config
209-
<$> withDef SimpleAlign.cCases "cases"
210-
<*> withDef SimpleAlign.cTopLevelPatterns "top_level_patterns"
211-
<*> withDef SimpleAlign.cRecords "records"
212-
<*> withDef SimpleAlign.cMultiWayIf "multi_way_if")
211+
<$> parseAlign "cases" SimpleAlign.cCases
212+
<*> parseAlign "top_level_patterns" SimpleAlign.cTopLevelPatterns
213+
<*> parseAlign "records" SimpleAlign.cRecords
214+
<*> parseAlign "multi_way_if" SimpleAlign.cMultiWayIf)
213215
where
214-
withDef f k = fromMaybe (f SimpleAlign.defaultConfig) <$> (o A..:? k)
216+
parseAlign key f =
217+
(o A..:? key >>= parseEnum aligns (f SimpleAlign.defaultConfig)) <|>
218+
(boolToAlign <$> o A..: key)
219+
aligns =
220+
[ ("always", SimpleAlign.Always)
221+
, ("adjacent", SimpleAlign.Adjacent)
222+
, ("never", SimpleAlign.Never)
223+
]
224+
boolToAlign True = SimpleAlign.Always
225+
boolToAlign False = SimpleAlign.Never
226+
215227

216228
--------------------------------------------------------------------------------
217229
parseRecords :: Config -> A.Object -> A.Parser Step
@@ -295,8 +307,8 @@ parseImports config o = fmap (Imports.step columns) $ Imports.Options
295307

296308
parseListPadding = \case
297309
A.String "module_name" -> pure Imports.LPModuleName
298-
A.Number n | n >= 1 -> pure $ Imports.LPConstant (truncate n)
299-
v -> A.typeMismatch "'module_name' or >=1 number" v
310+
A.Number n | n >= 1 -> pure $ Imports.LPConstant (truncate n)
311+
v -> A.typeMismatch "'module_name' or >=1 number" v
300312

301313
--------------------------------------------------------------------------------
302314
parseLanguagePragmas :: Config -> A.Object -> A.Parser Step

‎lib/Language/Haskell/Stylish/GHC.hs‎

Lines changed: 21 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -6,6 +6,7 @@ module Language.Haskell.Stylish.GHC
66
, dropBeforeLocated
77
, dropBeforeAndAfter
88
-- * Unsafe getters
9+
, unsafeGetRealSrcSpan
910
, getEndLineUnsafe
1011
, getStartLineUnsafe
1112
-- * Standard settings
@@ -18,32 +19,33 @@ module Language.Haskell.Stylish.GHC
1819
) where
1920

2021
--------------------------------------------------------------------------------
21-
import Data.Function (on)
22+
import Data.Function (on)
2223

2324
--------------------------------------------------------------------------------
24-
import DynFlags (Settings(..), defaultDynFlags)
25-
import qualified DynFlags as GHC
26-
import FileSettings (FileSettings(..))
27-
import GHC.Fingerprint (fingerprint0)
25+
import DynFlags (Settings (..), defaultDynFlags)
26+
import qualified DynFlags as GHC
27+
import FileSettings (FileSettings (..))
28+
import GHC.Fingerprint (fingerprint0)
2829
import GHC.Platform
29-
import GHC.Version (cProjectVersion)
30-
import GhcNameVersion (GhcNameVersion(..))
31-
import PlatformConstants (PlatformConstants(..))
32-
import SrcLoc (GenLocated(..), SrcSpan(..))
33-
import SrcLoc (Located, RealLocated)
34-
import SrcLoc (srcSpanStartLine, srcSpanEndLine)
35-
import ToolSettings (ToolSettings(..))
36-
import qualified Outputable as GHC
30+
import GHC.Version (cProjectVersion)
31+
import GhcNameVersion (GhcNameVersion (..))
32+
import qualified Outputable as GHC
33+
import PlatformConstants (PlatformConstants (..))
34+
import SrcLoc (GenLocated (..), Located, RealLocated,
35+
RealSrcSpan, SrcSpan (..), srcSpanEndLine,
36+
srcSpanStartLine)
37+
import ToolSettings (ToolSettings (..))
38+
39+
unsafeGetRealSrcSpan :: Located a -> RealSrcSpan
40+
unsafeGetRealSrcSpan = \case
41+
(L (RealSrcSpan s) _) -> s
42+
_ -> error "could not get source code location"
3743

3844
getStartLineUnsafe :: Located a -> Int
39-
getStartLineUnsafe = \case
40-
(L (RealSrcSpan s) _) -> srcSpanStartLine s
41-
_ -> error "could not get start line of block"
45+
getStartLineUnsafe = srcSpanStartLine . unsafeGetRealSrcSpan
4246

4347
getEndLineUnsafe :: Located a -> Int
44-
getEndLineUnsafe = \case
45-
(L (RealSrcSpan s) _) -> srcSpanEndLine s
46-
_ -> error "could not get end line of block"
48+
getEndLineUnsafe = srcSpanEndLine . unsafeGetRealSrcSpan
4749

4850
dropAfterLocated :: Maybe (Located a) -> [RealLocated b] -> [RealLocated b]
4951
dropAfterLocated loc xs = case loc of

‎lib/Language/Haskell/Stylish/Module.hs‎

Lines changed: 15 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -24,6 +24,7 @@ module Language.Haskell.Stylish.Module
2424
, moduleComments
2525
, moduleLanguagePragmas
2626
, queryModule
27+
, groupByLine
2728

2829
-- * Imports
2930
, canMergeImport
@@ -192,22 +193,21 @@ moduleImports m
192193

193194
-- | Get groups of imports from module
194195
moduleImportGroups :: Module -> [NonEmpty (Located Import)]
195-
moduleImportGroups = go [] Nothing . moduleImports
196+
moduleImportGroups = groupByLine unsafeGetRealSrcSpan . moduleImports
197+
198+
-- The same logic as 'Language.Haskell.Stylish.Module.moduleImportGroups'.
199+
groupByLine :: (a -> RealSrcSpan) -> [a] -> [NonEmpty a]
200+
groupByLine f = go [] Nothing
196201
where
197-
-- Run through all imports (assume they are sorted already in order of
198-
-- appearance in the file) and group the ones that are on consecutive
199-
-- lines.
200-
go :: [Located Import] -> Maybe Int -> [Located Import]
201-
-> [NonEmpty (Located Import)]
202-
go acc _ [] = ne acc
203-
go acc mbCurrentLine (imp : impRest) =
204-
let
205-
lStart = getStartLineUnsafe imp
206-
lEnd = getEndLineUnsafe imp in
207-
case mbCurrentLine of
208-
Just lPrevEnd | lPrevEnd + 1 < lStart
209-
-> ne acc ++ go [imp] (Just lEnd) impRest
210-
_ -> go (acc ++ [imp]) (Just lEnd) impRest
202+
go acc _ [] = ne acc
203+
go acc mbCurrentLine (x:xs) =
204+
let
205+
lStart = GHC.srcSpanStartLine (f x)
206+
lEnd = GHC.srcSpanEndLine (f x) in
207+
case mbCurrentLine of
208+
Just lPrevEnd | lPrevEnd + 1 < lStart
209+
-> ne acc ++ go [x] (Just lEnd) xs
210+
_ -> go (acc ++ [x]) (Just lEnd) xs
211211

212212
ne [] = []
213213
ne (x : xs) = [x :| xs]

0 commit comments

Comments
 (0)