{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
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 HsExtension
import HsImpExp (IE (..))
import Ormolu.Utils (notImplemented)
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 {..} ->
ImportDecl :: forall pass.
XCImportDecl pass
-> SourceText
-> Located ModuleName
-> Maybe StringLiteral
-> Bool
-> Bool
-> Bool
-> 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,
..
}
XImportDecl {} -> String -> ImportDecl GhcPs
forall a. String -> a
notImplemented "XImportDecl"
compareIdecl :: LImportDecl GhcPs -> LImportDecl GhcPs -> Ordering
compareIdecl :: LImportDecl GhcPs -> LImportDecl GhcPs -> Ordering
compareIdecl (L _ m0 :: ImportDecl GhcPs
m0) (L _ m1 :: ImportDecl GhcPs
m1) =
case (ModuleName -> Bool
isPrelude ModuleName
n0, ModuleName -> Bool
isPrelude ModuleName
n1) of
(False, False) -> ModuleName
n0 ModuleName -> ModuleName -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` ModuleName
n1
(True, False) -> Ordering
GT
(False, True) -> Ordering
LT
(True, 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 = (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "Prelude") (String -> Bool) -> (ModuleName -> String) -> ModuleName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> String
moduleNameString
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)
sortThings :: IE GhcPs -> IE GhcPs
sortThings :: IE GhcPs -> IE GhcPs
sortThings = \case
IEThingWith NoExt x :: LIEWrappedName (IdP GhcPs)
x w :: IEWildcard
w xs :: [LIEWrappedName (IdP GhcPs)]
xs fl :: [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 NoExt
XIEThingWith GhcPs
NoExt 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
other :: IE GhcPs
other -> IE GhcPs
other
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
getIewn :: IE GhcPs -> IEWrappedName RdrName
getIewn :: IE GhcPs -> IEWrappedName RdrName
getIewn = \case
IEVar NoExt x :: LIEWrappedName (IdP GhcPs)
x -> LIEWrappedName RdrName -> SrcSpanLess (LIEWrappedName RdrName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LIEWrappedName (IdP GhcPs)
LIEWrappedName RdrName
x
IEThingAbs NoExt x :: LIEWrappedName (IdP GhcPs)
x -> LIEWrappedName RdrName -> SrcSpanLess (LIEWrappedName RdrName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LIEWrappedName (IdP GhcPs)
LIEWrappedName RdrName
x
IEThingAll NoExt x :: LIEWrappedName (IdP GhcPs)
x -> LIEWrappedName RdrName -> SrcSpanLess (LIEWrappedName RdrName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LIEWrappedName (IdP GhcPs)
LIEWrappedName RdrName
x
IEThingWith NoExt x :: LIEWrappedName (IdP GhcPs)
x _ _ _ -> LIEWrappedName RdrName -> SrcSpanLess (LIEWrappedName RdrName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LIEWrappedName (IdP GhcPs)
LIEWrappedName RdrName
x
IEModuleContents NoExt _ -> String -> IEWrappedName RdrName
forall a. String -> a
notImplemented "IEModuleContents"
IEGroup NoExt _ _ -> String -> IEWrappedName RdrName
forall a. String -> a
notImplemented "IEGroup"
IEDoc NoExt _ -> String -> IEWrappedName RdrName
forall a. String -> a
notImplemented "IEDoc"
IEDocNamed NoExt _ -> String -> IEWrappedName RdrName
forall a. String -> a
notImplemented "IEDocNamed"
XIE NoExt -> String -> IEWrappedName RdrName
forall a. String -> a
notImplemented "XIE"
compareIewn :: IEWrappedName RdrName -> IEWrappedName RdrName -> Ordering
compareIewn :: IEWrappedName RdrName -> IEWrappedName RdrName -> Ordering
compareIewn (IEName x :: Located RdrName
x) (IEName y :: 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 _) (IEPattern _) = Ordering
LT
compareIewn (IEName _) (IEType _) = Ordering
LT
compareIewn (IEPattern _) (IEName _) = Ordering
GT
compareIewn (IEPattern x :: Located RdrName
x) (IEPattern y :: 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 _) (IEType _) = Ordering
LT
compareIewn (IEType _) (IEName _) = Ordering
GT
compareIewn (IEType _) (IEPattern _) = Ordering
GT
compareIewn (IEType x :: Located RdrName
x) (IEType y :: 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