{-# LANGUAGE LambdaCase #-}
module Language.Haskell.Stylish.Ordering
( compareImports
, compareLIE
, compareWrappedName
, compareOutputableCI
) where
import Data.Char (isUpper, toLower)
import Data.Function (on)
import Data.Ord (comparing)
import GHC.Hs
import qualified GHC.Hs as GHC
import GHC.Types.Name.Reader (RdrName)
import GHC.Types.SrcLoc (unLoc)
import GHC.Utils.Outputable (Outputable)
import qualified GHC.Utils.Outputable as GHC
import Language.Haskell.Stylish.GHC (showOutputable)
compareImports
:: GHC.ImportDecl GHC.GhcPs -> GHC.ImportDecl GHC.GhcPs -> Ordering
compareImports :: ImportDecl GhcPs -> ImportDecl GhcPs -> Ordering
compareImports ImportDecl GhcPs
i0 ImportDecl GhcPs
i1 =
ImportDecl GhcPs -> XRec GhcPs ModuleName
forall pass. ImportDecl pass -> XRec pass ModuleName
ideclName ImportDecl GhcPs
i0 GenLocated SrcSpanAnnA ModuleName
-> GenLocated SrcSpanAnnA ModuleName -> Ordering
forall a. Outputable a => a -> a -> Ordering
`compareOutputableCI` ImportDecl GhcPs -> XRec GhcPs ModuleName
forall pass. ImportDecl pass -> XRec pass ModuleName
ideclName ImportDecl GhcPs
i1 Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<>
(StringLiteral -> String) -> Maybe StringLiteral -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap StringLiteral -> String
forall a. Outputable a => a -> String
showOutputable (ImportDecl GhcPs -> Maybe StringLiteral
forall pass. ImportDecl pass -> Maybe StringLiteral
ideclPkgQual ImportDecl GhcPs
i0) Maybe String -> Maybe String -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare`
(StringLiteral -> String) -> Maybe StringLiteral -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap StringLiteral -> String
forall a. Outputable a => a -> String
showOutputable (ImportDecl GhcPs -> Maybe StringLiteral
forall pass. ImportDecl pass -> Maybe StringLiteral
ideclPkgQual ImportDecl GhcPs
i1) Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<>
ImportDecl GhcPs -> ImportDecl GhcPs -> Ordering
forall a. Outputable a => a -> a -> Ordering
compareOutputableCI ImportDecl GhcPs
i0 ImportDecl GhcPs
i1
compareLIE :: LIE GhcPs -> LIE GhcPs -> Ordering
compareLIE :: LIE GhcPs -> LIE GhcPs -> Ordering
compareLIE = (GenLocated SrcSpanAnnA (IE GhcPs) -> (Int, String))
-> GenLocated SrcSpanAnnA (IE GhcPs)
-> GenLocated SrcSpanAnnA (IE GhcPs)
-> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing ((GenLocated SrcSpanAnnA (IE GhcPs) -> (Int, String))
-> GenLocated SrcSpanAnnA (IE GhcPs)
-> GenLocated SrcSpanAnnA (IE GhcPs)
-> Ordering)
-> (GenLocated SrcSpanAnnA (IE GhcPs) -> (Int, String))
-> GenLocated SrcSpanAnnA (IE GhcPs)
-> GenLocated SrcSpanAnnA (IE GhcPs)
-> Ordering
forall a b. (a -> b) -> a -> b
$ IE GhcPs -> (Int, String)
ieKey (IE GhcPs -> (Int, String))
-> (GenLocated SrcSpanAnnA (IE GhcPs) -> IE GhcPs)
-> GenLocated SrcSpanAnnA (IE GhcPs)
-> (Int, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (IE GhcPs) -> IE GhcPs
forall l e. GenLocated l e -> e
unLoc
where
ieKey :: IE GhcPs -> (Int, String)
ieKey :: IE GhcPs -> (Int, String)
ieKey = \case
IEVar XIEVar GhcPs
_ LIEWrappedName (IdP GhcPs)
n -> LIEWrappedName RdrName -> (Int, String)
forall name. Outputable name => name -> (Int, String)
nameKey LIEWrappedName (IdP GhcPs)
LIEWrappedName RdrName
n
IEThingAbs XIEThingAbs GhcPs
_ LIEWrappedName (IdP GhcPs)
n -> LIEWrappedName RdrName -> (Int, String)
forall name. Outputable name => name -> (Int, String)
nameKey LIEWrappedName (IdP GhcPs)
LIEWrappedName RdrName
n
IEThingAll XIEThingAll GhcPs
_ LIEWrappedName (IdP GhcPs)
n -> LIEWrappedName RdrName -> (Int, String)
forall name. Outputable name => name -> (Int, String)
nameKey LIEWrappedName (IdP GhcPs)
LIEWrappedName RdrName
n
IEThingWith XIEThingWith GhcPs
_ LIEWrappedName (IdP GhcPs)
n IEWildcard
_ [LIEWrappedName (IdP GhcPs)]
_ -> LIEWrappedName RdrName -> (Int, String)
forall name. Outputable name => name -> (Int, String)
nameKey LIEWrappedName (IdP GhcPs)
LIEWrappedName RdrName
n
IEModuleContents XIEModuleContents GhcPs
_ XRec GhcPs ModuleName
n -> GenLocated SrcSpanAnnA ModuleName -> (Int, String)
forall name. Outputable name => name -> (Int, String)
nameKey XRec GhcPs ModuleName
GenLocated SrcSpanAnnA ModuleName
n
IE GhcPs
_ -> (Int
2, String
"")
compareWrappedName :: IEWrappedName RdrName -> IEWrappedName RdrName -> Ordering
compareWrappedName :: IEWrappedName RdrName -> IEWrappedName RdrName -> Ordering
compareWrappedName = (IEWrappedName RdrName -> (Int, String))
-> IEWrappedName RdrName -> IEWrappedName RdrName -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing IEWrappedName RdrName -> (Int, String)
forall name. Outputable name => name -> (Int, String)
nameKey
nameKey :: Outputable name => name -> (Int, String)
nameKey :: name -> (Int, String)
nameKey name
n = case name -> String
forall a. Outputable a => a -> String
showOutputable name
n of
o :: String
o@(Char
'(' : String
_) -> (Int
2, String
o)
o :: String
o@(Char
o0 : String
_) | Char -> Bool
isUpper Char
o0 -> (Int
0, String
o)
String
o -> (Int
1, String
o)
compareOutputableCI :: GHC.Outputable a => a -> a -> Ordering
compareOutputableCI :: a -> a -> Ordering
compareOutputableCI = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (String -> String -> Ordering)
-> (a -> String) -> a -> a -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ((Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (String -> String) -> (a -> String) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Outputable a => a -> String
showOutputable)