{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DoAndIfThenElse #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
module Language.Haskell.Stylish.Step.Imports
( Options (..)
, defaultOptions
, ImportAlign (..)
, ListAlign (..)
, LongListAlign (..)
, EmptyListAlign (..)
, ListPadding (..)
, step
, printImport
) where
import Control.Monad (forM_, when, void)
import Data.Function ((&), on)
import Data.Functor (($>))
import Data.Foldable (toList)
import Data.Maybe (isJust)
import Data.List (sortBy)
import Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.Map as Map
import qualified Data.Set as Set
import BasicTypes (StringLiteral (..),
SourceText (..))
import qualified FastString as FS
import GHC.Hs.Extension (GhcPs)
import qualified GHC.Hs.Extension as GHC
import GHC.Hs.ImpExp
import Module (moduleNameString)
import RdrName (RdrName)
import SrcLoc (Located, GenLocated(..), unLoc)
import Language.Haskell.Stylish.Block
import Language.Haskell.Stylish.Module
import Language.Haskell.Stylish.Ordering
import Language.Haskell.Stylish.Printer
import Language.Haskell.Stylish.Step
import Language.Haskell.Stylish.Editor
import Language.Haskell.Stylish.GHC
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
} deriving (Options -> Options -> Bool
(Options -> Options -> Bool)
-> (Options -> Options -> Bool) -> Eq Options
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Options -> Options -> Bool
$c/= :: Options -> Options -> Bool
== :: Options -> Options -> Bool
$c== :: Options -> Options -> Bool
Eq, Int -> Options -> ShowS
[Options] -> ShowS
Options -> String
(Int -> Options -> ShowS)
-> (Options -> String) -> ([Options] -> ShowS) -> Show Options
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Options] -> ShowS
$cshowList :: [Options] -> ShowS
show :: Options -> String
$cshow :: Options -> String
showsPrec :: Int -> Options -> ShowS
$cshowsPrec :: Int -> Options -> ShowS
Show)
defaultOptions :: Options
defaultOptions :: Options
defaultOptions = Options :: ImportAlign
-> ListAlign
-> Bool
-> LongListAlign
-> EmptyListAlign
-> ListPadding
-> Bool
-> Bool
-> Bool
-> Options
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
}
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
/= :: ListPadding -> ListPadding -> Bool
$c/= :: ListPadding -> ListPadding -> Bool
== :: ListPadding -> ListPadding -> Bool
$c== :: ListPadding -> ListPadding -> Bool
Eq, Int -> ListPadding -> ShowS
[ListPadding] -> ShowS
ListPadding -> String
(Int -> ListPadding -> ShowS)
-> (ListPadding -> String)
-> ([ListPadding] -> ShowS)
-> Show ListPadding
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListPadding] -> ShowS
$cshowList :: [ListPadding] -> ShowS
show :: ListPadding -> String
$cshow :: ListPadding -> String
showsPrec :: Int -> ListPadding -> ShowS
$cshowsPrec :: Int -> 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
/= :: ImportAlign -> ImportAlign -> Bool
$c/= :: ImportAlign -> ImportAlign -> Bool
== :: ImportAlign -> ImportAlign -> Bool
$c== :: ImportAlign -> ImportAlign -> Bool
Eq, Int -> ImportAlign -> ShowS
[ImportAlign] -> ShowS
ImportAlign -> String
(Int -> ImportAlign -> ShowS)
-> (ImportAlign -> String)
-> ([ImportAlign] -> ShowS)
-> Show ImportAlign
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImportAlign] -> ShowS
$cshowList :: [ImportAlign] -> ShowS
show :: ImportAlign -> String
$cshow :: ImportAlign -> String
showsPrec :: Int -> ImportAlign -> ShowS
$cshowsPrec :: Int -> 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
/= :: ListAlign -> ListAlign -> Bool
$c/= :: ListAlign -> ListAlign -> Bool
== :: ListAlign -> ListAlign -> Bool
$c== :: ListAlign -> ListAlign -> Bool
Eq, Int -> ListAlign -> ShowS
[ListAlign] -> ShowS
ListAlign -> String
(Int -> ListAlign -> ShowS)
-> (ListAlign -> String)
-> ([ListAlign] -> ShowS)
-> Show ListAlign
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListAlign] -> ShowS
$cshowList :: [ListAlign] -> ShowS
show :: ListAlign -> String
$cshow :: ListAlign -> String
showsPrec :: Int -> ListAlign -> ShowS
$cshowsPrec :: Int -> 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
/= :: EmptyListAlign -> EmptyListAlign -> Bool
$c/= :: EmptyListAlign -> EmptyListAlign -> Bool
== :: EmptyListAlign -> EmptyListAlign -> Bool
$c== :: EmptyListAlign -> EmptyListAlign -> Bool
Eq, Int -> EmptyListAlign -> ShowS
[EmptyListAlign] -> ShowS
EmptyListAlign -> String
(Int -> EmptyListAlign -> ShowS)
-> (EmptyListAlign -> String)
-> ([EmptyListAlign] -> ShowS)
-> Show EmptyListAlign
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EmptyListAlign] -> ShowS
$cshowList :: [EmptyListAlign] -> ShowS
show :: EmptyListAlign -> String
$cshow :: EmptyListAlign -> String
showsPrec :: Int -> EmptyListAlign -> ShowS
$cshowsPrec :: Int -> 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
/= :: LongListAlign -> LongListAlign -> Bool
$c/= :: LongListAlign -> LongListAlign -> Bool
== :: LongListAlign -> LongListAlign -> Bool
$c== :: LongListAlign -> LongListAlign -> Bool
Eq, Int -> LongListAlign -> ShowS
[LongListAlign] -> ShowS
LongListAlign -> String
(Int -> LongListAlign -> ShowS)
-> (LongListAlign -> String)
-> ([LongListAlign] -> ShowS)
-> Show LongListAlign
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LongListAlign] -> ShowS
$cshowList :: [LongListAlign] -> ShowS
show :: LongListAlign -> String
$cshow :: LongListAlign -> String
showsPrec :: Int -> LongListAlign -> ShowS
$cshowsPrec :: Int -> LongListAlign -> ShowS
Show)
step :: Maybe Int -> Options -> Step
step :: Maybe Int -> Options -> Step
step Maybe Int
columns = String -> (Lines -> Module -> Lines) -> Step
makeStep String
"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
align Lines
ls Module
m = [Change String] -> Lines -> Lines
forall a. [Change a] -> [a] -> [a]
applyChanges [Change String]
changes Lines
ls
where
groups :: [NonEmpty (Located Import)]
groups = Module -> [NonEmpty (Located Import)]
moduleImportGroups Module
m
moduleStats :: ImportStats
moduleStats = (Import -> ImportStats) -> [Import] -> ImportStats
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Import -> ImportStats
importStats ([Import] -> ImportStats)
-> ([Located Import] -> [Import])
-> [Located Import]
-> ImportStats
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Located Import -> Import) -> [Located Import] -> [Import]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Located Import -> Import
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc ([Located Import] -> ImportStats)
-> [Located Import] -> ImportStats
forall a b. (a -> b) -> a -> b
$ (NonEmpty (Located Import) -> [Located Import])
-> [NonEmpty (Located Import)] -> [Located Import]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap NonEmpty (Located Import) -> [Located Import]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList [NonEmpty (Located Import)]
groups
changes :: [Change String]
changes = do
NonEmpty (Located Import)
group <- [NonEmpty (Located Import)]
groups
Change String -> [Change String]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Change String -> [Change String])
-> Change String -> [Change String]
forall a b. (a -> b) -> a -> b
$ Maybe Int
-> Options
-> Module
-> ImportStats
-> NonEmpty (Located Import)
-> Change String
formatGroup Maybe Int
maxCols Options
align Module
m ImportStats
moduleStats NonEmpty (Located Import)
group
formatGroup
:: Maybe Int -> Options -> Module -> ImportStats
-> NonEmpty (Located Import) -> Change String
formatGroup :: Maybe Int
-> Options
-> Module
-> ImportStats
-> NonEmpty (Located Import)
-> Change String
formatGroup Maybe Int
maxCols Options
options Module
m ImportStats
moduleStats NonEmpty (Located Import)
imports =
let newLines :: Lines
newLines = Maybe Int
-> Options
-> Module
-> ImportStats
-> NonEmpty (Located Import)
-> Lines
formatImports Maybe Int
maxCols Options
options Module
m ImportStats
moduleStats NonEmpty (Located Import)
imports in
Block String -> (Lines -> Lines) -> Change String
forall a. Block a -> ([a] -> [a]) -> Change a
change (NonEmpty (Located Import) -> Block String
forall a. NonEmpty (Located a) -> Block String
importBlock NonEmpty (Located Import)
imports) (Lines -> Lines -> Lines
forall a b. a -> b -> a
const Lines
newLines)
importBlock :: NonEmpty (Located a) -> Block String
importBlock :: NonEmpty (Located a) -> Block String
importBlock NonEmpty (Located a)
group = Int -> Int -> Block String
forall a. Int -> Int -> Block a
Block
(Located a -> Int
forall a. Located a -> Int
getStartLineUnsafe (Located a -> Int) -> Located a -> Int
forall a b. (a -> b) -> a -> b
$ NonEmpty (Located a) -> Located a
forall a. NonEmpty a -> a
NonEmpty.head NonEmpty (Located a)
group)
(Located a -> Int
forall a. Located a -> Int
getEndLineUnsafe (Located a -> Int) -> Located a -> Int
forall a b. (a -> b) -> a -> b
$ NonEmpty (Located a) -> Located a
forall a. NonEmpty a -> a
NonEmpty.last NonEmpty (Located a)
group)
formatImports
:: Maybe Int
-> Options
-> Module
-> ImportStats
-> NonEmpty (Located Import) -> Lines
formatImports :: Maybe Int
-> Options
-> Module
-> ImportStats
-> NonEmpty (Located Import)
-> Lines
formatImports Maybe Int
maxCols Options
options Module
m ImportStats
moduleStats NonEmpty (Located Import)
rawGroup =
PrinterConfig
-> [RealLocated AnnotationComment] -> Module -> Printer () -> Lines
forall a.
PrinterConfig
-> [RealLocated AnnotationComment] -> Module -> Printer a -> Lines
runPrinter_ (Maybe Int -> PrinterConfig
PrinterConfig Maybe Int
maxCols) [] Module
m do
let
group :: NonEmpty (Located Import)
group
= (Located Import -> Import)
-> NonEmpty (Located Import) -> NonEmpty (Located Import)
forall o a. Ord o => (a -> o) -> NonEmpty a -> NonEmpty a
NonEmpty.sortWith Located Import -> Import
forall a. Located a -> a
unLocated NonEmpty (Located Import)
rawGroup
NonEmpty (Located Import)
-> (NonEmpty (Located Import) -> NonEmpty (Located Import))
-> NonEmpty (Located Import)
forall a b. a -> (a -> b) -> b
& NonEmpty (Located Import) -> NonEmpty (Located Import)
mergeImports
unLocatedGroup :: [Import]
unLocatedGroup = (Located Import -> Import) -> [Located Import] -> [Import]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Located Import -> Import
forall a. Located a -> a
unLocated ([Located Import] -> [Import]) -> [Located Import] -> [Import]
forall a b. (a -> b) -> a -> b
$ NonEmpty (Located Import) -> [Located Import]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (Located Import)
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 :: Bool
isAnyQualified = Bool
True}
ImportAlign
File -> ImportStats
moduleStats
ImportAlign
Group -> (Import -> ImportStats) -> [Import] -> ImportStats
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Import -> ImportStats
importStats [Import]
unLocatedGroup
ImportAlign
None -> ImportStats
forall a. Monoid a => a
mempty
NonEmpty (Located Import)
-> (Located Import -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ NonEmpty (Located Import)
group \Located Import
imp -> Options -> Bool -> ImportStats -> Located Import -> Printer ()
printQualified Options
options Bool
padNames ImportStats
stats Located Import
imp Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
newline
printQualified :: Options -> Bool -> ImportStats -> Located Import -> P ()
printQualified :: Options -> Bool -> ImportStats -> Located Import -> Printer ()
printQualified Options{Bool
LongListAlign
EmptyListAlign
ListAlign
ImportAlign
ListPadding
postQualified :: Bool
spaceSurround :: Bool
separateLists :: Bool
listPadding :: ListPadding
emptyListAlign :: EmptyListAlign
longListAlign :: LongListAlign
padModuleNames :: Bool
listAlign :: ListAlign
importAlign :: ImportAlign
postQualified :: Options -> Bool
spaceSurround :: Options -> Bool
separateLists :: Options -> Bool
listPadding :: Options -> ListPadding
emptyListAlign :: Options -> EmptyListAlign
longListAlign :: Options -> LongListAlign
padModuleNames :: Options -> Bool
listAlign :: Options -> ListAlign
importAlign :: Options -> ImportAlign
..} Bool
padNames ImportStats
stats (L SrcSpan
_ Import
decl) = do
let decl' :: ImportDecl GhcPs
decl' = Import -> ImportDecl GhcPs
rawImport Import
decl
String -> Printer ()
putText String
"import" Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
space
case (Import -> Bool
isSource Import
decl, ImportStats -> Bool
isAnySource ImportStats
stats) of
(Bool
True, Bool
_) -> String -> Printer ()
putText String
"{-# SOURCE #-}" Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
space
(Bool
_, Bool
True) -> String -> Printer ()
putText String
" " Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
space
(Bool, Bool)
_ -> () -> Printer ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Import -> Bool
isSafe Import
decl) (String -> Printer ()
putText String
"safe" Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
space)
let
module_ :: Printer Int
module_ = do
Int
moduleNamePosition <- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> Printer String -> Printer Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Printer String
getCurrentLine
Maybe StringLiteral -> (StringLiteral -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (ImportDecl GhcPs -> Maybe StringLiteral
forall pass. ImportDecl pass -> Maybe StringLiteral
ideclPkgQual ImportDecl GhcPs
decl') ((StringLiteral -> Printer ()) -> Printer ())
-> (StringLiteral -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \StringLiteral
pkg -> String -> Printer ()
putText (StringLiteral -> String
stringLiteral StringLiteral
pkg) Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
space
String -> Printer ()
putText (Import -> String
moduleName Import
decl)
Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
padNames (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$
Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe (Located ModuleName) -> Bool
forall a. Maybe a -> Bool
isJust (ImportDecl GhcPs -> Maybe (Located ModuleName)
forall pass. ImportDecl pass -> Maybe (Located ModuleName)
ideclAs ImportDecl GhcPs
decl') Bool -> Bool -> Bool
|| Import -> Bool
isHiding Import
decl Bool -> Bool -> Bool
||
Bool -> Bool
not (Maybe (Bool, Located [LIE GhcPs]) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Maybe (Bool, Located [LIE GhcPs]) -> Bool)
-> Maybe (Bool, Located [LIE GhcPs]) -> Bool
forall a b. (a -> b) -> a -> b
$ ImportDecl GhcPs -> Maybe (Bool, Located [LIE GhcPs])
forall pass. ImportDecl pass -> Maybe (Bool, Located [LIE pass])
ideclHiding ImportDecl GhcPs
decl')) (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$
String -> Printer ()
putText (String -> Printer ()) -> String -> Printer ()
forall a b. (a -> b) -> a -> b
$
Int -> Char -> String
forall a. Int -> a -> [a]
replicate (ImportStats -> Int
isLongestImport ImportStats
stats Int -> Int -> Int
forall a. Num a => a -> a -> a
- Import -> Int
importModuleNameLength Import
decl) Char
' '
Int -> Printer Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
moduleNamePosition
Int
moduleNamePosition <-
case (Bool
postQualified, Import -> Bool
isQualified Import
decl, ImportStats -> Bool
isAnyQualified ImportStats
stats) of
(Bool
False, Bool
True , Bool
_ ) -> String -> Printer ()
putText String
"qualified" Printer () -> Printer () -> Printer ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Printer ()
space Printer () -> Printer Int -> Printer Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Printer Int
module_
(Bool
False, Bool
_ , Bool
True) -> String -> Printer ()
putText String
" " Printer () -> Printer () -> Printer ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Printer ()
space Printer () -> Printer Int -> Printer Int
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 -> Printer () -> Printer Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Printer ()
space Printer Int -> Printer () -> Printer Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String -> Printer ()
putText String
"qualified"
(Bool, Bool, Bool)
_ -> Printer Int
module_
Int
beforeAliasPosition <- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> Printer String -> Printer Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Printer String
getCurrentLine
Maybe (Located ModuleName)
-> (Located ModuleName -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (ImportDecl GhcPs -> Maybe (Located ModuleName)
forall pass. ImportDecl pass -> Maybe (Located ModuleName)
ideclAs ImportDecl GhcPs
decl') \(L SrcSpan
_ ModuleName
name) -> do
Printer ()
space Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Printer ()
putText String
"as" Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
space Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Printer ()
putText (ModuleName -> String
moduleNameString ModuleName
name)
Int
afterAliasPosition <- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> Printer String -> Printer Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Printer String
getCurrentLine
Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Import -> Bool
isHiding Import
decl) (Printer ()
space Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Printer ()
putText String
"hiding")
let putOffset :: Printer ()
putOffset = String -> Printer ()
putText (String -> Printer ()) -> String -> Printer ()
forall a b. (a -> b) -> a -> b
$ Int -> Char -> String
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
case (Bool, Located [LIE GhcPs]) -> Located [LIE GhcPs]
forall a b. (a, b) -> b
snd ((Bool, Located [LIE GhcPs]) -> Located [LIE GhcPs])
-> Maybe (Bool, Located [LIE GhcPs]) -> Maybe (Located [LIE GhcPs])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImportDecl GhcPs -> Maybe (Bool, Located [LIE GhcPs])
forall pass. ImportDecl pass -> Maybe (Bool, Located [LIE pass])
ideclHiding ImportDecl GhcPs
decl' of
Maybe (Located [LIE GhcPs])
Nothing -> () -> Printer ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just (L SrcSpan
_ []) -> case EmptyListAlign
emptyListAlign of
EmptyListAlign
RightAfter -> ShowS -> Printer ()
modifyCurrentLine ShowS
trimRight Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
space Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Printer ()
putText String
"()"
EmptyListAlign
Inherit -> case ListAlign
listAlign of
ListAlign
NewLine ->
ShowS -> Printer ()
modifyCurrentLine ShowS
trimRight Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
newline Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
putOffset Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Printer ()
putText String
"()"
ListAlign
_ -> Printer ()
space Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Printer ()
putText String
"()"
Just (L SrcSpan
_ [LIE GhcPs]
imports) -> do
let printedImports :: [(Printer (), Bool, Bool)]
printedImports = [Printer ()] -> [(Printer (), Bool, Bool)]
forall a. [a] -> [(a, Bool, Bool)]
flagEnds ([Printer ()] -> [(Printer (), Bool, Bool)])
-> [Printer ()] -> [(Printer (), Bool, Bool)]
forall a b. (a -> b) -> a -> b
$
(LIE GhcPs -> Printer ()) -> [LIE GhcPs] -> [Printer ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Bool -> IE GhcPs -> Printer ()
printImport Bool
separateLists) (IE GhcPs -> Printer ())
-> (LIE GhcPs -> IE GhcPs) -> LIE GhcPs -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LIE GhcPs -> IE GhcPs
forall a. Located a -> a
unLocated)
([LIE GhcPs] -> [LIE GhcPs]
prepareImportList [LIE GhcPs]
imports)
String
wrapPrefix <- case ListAlign
listAlign of
ListAlign
AfterAlias -> String -> Printer String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Printer String) -> String -> Printer String
forall a b. (a -> b) -> a -> b
$ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
afterAliasPosition Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Char
' '
ListAlign
WithAlias -> String -> Printer String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Printer String) -> String -> Printer String
forall a b. (a -> b) -> a -> b
$ Int -> Char -> String
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 String -> Printer String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" (") Printer String
getCurrentLine
ListAlign
WithModuleName -> String -> Printer String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Printer String) -> String -> Printer String
forall a b. (a -> b) -> a -> b
$ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
moduleNamePosition Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
offset) Char
' '
ListAlign
NewLine -> String -> Printer String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Printer String) -> String -> Printer String
forall a b. (a -> b) -> a -> b
$ Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
offset Char
' '
let
doSpaceSurround :: Printer ()
doSpaceSurround = Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
spaceSurround Printer ()
space
printAsSingleLine :: Printer ()
printAsSingleLine = [(Printer (), Bool, Bool)]
-> ((Printer (), Bool, Bool) -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Printer (), Bool, Bool)]
printedImports (((Printer (), Bool, Bool) -> Printer ()) -> Printer ())
-> ((Printer (), Bool, Bool) -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \(Printer ()
imp, Bool
start, Bool
end) -> do
Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
start (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ String -> Printer ()
putText String
"(" Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
doSpaceSurround
Printer ()
imp
if Bool
end then Printer ()
doSpaceSurround Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Printer ()
putText String
")" else Printer ()
comma Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
space
printAsInlineWrapping :: Printer a -> Printer ()
printAsInlineWrapping Printer a
wprefix = [(Printer (), Bool, Bool)]
-> ((Printer (), Bool, Bool) -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Printer (), Bool, Bool)]
printedImports (((Printer (), Bool, Bool) -> Printer ()) -> Printer ())
-> ((Printer (), Bool, Bool) -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$
\(Printer ()
imp, Bool
start, Bool
end) ->
Printer () -> Printer ()
forall a. P a -> P a
patchForRepeatHiding (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Printer () -> Printer () -> Printer ()
forall a. P a -> P a -> P a
wrapping
(do
if Bool
start then String -> Printer ()
putText String
"(" Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
doSpaceSurround else Printer ()
space
Printer ()
imp
if Bool
end then Printer ()
doSpaceSurround Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Printer ()
putText String
")" else Printer ()
comma)
(do
case ListAlign
listAlign of
ListAlign
Repeat | Bool -> Bool
not Bool
start -> ShowS -> Printer ()
modifyCurrentLine (ShowS -> Printer ())
-> ((Char -> Char) -> ShowS) -> (Char -> Char) -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> ShowS
forall a. (a -> a) -> [a] -> [a]
withLast ((Char -> Char) -> Printer ()) -> (Char -> Char) -> Printer ()
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 -> Printer ()
modifyCurrentLine ShowS
trimRight
ListAlign
_ -> () -> Printer ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Printer ()
newline
Printer a -> Printer ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Printer a
wprefix
case ListAlign
listAlign of
ListAlign
Repeat -> () -> Printer ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
ListAlign
_ | Bool
start -> String -> Printer ()
putText String
"(" Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
doSpaceSurround
ListAlign
_ | LongListAlign
longListAlign LongListAlign -> LongListAlign -> Bool
forall a. Eq a => a -> a -> Bool
/= LongListAlign
Inline -> () -> Printer ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
ListAlign
AfterAlias -> Printer ()
space Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
doSpaceSurround
ListAlign
WithModuleName -> () -> Printer ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
ListAlign
WithAlias -> () -> Printer ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
ListAlign
NewLine -> () -> Printer ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Printer ()
imp
if Bool
end then Printer ()
doSpaceSurround Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Printer ()
putText String
")" else Printer ()
comma)
printAsMultiLine :: Printer ()
printAsMultiLine = [(Printer (), Bool, Bool)]
-> ((Printer (), Bool, Bool) -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Printer (), Bool, Bool)]
printedImports (((Printer (), Bool, Bool) -> Printer ()) -> Printer ())
-> ((Printer (), Bool, Bool) -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \(Printer ()
imp, Bool
start, Bool
end) -> do
Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
start (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ ShowS -> Printer ()
modifyCurrentLine ShowS
trimRight
Printer ()
newline
Printer ()
putOffset
if Bool
start then String -> Printer ()
putText String
"( " else String -> Printer ()
putText String
", "
Printer ()
imp
Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
end (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Printer ()
newline Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
putOffset Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Printer ()
putText String
")"
case LongListAlign
longListAlign of
LongListAlign
Multiline -> Printer () -> Printer () -> Printer ()
forall a. P a -> P a -> P a
wrapping
(Printer ()
space Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
printAsSingleLine)
Printer ()
printAsMultiLine
LongListAlign
Inline | ListAlign
NewLine <- ListAlign
listAlign -> do
ShowS -> Printer ()
modifyCurrentLine ShowS
trimRight
Printer ()
newline Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
putOffset Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer () -> Printer ()
forall a. Printer a -> Printer ()
printAsInlineWrapping (String -> Printer ()
putText String
wrapPrefix)
LongListAlign
Inline -> Printer ()
space Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer () -> Printer ()
forall a. Printer a -> Printer ()
printAsInlineWrapping (String -> Printer ()
putText String
wrapPrefix)
LongListAlign
InlineWithBreak -> Printer () -> Printer () -> Printer ()
forall a. P a -> P a -> P a
wrapping
(Printer ()
space Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
printAsSingleLine)
(do
ShowS -> Printer ()
modifyCurrentLine ShowS
trimRight
Printer ()
newline Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
putOffset Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer () -> Printer ()
forall a. Printer a -> Printer ()
printAsInlineWrapping Printer ()
putOffset)
LongListAlign
InlineToMultiline -> Printer () -> Printer () -> Printer ()
forall a. P a -> P a -> P a
wrapping
(Printer ()
space Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
printAsSingleLine)
(Printer () -> Printer () -> Printer ()
forall a. P a -> P a -> P a
wrapping
(do
ShowS -> Printer ()
modifyCurrentLine ShowS
trimRight
Printer ()
newline Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
putOffset Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
printAsSingleLine)
Printer ()
printAsMultiLine)
where
patchForRepeatHiding :: P a -> P a
patchForRepeatHiding = case ListAlign
listAlign of
ListAlign
Repeat | Import -> Bool
isHiding Import
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 -> IE GhcPs -> P ()
printImport :: Bool -> IE GhcPs -> Printer ()
printImport Bool
_ (IEVar XIEVar GhcPs
_ LIEWrappedName (IdP GhcPs)
name) = do
LIEWrappedName RdrName -> Printer ()
printIeWrappedName LIEWrappedName (IdP GhcPs)
LIEWrappedName RdrName
name
printImport Bool
_ (IEThingAbs XIEThingAbs GhcPs
_ LIEWrappedName (IdP GhcPs)
name) = do
LIEWrappedName RdrName -> Printer ()
printIeWrappedName LIEWrappedName (IdP GhcPs)
LIEWrappedName RdrName
name
printImport Bool
separateLists (IEThingAll XIEThingAll GhcPs
_ LIEWrappedName (IdP GhcPs)
name) = do
LIEWrappedName RdrName -> Printer ()
printIeWrappedName LIEWrappedName (IdP GhcPs)
LIEWrappedName RdrName
name
Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
separateLists Printer ()
space
String -> Printer ()
putText String
"(..)"
printImport Bool
_ (IEModuleContents XIEModuleContents GhcPs
_ (L SrcSpan
_ ModuleName
m)) = do
String -> Printer ()
putText String
"module"
Printer ()
space
String -> Printer ()
putText (ModuleName -> String
moduleNameString ModuleName
m)
printImport Bool
separateLists (IEThingWith XIEThingWith GhcPs
_ LIEWrappedName (IdP GhcPs)
name IEWildcard
wildcard [LIEWrappedName (IdP GhcPs)]
imps [Located (FieldLbl (IdP GhcPs))]
_) = do
LIEWrappedName RdrName -> Printer ()
printIeWrappedName LIEWrappedName (IdP GhcPs)
LIEWrappedName RdrName
name
Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
separateLists Printer ()
space
let ellipsis :: [Printer ()]
ellipsis = case IEWildcard
wildcard of
IEWildcard Int
_position -> [String -> Printer ()
putText String
".."]
IEWildcard
NoIEWildcard -> []
Printer () -> Printer ()
forall a. P a -> P a
parenthesize (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$
Printer () -> [Printer ()] -> Printer ()
forall a. P a -> [P a] -> Printer ()
sep (Printer ()
comma Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
space) ([Printer ()]
ellipsis [Printer ()] -> [Printer ()] -> [Printer ()]
forall a. Semigroup a => a -> a -> a
<> (LIEWrappedName RdrName -> Printer ())
-> [LIEWrappedName RdrName] -> [Printer ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LIEWrappedName RdrName -> Printer ()
printIeWrappedName [LIEWrappedName (IdP GhcPs)]
[LIEWrappedName RdrName]
imps)
printImport Bool
_ (IEGroup XIEGroup GhcPs
_ Int
_ HsDocString
_ ) =
String -> Printer ()
forall a. HasCallStack => String -> a
error String
"Language.Haskell.Stylish.Printer.Imports.printImportExport: unhandled case 'IEGroup'"
printImport Bool
_ (IEDoc XIEDoc GhcPs
_ HsDocString
_) =
String -> Printer ()
forall a. HasCallStack => String -> a
error String
"Language.Haskell.Stylish.Printer.Imports.printImportExport: unhandled case 'IEDoc'"
printImport Bool
_ (IEDocNamed XIEDocNamed GhcPs
_ String
_) =
String -> Printer ()
forall a. HasCallStack => String -> a
error String
"Language.Haskell.Stylish.Printer.Imports.printImportExport: unhandled case 'IEDocNamed'"
printImport Bool
_ (XIE XXIE GhcPs
ext) =
NoExtCon -> Printer ()
forall a. NoExtCon -> a
GHC.noExtCon NoExtCon
XXIE GhcPs
ext
printIeWrappedName :: LIEWrappedName RdrName -> P ()
printIeWrappedName :: LIEWrappedName RdrName -> Printer ()
printIeWrappedName LIEWrappedName RdrName
lie = LIEWrappedName RdrName -> IEWrappedName RdrName
forall a. Located a -> a
unLocated LIEWrappedName RdrName
lie IEWrappedName RdrName
-> (IEWrappedName RdrName -> Printer ()) -> Printer ()
forall a b. a -> (a -> b) -> b
& \case
IEName Located RdrName
n -> Located RdrName -> Printer ()
putRdrName Located RdrName
n
IEPattern Located RdrName
n -> String -> Printer ()
putText String
"pattern" Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
space Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Located RdrName -> Printer ()
putRdrName Located RdrName
n
IEType Located RdrName
n -> String -> Printer ()
putText String
"type" Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
space Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Located RdrName -> Printer ()
putRdrName Located RdrName
n
mergeImports :: NonEmpty (Located Import) -> NonEmpty (Located Import)
mergeImports :: NonEmpty (Located Import) -> NonEmpty (Located Import)
mergeImports (Located Import
x :| []) = Located Import
x Located Import -> [Located Import] -> NonEmpty (Located Import)
forall a. a -> [a] -> NonEmpty a
:| []
mergeImports (Located Import
h :| (Located Import
t : [Located Import]
ts))
| Import -> Import -> Bool
canMergeImport (Located Import -> Import
forall a. Located a -> a
unLocated Located Import
h) (Located Import -> Import
forall a. Located a -> a
unLocated Located Import
t) = NonEmpty (Located Import) -> NonEmpty (Located Import)
mergeImports (Located Import -> Located Import -> Located Import
mergeModuleImport Located Import
h Located Import
t Located Import -> [Located Import] -> NonEmpty (Located Import)
forall a. a -> [a] -> NonEmpty a
:| [Located Import]
ts)
| Bool
otherwise = Located Import
h Located Import -> [Located Import] -> NonEmpty (Located Import)
forall a. a -> [a] -> NonEmpty a
:| [Located Import] -> [Located Import]
mergeImportsTail (Located Import
t Located Import -> [Located Import] -> [Located Import]
forall a. a -> [a] -> [a]
: [Located Import]
ts)
where
mergeImportsTail :: [Located Import] -> [Located Import]
mergeImportsTail (Located Import
x : Located Import
y : [Located Import]
ys)
| Import -> Import -> Bool
canMergeImport (Located Import -> Import
forall a. Located a -> a
unLocated Located Import
x) (Located Import -> Import
forall a. Located a -> a
unLocated Located Import
y) = [Located Import] -> [Located Import]
mergeImportsTail ((Located Import -> Located Import -> Located Import
mergeModuleImport Located Import
x Located Import
y) Located Import -> [Located Import] -> [Located Import]
forall a. a -> [a] -> [a]
: [Located Import]
ys)
| Bool
otherwise = Located Import
x Located Import -> [Located Import] -> [Located Import]
forall a. a -> [a] -> [a]
: [Located Import] -> [Located Import]
mergeImportsTail (Located Import
y Located Import -> [Located Import] -> [Located Import]
forall a. a -> [a] -> [a]
: [Located Import]
ys)
mergeImportsTail [Located Import]
xs = [Located Import]
xs
moduleName :: Import -> String
moduleName :: Import -> String
moduleName
= ModuleName -> String
moduleNameString
(ModuleName -> String)
-> (Import -> ModuleName) -> Import -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located ModuleName -> ModuleName
forall a. Located a -> a
unLocated
(Located ModuleName -> ModuleName)
-> (Import -> Located ModuleName) -> Import -> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImportDecl GhcPs -> Located ModuleName
forall pass. ImportDecl pass -> Located ModuleName
ideclName
(ImportDecl GhcPs -> Located ModuleName)
-> (Import -> ImportDecl GhcPs) -> Import -> Located ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Import -> ImportDecl GhcPs
rawImport
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 :: Int -> Bool -> Bool -> Bool -> ImportStats
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 :: Import -> ImportStats
importStats :: Import -> ImportStats
importStats Import
i =
Int -> Bool -> Bool -> Bool -> ImportStats
ImportStats (Import -> Int
importModuleNameLength Import
i) (Import -> Bool
isSource Import
i) (Import -> Bool
isQualified Import
i) (Import -> Bool
isSafe Import
i)
importModuleNameLength :: Import -> Int
importModuleNameLength :: Import -> Int
importModuleNameLength Import
imp =
(case ImportDecl GhcPs -> Maybe StringLiteral
forall pass. ImportDecl pass -> Maybe StringLiteral
ideclPkgQual (Import -> ImportDecl GhcPs
rawImport Import
imp) of
Maybe StringLiteral
Nothing -> Int
0
Just StringLiteral
sl -> Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (StringLiteral -> String
stringLiteral StringLiteral
sl)) Int -> Int -> Int
forall a. Num a => a -> a -> a
+
(String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ Import -> String
moduleName Import
imp)
stringLiteral :: StringLiteral -> String
stringLiteral :: StringLiteral -> String
stringLiteral StringLiteral
sl = case StringLiteral -> SourceText
sl_st StringLiteral
sl of
SourceText
NoSourceText -> FastString -> String
FS.unpackFS (FastString -> String) -> FastString -> String
forall a b. (a -> b) -> a -> b
$ StringLiteral -> FastString
sl_fs StringLiteral
sl
SourceText String
s -> String
s
isQualified :: Import -> Bool
isQualified :: Import -> Bool
isQualified
= ImportDeclQualifiedStyle -> ImportDeclQualifiedStyle -> Bool
forall a. Eq a => a -> a -> Bool
(/=) ImportDeclQualifiedStyle
NotQualified
(ImportDeclQualifiedStyle -> Bool)
-> (Import -> ImportDeclQualifiedStyle) -> Import -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImportDecl GhcPs -> ImportDeclQualifiedStyle
forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
ideclQualified
(ImportDecl GhcPs -> ImportDeclQualifiedStyle)
-> (Import -> ImportDecl GhcPs)
-> Import
-> ImportDeclQualifiedStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Import -> ImportDecl GhcPs
rawImport
isHiding :: Import -> Bool
isHiding :: Import -> Bool
isHiding
= Bool
-> ((Bool, Located [LIE GhcPs]) -> Bool)
-> Maybe (Bool, Located [LIE GhcPs])
-> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Bool, Located [LIE GhcPs]) -> Bool
forall a b. (a, b) -> a
fst
(Maybe (Bool, Located [LIE GhcPs]) -> Bool)
-> (Import -> Maybe (Bool, Located [LIE GhcPs])) -> Import -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImportDecl GhcPs -> Maybe (Bool, Located [LIE GhcPs])
forall pass. ImportDecl pass -> Maybe (Bool, Located [LIE pass])
ideclHiding
(ImportDecl GhcPs -> Maybe (Bool, Located [LIE GhcPs]))
-> (Import -> ImportDecl GhcPs)
-> Import
-> Maybe (Bool, Located [LIE GhcPs])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Import -> ImportDecl GhcPs
rawImport
isSource :: Import -> Bool
isSource :: Import -> Bool
isSource
= ImportDecl GhcPs -> Bool
forall pass. ImportDecl pass -> Bool
ideclSource
(ImportDecl GhcPs -> Bool)
-> (Import -> ImportDecl GhcPs) -> Import -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Import -> ImportDecl GhcPs
rawImport
isSafe :: Import -> Bool
isSafe :: Import -> Bool
isSafe
= ImportDecl GhcPs -> Bool
forall pass. ImportDecl pass -> Bool
ideclSafe
(ImportDecl GhcPs -> Bool)
-> (Import -> ImportDecl GhcPs) -> Import -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Import -> ImportDecl GhcPs
rawImport
prepareImportList :: [LIE GhcPs] -> [LIE GhcPs]
prepareImportList :: [LIE GhcPs] -> [LIE GhcPs]
prepareImportList =
(LIE GhcPs -> LIE GhcPs -> Ordering) -> [LIE GhcPs] -> [LIE GhcPs]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy LIE GhcPs -> LIE GhcPs -> Ordering
compareLIE ([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 a b. (a -> b) -> [a] -> [b]
map ((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
prepareInner) ([LIE GhcPs] -> [LIE GhcPs])
-> ([LIE GhcPs] -> [LIE GhcPs]) -> [LIE GhcPs] -> [LIE GhcPs]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
((RdrName, NonEmpty (LIE GhcPs)) -> [LIE GhcPs])
-> [(RdrName, NonEmpty (LIE GhcPs))] -> [LIE GhcPs]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (NonEmpty (LIE GhcPs) -> [LIE GhcPs]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty (LIE GhcPs) -> [LIE GhcPs])
-> ((RdrName, NonEmpty (LIE GhcPs)) -> NonEmpty (LIE GhcPs))
-> (RdrName, NonEmpty (LIE GhcPs))
-> [LIE GhcPs]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RdrName, NonEmpty (LIE GhcPs)) -> NonEmpty (LIE GhcPs)
forall a b. (a, b) -> b
snd) ([(RdrName, NonEmpty (LIE GhcPs))] -> [LIE GhcPs])
-> ([LIE GhcPs] -> [(RdrName, NonEmpty (LIE GhcPs))])
-> [LIE GhcPs]
-> [LIE GhcPs]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map RdrName (NonEmpty (LIE GhcPs))
-> [(RdrName, NonEmpty (LIE GhcPs))]
forall k a. Map k a -> [(k, a)]
Map.toAscList (Map RdrName (NonEmpty (LIE GhcPs))
-> [(RdrName, NonEmpty (LIE GhcPs))])
-> ([LIE GhcPs] -> Map RdrName (NonEmpty (LIE GhcPs)))
-> [LIE GhcPs]
-> [(RdrName, NonEmpty (LIE GhcPs))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LIE GhcPs] -> Map RdrName (NonEmpty (LIE GhcPs))
mergeByName
where
mergeByName :: [LIE GhcPs] -> Map.Map RdrName (NonEmpty (LIE GhcPs))
mergeByName :: [LIE GhcPs] -> Map RdrName (NonEmpty (LIE GhcPs))
mergeByName [LIE GhcPs]
imports0 = (NonEmpty (LIE GhcPs)
-> NonEmpty (LIE GhcPs) -> NonEmpty (LIE GhcPs))
-> [(RdrName, NonEmpty (LIE GhcPs))]
-> Map RdrName (NonEmpty (LIE GhcPs))
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith
(\(LIE GhcPs
x :| [LIE GhcPs]
xs) (LIE GhcPs
y :| [LIE GhcPs]
ys) -> case IE GhcPs -> IE GhcPs -> Maybe (IE GhcPs)
ieMerge (LIE GhcPs -> IE GhcPs
forall a. Located a -> a
unLocated LIE GhcPs
x) (LIE GhcPs -> IE GhcPs
forall a. Located a -> a
unLocated LIE GhcPs
y) of
Just IE GhcPs
z -> (LIE GhcPs
x LIE GhcPs -> IE GhcPs -> LIE GhcPs
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> IE GhcPs
z) LIE GhcPs -> [LIE GhcPs] -> NonEmpty (LIE GhcPs)
forall a. a -> [a] -> NonEmpty a
:| ([LIE GhcPs]
xs [LIE GhcPs] -> [LIE GhcPs] -> [LIE GhcPs]
forall a. [a] -> [a] -> [a]
++ [LIE GhcPs]
ys)
Maybe (IE GhcPs)
Nothing -> LIE GhcPs
x LIE GhcPs -> [LIE GhcPs] -> NonEmpty (LIE GhcPs)
forall a. a -> [a] -> NonEmpty a
:| ([LIE GhcPs]
xs [LIE GhcPs] -> [LIE GhcPs] -> [LIE GhcPs]
forall a. [a] -> [a] -> [a]
++ LIE GhcPs
y LIE GhcPs -> [LIE GhcPs] -> [LIE GhcPs]
forall a. a -> [a] -> [a]
: [LIE GhcPs]
ys))
[(IE GhcPs -> IdP GhcPs
forall (p :: Pass). IE (GhcPass p) -> IdP (GhcPass p)
ieName (IE GhcPs -> IdP GhcPs) -> IE GhcPs -> IdP GhcPs
forall a b. (a -> b) -> a -> b
$ LIE GhcPs -> IE GhcPs
forall a. Located a -> a
unLocated LIE GhcPs
imp, LIE GhcPs
imp LIE GhcPs -> [LIE GhcPs] -> NonEmpty (LIE GhcPs)
forall a. a -> [a] -> NonEmpty a
:| []) | LIE GhcPs
imp <- [LIE GhcPs]
imports0]
prepareInner :: IE GhcPs -> IE GhcPs
prepareInner :: IE GhcPs -> IE GhcPs
prepareInner = \case
IEThingWith XIEThingWith GhcPs
x LIEWrappedName (IdP GhcPs)
n IEWildcard
NoIEWildcard [] [] -> XIEThingAbs GhcPs -> LIEWrappedName (IdP GhcPs) -> IE GhcPs
forall pass.
XIEThingAbs pass -> LIEWrappedName (IdP pass) -> IE pass
IEThingAbs XIEThingAbs GhcPs
XIEThingWith GhcPs
x LIEWrappedName (IdP GhcPs)
n
IEThingWith XIEThingWith GhcPs
x LIEWrappedName (IdP GhcPs)
n IEWildcard
w [LIEWrappedName (IdP GhcPs)]
ns [Located (FieldLbl (IdP GhcPs))]
fs ->
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 XIEThingWith GhcPs
x LIEWrappedName (IdP GhcPs)
n IEWildcard
w ((LIEWrappedName RdrName -> LIEWrappedName RdrName -> Ordering)
-> [LIEWrappedName RdrName] -> [LIEWrappedName RdrName]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (IEWrappedName RdrName -> IEWrappedName RdrName -> Ordering
compareWrappedName (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]
ns) [Located (FieldLbl (IdP GhcPs))]
fs
IE GhcPs
ie -> IE GhcPs
ie
ieMerge :: IE GhcPs -> IE GhcPs -> Maybe (IE GhcPs)
ieMerge :: IE GhcPs -> IE GhcPs -> Maybe (IE GhcPs)
ieMerge l :: IE GhcPs
l@(IEVar XIEVar GhcPs
_ LIEWrappedName (IdP GhcPs)
_) IE GhcPs
_ = IE GhcPs -> Maybe (IE GhcPs)
forall a. a -> Maybe a
Just IE GhcPs
l
ieMerge IE GhcPs
_ r :: IE GhcPs
r@(IEVar XIEVar GhcPs
_ LIEWrappedName (IdP GhcPs)
_) = IE GhcPs -> Maybe (IE GhcPs)
forall a. a -> Maybe a
Just IE GhcPs
r
ieMerge (IEThingAbs XIEThingAbs GhcPs
_ LIEWrappedName (IdP GhcPs)
_) IE GhcPs
r = IE GhcPs -> Maybe (IE GhcPs)
forall a. a -> Maybe a
Just IE GhcPs
r
ieMerge IE GhcPs
l (IEThingAbs XIEThingAbs GhcPs
_ LIEWrappedName (IdP GhcPs)
_) = IE GhcPs -> Maybe (IE GhcPs)
forall a. a -> Maybe a
Just IE GhcPs
l
ieMerge l :: IE GhcPs
l@(IEThingAll XIEThingAll GhcPs
_ LIEWrappedName (IdP GhcPs)
_) IE GhcPs
_ = IE GhcPs -> Maybe (IE GhcPs)
forall a. a -> Maybe a
Just IE GhcPs
l
ieMerge IE GhcPs
_ r :: IE GhcPs
r@(IEThingAll XIEThingAll GhcPs
_ LIEWrappedName (IdP GhcPs)
_) = IE GhcPs -> Maybe (IE GhcPs)
forall a. a -> Maybe a
Just IE GhcPs
r
ieMerge (IEThingWith XIEThingWith GhcPs
x0 LIEWrappedName (IdP GhcPs)
n0 IEWildcard
w0 [LIEWrappedName (IdP GhcPs)]
ns0 []) (IEThingWith XIEThingWith GhcPs
_ LIEWrappedName (IdP GhcPs)
_ IEWildcard
w1 [LIEWrappedName (IdP 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 (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 XIEThingWith GhcPs
x0 LIEWrappedName (IdP GhcPs)
n0 IEWildcard
w0 ((LIEWrappedName RdrName -> RdrName)
-> [LIEWrappedName RdrName] -> [LIEWrappedName RdrName]
forall k a. Ord k => (a -> k) -> [a] -> [a]
nubOn (IEWrappedName RdrName -> RdrName
forall n. IEWrappedName n -> n
unwrapName (IEWrappedName RdrName -> RdrName)
-> (LIEWrappedName RdrName -> IEWrappedName RdrName)
-> LIEWrappedName RdrName
-> RdrName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LIEWrappedName RdrName -> IEWrappedName RdrName
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) ([LIEWrappedName RdrName] -> [LIEWrappedName RdrName])
-> [LIEWrappedName RdrName] -> [LIEWrappedName RdrName]
forall a b. (a -> b) -> a -> b
$ [LIEWrappedName (IdP GhcPs)]
[LIEWrappedName RdrName]
ns0 [LIEWrappedName RdrName]
-> [LIEWrappedName RdrName] -> [LIEWrappedName RdrName]
forall a. [a] -> [a] -> [a]
++ [LIEWrappedName (IdP GhcPs)]
[LIEWrappedName RdrName]
ns1) []
ieMerge IE GhcPs
_ IE GhcPs
_ = Maybe (IE GhcPs)
forall a. Maybe a
Nothing
nubOn :: Ord k => (a -> k) -> [a] -> [a]
nubOn :: (a -> k) -> [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