--------------------------------------------------------------------------------
-- | There are a number of steps that sort items: 'Imports' and 'ModuleHeader',
-- and maybe more in the future.  This module provides consistent sorting
-- utilities.
{-# 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)


--------------------------------------------------------------------------------
-- | NOTE: Can we get rid off this by adding a properly sorting newtype around
-- 'RdrName'?
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
    -- | The implementation is a bit hacky to get proper sorting for input specs:
    -- constructors first, followed by functions, and then operators.
    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)