From f43f0a2ccc88eca3a0f4824f528d40bb55a359ff Mon Sep 17 00:00:00 2001 From: vlatkoB Date: Fri, 5 Nov 2021 17:30:17 +0100 Subject: [PATCH 1/2] test case-insensitive imports sort --- tests/Language/Haskell/Stylish/Step/Imports/Tests.hs | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/tests/Language/Haskell/Stylish/Step/Imports/Tests.hs b/tests/Language/Haskell/Stylish/Step/Imports/Tests.hs index 479c9db6..f80e48cf 100644 --- a/tests/Language/Haskell/Stylish/Step/Imports/Tests.hs +++ b/tests/Language/Haskell/Stylish/Step/Imports/Tests.hs @@ -69,6 +69,7 @@ tests = testGroup "Language.Haskell.Stylish.Step.Imports.Tests" , testCase "case 35" case35 , testCase "case 36" case36 , testCase "case 37" case37 + , testCase "case 38" case38 ] @@ -923,3 +924,13 @@ case37 = assertSnippet (step Nothing defaultOptions {postQualified = True}) ] [ "import Data.Aeson qualified as JSON (Value, decode, encode)" ] + +-------------------------------------------------------------------------------- +case38 :: Assertion +case38 = assertSnippet (step (Just 80) $ fromImportAlign File) + [ "import HSP" + , "import Happstack.Server" + ] + [ "import Happstack.Server" + , "import HSP" + ] From cb39f29b7d44ecb46d6d7ff32d0252115b5465a2 Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Mon, 22 Nov 2021 15:09:49 +0100 Subject: [PATCH 2/2] Fix case-insensitive import sorting --- lib/Language/Haskell/Stylish/GHC.hs | 7 --- lib/Language/Haskell/Stylish/Module.hs | 14 +---- lib/Language/Haskell/Stylish/Ordering.hs | 33 +++++++++--- lib/Language/Haskell/Stylish/Step/Data.hs | 56 +++++++++++--------- lib/Language/Haskell/Stylish/Step/Imports.hs | 4 +- 5 files changed, 59 insertions(+), 55 deletions(-) diff --git a/lib/Language/Haskell/Stylish/GHC.hs b/lib/Language/Haskell/Stylish/GHC.hs index c99d4bf6..51f8baa3 100644 --- a/lib/Language/Haskell/Stylish/GHC.hs +++ b/lib/Language/Haskell/Stylish/GHC.hs @@ -15,12 +15,8 @@ module Language.Haskell.Stylish.GHC , unLocated -- * Outputable operators , showOutputable - , compareOutputable ) where --------------------------------------------------------------------------------- -import Data.Function (on) - -------------------------------------------------------------------------------- import DynFlags (Settings (..), defaultDynFlags) import qualified DynFlags as GHC @@ -98,6 +94,3 @@ unLocated (L _ a) = a showOutputable :: GHC.Outputable a => a -> String showOutputable = GHC.showPpr baseDynFlags - -compareOutputable :: GHC.Outputable a => a -> a -> Ordering -compareOutputable = compare `on` showOutputable diff --git a/lib/Language/Haskell/Stylish/Module.hs b/lib/Language/Haskell/Stylish/Module.hs index 3dbebe03..866991bc 100644 --- a/lib/Language/Haskell/Stylish/Module.hs +++ b/lib/Language/Haskell/Stylish/Module.hs @@ -10,7 +10,7 @@ module Language.Haskell.Stylish.Module ( -- * Data types Module (..) , ModuleHeader - , Import + , Import (..) , Decls , Comments , Lines @@ -109,18 +109,6 @@ canMergeImport (Import i0) (Import i1) = and $ fmap (\f -> f i0 i1) hasMergableQualified QualifiedPost QualifiedPre = True hasMergableQualified q0 q1 = q0 == q1 -instance Eq Import where - i0 == i1 = canMergeImport i0 i1 && hasSameImports (unImport i0) (unImport i1) - where - hasSameImports = (==) `on` fmap snd . ideclHiding - -instance Ord Import where - compare (Import i0) (Import i1) = - ideclName i0 `compareOutputable` ideclName i1 <> - fmap showOutputable (ideclPkgQual i0) `compare` - fmap showOutputable (ideclPkgQual i1) <> - compareOutputable i0 i1 - -- | Comments associated with module newtype Comments = Comments [GHC.RealLocated GHC.AnnotationComment] diff --git a/lib/Language/Haskell/Stylish/Ordering.hs b/lib/Language/Haskell/Stylish/Ordering.hs index 1a05eb4e..ae9977fb 100644 --- a/lib/Language/Haskell/Stylish/Ordering.hs +++ b/lib/Language/Haskell/Stylish/Ordering.hs @@ -4,23 +4,37 @@ -- utilities. {-# LANGUAGE LambdaCase #-} module Language.Haskell.Stylish.Ordering - ( compareLIE + ( compareImports + , compareLIE , compareWrappedName + , compareOutputableCI , unwrapName ) where -------------------------------------------------------------------------------- -import Data.Char (isUpper) -import Data.Ord (comparing) +import Data.Char (isUpper, toLower) +import Data.Function (on) +import Data.Ord (comparing) import GHC.Hs -import RdrName (RdrName) -import SrcLoc (unLoc) +import Language.Haskell.Stylish.GHC (showOutputable) +import Language.Haskell.Stylish.Module (Import (..)) +import Outputable (Outputable) +import qualified Outputable as GHC +import RdrName (RdrName) +import SrcLoc (unLoc) + -------------------------------------------------------------------------------- -import Language.Haskell.Stylish.GHC (showOutputable) -import Outputable (Outputable) +-- | Compare imports for sorting. Cannot easily be a lawful instance due to +-- case insensitivity. +compareImports :: Import -> Import -> Ordering +compareImports (Import i0) (Import i1) = + ideclName i0 `compareOutputableCI` ideclName i1 <> + fmap showOutputable (ideclPkgQual i0) `compare` + fmap showOutputable (ideclPkgQual i1) <> + compareOutputableCI i0 i1 -------------------------------------------------------------------------------- @@ -59,3 +73,8 @@ nameKey n = case showOutputable n of o@('(' : _) -> (2, o) o@(o0 : _) | isUpper o0 -> (0, o) o -> (1, o) + + +-------------------------------------------------------------------------------- +compareOutputableCI :: GHC.Outputable a => a -> a -> Ordering +compareOutputableCI = compare `on` (map toLower . showOutputable) diff --git a/lib/Language/Haskell/Stylish/Step/Data.hs b/lib/Language/Haskell/Stylish/Step/Data.hs index 1cfa6e0e..de8628db 100644 --- a/lib/Language/Haskell/Stylish/Step/Data.hs +++ b/lib/Language/Haskell/Stylish/Step/Data.hs @@ -13,41 +13,45 @@ module Language.Haskell.Stylish.Step.Data ) where -------------------------------------------------------------------------------- -import Prelude hiding (init) +import Prelude hiding (init) -------------------------------------------------------------------------------- -import Control.Monad (forM_, unless, when) -import Data.Function ((&)) -import Data.Functor ((<&>)) -import Data.List (sortBy) -import Data.Maybe (listToMaybe) +import Control.Monad (forM_, unless, when) +import Data.Function ((&)) +import Data.Functor ((<&>)) +import Data.List (sortBy) +import Data.Maybe (listToMaybe) -------------------------------------------------------------------------------- -import ApiAnnotation (AnnotationComment) -import BasicTypes (LexicalFixity (..)) -import GHC.Hs.Decls (ConDecl (..), - DerivStrategy (..), - HsDataDefn (..), HsDecl (..), - HsDerivingClause (..), - NewOrData (..), - TyClDecl (..)) -import GHC.Hs.Extension (GhcPs, NoExtField (..), - noExtCon) -import GHC.Hs.Types (ConDeclField (..), - ForallVisFlag (..), - HsConDetails (..), HsContext, - HsImplicitBndrs (..), - HsTyVarBndr (..), - HsType (..), LHsQTyVars (..), LHsKind) -import RdrName (RdrName) -import SrcLoc (GenLocated (..), Located, - RealLocated) +import ApiAnnotation (AnnotationComment) +import BasicTypes (LexicalFixity (..)) +import GHC.Hs.Decls (ConDecl (..), + DerivStrategy (..), + HsDataDefn (..), + HsDecl (..), + HsDerivingClause (..), + NewOrData (..), + TyClDecl (..)) +import GHC.Hs.Extension (GhcPs, NoExtField (..), + noExtCon) +import GHC.Hs.Types (ConDeclField (..), + ForallVisFlag (..), + HsConDetails (..), + HsContext, + HsImplicitBndrs (..), + HsTyVarBndr (..), + HsType (..), LHsKind, + LHsQTyVars (..)) +import RdrName (RdrName) +import SrcLoc (GenLocated (..), Located, + RealLocated) -------------------------------------------------------------------------------- import Language.Haskell.Stylish.Block import Language.Haskell.Stylish.Editor import Language.Haskell.Stylish.GHC import Language.Haskell.Stylish.Module +import Language.Haskell.Stylish.Ordering import Language.Haskell.Stylish.Printer import Language.Haskell.Stylish.Step @@ -290,7 +294,7 @@ putDeriving Config{..} (L pos clause) = do = clause & deriv_clause_tys & unLocated - & (if cSortDeriving then sortBy compareOutputable else id) + & (if cSortDeriving then sortBy compareOutputableCI else id) & fmap hsib_body headTy = diff --git a/lib/Language/Haskell/Stylish/Step/Imports.hs b/lib/Language/Haskell/Stylish/Step/Imports.hs index 48f3f053..058d7c6e 100644 --- a/lib/Language/Haskell/Stylish/Step/Imports.hs +++ b/lib/Language/Haskell/Stylish/Step/Imports.hs @@ -146,9 +146,9 @@ formatImports formatImports maxCols options m moduleStats rawGroup = runPrinter_ (PrinterConfig maxCols) [] m do let - + group :: NonEmpty (Located Import) group - = NonEmpty.sortWith unLocated rawGroup + = NonEmpty.sortBy (compareImports `on` unLocated) rawGroup & mergeImports unLocatedGroup = fmap unLocated $ toList group