{-# LANGUAGE CPP #-}
{-# LANGUAGE RecordWildCards #-}

module HIndent.Ast.Import.Entry
  ( ImportEntry
  , mkImportEntry
  , sortVariantsAndExplicitImports
  ) where

import Data.Char
import Data.Function
import Data.List
import qualified GHC.Hs as GHC
import HIndent.Ast.NodeComments
import HIndent.Ast.WithComments
import HIndent.Pretty
import HIndent.Pretty.Combinators
import HIndent.Pretty.NodeComments
#if MIN_VERSION_ghc_lib_parser(9, 6, 1)
data ImportEntry
  = SingleIdentifier (GHC.LIEWrappedName GHC.GhcPs)
  | WithSpecificConstructors
      { ImportEntry -> LIEWrappedName GhcPs
name :: GHC.LIEWrappedName GHC.GhcPs
      , ImportEntry -> [LIEWrappedName GhcPs]
constructors :: [GHC.LIEWrappedName GHC.GhcPs]
      }
  | WithAllConstructors (GHC.LIEWrappedName GHC.GhcPs)
#else
data ImportEntry
  = SingleIdentifier (GHC.LIEWrappedName (GHC.IdP GHC.GhcPs))
  | WithSpecificConstructors
      { name :: GHC.LIEWrappedName (GHC.IdP GHC.GhcPs)
      , constructors :: [GHC.LIEWrappedName (GHC.IdP GHC.GhcPs)]
      }
  | WithAllConstructors (GHC.LIEWrappedName (GHC.IdP GHC.GhcPs))
#endif
instance CommentExtraction ImportEntry where
  nodeComments :: ImportEntry -> NodeComments
nodeComments ImportEntry
_ = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments
NodeComments [] [] []

instance Pretty ImportEntry where
  pretty' :: ImportEntry -> Printer ()
pretty' (SingleIdentifier LIEWrappedName GhcPs
wrapped) = GenLocated SrcSpanAnnA (IEWrappedName GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LIEWrappedName GhcPs
GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
wrapped
  pretty' (WithAllConstructors LIEWrappedName GhcPs
wrapped) = GenLocated SrcSpanAnnA (IEWrappedName GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LIEWrappedName GhcPs
GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
wrapped Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HasCallStack => String -> Printer ()
String -> Printer ()
string String
"(..)"
  pretty' WithSpecificConstructors {[LIEWrappedName GhcPs]
LIEWrappedName GhcPs
name :: ImportEntry -> LIEWrappedName GhcPs
constructors :: ImportEntry -> [LIEWrappedName GhcPs]
name :: LIEWrappedName GhcPs
constructors :: [LIEWrappedName GhcPs]
..} =
    GenLocated SrcSpanAnnA (IEWrappedName GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty LIEWrappedName GhcPs
GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
name Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Printer ()] -> Printer ()
hFillingTuple ((GenLocated SrcSpanAnnA (IEWrappedName GhcPs) -> Printer ())
-> [GenLocated SrcSpanAnnA (IEWrappedName GhcPs)] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnA (IEWrappedName GhcPs) -> Printer ()
forall a. Pretty a => a -> Printer ()
pretty [LIEWrappedName GhcPs]
[GenLocated SrcSpanAnnA (IEWrappedName GhcPs)]
constructors)

mkImportEntry :: GHC.IE GHC.GhcPs -> ImportEntry
#if MIN_VERSION_ghc_lib_parser(9, 10, 1)
mkImportEntry :: IE GhcPs -> ImportEntry
mkImportEntry (GHC.IEVar XIEVar GhcPs
_ LIEWrappedName GhcPs
name Maybe (ExportDoc GhcPs)
_) = LIEWrappedName GhcPs -> ImportEntry
SingleIdentifier LIEWrappedName GhcPs
name
mkImportEntry (GHC.IEThingAbs XIEThingAbs GhcPs
_ LIEWrappedName GhcPs
name Maybe (ExportDoc GhcPs)
_) = LIEWrappedName GhcPs -> ImportEntry
SingleIdentifier LIEWrappedName GhcPs
name
mkImportEntry (GHC.IEThingAll XIEThingAll GhcPs
_ LIEWrappedName GhcPs
name Maybe (ExportDoc GhcPs)
_) = LIEWrappedName GhcPs -> ImportEntry
WithAllConstructors LIEWrappedName GhcPs
name
mkImportEntry (GHC.IEThingWith XIEThingWith GhcPs
_ LIEWrappedName GhcPs
name IEWildcard
_ [LIEWrappedName GhcPs]
constructors Maybe (ExportDoc GhcPs)
_) =
  WithSpecificConstructors {[LIEWrappedName GhcPs]
LIEWrappedName GhcPs
name :: LIEWrappedName GhcPs
constructors :: [LIEWrappedName GhcPs]
name :: LIEWrappedName GhcPs
constructors :: [LIEWrappedName GhcPs]
..}
#else
mkImportEntry (GHC.IEVar _ name) = SingleIdentifier name
mkImportEntry (GHC.IEThingAbs _ name) = SingleIdentifier name
mkImportEntry (GHC.IEThingAll _ name) = WithAllConstructors name
mkImportEntry (GHC.IEThingWith _ name _ constructors) =
  WithSpecificConstructors {..}
#endif
mkImportEntry IE GhcPs
_ = ImportEntry
forall a. HasCallStack => a
undefined

sortVariantsAndExplicitImports ::
     [WithComments ImportEntry] -> [WithComments ImportEntry]
sortVariantsAndExplicitImports :: [WithComments ImportEntry] -> [WithComments ImportEntry]
sortVariantsAndExplicitImports = (WithComments ImportEntry -> WithComments ImportEntry)
-> [WithComments ImportEntry] -> [WithComments ImportEntry]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WithComments ImportEntry -> WithComments ImportEntry
sortVariants ([WithComments ImportEntry] -> [WithComments ImportEntry])
-> ([WithComments ImportEntry] -> [WithComments ImportEntry])
-> [WithComments ImportEntry]
-> [WithComments ImportEntry]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [WithComments ImportEntry] -> [WithComments ImportEntry]
sortExplicitImports

-- | This function sorts variants (e.g., data constructors and class
-- methods) in the given explicit import by their names.
sortVariants :: WithComments ImportEntry -> WithComments ImportEntry
sortVariants :: WithComments ImportEntry -> WithComments ImportEntry
sortVariants = (ImportEntry -> ImportEntry)
-> WithComments ImportEntry -> WithComments ImportEntry
forall a b. (a -> b) -> WithComments a -> WithComments b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ImportEntry -> ImportEntry
f
  where
    f :: ImportEntry -> ImportEntry
f WithSpecificConstructors {[LIEWrappedName GhcPs]
LIEWrappedName GhcPs
name :: ImportEntry -> LIEWrappedName GhcPs
constructors :: ImportEntry -> [LIEWrappedName GhcPs]
name :: LIEWrappedName GhcPs
constructors :: [LIEWrappedName GhcPs]
..} =
      WithSpecificConstructors
        {constructors :: [LIEWrappedName GhcPs]
constructors = (GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
 -> GenLocated SrcSpanAnnA (IEWrappedName GhcPs) -> Ordering)
-> [GenLocated SrcSpanAnnA (IEWrappedName GhcPs)]
-> [GenLocated SrcSpanAnnA (IEWrappedName GhcPs)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (String -> String -> Ordering)
-> (GenLocated SrcSpanAnnA (IEWrappedName GhcPs) -> String)
-> GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
-> GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` GenLocated SrcSpanAnnA (IEWrappedName GhcPs) -> String
forall a. Outputable a => a -> String
showOutputable) [LIEWrappedName GhcPs]
[GenLocated SrcSpanAnnA (IEWrappedName GhcPs)]
constructors, LIEWrappedName GhcPs
name :: LIEWrappedName GhcPs
name :: LIEWrappedName GhcPs
..}
    f ImportEntry
x = ImportEntry
x

-- | This function sorts the given explicit imports by their names.
sortExplicitImports :: [WithComments ImportEntry] -> [WithComments ImportEntry]
sortExplicitImports :: [WithComments ImportEntry] -> [WithComments ImportEntry]
sortExplicitImports = (WithComments ImportEntry -> WithComments ImportEntry -> Ordering)
-> [WithComments ImportEntry] -> [WithComments ImportEntry]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (ImportEntry -> ImportEntry -> Ordering
compareImportEntities (ImportEntry -> ImportEntry -> Ordering)
-> (WithComments ImportEntry -> ImportEntry)
-> WithComments ImportEntry
-> WithComments ImportEntry
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` WithComments ImportEntry -> ImportEntry
forall a. WithComments a -> a
getNode)

-- | This function compares two import declarations by their module names.
compareImportEntities :: ImportEntry -> ImportEntry -> Ordering
compareImportEntities :: ImportEntry -> ImportEntry -> Ordering
compareImportEntities = String -> String -> Ordering
compareIdentifier (String -> String -> Ordering)
-> (ImportEntry -> String)
-> ImportEntry
-> ImportEntry
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` GenLocated SrcSpanAnnA (IEWrappedName GhcPs) -> String
forall a. Outputable a => a -> String
showOutputable (GenLocated SrcSpanAnnA (IEWrappedName GhcPs) -> String)
-> (ImportEntry -> GenLocated SrcSpanAnnA (IEWrappedName GhcPs))
-> ImportEntry
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImportEntry -> LIEWrappedName GhcPs
ImportEntry -> GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
getModuleName
-- | This function returns a 'Just' value with the module name extracted
-- from the import declaration. Otherwise, it returns a 'Nothing'.
#if MIN_VERSION_ghc_lib_parser(9, 6, 1)
getModuleName :: ImportEntry -> GHC.LIEWrappedName GHC.GhcPs
#else
getModuleName :: ImportEntry -> GHC.LIEWrappedName (GHC.IdP GHC.GhcPs)
#endif
getModuleName :: ImportEntry -> LIEWrappedName GhcPs
getModuleName (SingleIdentifier LIEWrappedName GhcPs
wrapped) = LIEWrappedName GhcPs
wrapped
getModuleName (WithAllConstructors LIEWrappedName GhcPs
wrapped) = LIEWrappedName GhcPs
wrapped
getModuleName (WithSpecificConstructors LIEWrappedName GhcPs
wrapped [LIEWrappedName GhcPs]
_) = LIEWrappedName GhcPs
wrapped

-- | 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

-- | 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)