{-# LANGUAGE ViewPatterns #-}

module Language.Haskell.Brittany.Internal.Layouters.Module (layoutModule) where

#include "prelude.inc"

import           Language.Haskell.Brittany.Internal.Types
import           Language.Haskell.Brittany.Internal.LayouterBasics
import           Language.Haskell.Brittany.Internal.Layouters.IE
import           Language.Haskell.Brittany.Internal.Layouters.Import
import           Language.Haskell.Brittany.Internal.Config.Types

import GHC (unLoc, runGhc, GenLocated(L), moduleNameString, AnnKeywordId(..))
#if MIN_VERSION_ghc(8,10,1)   /* ghc-8.10.1 */
import           GHC.Hs
import           GHC.Hs.ImpExp
#else
import           HsSyn
import           HsImpExp
#endif
import           Name
import           FieldLabel
import qualified FastString
import           BasicTypes
import           Language.Haskell.GHC.ExactPrint as ExactPrint
import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint.Types
import           Language.Haskell.GHC.ExactPrint.Types
                                                ( DeltaPos(..)
                                                , deltaRow
                                                , commentContents
                                                )

import           Language.Haskell.Brittany.Internal.Utils



layoutModule :: ToBriDoc HsModule
layoutModule :: ToBriDoc HsModule
layoutModule lmod :: Located (HsModule GhcPs)
lmod@(L SrcSpan
_ HsModule GhcPs
mod') = case HsModule GhcPs
mod' of
    -- Implicit module Main
  HsModule Maybe (Located ModuleName)
Nothing  Maybe (Located [LIE GhcPs])
_   [LImportDecl GhcPs]
imports [LHsDecl GhcPs]
_ Maybe (Located WarningTxt)
_ Maybe LHsDocString
_ -> do
    [CommentedImport]
commentedImports <- [LImportDecl GhcPs] -> ToBriDocM [CommentedImport]
transformToCommentedImport [LImportDecl GhcPs]
imports
    -- groupify commentedImports `forM_` tellDebugMessShow
    [ToBriDocM BriDocNumbered] -> ToBriDocM BriDocNumbered
docLines (CommentedImport -> ToBriDocM BriDocNumbered
commentedImportsToDoc (CommentedImport -> ToBriDocM BriDocNumbered)
-> [CommentedImport] -> [ToBriDocM BriDocNumbered]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CommentedImport] -> [CommentedImport]
sortCommentedImports [CommentedImport]
commentedImports)
    -- sortedImports <- sortImports imports
    -- docLines $ [layoutImport y i | (y, i) <- sortedImports]
  HsModule (Just Located ModuleName
n) Maybe (Located [LIE GhcPs])
les [LImportDecl GhcPs]
imports [LHsDecl GhcPs]
_ Maybe (Located WarningTxt)
_ Maybe LHsDocString
_ -> do
    [CommentedImport]
commentedImports <- [LImportDecl GhcPs] -> ToBriDocM [CommentedImport]
transformToCommentedImport [LImportDecl GhcPs]
imports
    -- groupify commentedImports `forM_` tellDebugMessShow
    -- sortedImports <- sortImports imports
    let tn :: Text
tn = String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ModuleName -> String
moduleNameString (ModuleName -> String) -> ModuleName -> String
forall a b. (a -> b) -> a -> b
$ Located ModuleName -> SrcSpanLess (Located ModuleName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located ModuleName
n
    Bool
allowSingleLineExportList <- MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  Config
forall a (m :: * -> *). MonadMultiReader a m => m a
mAsk
      MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  Config
-> (Config -> Bool)
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     Bool
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Config -> CLayoutConfig Identity
forall (f :: * -> *). CConfig f -> CLayoutConfig f
_conf_layout
      (Config -> CLayoutConfig Identity)
-> (CLayoutConfig Identity -> Identity (Last Bool))
-> Config
-> Identity (Last Bool)
forall a b c. (a -> b) -> (b -> c) -> a -> c
.>  CLayoutConfig Identity -> Identity (Last Bool)
forall (f :: * -> *). CLayoutConfig f -> f (Last Bool)
_lconfig_allowSingleLineExportList
      (Config -> Identity (Last Bool))
-> (Identity (Last Bool) -> Bool) -> Config -> Bool
forall a b c. (a -> b) -> (b -> c) -> a -> c
.>  Identity (Last Bool) -> Bool
forall a b. Coercible a b => Identity a -> b
confUnpack
    -- the config should not prevent single-line layout when there is no
    -- export list
    let allowSingleLine :: Bool
allowSingleLine = Bool
allowSingleLineExportList Bool -> Bool -> Bool
|| Maybe (Located [LIE GhcPs]) -> Bool
forall a. Maybe a -> Bool
Data.Maybe.isNothing Maybe (Located [LIE GhcPs])
les
    [ToBriDocM BriDocNumbered] -> ToBriDocM BriDocNumbered
docLines
      ([ToBriDocM BriDocNumbered] -> ToBriDocM BriDocNumbered)
-> [ToBriDocM BriDocNumbered] -> ToBriDocM BriDocNumbered
forall a b. (a -> b) -> a -> b
$ [ToBriDocM BriDocNumbered] -> ToBriDocM BriDocNumbered
docSeq
          [ Located (HsModule GhcPs)
-> Maybe AnnKeywordId
-> ToBriDocM BriDocNumbered
-> ToBriDocM BriDocNumbered
forall ast.
Data ast =>
Located ast
-> Maybe AnnKeywordId
-> ToBriDocM BriDocNumbered
-> ToBriDocM BriDocNumbered
docNodeAnnKW Located (HsModule GhcPs)
lmod Maybe AnnKeywordId
forall a. Maybe a
Nothing ToBriDocM BriDocNumbered
docEmpty
             -- A pseudo node that serves merely to force documentation
             -- before the node
          , Located (HsModule GhcPs)
-> AnnKeywordId
-> Bool
-> ToBriDocM BriDocNumbered
-> ToBriDocM BriDocNumbered
forall ast.
Data ast =>
Located ast
-> AnnKeywordId
-> Bool
-> ToBriDocM BriDocNumbered
-> ToBriDocM BriDocNumbered
docNodeMoveToKWDP Located (HsModule GhcPs)
lmod AnnKeywordId
AnnModule Bool
True (ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered)
-> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
forall a b. (a -> b) -> a -> b
$ CollectAltM () -> ToBriDocM BriDocNumbered
runFilteredAlternative (CollectAltM () -> ToBriDocM BriDocNumbered)
-> CollectAltM () -> ToBriDocM BriDocNumbered
forall a b. (a -> b) -> a -> b
$ do
            Bool -> ToBriDocM BriDocNumbered -> CollectAltM ()
addAlternativeCond Bool
allowSingleLine (ToBriDocM BriDocNumbered -> CollectAltM ())
-> ToBriDocM BriDocNumbered -> CollectAltM ()
forall a b. (a -> b) -> a -> b
$
              ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
docForceSingleline
                (ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered)
-> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
forall a b. (a -> b) -> a -> b
$ [ToBriDocM BriDocNumbered] -> ToBriDocM BriDocNumbered
docSeq
                [ ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
appSep (ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered)
-> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
forall a b. (a -> b) -> a -> b
$ Text -> ToBriDocM BriDocNumbered
docLit (Text -> ToBriDocM BriDocNumbered)
-> Text -> ToBriDocM BriDocNumbered
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
"module"
                , ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
appSep (ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered)
-> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
forall a b. (a -> b) -> a -> b
$ Text -> ToBriDocM BriDocNumbered
docLit Text
tn
                , Located (HsModule GhcPs)
-> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
forall a ast. (DocWrapable a, Data ast) => Located ast -> a -> a
docWrapNode Located (HsModule GhcPs)
lmod (ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered)
-> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
forall a b. (a -> b) -> a -> b
$ ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
appSep (ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered)
-> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
forall a b. (a -> b) -> a -> b
$ case Maybe (Located [LIE GhcPs])
les of
                  Maybe (Located [LIE GhcPs])
Nothing -> ToBriDocM BriDocNumbered
docEmpty
                  Just Located [LIE GhcPs]
x  -> Bool
-> SortItemsFlag -> Located [LIE GhcPs] -> ToBriDocM BriDocNumbered
layoutLLIEs Bool
True SortItemsFlag
KeepItemsUnsorted Located [LIE GhcPs]
x
                , ToBriDocM BriDocNumbered
docSeparator
                , Text -> ToBriDocM BriDocNumbered
docLit (Text -> ToBriDocM BriDocNumbered)
-> Text -> ToBriDocM BriDocNumbered
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
"where"
                ]
            ToBriDocM BriDocNumbered -> CollectAltM ()
addAlternative
              (ToBriDocM BriDocNumbered -> CollectAltM ())
-> ToBriDocM BriDocNumbered -> CollectAltM ()
forall a b. (a -> b) -> a -> b
$ [ToBriDocM BriDocNumbered] -> ToBriDocM BriDocNumbered
docLines
              [ BrIndent -> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
docAddBaseY BrIndent
BrIndentRegular (ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered)
-> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
forall a b. (a -> b) -> a -> b
$ ToBriDocM BriDocNumbered
-> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
docPar
                ([ToBriDocM BriDocNumbered] -> ToBriDocM BriDocNumbered
docSeq [ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
appSep (ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered)
-> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
forall a b. (a -> b) -> a -> b
$ Text -> ToBriDocM BriDocNumbered
docLit (Text -> ToBriDocM BriDocNumbered)
-> Text -> ToBriDocM BriDocNumbered
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
"module", Text -> ToBriDocM BriDocNumbered
docLit Text
tn]
                )
                ([ToBriDocM BriDocNumbered] -> ToBriDocM BriDocNumbered
docSeq [
                          Located (HsModule GhcPs)
-> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
forall a ast. (DocWrapable a, Data ast) => Located ast -> a -> a
docWrapNode Located (HsModule GhcPs)
lmod (ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered)
-> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
forall a b. (a -> b) -> a -> b
$ case Maybe (Located [LIE GhcPs])
les of
                           Maybe (Located [LIE GhcPs])
Nothing -> ToBriDocM BriDocNumbered
docEmpty
                           Just Located [LIE GhcPs]
x  -> Bool
-> SortItemsFlag -> Located [LIE GhcPs] -> ToBriDocM BriDocNumbered
layoutLLIEs Bool
False SortItemsFlag
KeepItemsUnsorted Located [LIE GhcPs]
x
                        , ToBriDocM BriDocNumbered
docSeparator
                        , Text -> ToBriDocM BriDocNumbered
docLit (Text -> ToBriDocM BriDocNumbered)
-> Text -> ToBriDocM BriDocNumbered
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
"where"
                        ]
                )
              ]
          ]
      ToBriDocM BriDocNumbered
-> [ToBriDocM BriDocNumbered] -> [ToBriDocM BriDocNumbered]
forall a. a -> [a] -> [a]
: (CommentedImport -> ToBriDocM BriDocNumbered
commentedImportsToDoc (CommentedImport -> ToBriDocM BriDocNumbered)
-> [CommentedImport] -> [ToBriDocM BriDocNumbered]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CommentedImport] -> [CommentedImport]
sortCommentedImports [CommentedImport]
commentedImports) -- [layoutImport y i | (y, i) <- sortedImports]

data CommentedImport
  = EmptyLine
  | IndependentComment (Comment, DeltaPos)
  | ImportStatement ImportStatementRecord

instance Show CommentedImport where
  show :: CommentedImport -> String
show = \case
    CommentedImport
EmptyLine            -> String
"EmptyLine"
    IndependentComment (Comment, DeltaPos)
_ -> String
"IndependentComment"
    ImportStatement ImportStatementRecord
r ->
      String
"ImportStatement " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([(Comment, DeltaPos)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([(Comment, DeltaPos)] -> Int) -> [(Comment, DeltaPos)] -> Int
forall a b. (a -> b) -> a -> b
$ ImportStatementRecord -> [(Comment, DeltaPos)]
commentsBefore ImportStatementRecord
r) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show
        ([(Comment, DeltaPos)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([(Comment, DeltaPos)] -> Int) -> [(Comment, DeltaPos)] -> Int
forall a b. (a -> b) -> a -> b
$ ImportStatementRecord -> [(Comment, DeltaPos)]
commentsAfter ImportStatementRecord
r)

data ImportStatementRecord = ImportStatementRecord
  { ImportStatementRecord -> [(Comment, DeltaPos)]
commentsBefore :: [(Comment, DeltaPos)]
  , ImportStatementRecord -> [(Comment, DeltaPos)]
commentsAfter :: [(Comment, DeltaPos)]
  , ImportStatementRecord -> ImportDecl GhcPs
importStatement :: ImportDecl GhcPs
  }

instance Show ImportStatementRecord where
  show :: ImportStatementRecord -> String
show ImportStatementRecord
r = String
"ImportStatement " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([(Comment, DeltaPos)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([(Comment, DeltaPos)] -> Int) -> [(Comment, DeltaPos)] -> Int
forall a b. (a -> b) -> a -> b
$ ImportStatementRecord -> [(Comment, DeltaPos)]
commentsBefore ImportStatementRecord
r) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show
        ([(Comment, DeltaPos)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([(Comment, DeltaPos)] -> Int) -> [(Comment, DeltaPos)] -> Int
forall a b. (a -> b) -> a -> b
$ ImportStatementRecord -> [(Comment, DeltaPos)]
commentsAfter ImportStatementRecord
r)

transformToCommentedImport
  :: [LImportDecl GhcPs] -> ToBriDocM [CommentedImport]
transformToCommentedImport :: [LImportDecl GhcPs] -> ToBriDocM [CommentedImport]
transformToCommentedImport [LImportDecl GhcPs]
is = do
  [(Maybe Annotation, ImportDecl GhcPs)]
nodeWithAnnotations <- [LImportDecl GhcPs]
is [LImportDecl GhcPs]
-> (LImportDecl GhcPs
    -> MultiRWST
         '[Config, Anns]
         '[[BrittanyError], Seq String]
         '[NodeAllocIndex]
         Identity
         (Maybe Annotation, ImportDecl GhcPs))
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     [(Maybe Annotation, ImportDecl GhcPs)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
`forM` \i :: LImportDecl GhcPs
i@(L SrcSpan
_ ImportDecl GhcPs
rawImport) -> do
    Maybe Annotation
annotionMay <- LImportDecl GhcPs
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     (Maybe Annotation)
forall ast (m :: * -> *).
(Data ast, MonadMultiReader Anns m) =>
Located ast -> m (Maybe Annotation)
astAnn LImportDecl GhcPs
i
    (Maybe Annotation, ImportDecl GhcPs)
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     (Maybe Annotation, ImportDecl GhcPs)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Annotation
annotionMay, ImportDecl GhcPs
rawImport)
  let
    convertComment :: (Comment, DeltaPos) -> [CommentedImport]
convertComment (Comment
c, DP (Int
y, Int
x)) =
      Int -> CommentedImport -> [CommentedImport]
forall a. Int -> a -> [a]
replicate (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) CommentedImport
EmptyLine [CommentedImport] -> [CommentedImport] -> [CommentedImport]
forall a. [a] -> [a] -> [a]
++ [(Comment, DeltaPos) -> CommentedImport
IndependentComment (Comment
c, (Int, Int) -> DeltaPos
DP (Int
1, Int
x))]
    accumF
      :: [(Comment, DeltaPos)]
      -> (Maybe Annotation, ImportDecl GhcPs)
      -> ([(Comment, DeltaPos)], [CommentedImport])
    accumF :: [(Comment, DeltaPos)]
-> (Maybe Annotation, ImportDecl GhcPs)
-> ([(Comment, DeltaPos)], [CommentedImport])
accumF [(Comment, DeltaPos)]
accConnectedComm (Maybe Annotation
annMay, ImportDecl GhcPs
decl) = case Maybe Annotation
annMay of
      Maybe Annotation
Nothing ->
        ( []
        , [ ImportStatementRecord -> CommentedImport
ImportStatement ImportStatementRecord :: [(Comment, DeltaPos)]
-> [(Comment, DeltaPos)]
-> ImportDecl GhcPs
-> ImportStatementRecord
ImportStatementRecord { commentsBefore :: [(Comment, DeltaPos)]
commentsBefore  = []
                                                  , commentsAfter :: [(Comment, DeltaPos)]
commentsAfter   = []
                                                  , importStatement :: ImportDecl GhcPs
importStatement = ImportDecl GhcPs
decl
                                                  }
          ]
        )
      Just Annotation
ann ->
        let
          blanksBeforeImportDecl :: Int
blanksBeforeImportDecl = DeltaPos -> Int
deltaRow (Annotation -> DeltaPos
annEntryDelta Annotation
ann) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
          ([(Comment, DeltaPos)]
newAccumulator, [(Comment, DeltaPos)]
priorComments') =
            ((Comment, DeltaPos) -> Bool)
-> [(Comment, DeltaPos)]
-> ([(Comment, DeltaPos)], [(Comment, DeltaPos)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
List.span ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (Int -> Bool)
-> ((Comment, DeltaPos) -> Int) -> (Comment, DeltaPos) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DeltaPos -> Int
deltaRow (DeltaPos -> Int)
-> ((Comment, DeltaPos) -> DeltaPos) -> (Comment, DeltaPos) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Comment, DeltaPos) -> DeltaPos
forall a b. (a, b) -> b
snd) (Annotation -> [(Comment, DeltaPos)]
annPriorComments Annotation
ann)
          go
            :: [(Comment, DeltaPos)]
            -> [(Comment, DeltaPos)]
            -> ([CommentedImport], [(Comment, DeltaPos)], Int)
          go :: [(Comment, DeltaPos)]
-> [(Comment, DeltaPos)]
-> ([CommentedImport], [(Comment, DeltaPos)], Int)
go [(Comment, DeltaPos)]
acc []                       = ([], [(Comment, DeltaPos)]
acc, Int
0)
          go [(Comment, DeltaPos)]
acc [c1 :: (Comment, DeltaPos)
c1@(Comment
_, DP (Int
y, Int
_))] = ([], (Comment, DeltaPos)
c1 (Comment, DeltaPos)
-> [(Comment, DeltaPos)] -> [(Comment, DeltaPos)]
forall a. a -> [a] -> [a]
: [(Comment, DeltaPos)]
acc, Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
          go [(Comment, DeltaPos)]
acc (c1 :: (Comment, DeltaPos)
c1@(Comment
_, DP (Int
1, Int
_)) : [(Comment, DeltaPos)]
xs) = [(Comment, DeltaPos)]
-> [(Comment, DeltaPos)]
-> ([CommentedImport], [(Comment, DeltaPos)], Int)
go ((Comment, DeltaPos)
c1 (Comment, DeltaPos)
-> [(Comment, DeltaPos)] -> [(Comment, DeltaPos)]
forall a. a -> [a] -> [a]
: [(Comment, DeltaPos)]
acc) [(Comment, DeltaPos)]
xs
          go [(Comment, DeltaPos)]
acc ((Comment
c1, DP (Int
y, Int
x)) : [(Comment, DeltaPos)]
xs) =
            ( ((Comment, DeltaPos) -> [CommentedImport]
convertComment ((Comment, DeltaPos) -> [CommentedImport])
-> [(Comment, DeltaPos)] -> [CommentedImport]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [(Comment, DeltaPos)]
xs) [CommentedImport] -> [CommentedImport] -> [CommentedImport]
forall a. [a] -> [a] -> [a]
++ Int -> CommentedImport -> [CommentedImport]
forall a. Int -> a -> [a]
replicate (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) CommentedImport
EmptyLine
            , (Comment
c1, (Int, Int) -> DeltaPos
DP (Int
1, Int
x)) (Comment, DeltaPos)
-> [(Comment, DeltaPos)] -> [(Comment, DeltaPos)]
forall a. a -> [a] -> [a]
: [(Comment, DeltaPos)]
acc
            , Int
0
            )
          ([CommentedImport]
convertedIndependentComments, [(Comment, DeltaPos)]
beforeComments, Int
initialBlanks) =
            if Int
blanksBeforeImportDecl Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
              then ((Comment, DeltaPos) -> [CommentedImport]
convertComment ((Comment, DeltaPos) -> [CommentedImport])
-> [(Comment, DeltaPos)] -> [CommentedImport]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [(Comment, DeltaPos)]
priorComments', [], Int
0)
              else [(Comment, DeltaPos)]
-> [(Comment, DeltaPos)]
-> ([CommentedImport], [(Comment, DeltaPos)], Int)
go [] ([(Comment, DeltaPos)] -> [(Comment, DeltaPos)]
forall a. [a] -> [a]
reverse [(Comment, DeltaPos)]
priorComments')
        in
          ( [(Comment, DeltaPos)]
newAccumulator
          , [CommentedImport]
convertedIndependentComments
          [CommentedImport] -> [CommentedImport] -> [CommentedImport]
forall a. [a] -> [a] -> [a]
++ Int -> CommentedImport -> [CommentedImport]
forall a. Int -> a -> [a]
replicate (Int
blanksBeforeImportDecl Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
initialBlanks) CommentedImport
EmptyLine
          [CommentedImport] -> [CommentedImport] -> [CommentedImport]
forall a. [a] -> [a] -> [a]
++ [ ImportStatementRecord -> CommentedImport
ImportStatement ImportStatementRecord :: [(Comment, DeltaPos)]
-> [(Comment, DeltaPos)]
-> ImportDecl GhcPs
-> ImportStatementRecord
ImportStatementRecord
                 { commentsBefore :: [(Comment, DeltaPos)]
commentsBefore  = [(Comment, DeltaPos)]
beforeComments
                 , commentsAfter :: [(Comment, DeltaPos)]
commentsAfter   = [(Comment, DeltaPos)]
accConnectedComm
                 , importStatement :: ImportDecl GhcPs
importStatement = ImportDecl GhcPs
decl
                 }
             ]
          )
  let ([(Comment, DeltaPos)]
finalAcc, [[CommentedImport]]
finalList) = ([(Comment, DeltaPos)]
 -> (Maybe Annotation, ImportDecl GhcPs)
 -> ([(Comment, DeltaPos)], [CommentedImport]))
-> [(Comment, DeltaPos)]
-> [(Maybe Annotation, ImportDecl GhcPs)]
-> ([(Comment, DeltaPos)], [[CommentedImport]])
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumR [(Comment, DeltaPos)]
-> (Maybe Annotation, ImportDecl GhcPs)
-> ([(Comment, DeltaPos)], [CommentedImport])
accumF [] [(Maybe Annotation, ImportDecl GhcPs)]
nodeWithAnnotations
  [CommentedImport] -> ToBriDocM [CommentedImport]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([CommentedImport] -> ToBriDocM [CommentedImport])
-> [CommentedImport] -> ToBriDocM [CommentedImport]
forall a b. (a -> b) -> a -> b
$ [[CommentedImport]] -> [CommentedImport]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[CommentedImport]] -> [CommentedImport])
-> [[CommentedImport]] -> [CommentedImport]
forall a b. (a -> b) -> a -> b
$ ((Comment, DeltaPos) -> [CommentedImport]
convertComment ((Comment, DeltaPos) -> [CommentedImport])
-> [(Comment, DeltaPos)] -> [CommentedImport]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [(Comment, DeltaPos)]
finalAcc) [CommentedImport] -> [[CommentedImport]] -> [[CommentedImport]]
forall a. a -> [a] -> [a]
: [[CommentedImport]]
finalList

sortCommentedImports :: [CommentedImport] -> [CommentedImport]
sortCommentedImports :: [CommentedImport] -> [CommentedImport]
sortCommentedImports =
  [CommentedImport] -> [CommentedImport]
unpackImports ([CommentedImport] -> [CommentedImport])
-> ([CommentedImport] -> [CommentedImport])
-> [CommentedImport]
-> [CommentedImport]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either CommentedImport [ImportStatementRecord]]
-> [CommentedImport]
mergeGroups ([Either CommentedImport [ImportStatementRecord]]
 -> [CommentedImport])
-> ([CommentedImport]
    -> [Either CommentedImport [ImportStatementRecord]])
-> [CommentedImport]
-> [CommentedImport]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either CommentedImport [ImportStatementRecord]
 -> Either CommentedImport [ImportStatementRecord])
-> [Either CommentedImport [ImportStatementRecord]]
-> [Either CommentedImport [ImportStatementRecord]]
forall a b. (a -> b) -> [a] -> [b]
map (([ImportStatementRecord] -> [ImportStatementRecord])
-> Either CommentedImport [ImportStatementRecord]
-> Either CommentedImport [ImportStatementRecord]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([ImportStatementRecord] -> [ImportStatementRecord]
sortGroups)) ([Either CommentedImport [ImportStatementRecord]]
 -> [Either CommentedImport [ImportStatementRecord]])
-> ([CommentedImport]
    -> [Either CommentedImport [ImportStatementRecord]])
-> [CommentedImport]
-> [Either CommentedImport [ImportStatementRecord]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CommentedImport]
-> [Either CommentedImport [ImportStatementRecord]]
groupify
 where
  unpackImports :: [CommentedImport] -> [CommentedImport]
  unpackImports :: [CommentedImport] -> [CommentedImport]
unpackImports [CommentedImport]
xs = [CommentedImport]
xs [CommentedImport]
-> (CommentedImport -> [CommentedImport]) -> [CommentedImport]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    l :: CommentedImport
l@CommentedImport
EmptyLine            -> [CommentedImport
l]
    l :: CommentedImport
l@IndependentComment{} -> [CommentedImport
l]
    ImportStatement ImportStatementRecord
r ->
      ((Comment, DeltaPos) -> CommentedImport)
-> [(Comment, DeltaPos)] -> [CommentedImport]
forall a b. (a -> b) -> [a] -> [b]
map (Comment, DeltaPos) -> CommentedImport
IndependentComment (ImportStatementRecord -> [(Comment, DeltaPos)]
commentsBefore ImportStatementRecord
r) [CommentedImport] -> [CommentedImport] -> [CommentedImport]
forall a. [a] -> [a] -> [a]
++ [ImportStatementRecord -> CommentedImport
ImportStatement ImportStatementRecord
r]
  mergeGroups
    :: [Either CommentedImport [ImportStatementRecord]] -> [CommentedImport]
  mergeGroups :: [Either CommentedImport [ImportStatementRecord]]
-> [CommentedImport]
mergeGroups [Either CommentedImport [ImportStatementRecord]]
xs = [Either CommentedImport [ImportStatementRecord]]
xs [Either CommentedImport [ImportStatementRecord]]
-> (Either CommentedImport [ImportStatementRecord]
    -> [CommentedImport])
-> [CommentedImport]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left  CommentedImport
x -> [CommentedImport
x]
    Right [ImportStatementRecord]
y -> ImportStatementRecord -> CommentedImport
ImportStatement (ImportStatementRecord -> CommentedImport)
-> [ImportStatementRecord] -> [CommentedImport]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ImportStatementRecord]
y
  sortGroups :: [ImportStatementRecord] -> [ImportStatementRecord]
  sortGroups :: [ImportStatementRecord] -> [ImportStatementRecord]
sortGroups =
    (ImportStatementRecord -> String)
-> [ImportStatementRecord] -> [ImportStatementRecord]
forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn (ModuleName -> String
moduleNameString (ModuleName -> String)
-> (ImportStatementRecord -> ModuleName)
-> ImportStatementRecord
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located ModuleName -> ModuleName
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc (Located ModuleName -> ModuleName)
-> (ImportStatementRecord -> Located ModuleName)
-> ImportStatementRecord
-> 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)
-> (ImportStatementRecord -> ImportDecl GhcPs)
-> ImportStatementRecord
-> Located ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImportStatementRecord -> ImportDecl GhcPs
importStatement)
  groupify
    :: [CommentedImport] -> [Either CommentedImport [ImportStatementRecord]]
  groupify :: [CommentedImport]
-> [Either CommentedImport [ImportStatementRecord]]
groupify [CommentedImport]
cs = [ImportStatementRecord]
-> [CommentedImport]
-> [Either CommentedImport [ImportStatementRecord]]
go [] [CommentedImport]
cs
   where
    go :: [ImportStatementRecord]
-> [CommentedImport]
-> [Either CommentedImport [ImportStatementRecord]]
go [] = \case
      (l :: CommentedImport
l@CommentedImport
EmptyLine            : [CommentedImport]
rest) -> CommentedImport -> Either CommentedImport [ImportStatementRecord]
forall a b. a -> Either a b
Left CommentedImport
l Either CommentedImport [ImportStatementRecord]
-> [Either CommentedImport [ImportStatementRecord]]
-> [Either CommentedImport [ImportStatementRecord]]
forall a. a -> [a] -> [a]
: [ImportStatementRecord]
-> [CommentedImport]
-> [Either CommentedImport [ImportStatementRecord]]
go [] [CommentedImport]
rest
      (l :: CommentedImport
l@IndependentComment{} : [CommentedImport]
rest) -> CommentedImport -> Either CommentedImport [ImportStatementRecord]
forall a b. a -> Either a b
Left CommentedImport
l Either CommentedImport [ImportStatementRecord]
-> [Either CommentedImport [ImportStatementRecord]]
-> [Either CommentedImport [ImportStatementRecord]]
forall a. a -> [a] -> [a]
: [ImportStatementRecord]
-> [CommentedImport]
-> [Either CommentedImport [ImportStatementRecord]]
go [] [CommentedImport]
rest
      (ImportStatement ImportStatementRecord
r      : [CommentedImport]
rest) -> [ImportStatementRecord]
-> [CommentedImport]
-> [Either CommentedImport [ImportStatementRecord]]
go [ImportStatementRecord
r] [CommentedImport]
rest
      []                              -> []
    go [ImportStatementRecord]
acc = \case
      (l :: CommentedImport
l@CommentedImport
EmptyLine : [CommentedImport]
rest) -> [ImportStatementRecord]
-> Either CommentedImport [ImportStatementRecord]
forall a b. b -> Either a b
Right ([ImportStatementRecord] -> [ImportStatementRecord]
forall a. [a] -> [a]
reverse [ImportStatementRecord]
acc) Either CommentedImport [ImportStatementRecord]
-> [Either CommentedImport [ImportStatementRecord]]
-> [Either CommentedImport [ImportStatementRecord]]
forall a. a -> [a] -> [a]
: CommentedImport -> Either CommentedImport [ImportStatementRecord]
forall a b. a -> Either a b
Left CommentedImport
l Either CommentedImport [ImportStatementRecord]
-> [Either CommentedImport [ImportStatementRecord]]
-> [Either CommentedImport [ImportStatementRecord]]
forall a. a -> [a] -> [a]
: [ImportStatementRecord]
-> [CommentedImport]
-> [Either CommentedImport [ImportStatementRecord]]
go [] [CommentedImport]
rest
      (l :: CommentedImport
l@IndependentComment{} : [CommentedImport]
rest) ->
        CommentedImport -> Either CommentedImport [ImportStatementRecord]
forall a b. a -> Either a b
Left CommentedImport
l Either CommentedImport [ImportStatementRecord]
-> [Either CommentedImport [ImportStatementRecord]]
-> [Either CommentedImport [ImportStatementRecord]]
forall a. a -> [a] -> [a]
: [ImportStatementRecord]
-> Either CommentedImport [ImportStatementRecord]
forall a b. b -> Either a b
Right ([ImportStatementRecord] -> [ImportStatementRecord]
forall a. [a] -> [a]
reverse [ImportStatementRecord]
acc) Either CommentedImport [ImportStatementRecord]
-> [Either CommentedImport [ImportStatementRecord]]
-> [Either CommentedImport [ImportStatementRecord]]
forall a. a -> [a] -> [a]
: [ImportStatementRecord]
-> [CommentedImport]
-> [Either CommentedImport [ImportStatementRecord]]
go [] [CommentedImport]
rest
      (ImportStatement ImportStatementRecord
r : [CommentedImport]
rest) -> [ImportStatementRecord]
-> [CommentedImport]
-> [Either CommentedImport [ImportStatementRecord]]
go (ImportStatementRecord
r ImportStatementRecord
-> [ImportStatementRecord] -> [ImportStatementRecord]
forall a. a -> [a] -> [a]
: [ImportStatementRecord]
acc) [CommentedImport]
rest
      []                         -> [[ImportStatementRecord]
-> Either CommentedImport [ImportStatementRecord]
forall a b. b -> Either a b
Right ([ImportStatementRecord] -> [ImportStatementRecord]
forall a. [a] -> [a]
reverse [ImportStatementRecord]
acc)]

commentedImportsToDoc :: CommentedImport -> ToBriDocM BriDocNumbered
commentedImportsToDoc :: CommentedImport -> ToBriDocM BriDocNumbered
commentedImportsToDoc = \case
  CommentedImport
EmptyLine -> String -> ToBriDocM BriDocNumbered
docLitS String
""
  IndependentComment (Comment, DeltaPos)
c -> (Comment, DeltaPos) -> ToBriDocM BriDocNumbered
commentToDoc (Comment, DeltaPos)
c
  ImportStatement ImportStatementRecord
r ->
    [ToBriDocM BriDocNumbered] -> ToBriDocM BriDocNumbered
docSeq
      ( ImportDecl GhcPs -> ToBriDocM BriDocNumbered
layoutImport (ImportStatementRecord -> ImportDecl GhcPs
importStatement ImportStatementRecord
r)
      ToBriDocM BriDocNumbered
-> [ToBriDocM BriDocNumbered] -> [ToBriDocM BriDocNumbered]
forall a. a -> [a] -> [a]
: ((Comment, DeltaPos) -> ToBriDocM BriDocNumbered)
-> [(Comment, DeltaPos)] -> [ToBriDocM BriDocNumbered]
forall a b. (a -> b) -> [a] -> [b]
map (Comment, DeltaPos) -> ToBriDocM BriDocNumbered
commentToDoc (ImportStatementRecord -> [(Comment, DeltaPos)]
commentsAfter ImportStatementRecord
r)
      )
 where
  commentToDoc :: (Comment, DeltaPos) -> ToBriDocM BriDocNumbered
commentToDoc (Comment
c, DP (Int
_y, Int
x)) = String -> ToBriDocM BriDocNumbered
docLitS (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
x Char
' ' String -> ShowS
forall a. [a] -> [a] -> [a]
++ Comment -> String
commentContents Comment
c)