-- | Import declaration sorting for pretty-printing.
module HIndent.Pretty.Import.Sort
  ( sortImportsByName
  , sortImportsByLocation
  ) where

import Data.Char
import Data.Function
import Data.List
import Data.Maybe
import GHC.Hs
import GHC.Stack
import GHC.Types.SrcLoc
import HIndent.Pretty.Combinators.Outputable

-- | The letter type of a 'Char'.
--
-- The order of constructors is important. HIndent sorts explicit imports
-- from ones starting from a capital letter (e.g., data constructors),
-- symbol identifiers, and functions.
data LetterType
  = Capital
  | Symbol
  | Lower
  deriving (LetterType -> LetterType -> Bool
(LetterType -> LetterType -> Bool)
-> (LetterType -> LetterType -> Bool) -> Eq LetterType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LetterType -> LetterType -> Bool
== :: LetterType -> LetterType -> Bool
$c/= :: LetterType -> LetterType -> Bool
/= :: LetterType -> LetterType -> Bool
Eq, Eq LetterType
Eq LetterType
-> (LetterType -> LetterType -> Ordering)
-> (LetterType -> LetterType -> Bool)
-> (LetterType -> LetterType -> Bool)
-> (LetterType -> LetterType -> Bool)
-> (LetterType -> LetterType -> Bool)
-> (LetterType -> LetterType -> LetterType)
-> (LetterType -> LetterType -> LetterType)
-> Ord LetterType
LetterType -> LetterType -> Bool
LetterType -> LetterType -> Ordering
LetterType -> LetterType -> LetterType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: LetterType -> LetterType -> Ordering
compare :: LetterType -> LetterType -> Ordering
$c< :: LetterType -> LetterType -> Bool
< :: LetterType -> LetterType -> Bool
$c<= :: LetterType -> LetterType -> Bool
<= :: LetterType -> LetterType -> Bool
$c> :: LetterType -> LetterType -> Bool
> :: LetterType -> LetterType -> Bool
$c>= :: LetterType -> LetterType -> Bool
>= :: LetterType -> LetterType -> Bool
$cmax :: LetterType -> LetterType -> LetterType
max :: LetterType -> LetterType -> LetterType
$cmin :: LetterType -> LetterType -> LetterType
min :: LetterType -> LetterType -> LetterType
Ord)

-- | This function sorts import declarations and explicit imports in them
-- by their names.
sortImportsByName :: [LImportDecl GhcPs] -> [LImportDecl GhcPs]
sortImportsByName :: [LImportDecl GhcPs] -> [LImportDecl GhcPs]
sortImportsByName = (GenLocated SrcSpanAnnA (ImportDecl GhcPs)
 -> GenLocated SrcSpanAnnA (ImportDecl GhcPs))
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> GenLocated SrcSpanAnnA (ImportDecl GhcPs)
LImportDecl GhcPs -> LImportDecl GhcPs
sortExplicitImportsInDecl ([GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
 -> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)])
-> ([GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
    -> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)])
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
[LImportDecl GhcPs] -> [LImportDecl GhcPs]
sortByModuleName

-- | This function sorts imports by their start line numbers.
sortImportsByLocation :: [LImportDecl GhcPs] -> [LImportDecl GhcPs]
sortImportsByLocation :: [LImportDecl GhcPs] -> [LImportDecl GhcPs]
sortImportsByLocation = (GenLocated SrcSpanAnnA (ImportDecl GhcPs)
 -> GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> Ordering)
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((Int -> Int -> Ordering) -> Int -> Int -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int -> Int -> Ordering)
-> (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> Int)
-> GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> Int
forall {a} {e}. GenLocated (SrcSpanAnn' a) e -> Int
lineIdx)
  where
    lineIdx :: GenLocated (SrcSpanAnn' a) e -> Int
lineIdx = HasCallStack => SrcSpan -> Int
SrcSpan -> Int
startLine (SrcSpan -> Int)
-> (GenLocated (SrcSpanAnn' a) e -> SrcSpan)
-> GenLocated (SrcSpanAnn' a) e
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpanAnn' a -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA (SrcSpanAnn' a -> SrcSpan)
-> (GenLocated (SrcSpanAnn' a) e -> SrcSpanAnn' a)
-> GenLocated (SrcSpanAnn' a) e
-> SrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated (SrcSpanAnn' a) e -> SrcSpanAnn' a
forall l e. GenLocated l e -> l
getLoc

-- | This function sorts import declarations by their module names.
sortByModuleName :: [LImportDecl GhcPs] -> [LImportDecl GhcPs]
sortByModuleName :: [LImportDecl GhcPs] -> [LImportDecl GhcPs]
sortByModuleName = (GenLocated SrcSpanAnnA (ImportDecl GhcPs)
 -> GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> Ordering)
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (ModuleName -> ModuleName -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (ModuleName -> ModuleName -> Ordering)
-> (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> ModuleName)
-> GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` GenLocated SrcSpanAnnA ModuleName -> ModuleName
forall l e. GenLocated l e -> e
unLoc (GenLocated SrcSpanAnnA ModuleName -> ModuleName)
-> (GenLocated SrcSpanAnnA (ImportDecl GhcPs)
    -> GenLocated SrcSpanAnnA ModuleName)
-> GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImportDecl GhcPs -> GenLocated SrcSpanAnnA ModuleName
ImportDecl GhcPs -> XRec GhcPs ModuleName
forall pass. ImportDecl pass -> XRec pass ModuleName
ideclName (ImportDecl GhcPs -> GenLocated SrcSpanAnnA ModuleName)
-> (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> ImportDecl GhcPs)
-> GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> GenLocated SrcSpanAnnA ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> ImportDecl GhcPs
forall l e. GenLocated l e -> e
unLoc)

-- | This function sorts explicit imports in the given import declaration
-- by their names.
sortExplicitImportsInDecl :: LImportDecl GhcPs -> LImportDecl GhcPs
sortExplicitImportsInDecl :: LImportDecl GhcPs -> LImportDecl GhcPs
sortExplicitImportsInDecl (L SrcSpanAnnA
l d :: ImportDecl GhcPs
d@ImportDecl {ideclHiding :: forall pass. ImportDecl pass -> Maybe (Bool, XRec pass [LIE pass])
ideclHiding = Just (Bool
x, XRec GhcPs [LIE GhcPs]
imports)}) =
  SrcSpanAnnA
-> ImportDecl GhcPs -> GenLocated SrcSpanAnnA (ImportDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l ImportDecl GhcPs
d {ideclHiding :: Maybe (Bool, XRec GhcPs [LIE GhcPs])
ideclHiding = (Bool, GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
-> Maybe
     (Bool, GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
forall a. a -> Maybe a
Just (Bool
x, GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
sorted)}
  where
    sorted :: GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
sorted = ([GenLocated SrcSpanAnnA (IE GhcPs)]
 -> [GenLocated SrcSpanAnnA (IE GhcPs)])
-> GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
-> GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
forall a b.
(a -> b) -> GenLocated SrcSpanAnnL a -> GenLocated SrcSpanAnnL b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((GenLocated SrcSpanAnnA (IE GhcPs)
 -> GenLocated SrcSpanAnnA (IE GhcPs))
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnA (IE GhcPs)
-> GenLocated SrcSpanAnnA (IE GhcPs)
LIE GhcPs -> LIE GhcPs
sortVariants ([GenLocated SrcSpanAnnA (IE GhcPs)]
 -> [GenLocated SrcSpanAnnA (IE GhcPs)])
-> ([GenLocated SrcSpanAnnA (IE GhcPs)]
    -> [GenLocated SrcSpanAnnA (IE GhcPs)])
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GenLocated SrcSpanAnnA (IE GhcPs)]
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
[LIE GhcPs] -> [LIE GhcPs]
sortExplicitImports) GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
XRec GhcPs [LIE GhcPs]
imports
sortExplicitImportsInDecl LImportDecl GhcPs
x = LImportDecl GhcPs
x

-- | This function sorts the given explicit imports by their names.
sortExplicitImports :: [LIE GhcPs] -> [LIE GhcPs]
sortExplicitImports :: [LIE GhcPs] -> [LIE GhcPs]
sortExplicitImports = (GenLocated SrcSpanAnnA (IE GhcPs)
 -> GenLocated SrcSpanAnnA (IE GhcPs) -> Ordering)
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy GenLocated SrcSpanAnnA (IE GhcPs)
-> GenLocated SrcSpanAnnA (IE GhcPs) -> Ordering
LIE GhcPs -> LIE GhcPs -> Ordering
compareImportEntities

-- | This function sorts variants (e.g., data constructors and class
-- methods) in the given explicit import by their names.
sortVariants :: LIE GhcPs -> LIE GhcPs
sortVariants :: LIE GhcPs -> LIE GhcPs
sortVariants (L SrcSpanAnnA
l (IEThingWith XIEThingWith GhcPs
x LIEWrappedName (IdP GhcPs)
x' IEWildcard
x'' [LIEWrappedName (IdP GhcPs)]
xs)) =
  SrcSpanAnnA -> IE GhcPs -> GenLocated SrcSpanAnnA (IE GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (IE GhcPs -> GenLocated SrcSpanAnnA (IE GhcPs))
-> IE GhcPs -> GenLocated SrcSpanAnnA (IE GhcPs)
forall a b. (a -> b) -> a -> b
$ XIEThingWith GhcPs
-> LIEWrappedName (IdP GhcPs)
-> IEWildcard
-> [LIEWrappedName (IdP GhcPs)]
-> IE GhcPs
forall pass.
XIEThingWith pass
-> LIEWrappedName (IdP pass)
-> IEWildcard
-> [LIEWrappedName (IdP pass)]
-> IE pass
IEThingWith XIEThingWith GhcPs
x LIEWrappedName (IdP GhcPs)
x' IEWildcard
x'' ([LIEWrappedName RdrName] -> [LIEWrappedName RdrName]
sortWrappedNames [LIEWrappedName (IdP GhcPs)]
[LIEWrappedName RdrName]
xs)
  where
    sortWrappedNames :: [LIEWrappedName RdrName] -> [LIEWrappedName RdrName]
sortWrappedNames = (LIEWrappedName RdrName -> LIEWrappedName RdrName -> Ordering)
-> [LIEWrappedName RdrName] -> [LIEWrappedName RdrName]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (String -> String -> Ordering)
-> (LIEWrappedName RdrName -> String)
-> LIEWrappedName RdrName
-> LIEWrappedName RdrName
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` LIEWrappedName RdrName -> String
forall a. Outputable a => a -> String
showOutputable)
sortVariants LIE GhcPs
x = LIE GhcPs
x

-- | This function compares two import declarations by their module names.
compareImportEntities :: LIE GhcPs -> LIE GhcPs -> Ordering
compareImportEntities :: LIE GhcPs -> LIE GhcPs -> Ordering
compareImportEntities (L SrcSpanAnnA
_ IE GhcPs
a) (L SrcSpanAnnA
_ IE GhcPs
b) =
  Ordering -> Maybe Ordering -> Ordering
forall a. a -> Maybe a -> a
fromMaybe Ordering
LT (Maybe Ordering -> Ordering) -> Maybe Ordering -> Ordering
forall a b. (a -> b) -> a -> b
$ String -> String -> Ordering
compareIdentifier (String -> String -> Ordering)
-> Maybe String -> Maybe (String -> Ordering)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IE GhcPs -> Maybe String
moduleName IE GhcPs
a Maybe (String -> Ordering) -> Maybe String -> Maybe Ordering
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IE GhcPs -> Maybe String
moduleName IE GhcPs
b

-- | This function returns a 'Just' value with the module name extracted
-- from the import declaration. Otherwise, it returns a 'Nothing'.
moduleName :: IE GhcPs -> Maybe String
moduleName :: IE GhcPs -> Maybe String
moduleName (IEVar XIEVar GhcPs
_ LIEWrappedName (IdP GhcPs)
wrapped) = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ LIEWrappedName RdrName -> String
forall a. Outputable a => a -> String
showOutputable LIEWrappedName (IdP GhcPs)
LIEWrappedName RdrName
wrapped
moduleName (IEThingAbs XIEThingAbs GhcPs
_ LIEWrappedName (IdP GhcPs)
wrapped) = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ LIEWrappedName RdrName -> String
forall a. Outputable a => a -> String
showOutputable LIEWrappedName (IdP GhcPs)
LIEWrappedName RdrName
wrapped
moduleName (IEThingAll XIEThingAll GhcPs
_ LIEWrappedName (IdP GhcPs)
wrapped) = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ LIEWrappedName RdrName -> String
forall a. Outputable a => a -> String
showOutputable LIEWrappedName (IdP GhcPs)
LIEWrappedName RdrName
wrapped
moduleName (IEThingWith XIEThingWith GhcPs
_ LIEWrappedName (IdP GhcPs)
wrapped IEWildcard
_ [LIEWrappedName (IdP GhcPs)]
_) = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ LIEWrappedName RdrName -> String
forall a. Outputable a => a -> String
showOutputable LIEWrappedName (IdP GhcPs)
LIEWrappedName RdrName
wrapped
moduleName IE GhcPs
_ = Maybe String
forall a. Maybe a
Nothing

-- | This function compares two identifiers in order of capitals, symbols,
-- and lowers.
compareIdentifier :: String -> String -> Ordering
compareIdentifier :: String -> String -> Ordering
compareIdentifier as :: String
as@(Char
a:String
_) bs :: String
bs@(Char
b:String
_) =
  case Char -> Char -> Ordering
compareChar Char
a Char
b of
    Ordering
EQ -> String -> String -> Ordering
compareSameIdentifierType String
as String
bs
    Ordering
x -> Ordering
x
compareIdentifier String
_ String
_ = String -> Ordering
forall a. HasCallStack => String -> a
error String
"Either identifier is an empty string."

-- | Almost similar to 'compare' but ignores parentheses for symbol
-- identifiers as they are enclosed by parentheses.
compareSameIdentifierType :: String -> String -> Ordering
compareSameIdentifierType :: String -> String -> Ordering
compareSameIdentifierType String
"" String
"" = Ordering
EQ
compareSameIdentifierType String
"" String
_ = Ordering
LT
compareSameIdentifierType String
_ String
"" = Ordering
GT
compareSameIdentifierType (Char
'(':String
as) String
bs = String -> String -> Ordering
compareSameIdentifierType String
as String
bs
compareSameIdentifierType (Char
')':String
as) String
bs = String -> String -> Ordering
compareSameIdentifierType String
as String
bs
compareSameIdentifierType String
as (Char
'(':String
bs) = String -> String -> Ordering
compareSameIdentifierType String
as String
bs
compareSameIdentifierType String
as (Char
')':String
bs) = String -> String -> Ordering
compareSameIdentifierType String
as String
bs
compareSameIdentifierType (Char
a:String
as) (Char
b:String
bs) =
  case Char -> Char -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Char
a Char
b of
    Ordering
EQ -> String -> String -> Ordering
compareSameIdentifierType String
as String
bs
    Ordering
x -> Ordering
x

-- | This function compares two characters by their types (capital, symbol,
-- and lower). If both are the same type, then it compares them by the
-- usual ordering.
compareChar :: Char -> Char -> Ordering
compareChar :: Char -> Char -> Ordering
compareChar Char
a Char
b =
  case LetterType -> LetterType -> Ordering
forall a. Ord a => a -> a -> Ordering
compare LetterType
at LetterType
bt of
    Ordering
EQ -> Char -> Char -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Char
a Char
b
    Ordering
x -> Ordering
x
  where
    at :: LetterType
at = Char -> LetterType
charToLetterType Char
a
    bt :: LetterType
bt = Char -> LetterType
charToLetterType Char
b

-- | This function returns a 'LetterType' based on the given character.
charToLetterType :: Char -> LetterType
charToLetterType :: Char -> LetterType
charToLetterType Char
c
  | Char -> Bool
isLower Char
c = LetterType
Lower
  | Char -> Bool
isUpper Char
c = LetterType
Capital
  | Bool
otherwise = LetterType
Symbol

-- | This function returns the start line of the given 'SrcSpan'. If it is
-- not available, it raises an error.
startLine :: HasCallStack => SrcSpan -> Int
startLine :: HasCallStack => SrcSpan -> Int
startLine (RealSrcSpan RealSrcSpan
x Maybe BufSpan
_) = RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
x
startLine (UnhelpfulSpan UnhelpfulSpanReason
_) = String -> Int
forall a. HasCallStack => String -> a
error String
"The src span is unavailable."