Skip to content

Case insensitive import sort #385

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 2 commits into from
Nov 24, 2021
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
7 changes: 0 additions & 7 deletions lib/Language/Haskell/Stylish/GHC.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
14 changes: 1 addition & 13 deletions lib/Language/Haskell/Stylish/Module.hs
Original file line number Diff line number Diff line change
Expand Up @@ -10,7 +10,7 @@ module Language.Haskell.Stylish.Module
( -- * Data types
Module (..)
, ModuleHeader
, Import
, Import (..)
, Decls
, Comments
, Lines
Expand Down Expand Up @@ -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]

Expand Down
33 changes: 26 additions & 7 deletions lib/Language/Haskell/Stylish/Ordering.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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


--------------------------------------------------------------------------------
Expand Down Expand Up @@ -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)
56 changes: 30 additions & 26 deletions lib/Language/Haskell/Stylish/Step/Data.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down Expand Up @@ -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 =
Expand Down
4 changes: 2 additions & 2 deletions lib/Language/Haskell/Stylish/Step/Imports.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
11 changes: 11 additions & 0 deletions tests/Language/Haskell/Stylish/Step/Imports/Tests.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
]


Expand Down Expand Up @@ -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"
]