{-# LANGUAGE LambdaCase #-}
module Language.Haskell.Stylish.Ordering
( compareLIE
, compareWrappedName
, unwrapName
) where
import Data.Char (isUpper)
import Data.Ord (comparing)
import GHC.Hs
import RdrName (RdrName)
import SrcLoc (unLoc)
import Language.Haskell.Stylish.GHC (showOutputable)
import Outputable (Outputable)
compareLIE :: LIE GhcPs -> LIE GhcPs -> Ordering
compareLIE :: LIE GhcPs -> LIE GhcPs -> Ordering
compareLIE = (LIE GhcPs -> (Int, String)) -> LIE GhcPs -> LIE GhcPs -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing ((LIE GhcPs -> (Int, String))
-> LIE GhcPs -> LIE GhcPs -> Ordering)
-> (LIE GhcPs -> (Int, String))
-> LIE GhcPs
-> LIE GhcPs
-> Ordering
forall a b. (a -> b) -> a -> b
$ IE GhcPs -> (Int, String)
ieKey (IE GhcPs -> (Int, String))
-> (LIE GhcPs -> IE GhcPs) -> LIE GhcPs -> (Int, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LIE GhcPs -> IE GhcPs
forall a. HasSrcSpan a => a -> SrcSpanLess a
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)]
_ [Located (FieldLbl (IdP GhcPs))]
_ -> LIEWrappedName RdrName -> (Int, String)
forall name. Outputable name => name -> (Int, String)
nameKey LIEWrappedName (IdP GhcPs)
LIEWrappedName RdrName
n
IEModuleContents XIEModuleContents GhcPs
_ Located ModuleName
n -> Located ModuleName -> (Int, String)
forall name. Outputable name => name -> (Int, String)
nameKey Located 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
unwrapName :: IEWrappedName n -> n
unwrapName :: IEWrappedName n -> n
unwrapName (IEName Located n
n) = Located n -> SrcSpanLess (Located n)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located n
n
unwrapName (IEPattern Located n
n) = Located n -> SrcSpanLess (Located n)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located n
n
unwrapName (IEType Located n
n) = Located n -> SrcSpanLess (Located n)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located n
n
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)