{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DoAndIfThenElse #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Language.Haskell.Stylish.Step.Imports
( Options (..)
, defaultOptions
, ImportAlign (..)
, ListAlign (..)
, LongListAlign (..)
, EmptyListAlign (..)
, ListPadding (..)
, GroupRule (..)
, step
, printImport
, parsePattern
, unsafeParsePattern
) where
import Control.Monad (forM_, void, when)
import qualified Data.Aeson as A
import Data.Foldable (toList)
import Data.Function (on, (&))
import Data.Functor (($>))
import Data.List (groupBy, intercalate,
partition, sortBy, sortOn)
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.Map as Map
import Data.Maybe (fromMaybe, isJust, mapMaybe)
import Data.Sequence (Seq ((:|>)))
import qualified Data.Sequence as Seq
import qualified Data.Set as Set
import qualified Data.Text as T
import qualified GHC.Data.FastString as GHC
import qualified GHC.Hs as GHC
import qualified GHC.Types.Name.Reader as GHC
import qualified GHC.Types.PkgQual as GHC
import qualified GHC.Types.SourceText as GHC
import qualified GHC.Types.SrcLoc as GHC
import qualified Text.Regex.TDFA as Regex
import Text.Regex.TDFA (Regex)
import Text.Regex.TDFA.ReadRegex (parseRegex)
import Language.Haskell.Stylish.Block
import qualified Language.Haskell.Stylish.Editor as Editor
import Language.Haskell.Stylish.Module
import Language.Haskell.Stylish.Ordering
import Language.Haskell.Stylish.Printer
import Language.Haskell.Stylish.Step
import Language.Haskell.Stylish.Util
data Options = Options
{ Options -> ImportAlign
importAlign :: ImportAlign
, Options -> ListAlign
listAlign :: ListAlign
, Options -> Bool
padModuleNames :: Bool
, Options -> LongListAlign
longListAlign :: LongListAlign
, Options -> EmptyListAlign
emptyListAlign :: EmptyListAlign
, Options -> ListPadding
listPadding :: ListPadding
, Options -> Bool
separateLists :: Bool
, Options -> Bool
spaceSurround :: Bool
, Options -> Bool
postQualified :: Bool
, Options -> Bool
groupImports :: Bool
, Options -> [GroupRule]
groupRules :: [GroupRule]
} deriving (Options -> Options -> Bool
(Options -> Options -> Bool)
-> (Options -> Options -> Bool) -> Eq Options
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Options -> Options -> Bool
== :: Options -> Options -> Bool
$c/= :: Options -> Options -> Bool
/= :: Options -> Options -> Bool
Eq, Int -> Options -> ShowS
[Options] -> ShowS
Options -> [Char]
(Int -> Options -> ShowS)
-> (Options -> [Char]) -> ([Options] -> ShowS) -> Show Options
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Options -> ShowS
showsPrec :: Int -> Options -> ShowS
$cshow :: Options -> [Char]
show :: Options -> [Char]
$cshowList :: [Options] -> ShowS
showList :: [Options] -> ShowS
Show)
defaultOptions :: Options
defaultOptions :: Options
defaultOptions = Options
{ importAlign :: ImportAlign
importAlign = ImportAlign
Global
, listAlign :: ListAlign
listAlign = ListAlign
AfterAlias
, padModuleNames :: Bool
padModuleNames = Bool
True
, longListAlign :: LongListAlign
longListAlign = LongListAlign
Inline
, emptyListAlign :: EmptyListAlign
emptyListAlign = EmptyListAlign
Inherit
, listPadding :: ListPadding
listPadding = Int -> ListPadding
LPConstant Int
4
, separateLists :: Bool
separateLists = Bool
True
, spaceSurround :: Bool
spaceSurround = Bool
False
, postQualified :: Bool
postQualified = Bool
False
, groupImports :: Bool
groupImports = Bool
False
, groupRules :: [GroupRule]
groupRules = [GroupRule
defaultGroupRule]
}
where defaultGroupRule :: GroupRule
defaultGroupRule = GroupRule
{ match :: Pattern
match = [Char] -> Pattern
unsafeParsePattern [Char]
".*"
, subGroup :: Maybe Pattern
subGroup = Pattern -> Maybe Pattern
forall a. a -> Maybe a
Just (Pattern -> Maybe Pattern) -> Pattern -> Maybe Pattern
forall a b. (a -> b) -> a -> b
$ [Char] -> Pattern
unsafeParsePattern [Char]
"^[^.]+"
}
data ListPadding
= LPConstant Int
| LPModuleName
deriving (ListPadding -> ListPadding -> Bool
(ListPadding -> ListPadding -> Bool)
-> (ListPadding -> ListPadding -> Bool) -> Eq ListPadding
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ListPadding -> ListPadding -> Bool
== :: ListPadding -> ListPadding -> Bool
$c/= :: ListPadding -> ListPadding -> Bool
/= :: ListPadding -> ListPadding -> Bool
Eq, Int -> ListPadding -> ShowS
[ListPadding] -> ShowS
ListPadding -> [Char]
(Int -> ListPadding -> ShowS)
-> (ListPadding -> [Char])
-> ([ListPadding] -> ShowS)
-> Show ListPadding
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ListPadding -> ShowS
showsPrec :: Int -> ListPadding -> ShowS
$cshow :: ListPadding -> [Char]
show :: ListPadding -> [Char]
$cshowList :: [ListPadding] -> ShowS
showList :: [ListPadding] -> ShowS
Show)
data ImportAlign
= Global
| File
| Group
| None
deriving (ImportAlign -> ImportAlign -> Bool
(ImportAlign -> ImportAlign -> Bool)
-> (ImportAlign -> ImportAlign -> Bool) -> Eq ImportAlign
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ImportAlign -> ImportAlign -> Bool
== :: ImportAlign -> ImportAlign -> Bool
$c/= :: ImportAlign -> ImportAlign -> Bool
/= :: ImportAlign -> ImportAlign -> Bool
Eq, Int -> ImportAlign -> ShowS
[ImportAlign] -> ShowS
ImportAlign -> [Char]
(Int -> ImportAlign -> ShowS)
-> (ImportAlign -> [Char])
-> ([ImportAlign] -> ShowS)
-> Show ImportAlign
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ImportAlign -> ShowS
showsPrec :: Int -> ImportAlign -> ShowS
$cshow :: ImportAlign -> [Char]
show :: ImportAlign -> [Char]
$cshowList :: [ImportAlign] -> ShowS
showList :: [ImportAlign] -> ShowS
Show)
data ListAlign
= NewLine
| WithModuleName
| WithAlias
| AfterAlias
| Repeat
deriving (ListAlign -> ListAlign -> Bool
(ListAlign -> ListAlign -> Bool)
-> (ListAlign -> ListAlign -> Bool) -> Eq ListAlign
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ListAlign -> ListAlign -> Bool
== :: ListAlign -> ListAlign -> Bool
$c/= :: ListAlign -> ListAlign -> Bool
/= :: ListAlign -> ListAlign -> Bool
Eq, Int -> ListAlign -> ShowS
[ListAlign] -> ShowS
ListAlign -> [Char]
(Int -> ListAlign -> ShowS)
-> (ListAlign -> [Char])
-> ([ListAlign] -> ShowS)
-> Show ListAlign
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ListAlign -> ShowS
showsPrec :: Int -> ListAlign -> ShowS
$cshow :: ListAlign -> [Char]
show :: ListAlign -> [Char]
$cshowList :: [ListAlign] -> ShowS
showList :: [ListAlign] -> ShowS
Show)
data EmptyListAlign
= Inherit
| RightAfter
deriving (EmptyListAlign -> EmptyListAlign -> Bool
(EmptyListAlign -> EmptyListAlign -> Bool)
-> (EmptyListAlign -> EmptyListAlign -> Bool) -> Eq EmptyListAlign
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EmptyListAlign -> EmptyListAlign -> Bool
== :: EmptyListAlign -> EmptyListAlign -> Bool
$c/= :: EmptyListAlign -> EmptyListAlign -> Bool
/= :: EmptyListAlign -> EmptyListAlign -> Bool
Eq, Int -> EmptyListAlign -> ShowS
[EmptyListAlign] -> ShowS
EmptyListAlign -> [Char]
(Int -> EmptyListAlign -> ShowS)
-> (EmptyListAlign -> [Char])
-> ([EmptyListAlign] -> ShowS)
-> Show EmptyListAlign
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EmptyListAlign -> ShowS
showsPrec :: Int -> EmptyListAlign -> ShowS
$cshow :: EmptyListAlign -> [Char]
show :: EmptyListAlign -> [Char]
$cshowList :: [EmptyListAlign] -> ShowS
showList :: [EmptyListAlign] -> ShowS
Show)
data LongListAlign
= Inline
| InlineWithBreak
| InlineToMultiline
| Multiline
deriving (LongListAlign -> LongListAlign -> Bool
(LongListAlign -> LongListAlign -> Bool)
-> (LongListAlign -> LongListAlign -> Bool) -> Eq LongListAlign
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LongListAlign -> LongListAlign -> Bool
== :: LongListAlign -> LongListAlign -> Bool
$c/= :: LongListAlign -> LongListAlign -> Bool
/= :: LongListAlign -> LongListAlign -> Bool
Eq, Int -> LongListAlign -> ShowS
[LongListAlign] -> ShowS
LongListAlign -> [Char]
(Int -> LongListAlign -> ShowS)
-> (LongListAlign -> [Char])
-> ([LongListAlign] -> ShowS)
-> Show LongListAlign
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LongListAlign -> ShowS
showsPrec :: Int -> LongListAlign -> ShowS
$cshow :: LongListAlign -> [Char]
show :: LongListAlign -> [Char]
$cshowList :: [LongListAlign] -> ShowS
showList :: [LongListAlign] -> ShowS
Show)
data GroupRule = GroupRule
{ GroupRule -> Pattern
match :: Pattern
, GroupRule -> Maybe Pattern
subGroup :: Maybe Pattern
} deriving (Int -> GroupRule -> ShowS
[GroupRule] -> ShowS
GroupRule -> [Char]
(Int -> GroupRule -> ShowS)
-> (GroupRule -> [Char])
-> ([GroupRule] -> ShowS)
-> Show GroupRule
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GroupRule -> ShowS
showsPrec :: Int -> GroupRule -> ShowS
$cshow :: GroupRule -> [Char]
show :: GroupRule -> [Char]
$cshowList :: [GroupRule] -> ShowS
showList :: [GroupRule] -> ShowS
Show, GroupRule -> GroupRule -> Bool
(GroupRule -> GroupRule -> Bool)
-> (GroupRule -> GroupRule -> Bool) -> Eq GroupRule
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GroupRule -> GroupRule -> Bool
== :: GroupRule -> GroupRule -> Bool
$c/= :: GroupRule -> GroupRule -> Bool
/= :: GroupRule -> GroupRule -> Bool
Eq)
instance A.FromJSON GroupRule where
parseJSON :: Value -> Parser GroupRule
parseJSON = [Char] -> (Object -> Parser GroupRule) -> Value -> Parser GroupRule
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"group_rule" Object -> Parser GroupRule
parse
where parse :: Object -> Parser GroupRule
parse Object
o = Pattern -> Maybe Pattern -> GroupRule
GroupRule
(Pattern -> Maybe Pattern -> GroupRule)
-> Parser Pattern -> Parser (Maybe Pattern -> GroupRule)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser Pattern
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"match")
Parser (Maybe Pattern -> GroupRule)
-> Parser (Maybe Pattern) -> Parser GroupRule
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Pattern)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"sub_group")
data Pattern = Pattern
{ Pattern -> Regex
regex :: Regex
, Pattern -> [Char]
string :: String
}
instance Show Pattern where show :: Pattern -> [Char]
show = ShowS
forall a. Show a => a -> [Char]
show ShowS -> (Pattern -> [Char]) -> Pattern -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern -> [Char]
string
instance Eq Pattern where == :: Pattern -> Pattern -> Bool
(==) = [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
(==) ([Char] -> [Char] -> Bool)
-> (Pattern -> [Char]) -> Pattern -> Pattern -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Pattern -> [Char]
string
instance A.FromJSON Pattern where
parseJSON :: Value -> Parser Pattern
parseJSON = [Char] -> (Text -> Parser Pattern) -> Value -> Parser Pattern
forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
A.withText [Char]
"regex" Text -> Parser Pattern
forall {m :: * -> *}. MonadFail m => Text -> m Pattern
parse
where parse :: Text -> m Pattern
parse Text
text = case [Char] -> Either [Char] Pattern
parsePattern ([Char] -> Either [Char] Pattern)
-> [Char] -> Either [Char] Pattern
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
text of
Left [Char]
err -> [Char] -> m Pattern
forall a. [Char] -> m a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> m Pattern) -> [Char] -> m Pattern
forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid regex:\n" [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
err
Right Pattern
pat -> Pattern -> m Pattern
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pattern
pat
parsePattern :: String -> Either String Pattern
parsePattern :: [Char] -> Either [Char] Pattern
parsePattern [Char]
string = case [Char] -> Either ParseError (Pattern, (Int, DoPa))
parseRegex [Char]
string of
Right (Pattern, (Int, DoPa))
_ -> Pattern -> Either [Char] Pattern
forall a b. b -> Either a b
Right (Pattern -> Either [Char] Pattern)
-> Pattern -> Either [Char] Pattern
forall a b. (a -> b) -> a -> b
$ Pattern { [Char]
string :: [Char]
string :: [Char]
string, regex :: Regex
regex = [Char] -> Regex
forall regex compOpt execOpt source.
RegexMaker regex compOpt execOpt source =>
source -> regex
Regex.makeRegex [Char]
string }
Left ParseError
err -> [Char] -> Either [Char] Pattern
forall a b. a -> Either a b
Left (ParseError -> [Char]
forall a. Show a => a -> [Char]
show ParseError
err)
unsafeParsePattern :: String -> Pattern
unsafeParsePattern :: [Char] -> Pattern
unsafeParsePattern = ([Char] -> Pattern)
-> (Pattern -> Pattern) -> Either [Char] Pattern -> Pattern
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [Char] -> Pattern
forall a. HasCallStack => [Char] -> a
error Pattern -> Pattern
forall a. a -> a
id (Either [Char] Pattern -> Pattern)
-> ([Char] -> Either [Char] Pattern) -> [Char] -> Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Either [Char] Pattern
parsePattern
step :: Maybe Int -> Options -> Step
step :: Maybe Int -> Options -> Step
step Maybe Int
columns = [Char] -> (Lines -> Module -> Lines) -> Step
makeStep [Char]
"Imports (ghc-lib-parser)" ((Lines -> Module -> Lines) -> Step)
-> (Options -> Lines -> Module -> Lines) -> Options -> Step
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Int -> Options -> Lines -> Module -> Lines
printImports Maybe Int
columns
printImports :: Maybe Int -> Options -> Lines -> Module -> Lines
printImports :: Maybe Int -> Options -> Lines -> Module -> Lines
printImports Maybe Int
maxCols Options
options Lines
ls Module
m = Edits -> Lines -> Lines
Editor.apply Edits
changes Lines
ls
where
groups :: [NonEmpty (LImportDecl GhcPs)]
groups = Module -> [NonEmpty (LImportDecl GhcPs)]
moduleImportGroups Module
m
moduleStats :: ImportStats
moduleStats = (ImportDecl GhcPs -> ImportStats)
-> [ImportDecl GhcPs] -> ImportStats
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ImportDecl GhcPs -> ImportStats
importStats ([ImportDecl GhcPs] -> ImportStats)
-> ([GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> [ImportDecl GhcPs])
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> ImportStats
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> ImportDecl GhcPs)
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> [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) -> ImportDecl GhcPs
forall l e. GenLocated l e -> e
GHC.unLoc ([GenLocated SrcSpanAnnA (ImportDecl GhcPs)] -> ImportStats)
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)] -> ImportStats
forall a b. (a -> b) -> a -> b
$ (NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)])
-> [NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))]
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList [NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))]
groups
changes :: Edits
changes
| Options -> Bool
groupImports Options
options =
Maybe Int
-> Options
-> ImportStats
-> [NonEmpty (LImportDecl GhcPs)]
-> Edits
groupAndFormat Maybe Int
maxCols Options
options ImportStats
moduleStats [NonEmpty (LImportDecl GhcPs)]
[NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))]
groups
| Bool
otherwise =
(NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs)) -> Edits)
-> [NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))] -> Edits
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Maybe Int
-> Options -> ImportStats -> NonEmpty (LImportDecl GhcPs) -> Edits
formatGroup Maybe Int
maxCols Options
options ImportStats
moduleStats) [NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))]
groups
formatGroup
:: Maybe Int -> Options -> ImportStats
-> NonEmpty (GHC.LImportDecl GHC.GhcPs) -> Editor.Edits
formatGroup :: Maybe Int
-> Options -> ImportStats -> NonEmpty (LImportDecl GhcPs) -> Edits
formatGroup Maybe Int
maxCols Options
options ImportStats
moduleStats NonEmpty (LImportDecl GhcPs)
imports =
let newLines :: Lines
newLines = Maybe Int
-> Options -> ImportStats -> NonEmpty (LImportDecl GhcPs) -> Lines
formatImports Maybe Int
maxCols Options
options ImportStats
moduleStats NonEmpty (LImportDecl GhcPs)
imports in
Block [Char] -> (Lines -> Lines) -> Edits
Editor.changeLines (NonEmpty (LImportDecl GhcPs) -> Block [Char]
importBlock NonEmpty (LImportDecl GhcPs)
imports) (Lines -> Lines -> Lines
forall a b. a -> b -> a
const Lines
newLines)
importBlock :: NonEmpty (GHC.LImportDecl GHC.GhcPs) -> Block String
importBlock :: NonEmpty (LImportDecl GhcPs) -> Block [Char]
importBlock NonEmpty (LImportDecl GhcPs)
group = Int -> Int -> Block [Char]
forall a. Int -> Int -> Block a
Block
(RealSrcSpan -> Int
GHC.srcSpanStartLine (RealSrcSpan -> Int)
-> (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> RealSrcSpan)
-> GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> RealSrcSpan
forall {a} {e}. GenLocated (SrcSpanAnn' a) e -> RealSrcSpan
src (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> Int)
-> GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> Int
forall a b. (a -> b) -> a -> b
$ NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
-> GenLocated SrcSpanAnnA (ImportDecl GhcPs)
forall a. NonEmpty a -> a
NonEmpty.head NonEmpty (LImportDecl GhcPs)
NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
group)
(RealSrcSpan -> Int
GHC.srcSpanEndLine (RealSrcSpan -> Int)
-> (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> RealSrcSpan)
-> GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> RealSrcSpan
forall {a} {e}. GenLocated (SrcSpanAnn' a) e -> RealSrcSpan
src (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> Int)
-> GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> Int
forall a b. (a -> b) -> a -> b
$ NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
-> GenLocated SrcSpanAnnA (ImportDecl GhcPs)
forall a. NonEmpty a -> a
NonEmpty.last NonEmpty (LImportDecl GhcPs)
NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
group)
where
src :: GenLocated (SrcSpanAnn' a) e -> RealSrcSpan
src = RealSrcSpan -> Maybe RealSrcSpan -> RealSrcSpan
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> RealSrcSpan
forall a. HasCallStack => [Char] -> a
error [Char]
"importBlock: missing location") (Maybe RealSrcSpan -> RealSrcSpan)
-> (GenLocated (SrcSpanAnn' a) e -> Maybe RealSrcSpan)
-> GenLocated (SrcSpanAnn' a) e
-> RealSrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
SrcSpan -> Maybe RealSrcSpan
GHC.srcSpanToRealSrcSpan (SrcSpan -> Maybe RealSrcSpan)
-> (GenLocated (SrcSpanAnn' a) e -> SrcSpan)
-> GenLocated (SrcSpanAnn' a) e
-> Maybe RealSrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated (SrcSpanAnn' a) e -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
GHC.getLocA
formatImports
:: Maybe Int
-> Options
-> ImportStats
-> NonEmpty (GHC.LImportDecl GHC.GhcPs) -> Lines
formatImports :: Maybe Int
-> Options -> ImportStats -> NonEmpty (LImportDecl GhcPs) -> Lines
formatImports Maybe Int
maxCols Options
options ImportStats
moduleStats NonEmpty (LImportDecl GhcPs)
rawGroup =
PrinterConfig -> P () -> Lines
forall a. PrinterConfig -> Printer a -> Lines
runPrinter_ (Maybe Int -> PrinterConfig
PrinterConfig Maybe Int
maxCols) do
let
group :: NonEmpty (GHC.LImportDecl GHC.GhcPs)
group :: NonEmpty (LImportDecl GhcPs)
group
= (GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> Ordering)
-> NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
-> NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
forall a. (a -> a -> Ordering) -> NonEmpty a -> NonEmpty a
NonEmpty.sortBy (ImportDecl GhcPs -> ImportDecl GhcPs -> Ordering
compareImports (ImportDecl GhcPs -> ImportDecl GhcPs -> Ordering)
-> (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> ImportDecl GhcPs)
-> 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) -> ImportDecl GhcPs
forall l e. GenLocated l e -> e
GHC.unLoc) NonEmpty (LImportDecl GhcPs)
NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
rawGroup
NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
-> (NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
-> NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))
-> NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
forall a b. a -> (a -> b) -> b
& NonEmpty (LImportDecl GhcPs) -> NonEmpty (LImportDecl GhcPs)
NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
-> NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
mergeImports
unLocatedGroup :: [ImportDecl GhcPs]
unLocatedGroup = (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> ImportDecl GhcPs)
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> [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) -> ImportDecl GhcPs
forall l e. GenLocated l e -> e
GHC.unLoc ([GenLocated SrcSpanAnnA (ImportDecl GhcPs)] -> [ImportDecl GhcPs])
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> [ImportDecl GhcPs]
forall a b. (a -> b) -> a -> b
$ NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (LImportDecl GhcPs)
NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
group
align' :: ImportAlign
align' = Options -> ImportAlign
importAlign Options
options
padModuleNames' :: Bool
padModuleNames' = Options -> Bool
padModuleNames Options
options
padNames :: Bool
padNames = ImportAlign
align' ImportAlign -> ImportAlign -> Bool
forall a. Eq a => a -> a -> Bool
/= ImportAlign
None Bool -> Bool -> Bool
&& Bool
padModuleNames'
stats :: ImportStats
stats = case ImportAlign
align' of
ImportAlign
Global -> ImportStats
moduleStats {isAnyQualified = True}
ImportAlign
File -> ImportStats
moduleStats
ImportAlign
Group -> (ImportDecl GhcPs -> ImportStats)
-> [ImportDecl GhcPs] -> ImportStats
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ImportDecl GhcPs -> ImportStats
importStats [ImportDecl GhcPs]
unLocatedGroup
ImportAlign
None -> ImportStats
forall a. Monoid a => a
mempty
NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
-> (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> P ()) -> P ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ NonEmpty (LImportDecl GhcPs)
NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
group \GenLocated SrcSpanAnnA (ImportDecl GhcPs)
imp -> Options -> Bool -> ImportStats -> LImportDecl GhcPs -> P ()
printQualified Options
options Bool
padNames ImportStats
stats LImportDecl GhcPs
GenLocated SrcSpanAnnA (ImportDecl GhcPs)
imp P () -> P () -> P ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P ()
newline
groupAndFormat
:: Maybe Int
-> Options
-> ImportStats
-> [NonEmpty (GHC.LImportDecl GHC.GhcPs)]
-> Editor.Edits
groupAndFormat :: Maybe Int
-> Options
-> ImportStats
-> [NonEmpty (LImportDecl GhcPs)]
-> Edits
groupAndFormat Maybe Int
_ Options
_ ImportStats
_ [] = Edits
forall a. Monoid a => a
mempty
groupAndFormat Maybe Int
maxCols Options
options ImportStats
moduleStats [NonEmpty (LImportDecl GhcPs)]
groups =
Block [Char] -> (Lines -> Lines) -> Edits
Editor.changeLines Block [Char]
forall {a}. Block a
block (Lines -> Lines -> Lines
forall a b. a -> b -> a
const Lines
regroupedLines)
where
regroupedLines :: Lines
regroupedLines :: Lines
regroupedLines = Lines -> [Lines] -> Lines
forall a. [a] -> [[a]] -> [a]
intercalate [[Char]
""] ([Lines] -> Lines) -> [Lines] -> Lines
forall a b. (a -> b) -> a -> b
$
(NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs)) -> Lines)
-> [NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))]
-> [Lines]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe Int
-> Options -> ImportStats -> NonEmpty (LImportDecl GhcPs) -> Lines
formatImports Maybe Int
maxCols Options
options ImportStats
moduleStats) [NonEmpty (LImportDecl GhcPs)]
[NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))]
grouped
grouped :: [NonEmpty (GHC.LImportDecl GHC.GhcPs)]
grouped :: [NonEmpty (LImportDecl GhcPs)]
grouped = [GroupRule]
-> [LImportDecl GhcPs] -> [NonEmpty (LImportDecl GhcPs)]
groupByRules (Options -> [GroupRule]
groupRules Options
options) [LImportDecl GhcPs]
imports
imports :: [GHC.LImportDecl GHC.GhcPs]
imports :: [LImportDecl GhcPs]
imports = (NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)])
-> [NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))]
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList [NonEmpty (LImportDecl GhcPs)]
[NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))]
groups
block :: Block a
block = Int -> Int -> Block a
forall a. Int -> Int -> Block a
Block
(RealSrcSpan -> Int
GHC.srcSpanStartLine (RealSrcSpan -> Int)
-> (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> RealSrcSpan)
-> GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> RealSrcSpan
forall {a} {e}. GenLocated (SrcSpanAnn' a) e -> RealSrcSpan
src (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> Int)
-> GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> Int
forall a b. (a -> b) -> a -> b
$ [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> GenLocated SrcSpanAnnA (ImportDecl GhcPs)
forall a. HasCallStack => [a] -> a
head [LImportDecl GhcPs]
[GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
imports)
(RealSrcSpan -> Int
GHC.srcSpanEndLine (RealSrcSpan -> Int)
-> (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> RealSrcSpan)
-> GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> RealSrcSpan
forall {a} {e}. GenLocated (SrcSpanAnn' a) e -> RealSrcSpan
src (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> Int)
-> GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> Int
forall a b. (a -> b) -> a -> b
$ [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> GenLocated SrcSpanAnnA (ImportDecl GhcPs)
forall a. HasCallStack => [a] -> a
last [LImportDecl GhcPs]
[GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
imports)
src :: GenLocated (SrcSpanAnn' a) e -> RealSrcSpan
src = RealSrcSpan -> Maybe RealSrcSpan -> RealSrcSpan
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> RealSrcSpan
forall a. HasCallStack => [Char] -> a
error [Char]
"regroupImports: missing location") (Maybe RealSrcSpan -> RealSrcSpan)
-> (GenLocated (SrcSpanAnn' a) e -> Maybe RealSrcSpan)
-> GenLocated (SrcSpanAnn' a) e
-> RealSrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
SrcSpan -> Maybe RealSrcSpan
GHC.srcSpanToRealSrcSpan (SrcSpan -> Maybe RealSrcSpan)
-> (GenLocated (SrcSpanAnn' a) e -> SrcSpan)
-> GenLocated (SrcSpanAnn' a) e
-> Maybe RealSrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated (SrcSpanAnn' a) e -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
GHC.getLocA
groupByRules
:: [GroupRule]
-> [GHC.LImportDecl GHC.GhcPs]
-> [NonEmpty (GHC.LImportDecl GHC.GhcPs)]
groupByRules :: [GroupRule]
-> [LImportDecl GhcPs] -> [NonEmpty (LImportDecl GhcPs)]
groupByRules [GroupRule]
rules [LImportDecl GhcPs]
allImports = Seq (NonEmpty (LImportDecl GhcPs))
-> [NonEmpty (LImportDecl GhcPs)]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq (NonEmpty (LImportDecl GhcPs))
-> [NonEmpty (LImportDecl GhcPs)])
-> Seq (NonEmpty (LImportDecl GhcPs))
-> [NonEmpty (LImportDecl GhcPs)]
forall a b. (a -> b) -> a -> b
$ [GroupRule]
-> [LImportDecl GhcPs]
-> Seq (NonEmpty (LImportDecl GhcPs))
-> Seq (NonEmpty (LImportDecl GhcPs))
go [GroupRule]
rules [LImportDecl GhcPs]
allImports Seq (NonEmpty (LImportDecl GhcPs))
Seq (NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))
forall a. Seq a
Seq.empty
where
go :: [GroupRule]
-> [GHC.LImportDecl GHC.GhcPs]
-> Seq (NonEmpty (GHC.LImportDecl GHC.GhcPs))
-> Seq (NonEmpty (GHC.LImportDecl GHC.GhcPs))
go :: [GroupRule]
-> [LImportDecl GhcPs]
-> Seq (NonEmpty (LImportDecl GhcPs))
-> Seq (NonEmpty (LImportDecl GhcPs))
go [] [] Seq (NonEmpty (LImportDecl GhcPs))
groups = Seq (NonEmpty (LImportDecl GhcPs))
groups
go [] [LImportDecl GhcPs]
imports Seq (NonEmpty (LImportDecl GhcPs))
groups = Seq (NonEmpty (LImportDecl GhcPs))
Seq (NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))
groups Seq (NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))
-> NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
-> Seq (NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))
forall a. Seq a -> a -> Seq a
:|> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
forall a. HasCallStack => [a] -> NonEmpty a
NonEmpty.fromList [LImportDecl GhcPs]
[GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
imports
go (GroupRule
r : [GroupRule]
rs) [LImportDecl GhcPs]
imports Seq (NonEmpty (LImportDecl GhcPs))
groups =
let
(Seq (NonEmpty (LImportDecl GhcPs))
groups', [LImportDecl GhcPs]
rest) = GroupRule
-> [LImportDecl GhcPs]
-> (Seq (NonEmpty (LImportDecl GhcPs)), [LImportDecl GhcPs])
extract GroupRule
r [LImportDecl GhcPs]
imports
in
[GroupRule]
-> [LImportDecl GhcPs]
-> Seq (NonEmpty (LImportDecl GhcPs))
-> Seq (NonEmpty (LImportDecl GhcPs))
go [GroupRule]
rs [LImportDecl GhcPs]
[GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
rest (Seq (NonEmpty (LImportDecl GhcPs))
Seq (NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))
groups Seq (NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))
-> Seq (NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))
-> Seq (NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))
forall a. Semigroup a => a -> a -> a
<> Seq (NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))
groups')
extract :: GroupRule
-> [GHC.LImportDecl GHC.GhcPs]
-> ( Seq (NonEmpty (GHC.LImportDecl GHC.GhcPs))
, [GHC.LImportDecl GHC.GhcPs]
)
extract :: GroupRule
-> [LImportDecl GhcPs]
-> (Seq (NonEmpty (LImportDecl GhcPs)), [LImportDecl GhcPs])
extract GroupRule { Pattern
match :: GroupRule -> Pattern
match :: Pattern
match, Maybe Pattern
subGroup :: GroupRule -> Maybe Pattern
subGroup :: Maybe Pattern
subGroup } [LImportDecl GhcPs]
imports =
let
([GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
matched, [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
rest) = (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> Bool)
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> ([GenLocated SrcSpanAnnA (ImportDecl GhcPs)],
[GenLocated SrcSpanAnnA (ImportDecl GhcPs)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (Pattern -> LImportDecl GhcPs -> Bool
matches Pattern
match) [LImportDecl GhcPs]
[GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
imports
subgroups :: [[GenLocated SrcSpanAnnA (ImportDecl GhcPs)]]
subgroups = (GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> Bool)
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> [[GenLocated SrcSpanAnnA (ImportDecl GhcPs)]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy ([Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
(==) ([Char] -> [Char] -> Bool)
-> (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> [Char])
-> GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Maybe Pattern -> LImportDecl GhcPs -> [Char]
firstMatch Maybe Pattern
subGroup) ([GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> [[GenLocated SrcSpanAnnA (ImportDecl GhcPs)]])
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> [[GenLocated SrcSpanAnnA (ImportDecl GhcPs)]]
forall a b. (a -> b) -> a -> b
$
(GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> [Char])
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Maybe Pattern -> LImportDecl GhcPs -> [Char]
firstMatch Maybe Pattern
subGroup) [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
matched
in
([NonEmpty (LImportDecl GhcPs)]
-> Seq (NonEmpty (LImportDecl GhcPs))
forall a. [a] -> Seq a
Seq.fromList ([NonEmpty (LImportDecl GhcPs)]
-> Seq (NonEmpty (LImportDecl GhcPs)))
-> [NonEmpty (LImportDecl GhcPs)]
-> Seq (NonEmpty (LImportDecl GhcPs))
forall a b. (a -> b) -> a -> b
$ ([GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> Maybe (NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))))
-> [[GenLocated SrcSpanAnnA (ImportDecl GhcPs)]]
-> [NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> Maybe (NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs)))
forall a. [a] -> Maybe (NonEmpty a)
NonEmpty.nonEmpty [[GenLocated SrcSpanAnnA (ImportDecl GhcPs)]]
subgroups, [LImportDecl GhcPs]
[GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
rest)
matches :: Pattern -> GHC.LImportDecl GHC.GhcPs -> Bool
matches :: Pattern -> LImportDecl GhcPs -> Bool
matches Pattern { Regex
regex :: Pattern -> Regex
regex :: Regex
regex } LImportDecl GhcPs
import_ = Regex -> [Char] -> Bool
forall regex source target.
RegexContext regex source target =>
regex -> source -> target
Regex.match Regex
regex ([Char] -> Bool) -> [Char] -> Bool
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> [Char]
forall {l}. GenLocated l (ImportDecl GhcPs) -> [Char]
moduleName LImportDecl GhcPs
GenLocated SrcSpanAnnA (ImportDecl GhcPs)
import_
firstMatch :: Maybe Pattern -> GHC.LImportDecl GHC.GhcPs -> String
firstMatch :: Maybe Pattern -> LImportDecl GhcPs -> [Char]
firstMatch (Just Pattern { Regex
regex :: Pattern -> Regex
regex :: Regex
regex }) LImportDecl GhcPs
import_ =
Regex -> ShowS
forall regex source target.
RegexContext regex source target =>
regex -> source -> target
Regex.match Regex
regex ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> [Char]
forall {l}. GenLocated l (ImportDecl GhcPs) -> [Char]
moduleName LImportDecl GhcPs
GenLocated SrcSpanAnnA (ImportDecl GhcPs)
import_
firstMatch Maybe Pattern
Nothing LImportDecl GhcPs
_ =
[Char]
""
moduleName :: GenLocated l (ImportDecl GhcPs) -> [Char]
moduleName = ImportDecl GhcPs -> [Char]
importModuleName (ImportDecl GhcPs -> [Char])
-> (GenLocated l (ImportDecl GhcPs) -> ImportDecl GhcPs)
-> GenLocated l (ImportDecl GhcPs)
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated l (ImportDecl GhcPs) -> ImportDecl GhcPs
forall l e. GenLocated l e -> e
GHC.unLoc
printQualified
:: Options -> Bool -> ImportStats -> GHC.LImportDecl GHC.GhcPs -> P ()
printQualified :: Options -> Bool -> ImportStats -> LImportDecl GhcPs -> P ()
printQualified Options{Bool
[GroupRule]
LongListAlign
EmptyListAlign
ListAlign
ImportAlign
ListPadding
importAlign :: Options -> ImportAlign
listAlign :: Options -> ListAlign
padModuleNames :: Options -> Bool
longListAlign :: Options -> LongListAlign
emptyListAlign :: Options -> EmptyListAlign
listPadding :: Options -> ListPadding
separateLists :: Options -> Bool
spaceSurround :: Options -> Bool
postQualified :: Options -> Bool
groupImports :: Options -> Bool
groupRules :: Options -> [GroupRule]
importAlign :: ImportAlign
listAlign :: ListAlign
padModuleNames :: Bool
longListAlign :: LongListAlign
emptyListAlign :: EmptyListAlign
listPadding :: ListPadding
separateLists :: Bool
spaceSurround :: Bool
postQualified :: Bool
groupImports :: Bool
groupRules :: [GroupRule]
..} Bool
padNames ImportStats
stats LImportDecl GhcPs
ldecl = do
[Char] -> P ()
putText [Char]
"import" P () -> P () -> P ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P ()
space
case (ImportDecl GhcPs -> Bool
isSource ImportDecl GhcPs
decl, ImportStats -> Bool
isAnySource ImportStats
stats) of
(Bool
True, Bool
_) -> [Char] -> P ()
putText [Char]
"{-# SOURCE #-}" P () -> P () -> P ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P ()
space
(Bool
_, Bool
True) -> [Char] -> P ()
putText [Char]
" " P () -> P () -> P ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P ()
space
(Bool, Bool)
_ -> () -> P ()
forall a. a -> Printer a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Bool -> P () -> P ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ImportDecl GhcPs -> Bool
forall pass. ImportDecl pass -> Bool
GHC.ideclSafe ImportDecl GhcPs
decl) ([Char] -> P ()
putText [Char]
"safe" P () -> P () -> P ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P ()
space)
let module_ :: Printer Int
module_ = do
Int
moduleNamePosition <- [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Char] -> Int) -> Printer [Char] -> Printer Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Printer [Char]
getCurrentLine
case ImportDecl GhcPs -> ImportDeclPkgQual GhcPs
forall pass. ImportDecl pass -> ImportDeclPkgQual pass
GHC.ideclPkgQual ImportDecl GhcPs
decl of
ImportDeclPkgQual GhcPs
RawPkgQual
GHC.NoRawPkgQual -> () -> P ()
forall a. a -> Printer a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
GHC.RawPkgQual StringLiteral
pkg -> [Char] -> P ()
putText (StringLiteral -> [Char]
stringLiteral StringLiteral
pkg) P () -> P () -> P ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P ()
space
[Char] -> P ()
putText (ImportDecl GhcPs -> [Char]
importModuleName ImportDecl GhcPs
decl)
let somethingFollows :: Bool
somethingFollows =
Maybe (GenLocated SrcSpanAnnA ModuleName) -> Bool
forall a. Maybe a -> Bool
isJust (ImportDecl GhcPs -> Maybe (XRec GhcPs ModuleName)
forall pass. ImportDecl pass -> Maybe (XRec pass ModuleName)
GHC.ideclAs ImportDecl GhcPs
decl) Bool -> Bool -> Bool
|| ImportDecl GhcPs -> Bool
isHiding ImportDecl GhcPs
decl Bool -> Bool -> Bool
||
Bool -> Bool
not (Maybe
(ImportListInterpretation,
GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
-> Bool
forall a. Maybe a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Maybe
(ImportListInterpretation,
GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
-> Bool)
-> Maybe
(ImportListInterpretation,
GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
-> Bool
forall a b. (a -> b) -> a -> b
$ ImportDecl GhcPs
-> Maybe (ImportListInterpretation, XRec GhcPs [LIE GhcPs])
forall pass.
ImportDecl pass
-> Maybe (ImportListInterpretation, XRec pass [LIE pass])
GHC.ideclImportList ImportDecl GhcPs
decl)
Bool -> P () -> P ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
padNames Bool -> Bool -> Bool
&& Bool
somethingFollows) (P () -> P ()) -> P () -> P ()
forall a b. (a -> b) -> a -> b
$ [Char] -> P ()
putText ([Char] -> P ()) -> [Char] -> P ()
forall a b. (a -> b) -> a -> b
$ Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate
(ImportStats -> Int
isLongestImport ImportStats
stats Int -> Int -> Int
forall a. Num a => a -> a -> a
- ImportDecl GhcPs -> Int
importModuleNameLength ImportDecl GhcPs
decl)
Char
' '
Int -> Printer Int
forall a. a -> Printer a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
moduleNamePosition
Int
moduleNamePosition <-
case (Bool
postQualified, ImportDecl GhcPs -> Bool
isQualified ImportDecl GhcPs
decl, ImportStats -> Bool
isAnyQualified ImportStats
stats) of
(Bool
False, Bool
True , Bool
_ ) -> [Char] -> P ()
putText [Char]
"qualified" P () -> P () -> P ()
forall a b. Printer a -> Printer b -> Printer b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P ()
space P () -> Printer Int -> Printer Int
forall a b. Printer a -> Printer b -> Printer b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Printer Int
module_
(Bool
False, Bool
_ , Bool
True) -> [Char] -> P ()
putText [Char]
" " P () -> P () -> P ()
forall a b. Printer a -> Printer b -> Printer b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> P ()
space P () -> Printer Int -> Printer Int
forall a b. Printer a -> Printer b -> Printer b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Printer Int
module_
(Bool
True , Bool
True , Bool
_ ) -> Printer Int
module_ Printer Int -> P () -> Printer Int
forall a b. Printer a -> Printer b -> Printer a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* P ()
space Printer Int -> P () -> Printer Int
forall a b. Printer a -> Printer b -> Printer a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* [Char] -> P ()
putText [Char]
"qualified"
(Bool, Bool, Bool)
_ -> Printer Int
module_
Int
beforeAliasPosition <- [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Char] -> Int) -> Printer [Char] -> Printer Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Printer [Char]
getCurrentLine
Maybe (GenLocated SrcSpanAnnA ModuleName)
-> (GenLocated SrcSpanAnnA ModuleName -> P ()) -> P ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (ImportDecl GhcPs -> Maybe (XRec GhcPs ModuleName)
forall pass. ImportDecl pass -> Maybe (XRec pass ModuleName)
GHC.ideclAs ImportDecl GhcPs
decl) ((GenLocated SrcSpanAnnA ModuleName -> P ()) -> P ())
-> (GenLocated SrcSpanAnnA ModuleName -> P ()) -> P ()
forall a b. (a -> b) -> a -> b
$ \GenLocated SrcSpanAnnA ModuleName
lname -> do
P ()
space P () -> P () -> P ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> P ()
putText [Char]
"as" P () -> P () -> P ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P ()
space
[Char] -> P ()
putText ([Char] -> P ()) -> (ModuleName -> [Char]) -> ModuleName -> P ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> [Char]
GHC.moduleNameString (ModuleName -> P ()) -> ModuleName -> P ()
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA ModuleName -> ModuleName
forall l e. GenLocated l e -> e
GHC.unLoc GenLocated SrcSpanAnnA ModuleName
lname
Int
afterAliasPosition <- [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Char] -> Int) -> Printer [Char] -> Printer Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Printer [Char]
getCurrentLine
Bool -> P () -> P ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ImportDecl GhcPs -> Bool
isHiding ImportDecl GhcPs
decl) (P ()
space P () -> P () -> P ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> P ()
putText [Char]
"hiding")
let putOffset :: P ()
putOffset = [Char] -> P ()
putText ([Char] -> P ()) -> [Char] -> P ()
forall a b. (a -> b) -> a -> b
$ Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate Int
offset Char
' '
offset :: Int
offset = case ListPadding
listPadding of
LPConstant Int
n -> Int
n
ListPadding
LPModuleName -> Int
moduleNamePosition
() -> P ()
forall a. a -> Printer a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
case (ImportListInterpretation,
GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
-> GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
forall a b. (a, b) -> b
snd ((ImportListInterpretation,
GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
-> GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
-> Maybe
(ImportListInterpretation,
GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
-> Maybe
(GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImportDecl GhcPs
-> Maybe (ImportListInterpretation, XRec GhcPs [LIE GhcPs])
forall pass.
ImportDecl pass
-> Maybe (ImportListInterpretation, XRec pass [LIE pass])
GHC.ideclImportList ImportDecl GhcPs
decl of
Maybe (GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
Nothing -> () -> P ()
forall a. a -> Printer a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
limports | [GenLocated SrcSpanAnnA (IE GhcPs)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
forall l e. GenLocated l e -> e
GHC.unLoc GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
limports) -> case EmptyListAlign
emptyListAlign of
EmptyListAlign
RightAfter -> ShowS -> P ()
modifyCurrentLine ShowS
trimRight P () -> P () -> P ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P ()
space P () -> P () -> P ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> P ()
putText [Char]
"()"
EmptyListAlign
Inherit -> case ListAlign
listAlign of
ListAlign
NewLine -> do
ShowS -> P ()
modifyCurrentLine ShowS
trimRight
P ()
newline P () -> P () -> P ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P ()
putOffset P () -> P () -> P ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> P ()
putText [Char]
"()"
ListAlign
_ -> P ()
space P () -> P () -> P ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> P ()
putText [Char]
"()"
Just GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
limports -> do
let imports :: [GenLocated SrcSpanAnnA (IE GhcPs)]
imports = GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
forall l e. GenLocated l e -> e
GHC.unLoc GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)]
limports
printedImports :: [(P (), Bool, Bool)]
printedImports = [P ()] -> [(P (), Bool, Bool)]
forall a. [a] -> [(a, Bool, Bool)]
flagEnds ([P ()] -> [(P (), Bool, Bool)]) -> [P ()] -> [(P (), Bool, Bool)]
forall a b. (a -> b) -> a -> b
$
(Bool -> IE GhcPs -> P ()
printImport Bool
separateLists) (IE GhcPs -> P ())
-> (GenLocated SrcSpanAnnA (IE GhcPs) -> IE GhcPs)
-> GenLocated SrcSpanAnnA (IE GhcPs)
-> P ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (IE GhcPs) -> IE GhcPs
forall l e. GenLocated l e -> e
GHC.unLoc (GenLocated SrcSpanAnnA (IE GhcPs) -> P ())
-> [GenLocated SrcSpanAnnA (IE GhcPs)] -> [P ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
[LIE GhcPs] -> [LIE GhcPs]
prepareImportList [LIE GhcPs]
[GenLocated SrcSpanAnnA (IE GhcPs)]
imports
[Char]
wrapPrefix <- case ListAlign
listAlign of
ListAlign
AfterAlias -> [Char] -> Printer [Char]
forall a. a -> Printer a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char] -> Printer [Char]) -> [Char] -> Printer [Char]
forall a b. (a -> b) -> a -> b
$ Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Int
afterAliasPosition Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Char
' '
ListAlign
WithAlias -> [Char] -> Printer [Char]
forall a. a -> Printer a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char] -> Printer [Char]) -> [Char] -> Printer [Char]
forall a b. (a -> b) -> a -> b
$ Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Int
beforeAliasPosition Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Char
' '
ListAlign
Repeat -> ShowS -> Printer [Char] -> Printer [Char]
forall a b. (a -> b) -> Printer a -> Printer b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" (") Printer [Char]
getCurrentLine
ListAlign
WithModuleName -> [Char] -> Printer [Char]
forall a. a -> Printer a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char] -> Printer [Char]) -> [Char] -> Printer [Char]
forall a b. (a -> b) -> a -> b
$ Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Int
moduleNamePosition Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
offset) Char
' '
ListAlign
NewLine -> [Char] -> Printer [Char]
forall a. a -> Printer a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Char] -> Printer [Char]) -> [Char] -> Printer [Char]
forall a b. (a -> b) -> a -> b
$ Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate Int
offset Char
' '
let doSpaceSurround :: P ()
doSpaceSurround = Bool -> P () -> P ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
spaceSurround P ()
space
let printAsSingleLine :: P ()
printAsSingleLine = [(P (), Bool, Bool)] -> ((P (), Bool, Bool) -> P ()) -> P ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(P (), Bool, Bool)]
printedImports (((P (), Bool, Bool) -> P ()) -> P ())
-> ((P (), Bool, Bool) -> P ()) -> P ()
forall a b. (a -> b) -> a -> b
$ \(P ()
imp, Bool
start, Bool
end) -> do
Bool -> P () -> P ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
start (P () -> P ()) -> P () -> P ()
forall a b. (a -> b) -> a -> b
$ [Char] -> P ()
putText [Char]
"(" P () -> P () -> P ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P ()
doSpaceSurround
P ()
imp
if Bool
end then P ()
doSpaceSurround P () -> P () -> P ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> P ()
putText [Char]
")" else P ()
comma P () -> P () -> P ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P ()
space
let printAsInlineWrapping :: Printer a -> P ()
printAsInlineWrapping Printer a
wprefix = [(P (), Bool, Bool)] -> ((P (), Bool, Bool) -> P ()) -> P ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(P (), Bool, Bool)]
printedImports (((P (), Bool, Bool) -> P ()) -> P ())
-> ((P (), Bool, Bool) -> P ()) -> P ()
forall a b. (a -> b) -> a -> b
$
\(P ()
imp, Bool
start, Bool
end) ->
P () -> P ()
forall {a}. P a -> P a
patchForRepeatHiding (P () -> P ()) -> P () -> P ()
forall a b. (a -> b) -> a -> b
$ P () -> P () -> P ()
forall a. P a -> P a -> P a
wrapping
(do
if Bool
start then [Char] -> P ()
putText [Char]
"(" P () -> P () -> P ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P ()
doSpaceSurround else P ()
space
P ()
imp
if Bool
end then P ()
doSpaceSurround P () -> P () -> P ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> P ()
putText [Char]
")" else P ()
comma)
(do
case ListAlign
listAlign of
ListAlign
Repeat | Bool -> Bool
not Bool
start -> ShowS -> P ()
modifyCurrentLine (ShowS -> P ())
-> ((Char -> Char) -> ShowS) -> (Char -> Char) -> P ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> ShowS
forall a. (a -> a) -> [a] -> [a]
withLast ((Char -> Char) -> P ()) -> (Char -> Char) -> P ()
forall a b. (a -> b) -> a -> b
$
\Char
c -> if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',' then Char
')' else Char
c
ListAlign
_ | Bool
start Bool -> Bool -> Bool
&& Bool
spaceSurround ->
ShowS -> P ()
modifyCurrentLine ShowS
trimRight
ListAlign
_ -> () -> P ()
forall a. a -> Printer a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
P ()
newline
Printer a -> P ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Printer a
wprefix
case ListAlign
listAlign of
ListAlign
Repeat -> () -> P ()
forall a. a -> Printer a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
ListAlign
_ | Bool
start -> [Char] -> P ()
putText [Char]
"(" P () -> P () -> P ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P ()
doSpaceSurround
ListAlign
_ | LongListAlign
longListAlign LongListAlign -> LongListAlign -> Bool
forall a. Eq a => a -> a -> Bool
/= LongListAlign
Inline -> () -> P ()
forall a. a -> Printer a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
ListAlign
AfterAlias -> P ()
space P () -> P () -> P ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P ()
doSpaceSurround
ListAlign
WithModuleName -> () -> P ()
forall a. a -> Printer a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
ListAlign
WithAlias -> () -> P ()
forall a. a -> Printer a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
ListAlign
NewLine -> () -> P ()
forall a. a -> Printer a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
P ()
imp
if Bool
end then P ()
doSpaceSurround P () -> P () -> P ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> P ()
putText [Char]
")" else P ()
comma)
let printAsMultiLine :: P ()
printAsMultiLine = [(P (), Bool, Bool)] -> ((P (), Bool, Bool) -> P ()) -> P ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(P (), Bool, Bool)]
printedImports (((P (), Bool, Bool) -> P ()) -> P ())
-> ((P (), Bool, Bool) -> P ()) -> P ()
forall a b. (a -> b) -> a -> b
$ \(P ()
imp, Bool
start, Bool
end) -> do
Bool -> P () -> P ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
start (P () -> P ()) -> P () -> P ()
forall a b. (a -> b) -> a -> b
$ ShowS -> P ()
modifyCurrentLine ShowS
trimRight
P ()
newline
P ()
putOffset
if Bool
start then [Char] -> P ()
putText [Char]
"( " else [Char] -> P ()
putText [Char]
", "
P ()
imp
Bool -> P () -> P ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
end (P () -> P ()) -> P () -> P ()
forall a b. (a -> b) -> a -> b
$ P ()
newline P () -> P () -> P ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P ()
putOffset P () -> P () -> P ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> P ()
putText [Char]
")"
case LongListAlign
longListAlign of
LongListAlign
Multiline -> P () -> P () -> P ()
forall a. P a -> P a -> P a
wrapping
(P ()
space P () -> P () -> P ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P ()
printAsSingleLine)
P ()
printAsMultiLine
LongListAlign
Inline | ListAlign
NewLine <- ListAlign
listAlign -> do
ShowS -> P ()
modifyCurrentLine ShowS
trimRight
P ()
newline P () -> P () -> P ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P ()
putOffset P () -> P () -> P ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P () -> P ()
forall {a}. Printer a -> P ()
printAsInlineWrapping ([Char] -> P ()
putText [Char]
wrapPrefix)
LongListAlign
Inline -> P ()
space P () -> P () -> P ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P () -> P ()
forall {a}. Printer a -> P ()
printAsInlineWrapping ([Char] -> P ()
putText [Char]
wrapPrefix)
LongListAlign
InlineWithBreak -> P () -> P () -> P ()
forall a. P a -> P a -> P a
wrapping
(P ()
space P () -> P () -> P ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P ()
printAsSingleLine)
(do
ShowS -> P ()
modifyCurrentLine ShowS
trimRight
P ()
newline P () -> P () -> P ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P ()
putOffset P () -> P () -> P ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P () -> P ()
forall {a}. Printer a -> P ()
printAsInlineWrapping P ()
putOffset)
LongListAlign
InlineToMultiline -> P () -> P () -> P ()
forall a. P a -> P a -> P a
wrapping
(P ()
space P () -> P () -> P ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P ()
printAsSingleLine)
(P () -> P () -> P ()
forall a. P a -> P a -> P a
wrapping
(do
ShowS -> P ()
modifyCurrentLine ShowS
trimRight
P ()
newline P () -> P () -> P ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P ()
putOffset P () -> P () -> P ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P ()
printAsSingleLine)
P ()
printAsMultiLine)
where
decl :: ImportDecl GhcPs
decl = GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> ImportDecl GhcPs
forall l e. GenLocated l e -> e
GHC.unLoc LImportDecl GhcPs
GenLocated SrcSpanAnnA (ImportDecl GhcPs)
ldecl
patchForRepeatHiding :: P a -> P a
patchForRepeatHiding = case ListAlign
listAlign of
ListAlign
Repeat | ImportDecl GhcPs -> Bool
isHiding ImportDecl GhcPs
decl -> Maybe Int -> P a -> P a
forall a. Maybe Int -> P a -> P a
withColumns Maybe Int
forall a. Maybe a
Nothing
ListAlign
_ -> P a -> P a
forall a. a -> a
id
printImport :: Bool -> GHC.IE GHC.GhcPs -> P ()
printImport :: Bool -> IE GhcPs -> P ()
printImport Bool
_ (GHC.IEVar XIEVar GhcPs
_ LIEWrappedName GhcPs
name) = do
LIEWrappedName GhcPs -> P ()
printIeWrappedName LIEWrappedName GhcPs
name
printImport Bool
_ (GHC.IEThingAbs XIEThingAbs GhcPs
_ LIEWrappedName GhcPs
name) = do
LIEWrappedName GhcPs -> P ()
printIeWrappedName LIEWrappedName GhcPs
name
printImport Bool
separateLists (GHC.IEThingAll XIEThingAll GhcPs
_ LIEWrappedName GhcPs
name) = do
LIEWrappedName GhcPs -> P ()
printIeWrappedName LIEWrappedName GhcPs
name
Bool -> P () -> P ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
separateLists P ()
space
[Char] -> P ()
putText [Char]
"(..)"
printImport Bool
_ (GHC.IEModuleContents XIEModuleContents GhcPs
_ XRec GhcPs ModuleName
modu) = do
[Char] -> P ()
putText [Char]
"module"
P ()
space
[Char] -> P ()
putText ([Char] -> P ()) -> (ModuleName -> [Char]) -> ModuleName -> P ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> [Char]
GHC.moduleNameString (ModuleName -> P ()) -> ModuleName -> P ()
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA ModuleName -> ModuleName
forall l e. GenLocated l e -> e
GHC.unLoc XRec GhcPs ModuleName
GenLocated SrcSpanAnnA ModuleName
modu
printImport Bool
separateLists (GHC.IEThingWith XIEThingWith GhcPs
_ LIEWrappedName GhcPs
name IEWildcard
wildcard [LIEWrappedName GhcPs]
imps) = do
LIEWrappedName GhcPs -> P ()
printIeWrappedName LIEWrappedName GhcPs
name
Bool -> P () -> P ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
separateLists P ()
space
let ellipsis :: [P ()]
ellipsis = case IEWildcard
wildcard of
GHC.IEWildcard Int
_position -> [[Char] -> P ()
putText [Char]
".."]
IEWildcard
GHC.NoIEWildcard -> []
P () -> P ()
forall {a}. P a -> P a
parenthesize (P () -> P ()) -> P () -> P ()
forall a b. (a -> b) -> a -> b
$
P () -> [P ()] -> P ()
forall a. P a -> [P a] -> P ()
sep (P ()
comma P () -> P () -> P ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P ()
space) ([P ()]
ellipsis [P ()] -> [P ()] -> [P ()]
forall a. Semigroup a => a -> a -> a
<> (GenLocated SrcSpanAnnA (IEWrappedName GhcPs) -> P ())
-> [GenLocated SrcSpanAnnA (IEWrappedName GhcPs)] -> [P ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LIEWrappedName GhcPs -> P ()
GenLocated SrcSpanAnnA (IEWrappedName GhcPs) -> P ()
printIeWrappedName [LIEWrappedName GhcPs]
[GenLocated SrcSpanAnnA (IEWrappedName GhcPs)]
imps)
printImport Bool
_ (GHC.IEGroup XIEGroup GhcPs
_ Int
_ LHsDoc GhcPs
_ ) =
[Char] -> P ()
forall a. HasCallStack => [Char] -> a
error [Char]
"Language.Haskell.Stylish.Printer.Imports.printImportExport: unhandled case 'IEGroup'"
printImport Bool
_ (GHC.IEDoc XIEDoc GhcPs
_ LHsDoc GhcPs
_) =
[Char] -> P ()
forall a. HasCallStack => [Char] -> a
error [Char]
"Language.Haskell.Stylish.Printer.Imports.printImportExport: unhandled case 'IEDoc'"
printImport Bool
_ (GHC.IEDocNamed XIEDocNamed GhcPs
_ [Char]
_) =
[Char] -> P ()
forall a. HasCallStack => [Char] -> a
error [Char]
"Language.Haskell.Stylish.Printer.Imports.printImportExport: unhandled case 'IEDocNamed'"
printIeWrappedName :: GHC.LIEWrappedName GHC.GhcPs -> P ()
printIeWrappedName :: LIEWrappedName GhcPs -> P ()
printIeWrappedName LIEWrappedName GhcPs
lie = case GenLocated SrcSpanAnnA (IEWrappedName GhcPs) -> IEWrappedName GhcPs
forall l e. GenLocated l e -> e
GHC.unLoc LIEWrappedName GhcPs
GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
lie of
GHC.IEName XIEName GhcPs
_ LIdP GhcPs
n -> GenLocated SrcSpanAnnN RdrName -> P ()
putRdrName LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
n
GHC.IEPattern XIEPattern GhcPs
_ LIdP GhcPs
n -> [Char] -> P ()
putText [Char]
"pattern" P () -> P () -> P ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P ()
space P () -> P () -> P ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated SrcSpanAnnN RdrName -> P ()
putRdrName LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
n
GHC.IEType XIEType GhcPs
_ LIdP GhcPs
n -> [Char] -> P ()
putText [Char]
"type" P () -> P () -> P ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P ()
space P () -> P () -> P ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated SrcSpanAnnN RdrName -> P ()
putRdrName LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
n
mergeImports
:: NonEmpty (GHC.LImportDecl GHC.GhcPs)
-> NonEmpty (GHC.LImportDecl GHC.GhcPs)
mergeImports :: NonEmpty (LImportDecl GhcPs) -> NonEmpty (LImportDecl GhcPs)
mergeImports (LImportDecl GhcPs
x :| []) = LImportDecl GhcPs
GenLocated SrcSpanAnnA (ImportDecl GhcPs)
x GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
forall a. a -> [a] -> NonEmpty a
:| []
mergeImports (LImportDecl GhcPs
h :| (LImportDecl GhcPs
t : [LImportDecl GhcPs]
ts))
| ImportDecl GhcPs -> ImportDecl GhcPs -> Bool
canMergeImport (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> ImportDecl GhcPs
forall l e. GenLocated l e -> e
GHC.unLoc LImportDecl GhcPs
GenLocated SrcSpanAnnA (ImportDecl GhcPs)
h) (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> ImportDecl GhcPs
forall l e. GenLocated l e -> e
GHC.unLoc LImportDecl GhcPs
GenLocated SrcSpanAnnA (ImportDecl GhcPs)
t) = NonEmpty (LImportDecl GhcPs) -> NonEmpty (LImportDecl GhcPs)
mergeImports (LImportDecl GhcPs -> LImportDecl GhcPs -> LImportDecl GhcPs
mergeModuleImport LImportDecl GhcPs
h LImportDecl GhcPs
t GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
forall a. a -> [a] -> NonEmpty a
:| [LImportDecl GhcPs]
[GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
ts)
| Bool
otherwise = LImportDecl GhcPs
GenLocated SrcSpanAnnA (ImportDecl GhcPs)
h GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> NonEmpty (GenLocated SrcSpanAnnA (ImportDecl GhcPs))
forall a. a -> [a] -> NonEmpty a
:| [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
mergeImportsTail (LImportDecl GhcPs
GenLocated SrcSpanAnnA (ImportDecl GhcPs)
t GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
forall a. a -> [a] -> [a]
: [LImportDecl GhcPs]
[GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
ts)
where
mergeImportsTail :: [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
mergeImportsTail (GenLocated SrcSpanAnnA (ImportDecl GhcPs)
x : GenLocated SrcSpanAnnA (ImportDecl GhcPs)
y : [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
ys)
| ImportDecl GhcPs -> ImportDecl GhcPs -> Bool
canMergeImport (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> ImportDecl GhcPs
forall l e. GenLocated l e -> e
GHC.unLoc GenLocated SrcSpanAnnA (ImportDecl GhcPs)
x) (GenLocated SrcSpanAnnA (ImportDecl GhcPs) -> ImportDecl GhcPs
forall l e. GenLocated l e -> e
GHC.unLoc GenLocated SrcSpanAnnA (ImportDecl GhcPs)
y) = [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
mergeImportsTail ((LImportDecl GhcPs -> LImportDecl GhcPs -> LImportDecl GhcPs
mergeModuleImport LImportDecl GhcPs
GenLocated SrcSpanAnnA (ImportDecl GhcPs)
x LImportDecl GhcPs
GenLocated SrcSpanAnnA (ImportDecl GhcPs)
y) GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
forall a. a -> [a] -> [a]
: [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
ys)
| Bool
otherwise = GenLocated SrcSpanAnnA (ImportDecl GhcPs)
x GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
forall a. a -> [a] -> [a]
: [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
mergeImportsTail (GenLocated SrcSpanAnnA (ImportDecl GhcPs)
y GenLocated SrcSpanAnnA (ImportDecl GhcPs)
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
forall a. a -> [a] -> [a]
: [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
ys)
mergeImportsTail [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
xs = [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
xs
data ImportStats = ImportStats
{ ImportStats -> Int
isLongestImport :: !Int
, ImportStats -> Bool
isAnySource :: !Bool
, ImportStats -> Bool
isAnyQualified :: !Bool
, ImportStats -> Bool
isAnySafe :: !Bool
}
instance Semigroup ImportStats where
ImportStats
l <> :: ImportStats -> ImportStats -> ImportStats
<> ImportStats
r = ImportStats
{ isLongestImport :: Int
isLongestImport = ImportStats -> Int
isLongestImport ImportStats
l Int -> Int -> Int
forall a. Ord a => a -> a -> a
`max` ImportStats -> Int
isLongestImport ImportStats
r
, isAnySource :: Bool
isAnySource = ImportStats -> Bool
isAnySource ImportStats
l Bool -> Bool -> Bool
|| ImportStats -> Bool
isAnySource ImportStats
r
, isAnyQualified :: Bool
isAnyQualified = ImportStats -> Bool
isAnyQualified ImportStats
l Bool -> Bool -> Bool
|| ImportStats -> Bool
isAnyQualified ImportStats
r
, isAnySafe :: Bool
isAnySafe = ImportStats -> Bool
isAnySafe ImportStats
l Bool -> Bool -> Bool
|| ImportStats -> Bool
isAnySafe ImportStats
r
}
instance Monoid ImportStats where
mappend :: ImportStats -> ImportStats -> ImportStats
mappend = ImportStats -> ImportStats -> ImportStats
forall a. Semigroup a => a -> a -> a
(<>)
mempty :: ImportStats
mempty = Int -> Bool -> Bool -> Bool -> ImportStats
ImportStats Int
0 Bool
False Bool
False Bool
False
importStats :: GHC.ImportDecl GHC.GhcPs -> ImportStats
importStats :: ImportDecl GhcPs -> ImportStats
importStats ImportDecl GhcPs
i =
Int -> Bool -> Bool -> Bool -> ImportStats
ImportStats (ImportDecl GhcPs -> Int
importModuleNameLength ImportDecl GhcPs
i) (ImportDecl GhcPs -> Bool
isSource ImportDecl GhcPs
i) (ImportDecl GhcPs -> Bool
isQualified ImportDecl GhcPs
i) (ImportDecl GhcPs -> Bool
forall pass. ImportDecl pass -> Bool
GHC.ideclSafe ImportDecl GhcPs
i)
importModuleNameLength :: GHC.ImportDecl GHC.GhcPs -> Int
importModuleNameLength :: ImportDecl GhcPs -> Int
importModuleNameLength ImportDecl GhcPs
imp =
(case ImportDecl GhcPs -> ImportDeclPkgQual GhcPs
forall pass. ImportDecl pass -> ImportDeclPkgQual pass
GHC.ideclPkgQual ImportDecl GhcPs
imp of
ImportDeclPkgQual GhcPs
RawPkgQual
GHC.NoRawPkgQual -> Int
0
GHC.RawPkgQual StringLiteral
sl -> Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (StringLiteral -> [Char]
stringLiteral StringLiteral
sl)) Int -> Int -> Int
forall a. Num a => a -> a -> a
+
([Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Char] -> Int) -> [Char] -> Int
forall a b. (a -> b) -> a -> b
$ ImportDecl GhcPs -> [Char]
importModuleName ImportDecl GhcPs
imp)
stringLiteral :: GHC.StringLiteral -> String
stringLiteral :: StringLiteral -> [Char]
stringLiteral StringLiteral
sl = case StringLiteral -> SourceText
GHC.sl_st StringLiteral
sl of
SourceText
GHC.NoSourceText -> FastString -> [Char]
GHC.unpackFS (FastString -> [Char]) -> FastString -> [Char]
forall a b. (a -> b) -> a -> b
$ StringLiteral -> FastString
GHC.sl_fs StringLiteral
sl
GHC.SourceText FastString
s -> FastString -> [Char]
GHC.unpackFS (FastString -> [Char]) -> FastString -> [Char]
forall a b. (a -> b) -> a -> b
$ FastString
s
isQualified :: GHC.ImportDecl GHC.GhcPs -> Bool
isQualified :: ImportDecl GhcPs -> Bool
isQualified = ImportDeclQualifiedStyle -> ImportDeclQualifiedStyle -> Bool
forall a. Eq a => a -> a -> Bool
(/=) ImportDeclQualifiedStyle
GHC.NotQualified (ImportDeclQualifiedStyle -> Bool)
-> (ImportDecl GhcPs -> ImportDeclQualifiedStyle)
-> ImportDecl GhcPs
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImportDecl GhcPs -> ImportDeclQualifiedStyle
forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
GHC.ideclQualified
isHiding :: GHC.ImportDecl GHC.GhcPs -> Bool
isHiding :: ImportDecl GhcPs -> Bool
isHiding ImportDecl GhcPs
d = case ImportDecl GhcPs
-> Maybe (ImportListInterpretation, XRec GhcPs [LIE GhcPs])
forall pass.
ImportDecl pass
-> Maybe (ImportListInterpretation, XRec pass [LIE pass])
GHC.ideclImportList ImportDecl GhcPs
d of
Just (ImportListInterpretation
GHC.EverythingBut, XRec GhcPs [LIE GhcPs]
_) -> Bool
True
Maybe (ImportListInterpretation, XRec GhcPs [LIE GhcPs])
_ -> Bool
False
isSource :: GHC.ImportDecl GHC.GhcPs -> Bool
isSource :: ImportDecl GhcPs -> Bool
isSource = IsBootInterface -> IsBootInterface -> Bool
forall a. Eq a => a -> a -> Bool
(==) IsBootInterface
GHC.IsBoot (IsBootInterface -> Bool)
-> (ImportDecl GhcPs -> IsBootInterface)
-> ImportDecl GhcPs
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImportDecl GhcPs -> IsBootInterface
forall pass. ImportDecl pass -> IsBootInterface
GHC.ideclSource
prepareImportList :: [GHC.LIE GHC.GhcPs] -> [GHC.LIE GHC.GhcPs]
prepareImportList :: [LIE GhcPs] -> [LIE GhcPs]
prepareImportList =
(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 LIE GhcPs -> LIE GhcPs -> Ordering
GenLocated SrcSpanAnnA (IE GhcPs)
-> GenLocated SrcSpanAnnA (IE GhcPs) -> Ordering
compareLIE ([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))
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
forall a b. (a -> b) -> [a] -> [b]
map ((IE GhcPs -> IE GhcPs)
-> GenLocated SrcSpanAnnA (IE GhcPs)
-> GenLocated SrcSpanAnnA (IE GhcPs)
forall a b.
(a -> b) -> GenLocated SrcSpanAnnA a -> GenLocated SrcSpanAnnA b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IE GhcPs -> IE GhcPs
prepareInner) ([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
.
((RdrName, NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs)))
-> [GenLocated SrcSpanAnnA (IE GhcPs)])
-> [(RdrName, NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs)))]
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs))
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs))
-> [GenLocated SrcSpanAnnA (IE GhcPs)])
-> ((RdrName, NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs)))
-> NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs)))
-> (RdrName, NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs)))
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RdrName, NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs)))
-> NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs))
forall a b. (a, b) -> b
snd) ([(RdrName, NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs)))]
-> [GenLocated SrcSpanAnnA (IE GhcPs)])
-> ([GenLocated SrcSpanAnnA (IE GhcPs)]
-> [(RdrName, NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs)))])
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map RdrName (NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs)))
-> [(RdrName, NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs)))]
forall k a. Map k a -> [(k, a)]
Map.toAscList (Map RdrName (NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs)))
-> [(RdrName, NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs)))])
-> ([GenLocated SrcSpanAnnA (IE GhcPs)]
-> Map RdrName (NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs))))
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
-> [(RdrName, NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs)))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LIE GhcPs] -> Map RdrName (NonEmpty (LIE GhcPs))
[GenLocated SrcSpanAnnA (IE GhcPs)]
-> Map RdrName (NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs)))
mergeByName
where
mergeByName
:: [GHC.LIE GHC.GhcPs]
-> Map.Map GHC.RdrName (NonEmpty (GHC.LIE GHC.GhcPs))
mergeByName :: [LIE GhcPs] -> Map RdrName (NonEmpty (LIE GhcPs))
mergeByName [LIE GhcPs]
imports0 = (NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs))
-> NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs))
-> NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs)))
-> [(RdrName, NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs)))]
-> Map RdrName (NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs)))
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith
(\(GenLocated SrcSpanAnnA (IE GhcPs)
x :| [GenLocated SrcSpanAnnA (IE GhcPs)]
xs) (GenLocated SrcSpanAnnA (IE GhcPs)
y :| [GenLocated SrcSpanAnnA (IE GhcPs)]
ys) -> case IE GhcPs -> IE GhcPs -> Maybe (IE GhcPs)
ieMerge (GenLocated SrcSpanAnnA (IE GhcPs) -> IE GhcPs
forall l e. GenLocated l e -> e
GHC.unLoc GenLocated SrcSpanAnnA (IE GhcPs)
x) (GenLocated SrcSpanAnnA (IE GhcPs) -> IE GhcPs
forall l e. GenLocated l e -> e
GHC.unLoc GenLocated SrcSpanAnnA (IE GhcPs)
y) of
Just IE GhcPs
z -> (GenLocated SrcSpanAnnA (IE GhcPs)
x GenLocated SrcSpanAnnA (IE GhcPs)
-> IE GhcPs -> GenLocated SrcSpanAnnA (IE GhcPs)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> IE GhcPs
z) GenLocated SrcSpanAnnA (IE GhcPs)
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
-> NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs))
forall a. a -> [a] -> NonEmpty a
:| ([GenLocated SrcSpanAnnA (IE GhcPs)]
xs [GenLocated SrcSpanAnnA (IE GhcPs)]
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
forall a. [a] -> [a] -> [a]
++ [GenLocated SrcSpanAnnA (IE GhcPs)]
ys)
Maybe (IE GhcPs)
Nothing -> GenLocated SrcSpanAnnA (IE GhcPs)
x GenLocated SrcSpanAnnA (IE GhcPs)
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
-> NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs))
forall a. a -> [a] -> NonEmpty a
:| ([GenLocated SrcSpanAnnA (IE GhcPs)]
xs [GenLocated SrcSpanAnnA (IE GhcPs)]
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
forall a. [a] -> [a] -> [a]
++ GenLocated SrcSpanAnnA (IE GhcPs)
y GenLocated SrcSpanAnnA (IE GhcPs)
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
forall a. a -> [a] -> [a]
: [GenLocated SrcSpanAnnA (IE GhcPs)]
ys))
[(IE GhcPs -> IdP GhcPs
forall (p :: Pass). IE (GhcPass p) -> IdP (GhcPass p)
GHC.ieName (IE GhcPs -> IdP GhcPs) -> IE GhcPs -> IdP GhcPs
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (IE GhcPs) -> IE GhcPs
forall l e. GenLocated l e -> e
GHC.unLoc GenLocated SrcSpanAnnA (IE GhcPs)
imp, GenLocated SrcSpanAnnA (IE GhcPs)
imp GenLocated SrcSpanAnnA (IE GhcPs)
-> [GenLocated SrcSpanAnnA (IE GhcPs)]
-> NonEmpty (GenLocated SrcSpanAnnA (IE GhcPs))
forall a. a -> [a] -> NonEmpty a
:| []) | GenLocated SrcSpanAnnA (IE GhcPs)
imp <- [LIE GhcPs]
[GenLocated SrcSpanAnnA (IE GhcPs)]
imports0]
prepareInner :: GHC.IE GHC.GhcPs -> GHC.IE GHC.GhcPs
prepareInner :: IE GhcPs -> IE GhcPs
prepareInner = \case
GHC.IEThingWith XIEThingWith GhcPs
x LIEWrappedName GhcPs
n IEWildcard
GHC.NoIEWildcard [] -> XIEThingAbs GhcPs -> LIEWrappedName GhcPs -> IE GhcPs
forall pass. XIEThingAbs pass -> LIEWrappedName pass -> IE pass
GHC.IEThingAbs XIEThingWith GhcPs
XIEThingAbs GhcPs
x LIEWrappedName GhcPs
n
GHC.IEThingWith XIEThingWith GhcPs
x LIEWrappedName GhcPs
n IEWildcard
w [LIEWrappedName GhcPs]
ns ->
XIEThingWith GhcPs
-> LIEWrappedName GhcPs
-> IEWildcard
-> [LIEWrappedName GhcPs]
-> IE GhcPs
forall pass.
XIEThingWith pass
-> LIEWrappedName pass
-> IEWildcard
-> [LIEWrappedName pass]
-> IE pass
GHC.IEThingWith XIEThingWith GhcPs
x LIEWrappedName GhcPs
n IEWildcard
w ((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 (IEWrappedName GhcPs -> IEWrappedName GhcPs -> Ordering
compareWrappedName (IEWrappedName GhcPs -> IEWrappedName GhcPs -> Ordering)
-> (GenLocated SrcSpanAnnA (IEWrappedName GhcPs)
-> IEWrappedName GhcPs)
-> 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) -> IEWrappedName GhcPs
forall l e. GenLocated l e -> e
GHC.unLoc) [LIEWrappedName GhcPs]
[GenLocated SrcSpanAnnA (IEWrappedName GhcPs)]
ns)
IE GhcPs
ie -> IE GhcPs
ie
ieMerge :: GHC.IE GHC.GhcPs -> GHC.IE GHC.GhcPs -> Maybe (GHC.IE GHC.GhcPs)
ieMerge :: IE GhcPs -> IE GhcPs -> Maybe (IE GhcPs)
ieMerge l :: IE GhcPs
l@(GHC.IEVar XIEVar GhcPs
_ LIEWrappedName GhcPs
_) IE GhcPs
_ = IE GhcPs -> Maybe (IE GhcPs)
forall a. a -> Maybe a
Just IE GhcPs
l
ieMerge IE GhcPs
_ r :: IE GhcPs
r@(GHC.IEVar XIEVar GhcPs
_ LIEWrappedName GhcPs
_) = IE GhcPs -> Maybe (IE GhcPs)
forall a. a -> Maybe a
Just IE GhcPs
r
ieMerge (GHC.IEThingAbs XIEThingAbs GhcPs
_ LIEWrappedName GhcPs
_) IE GhcPs
r = IE GhcPs -> Maybe (IE GhcPs)
forall a. a -> Maybe a
Just IE GhcPs
r
ieMerge IE GhcPs
l (GHC.IEThingAbs XIEThingAbs GhcPs
_ LIEWrappedName GhcPs
_) = IE GhcPs -> Maybe (IE GhcPs)
forall a. a -> Maybe a
Just IE GhcPs
l
ieMerge l :: IE GhcPs
l@(GHC.IEThingAll XIEThingAll GhcPs
_ LIEWrappedName GhcPs
_) IE GhcPs
_ = IE GhcPs -> Maybe (IE GhcPs)
forall a. a -> Maybe a
Just IE GhcPs
l
ieMerge IE GhcPs
_ r :: IE GhcPs
r@(GHC.IEThingAll XIEThingAll GhcPs
_ LIEWrappedName GhcPs
_) = IE GhcPs -> Maybe (IE GhcPs)
forall a. a -> Maybe a
Just IE GhcPs
r
ieMerge (GHC.IEThingWith XIEThingWith GhcPs
x0 LIEWrappedName GhcPs
n0 IEWildcard
w0 [LIEWrappedName GhcPs]
ns0) (GHC.IEThingWith XIEThingWith GhcPs
_ LIEWrappedName GhcPs
_ IEWildcard
w1 [LIEWrappedName GhcPs]
ns1)
| IEWildcard
w0 IEWildcard -> IEWildcard -> Bool
forall a. Eq a => a -> a -> Bool
/= IEWildcard
w1 = Maybe (IE GhcPs)
forall a. Maybe a
Nothing
| Bool
otherwise = IE GhcPs -> Maybe (IE GhcPs)
forall a. a -> Maybe a
Just (IE GhcPs -> Maybe (IE GhcPs)) -> IE GhcPs -> Maybe (IE GhcPs)
forall a b. (a -> b) -> a -> b
$
XIEThingWith GhcPs
-> LIEWrappedName GhcPs
-> IEWildcard
-> [LIEWrappedName GhcPs]
-> IE GhcPs
forall pass.
XIEThingWith pass
-> LIEWrappedName pass
-> IEWildcard
-> [LIEWrappedName pass]
-> IE pass
GHC.IEThingWith XIEThingWith GhcPs
x0 LIEWrappedName GhcPs
n0 IEWildcard
w0 ((LIEWrappedName GhcPs -> RdrName)
-> [LIEWrappedName GhcPs] -> [LIEWrappedName GhcPs]
forall b a. Ord b => (a -> b) -> [a] -> [a]
nubOn LIEWrappedName GhcPs -> IdP GhcPs
LIEWrappedName GhcPs -> RdrName
forall (p :: Pass). LIEWrappedName (GhcPass p) -> IdP (GhcPass p)
GHC.lieWrappedName ([LIEWrappedName GhcPs] -> [LIEWrappedName GhcPs])
-> [LIEWrappedName GhcPs] -> [LIEWrappedName GhcPs]
forall a b. (a -> b) -> a -> b
$ [LIEWrappedName GhcPs]
[GenLocated SrcSpanAnnA (IEWrappedName GhcPs)]
ns0 [GenLocated SrcSpanAnnA (IEWrappedName GhcPs)]
-> [GenLocated SrcSpanAnnA (IEWrappedName GhcPs)]
-> [GenLocated SrcSpanAnnA (IEWrappedName GhcPs)]
forall a. [a] -> [a] -> [a]
++ [LIEWrappedName GhcPs]
[GenLocated SrcSpanAnnA (IEWrappedName GhcPs)]
ns1)
ieMerge IE GhcPs
_ IE GhcPs
_ = Maybe (IE GhcPs)
forall a. Maybe a
Nothing
nubOn :: Ord k => (a -> k) -> [a] -> [a]
nubOn :: forall b a. Ord b => (a -> b) -> [a] -> [a]
nubOn a -> k
f = Set k -> [a] -> [a]
go Set k
forall a. Set a
Set.empty
where
go :: Set k -> [a] -> [a]
go Set k
_ [] = []
go Set k
acc (a
x : [a]
xs)
| k
y k -> Set k -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set k
acc = Set k -> [a] -> [a]
go Set k
acc [a]
xs
| Bool
otherwise = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Set k -> [a] -> [a]
go (k -> Set k -> Set k
forall a. Ord a => a -> Set a -> Set a
Set.insert k
y Set k
acc) [a]
xs
where
y :: k
y = a -> k
f a
x