{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}

-- | Manipulations on import lists.
module Ormolu.Imports
  ( sortImports,
  )
where

import Data.Bifunctor
import Data.Function (on)
import Data.Generics (gcompare)
import Data.List (sortBy)
import GHC hiding (GhcPs, IE)
import GHC.Hs.Extension
import GHC.Hs.ImpExp (IE (..))
import Ormolu.Utils (notImplemented)

-- | Sort imports by module name. This also sorts explicit import lists for
-- each declaration.
sortImports :: [LImportDecl GhcPs] -> [LImportDecl GhcPs]
sortImports :: [LImportDecl GhcPs] -> [LImportDecl GhcPs]
sortImports = (LImportDecl GhcPs -> LImportDecl GhcPs -> Ordering)
-> [LImportDecl GhcPs] -> [LImportDecl GhcPs]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy LImportDecl GhcPs -> LImportDecl GhcPs -> Ordering
compareIdecl ([LImportDecl GhcPs] -> [LImportDecl GhcPs])
-> ([LImportDecl GhcPs] -> [LImportDecl GhcPs])
-> [LImportDecl GhcPs]
-> [LImportDecl GhcPs]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LImportDecl GhcPs -> LImportDecl GhcPs)
-> [LImportDecl GhcPs] -> [LImportDecl GhcPs]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ImportDecl GhcPs -> ImportDecl GhcPs)
-> LImportDecl GhcPs -> LImportDecl GhcPs
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ImportDecl GhcPs -> ImportDecl GhcPs
sortImportLists)
  where
    sortImportLists :: ImportDecl GhcPs -> ImportDecl GhcPs
    sortImportLists :: ImportDecl GhcPs -> ImportDecl GhcPs
sortImportLists = \case
      ImportDecl {Bool
Maybe (Bool, Located [LIE GhcPs])
Maybe StringLiteral
Maybe (Located ModuleName)
ImportDeclQualifiedStyle
XCImportDecl GhcPs
SourceText
Located ModuleName
ideclExt :: forall pass. ImportDecl pass -> XCImportDecl pass
ideclSourceSrc :: forall pass. ImportDecl pass -> SourceText
ideclName :: forall pass. ImportDecl pass -> Located ModuleName
ideclPkgQual :: forall pass. ImportDecl pass -> Maybe StringLiteral
ideclSource :: forall pass. ImportDecl pass -> Bool
ideclSafe :: forall pass. ImportDecl pass -> Bool
ideclQualified :: forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
ideclImplicit :: forall pass. ImportDecl pass -> Bool
ideclAs :: forall pass. ImportDecl pass -> Maybe (Located ModuleName)
ideclHiding :: forall pass. ImportDecl pass -> Maybe (Bool, Located [LIE pass])
ideclHiding :: Maybe (Bool, Located [LIE GhcPs])
ideclAs :: Maybe (Located ModuleName)
ideclImplicit :: Bool
ideclQualified :: ImportDeclQualifiedStyle
ideclSafe :: Bool
ideclSource :: Bool
ideclPkgQual :: Maybe StringLiteral
ideclName :: Located ModuleName
ideclSourceSrc :: SourceText
ideclExt :: XCImportDecl GhcPs
..} ->
        ImportDecl :: forall pass.
XCImportDecl pass
-> SourceText
-> Located ModuleName
-> Maybe StringLiteral
-> Bool
-> Bool
-> ImportDeclQualifiedStyle
-> Bool
-> Maybe (Located ModuleName)
-> Maybe (Bool, Located [LIE pass])
-> ImportDecl pass
ImportDecl
          { ideclHiding :: Maybe (Bool, Located [LIE GhcPs])
ideclHiding = (Located [LIE GhcPs] -> Located [LIE GhcPs])
-> (Bool, Located [LIE GhcPs]) -> (Bool, Located [LIE GhcPs])
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (([LIE GhcPs] -> [LIE GhcPs])
-> Located [LIE GhcPs] -> Located [LIE GhcPs]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [LIE GhcPs] -> [LIE GhcPs]
sortLies) ((Bool, Located [LIE GhcPs]) -> (Bool, Located [LIE GhcPs]))
-> Maybe (Bool, Located [LIE GhcPs])
-> Maybe (Bool, Located [LIE GhcPs])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Bool, Located [LIE GhcPs])
ideclHiding,
            Bool
Maybe StringLiteral
Maybe (Located ModuleName)
ImportDeclQualifiedStyle
XCImportDecl GhcPs
SourceText
Located ModuleName
ideclExt :: XCImportDecl GhcPs
ideclSourceSrc :: SourceText
ideclName :: Located ModuleName
ideclPkgQual :: Maybe StringLiteral
ideclSource :: Bool
ideclSafe :: Bool
ideclQualified :: ImportDeclQualifiedStyle
ideclImplicit :: Bool
ideclAs :: Maybe (Located ModuleName)
ideclAs :: Maybe (Located ModuleName)
ideclImplicit :: Bool
ideclQualified :: ImportDeclQualifiedStyle
ideclSafe :: Bool
ideclSource :: Bool
ideclPkgQual :: Maybe StringLiteral
ideclName :: Located ModuleName
ideclSourceSrc :: SourceText
ideclExt :: XCImportDecl GhcPs
..
          }
      XImportDecl XXImportDecl GhcPs
x -> NoExtCon -> ImportDecl GhcPs
forall a. NoExtCon -> a
noExtCon NoExtCon
XXImportDecl GhcPs
x

-- | Compare two @'LImportDecl' 'GhcPs'@ things.
compareIdecl :: LImportDecl GhcPs -> LImportDecl GhcPs -> Ordering
compareIdecl :: LImportDecl GhcPs -> LImportDecl GhcPs -> Ordering
compareIdecl (L SrcSpan
_ ImportDecl GhcPs
m0) (L SrcSpan
_ ImportDecl GhcPs
m1) =
  case (ModuleName -> Bool
isPrelude ModuleName
n0, ModuleName -> Bool
isPrelude ModuleName
n1) of
    (Bool
False, Bool
False) -> ModuleName
n0 ModuleName -> ModuleName -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` ModuleName
n1
    (Bool
True, Bool
False) -> Ordering
GT
    (Bool
False, Bool
True) -> Ordering
LT
    (Bool
True, Bool
True) -> ImportDecl GhcPs
m0 ImportDecl GhcPs -> ImportDecl GhcPs -> Ordering
forall a. Data a => a -> a -> Ordering
`gcompare` ImportDecl GhcPs
m1
  where
    n0 :: SrcSpanLess (Located ModuleName)
n0 = Located ModuleName -> SrcSpanLess (Located ModuleName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (ImportDecl GhcPs -> Located ModuleName
forall pass. ImportDecl pass -> Located ModuleName
ideclName ImportDecl GhcPs
m0)
    n1 :: SrcSpanLess (Located ModuleName)
n1 = Located ModuleName -> SrcSpanLess (Located ModuleName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (ImportDecl GhcPs -> Located ModuleName
forall pass. ImportDecl pass -> Located ModuleName
ideclName ImportDecl GhcPs
m1)
    isPrelude :: ModuleName -> Bool
isPrelude = ([Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"Prelude") ([Char] -> Bool) -> (ModuleName -> [Char]) -> ModuleName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> [Char]
moduleNameString

-- | Sort located import or export.
sortLies :: [LIE GhcPs] -> [LIE GhcPs]
sortLies :: [LIE GhcPs] -> [LIE GhcPs]
sortLies = (LIE GhcPs -> LIE GhcPs -> Ordering) -> [LIE GhcPs] -> [LIE GhcPs]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (IE GhcPs -> IE GhcPs -> Ordering
compareIE (IE GhcPs -> IE GhcPs -> Ordering)
-> (LIE GhcPs -> IE GhcPs) -> LIE GhcPs -> LIE GhcPs -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` LIE GhcPs -> IE GhcPs
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) ([LIE GhcPs] -> [LIE GhcPs])
-> ([LIE GhcPs] -> [LIE GhcPs]) -> [LIE GhcPs] -> [LIE GhcPs]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LIE GhcPs -> LIE GhcPs) -> [LIE GhcPs] -> [LIE GhcPs]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((IE GhcPs -> IE GhcPs) -> LIE GhcPs -> LIE GhcPs
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IE GhcPs -> IE GhcPs
sortThings)

-- | Sort imports\/exports inside of 'IEThingWith'.
sortThings :: IE GhcPs -> IE GhcPs
sortThings :: IE GhcPs -> IE GhcPs
sortThings = \case
  IEThingWith XIEThingWith GhcPs
NoExtField LIEWrappedName (IdP GhcPs)
x IEWildcard
w [LIEWrappedName (IdP GhcPs)]
xs [Located (FieldLbl (IdP GhcPs))]
fl ->
    XIEThingWith GhcPs
-> LIEWrappedName (IdP GhcPs)
-> IEWildcard
-> [LIEWrappedName (IdP GhcPs)]
-> [Located (FieldLbl (IdP GhcPs))]
-> IE GhcPs
forall pass.
XIEThingWith pass
-> LIEWrappedName (IdP pass)
-> IEWildcard
-> [LIEWrappedName (IdP pass)]
-> [Located (FieldLbl (IdP pass))]
-> IE pass
IEThingWith NoExtField
XIEThingWith GhcPs
NoExtField LIEWrappedName (IdP GhcPs)
x IEWildcard
w ((LIEWrappedName RdrName -> LIEWrappedName RdrName -> Ordering)
-> [LIEWrappedName RdrName] -> [LIEWrappedName RdrName]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (IEWrappedName RdrName -> IEWrappedName RdrName -> Ordering
compareIewn (IEWrappedName RdrName -> IEWrappedName RdrName -> Ordering)
-> (LIEWrappedName RdrName -> IEWrappedName RdrName)
-> LIEWrappedName RdrName
-> LIEWrappedName RdrName
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` LIEWrappedName RdrName -> IEWrappedName RdrName
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) [LIEWrappedName (IdP GhcPs)]
[LIEWrappedName RdrName]
xs) [Located (FieldLbl (IdP GhcPs))]
fl
  IE GhcPs
other -> IE GhcPs
other

-- | Compare two located imports or exports.
compareIE :: IE GhcPs -> IE GhcPs -> Ordering
compareIE :: IE GhcPs -> IE GhcPs -> Ordering
compareIE = IEWrappedName RdrName -> IEWrappedName RdrName -> Ordering
compareIewn (IEWrappedName RdrName -> IEWrappedName RdrName -> Ordering)
-> (IE GhcPs -> IEWrappedName RdrName)
-> IE GhcPs
-> IE GhcPs
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` IE GhcPs -> IEWrappedName RdrName
getIewn

-- | Project @'IEWrappedName' 'RdrName'@ from @'IE' 'GhcPs'@.
getIewn :: IE GhcPs -> IEWrappedName RdrName
getIewn :: IE GhcPs -> IEWrappedName RdrName
getIewn = \case
  IEVar XIEVar GhcPs
NoExtField LIEWrappedName (IdP GhcPs)
x -> LIEWrappedName RdrName -> SrcSpanLess (LIEWrappedName RdrName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LIEWrappedName (IdP GhcPs)
LIEWrappedName RdrName
x
  IEThingAbs XIEThingAbs GhcPs
NoExtField LIEWrappedName (IdP GhcPs)
x -> LIEWrappedName RdrName -> SrcSpanLess (LIEWrappedName RdrName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LIEWrappedName (IdP GhcPs)
LIEWrappedName RdrName
x
  IEThingAll XIEThingAll GhcPs
NoExtField LIEWrappedName (IdP GhcPs)
x -> LIEWrappedName RdrName -> SrcSpanLess (LIEWrappedName RdrName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LIEWrappedName (IdP GhcPs)
LIEWrappedName RdrName
x
  IEThingWith XIEThingWith GhcPs
NoExtField LIEWrappedName (IdP GhcPs)
x IEWildcard
_ [LIEWrappedName (IdP GhcPs)]
_ [Located (FieldLbl (IdP GhcPs))]
_ -> LIEWrappedName RdrName -> SrcSpanLess (LIEWrappedName RdrName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LIEWrappedName (IdP GhcPs)
LIEWrappedName RdrName
x
  IEModuleContents XIEModuleContents GhcPs
NoExtField Located ModuleName
_ -> [Char] -> IEWrappedName RdrName
forall a. [Char] -> a
notImplemented [Char]
"IEModuleContents"
  IEGroup XIEGroup GhcPs
NoExtField Int
_ HsDocString
_ -> [Char] -> IEWrappedName RdrName
forall a. [Char] -> a
notImplemented [Char]
"IEGroup"
  IEDoc XIEDoc GhcPs
NoExtField HsDocString
_ -> [Char] -> IEWrappedName RdrName
forall a. [Char] -> a
notImplemented [Char]
"IEDoc"
  IEDocNamed XIEDocNamed GhcPs
NoExtField [Char]
_ -> [Char] -> IEWrappedName RdrName
forall a. [Char] -> a
notImplemented [Char]
"IEDocNamed"
  XIE XXIE GhcPs
x -> NoExtCon -> IEWrappedName RdrName
forall a. NoExtCon -> a
noExtCon NoExtCon
XXIE GhcPs
x

-- | Compare two @'IEWrapppedName' 'RdrName'@ things.
compareIewn :: IEWrappedName RdrName -> IEWrappedName RdrName -> Ordering
compareIewn :: IEWrappedName RdrName -> IEWrappedName RdrName -> Ordering
compareIewn (IEName Located RdrName
x) (IEName Located RdrName
y) = Located RdrName -> SrcSpanLess (Located RdrName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located RdrName
x RdrName -> RdrName -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Located RdrName -> SrcSpanLess (Located RdrName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located RdrName
y
compareIewn (IEName Located RdrName
_) (IEPattern Located RdrName
_) = Ordering
LT
compareIewn (IEName Located RdrName
_) (IEType Located RdrName
_) = Ordering
LT
compareIewn (IEPattern Located RdrName
_) (IEName Located RdrName
_) = Ordering
GT
compareIewn (IEPattern Located RdrName
x) (IEPattern Located RdrName
y) = Located RdrName -> SrcSpanLess (Located RdrName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located RdrName
x RdrName -> RdrName -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Located RdrName -> SrcSpanLess (Located RdrName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located RdrName
y
compareIewn (IEPattern Located RdrName
_) (IEType Located RdrName
_) = Ordering
LT
compareIewn (IEType Located RdrName
_) (IEName Located RdrName
_) = Ordering
GT
compareIewn (IEType Located RdrName
_) (IEPattern Located RdrName
_) = Ordering
GT
compareIewn (IEType Located RdrName
x) (IEType Located RdrName
y) = Located RdrName -> SrcSpanLess (Located RdrName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located RdrName
x RdrName -> RdrName -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Located RdrName -> SrcSpanLess (Located RdrName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located RdrName
y