--------------------------------------------------------------------------------
-- | 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
    ( 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.SrcLoc             (unLoc)
import           GHC.Utils.Outputable         (Outputable)
import qualified GHC.Utils.Outputable         as GHC
import           Language.Haskell.Stylish.GHC (showOutputable)


--------------------------------------------------------------------------------
-- | Compare imports for sorting.  Cannot easily be a lawful instance due to
-- case insensitivity.
compareImports
    :: GHC.ImportDecl GHC.GhcPs -> GHC.ImportDecl GHC.GhcPs -> Ordering
compareImports :: ImportDecl GhcPs -> ImportDecl GhcPs -> Ordering
compareImports ImportDecl GhcPs
i0 ImportDecl GhcPs
i1 =
    forall pass. ImportDecl pass -> XRec pass ModuleName
ideclName ImportDecl GhcPs
i0 forall a. Outputable a => a -> a -> Ordering
`compareOutputableCI` forall pass. ImportDecl pass -> XRec pass ModuleName
ideclName ImportDecl GhcPs
i1 forall a. Semigroup a => a -> a -> a
<>
    forall a. Outputable a => a -> String
showOutputable (forall pass. ImportDecl pass -> ImportDeclPkgQual pass
ideclPkgQual ImportDecl GhcPs
i0) forall a. Ord a => a -> a -> Ordering
`compare`
        forall a. Outputable a => a -> String
showOutputable (forall pass. ImportDecl pass -> ImportDeclPkgQual pass
ideclPkgQual ImportDecl GhcPs
i1) forall a. Semigroup a => a -> a -> a
<>
    forall a. Outputable a => a -> a -> Ordering
compareOutputableCI ImportDecl GhcPs
i0 ImportDecl GhcPs
i1


--------------------------------------------------------------------------------
-- | 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 = forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall a b. (a -> b) -> a -> b
$ IE GhcPs -> (Int, String)
ieKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
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 GhcPs
n            -> forall name. Outputable name => name -> (Int, String)
nameKey LIEWrappedName GhcPs
n
        IEThingAbs XIEThingAbs GhcPs
_ LIEWrappedName GhcPs
n       -> forall name. Outputable name => name -> (Int, String)
nameKey LIEWrappedName GhcPs
n
        IEThingAll XIEThingAll GhcPs
_ LIEWrappedName GhcPs
n       -> forall name. Outputable name => name -> (Int, String)
nameKey LIEWrappedName GhcPs
n
        IEThingWith XIEThingWith GhcPs
_ LIEWrappedName GhcPs
n IEWildcard
_ [LIEWrappedName GhcPs]
_  -> forall name. Outputable name => name -> (Int, String)
nameKey LIEWrappedName GhcPs
n
        IEModuleContents XIEModuleContents GhcPs
_ XRec GhcPs ModuleName
n -> forall name. Outputable name => name -> (Int, String)
nameKey XRec GhcPs ModuleName
n
        IE GhcPs
_                    -> (Int
2, String
"")


--------------------------------------------------------------------------------
compareWrappedName :: IEWrappedName GhcPs -> IEWrappedName GhcPs -> Ordering
compareWrappedName :: IEWrappedName GhcPs -> IEWrappedName GhcPs -> Ordering
compareWrappedName = forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall name. Outputable name => name -> (Int, String)
nameKey


--------------------------------------------------------------------------------
nameKey :: Outputable name => name -> (Int, String)
nameKey :: forall name. Outputable name => name -> (Int, String)
nameKey name
n = case 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 :: forall a. Outputable a => a -> a -> Ordering
compareOutputableCI = forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Outputable a => a -> String
showOutputable)