Skip to content

Commit ba710aa

Browse files
jaspervdjvlatkoB
jaspervdj
and
vlatkoB
authored
Case insensitive import sort
Co-authored-by: vlatkoB <[email protected]>
1 parent fe604f6 commit ba710aa

File tree

6 files changed

+70
-55
lines changed

6 files changed

+70
-55
lines changed

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

Lines changed: 0 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -15,12 +15,8 @@ module Language.Haskell.Stylish.GHC
1515
, unLocated
1616
-- * Outputable operators
1717
, showOutputable
18-
, compareOutputable
1918
) where
2019

21-
--------------------------------------------------------------------------------
22-
import Data.Function (on)
23-
2420
--------------------------------------------------------------------------------
2521
import DynFlags (Settings (..), defaultDynFlags)
2622
import qualified DynFlags as GHC
@@ -98,6 +94,3 @@ unLocated (L _ a) = a
9894

9995
showOutputable :: GHC.Outputable a => a -> String
10096
showOutputable = GHC.showPpr baseDynFlags
101-
102-
compareOutputable :: GHC.Outputable a => a -> a -> Ordering
103-
compareOutputable = compare `on` showOutputable

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

Lines changed: 1 addition & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -10,7 +10,7 @@ module Language.Haskell.Stylish.Module
1010
( -- * Data types
1111
Module (..)
1212
, ModuleHeader
13-
, Import
13+
, Import (..)
1414
, Decls
1515
, Comments
1616
, Lines
@@ -109,18 +109,6 @@ canMergeImport (Import i0) (Import i1) = and $ fmap (\f -> f i0 i1)
109109
hasMergableQualified QualifiedPost QualifiedPre = True
110110
hasMergableQualified q0 q1 = q0 == q1
111111

112-
instance Eq Import where
113-
i0 == i1 = canMergeImport i0 i1 && hasSameImports (unImport i0) (unImport i1)
114-
where
115-
hasSameImports = (==) `on` fmap snd . ideclHiding
116-
117-
instance Ord Import where
118-
compare (Import i0) (Import i1) =
119-
ideclName i0 `compareOutputable` ideclName i1 <>
120-
fmap showOutputable (ideclPkgQual i0) `compare`
121-
fmap showOutputable (ideclPkgQual i1) <>
122-
compareOutputable i0 i1
123-
124112
-- | Comments associated with module
125113
newtype Comments = Comments [GHC.RealLocated GHC.AnnotationComment]
126114

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

Lines changed: 26 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -4,23 +4,37 @@
44
-- utilities.
55
{-# LANGUAGE LambdaCase #-}
66
module Language.Haskell.Stylish.Ordering
7-
( compareLIE
7+
( compareImports
8+
, compareLIE
89
, compareWrappedName
10+
, compareOutputableCI
911
, unwrapName
1012
) where
1113

1214

1315
--------------------------------------------------------------------------------
14-
import Data.Char (isUpper)
15-
import Data.Ord (comparing)
16+
import Data.Char (isUpper, toLower)
17+
import Data.Function (on)
18+
import Data.Ord (comparing)
1619
import GHC.Hs
17-
import RdrName (RdrName)
18-
import SrcLoc (unLoc)
20+
import Language.Haskell.Stylish.GHC (showOutputable)
21+
import Language.Haskell.Stylish.Module (Import (..))
22+
import Outputable (Outputable)
23+
import qualified Outputable as GHC
24+
import RdrName (RdrName)
25+
import SrcLoc (unLoc)
26+
1927

2028

2129
--------------------------------------------------------------------------------
22-
import Language.Haskell.Stylish.GHC (showOutputable)
23-
import Outputable (Outputable)
30+
-- | Compare imports for sorting. Cannot easily be a lawful instance due to
31+
-- case insensitivity.
32+
compareImports :: Import -> Import -> Ordering
33+
compareImports (Import i0) (Import i1) =
34+
ideclName i0 `compareOutputableCI` ideclName i1 <>
35+
fmap showOutputable (ideclPkgQual i0) `compare`
36+
fmap showOutputable (ideclPkgQual i1) <>
37+
compareOutputableCI i0 i1
2438

2539

2640
--------------------------------------------------------------------------------
@@ -59,3 +73,8 @@ nameKey n = case showOutputable n of
5973
o@('(' : _) -> (2, o)
6074
o@(o0 : _) | isUpper o0 -> (0, o)
6175
o -> (1, o)
76+
77+
78+
--------------------------------------------------------------------------------
79+
compareOutputableCI :: GHC.Outputable a => a -> a -> Ordering
80+
compareOutputableCI = compare `on` (map toLower . showOutputable)

‎lib/Language/Haskell/Stylish/Step/Data.hs

Lines changed: 30 additions & 26 deletions
Original file line numberDiff line numberDiff line change
@@ -13,41 +13,45 @@ module Language.Haskell.Stylish.Step.Data
1313
) where
1414

1515
--------------------------------------------------------------------------------
16-
import Prelude hiding (init)
16+
import Prelude hiding (init)
1717

1818
--------------------------------------------------------------------------------
19-
import Control.Monad (forM_, unless, when)
20-
import Data.Function ((&))
21-
import Data.Functor ((<&>))
22-
import Data.List (sortBy)
23-
import Data.Maybe (listToMaybe)
19+
import Control.Monad (forM_, unless, when)
20+
import Data.Function ((&))
21+
import Data.Functor ((<&>))
22+
import Data.List (sortBy)
23+
import Data.Maybe (listToMaybe)
2424

2525
--------------------------------------------------------------------------------
26-
import ApiAnnotation (AnnotationComment)
27-
import BasicTypes (LexicalFixity (..))
28-
import GHC.Hs.Decls (ConDecl (..),
29-
DerivStrategy (..),
30-
HsDataDefn (..), HsDecl (..),
31-
HsDerivingClause (..),
32-
NewOrData (..),
33-
TyClDecl (..))
34-
import GHC.Hs.Extension (GhcPs, NoExtField (..),
35-
noExtCon)
36-
import GHC.Hs.Types (ConDeclField (..),
37-
ForallVisFlag (..),
38-
HsConDetails (..), HsContext,
39-
HsImplicitBndrs (..),
40-
HsTyVarBndr (..),
41-
HsType (..), LHsQTyVars (..), LHsKind)
42-
import RdrName (RdrName)
43-
import SrcLoc (GenLocated (..), Located,
44-
RealLocated)
26+
import ApiAnnotation (AnnotationComment)
27+
import BasicTypes (LexicalFixity (..))
28+
import GHC.Hs.Decls (ConDecl (..),
29+
DerivStrategy (..),
30+
HsDataDefn (..),
31+
HsDecl (..),
32+
HsDerivingClause (..),
33+
NewOrData (..),
34+
TyClDecl (..))
35+
import GHC.Hs.Extension (GhcPs, NoExtField (..),
36+
noExtCon)
37+
import GHC.Hs.Types (ConDeclField (..),
38+
ForallVisFlag (..),
39+
HsConDetails (..),
40+
HsContext,
41+
HsImplicitBndrs (..),
42+
HsTyVarBndr (..),
43+
HsType (..), LHsKind,
44+
LHsQTyVars (..))
45+
import RdrName (RdrName)
46+
import SrcLoc (GenLocated (..), Located,
47+
RealLocated)
4548

4649
--------------------------------------------------------------------------------
4750
import Language.Haskell.Stylish.Block
4851
import Language.Haskell.Stylish.Editor
4952
import Language.Haskell.Stylish.GHC
5053
import Language.Haskell.Stylish.Module
54+
import Language.Haskell.Stylish.Ordering
5155
import Language.Haskell.Stylish.Printer
5256
import Language.Haskell.Stylish.Step
5357

@@ -290,7 +294,7 @@ putDeriving Config{..} (L pos clause) = do
290294
= clause
291295
& deriv_clause_tys
292296
& unLocated
293-
& (if cSortDeriving then sortBy compareOutputable else id)
297+
& (if cSortDeriving then sortBy compareOutputableCI else id)
294298
& fmap hsib_body
295299

296300
headTy =

‎lib/Language/Haskell/Stylish/Step/Imports.hs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -146,9 +146,9 @@ formatImports
146146
formatImports maxCols options m moduleStats rawGroup =
147147
runPrinter_ (PrinterConfig maxCols) [] m do
148148
let
149-
149+
group :: NonEmpty (Located Import)
150150
group
151-
= NonEmpty.sortWith unLocated rawGroup
151+
= NonEmpty.sortBy (compareImports `on` unLocated) rawGroup
152152
& mergeImports
153153

154154
unLocatedGroup = fmap unLocated $ toList group

‎tests/Language/Haskell/Stylish/Step/Imports/Tests.hs

Lines changed: 11 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -69,6 +69,7 @@ tests = testGroup "Language.Haskell.Stylish.Step.Imports.Tests"
6969
, testCase "case 35" case35
7070
, testCase "case 36" case36
7171
, testCase "case 37" case37
72+
, testCase "case 38" case38
7273
]
7374

7475

@@ -923,3 +924,13 @@ case37 = assertSnippet (step Nothing defaultOptions {postQualified = True})
923924
]
924925
[ "import Data.Aeson qualified as JSON (Value, decode, encode)"
925926
]
927+
928+
--------------------------------------------------------------------------------
929+
case38 :: Assertion
930+
case38 = assertSnippet (step (Just 80) $ fromImportAlign File)
931+
[ "import HSP"
932+
, "import Happstack.Server"
933+
]
934+
[ "import Happstack.Server"
935+
, "import HSP"
936+
]

0 commit comments

Comments
 (0)