module Language.Haskell.Brittany.Internal.Layouters.Import (layoutImport) 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.Config.Types

import           GHC                                      ( unLoc
                                                          , GenLocated(L)
                                                          , moduleNameString
                                                          , Located
                                                          )
#if MIN_VERSION_ghc(8,10,1)   /* ghc-8.10.1 */
import           GHC.Hs
#else
import           HsSyn
#endif
import           Name
import           FieldLabel
import qualified FastString
import           BasicTypes

import           Language.Haskell.Brittany.Internal.Utils



prepPkg :: SourceText -> String
prepPkg :: SourceText -> String
prepPkg SourceText
rawN = case SourceText
rawN of
  SourceText String
n -> String
n
  -- This would be odd to encounter and the
  -- result will most certainly be wrong
  SourceText
NoSourceText -> String
""
prepModName :: Located e -> e
prepModName :: Located e -> e
prepModName = Located e -> e
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc

layoutImport :: ToBriDoc ImportDecl
layoutImport :: ToBriDoc ImportDecl
layoutImport limportD :: Located (ImportDecl GhcPs)
limportD@(L SrcSpan
_ ImportDecl GhcPs
importD) = Located (ImportDecl GhcPs)
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
forall a ast. (DocWrapable a, Data ast) => Located ast -> a -> a
docWrapNode Located (ImportDecl GhcPs)
limportD (MultiRWST
   '[Config, Anns]
   '[[BrittanyError], Seq String]
   '[NodeAllocIndex]
   Identity
   BriDocNumbered
 -> MultiRWST
      '[Config, Anns]
      '[[BrittanyError], Seq String]
      '[NodeAllocIndex]
      Identity
      BriDocNumbered)
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
forall a b. (a -> b) -> a -> b
$ case ImportDecl GhcPs
importD of
  ImportDecl XCImportDecl GhcPs
_ SourceText
_ (L SrcSpan
_ ModuleName
modName) Maybe StringLiteral
pkg Bool
src Bool
safe ImportDeclQualifiedStyle
q Bool
False Maybe (GenLocated SrcSpan ModuleName)
mas Maybe (Bool, Located [LIE GhcPs])
mllies -> do
    Int
importCol <- 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 -> Int)
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     Int
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 Int))
-> Config
-> Identity (Last Int)
forall a b c. (a -> b) -> (b -> c) -> a -> c
.> CLayoutConfig Identity -> Identity (Last Int)
forall (f :: * -> *). CLayoutConfig f -> f (Last Int)
_lconfig_importColumn (Config -> Identity (Last Int))
-> (Identity (Last Int) -> Int) -> Config -> Int
forall a b c. (a -> b) -> (b -> c) -> a -> c
.> Identity (Last Int) -> Int
forall a b. Coercible a b => Identity a -> b
confUnpack
    Int
importAsCol <- 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 -> Int)
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     Int
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 Int))
-> Config
-> Identity (Last Int)
forall a b c. (a -> b) -> (b -> c) -> a -> c
.> CLayoutConfig Identity -> Identity (Last Int)
forall (f :: * -> *). CLayoutConfig f -> f (Last Int)
_lconfig_importAsColumn (Config -> Identity (Last Int))
-> (Identity (Last Int) -> Int) -> Config -> Int
forall a b c. (a -> b) -> (b -> c) -> a -> c
.> Identity (Last Int) -> Int
forall a b. Coercible a b => Identity a -> b
confUnpack
    IndentPolicy
indentPolicy <- 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 -> IndentPolicy)
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     IndentPolicy
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 IndentPolicy))
-> Config
-> Identity (Last IndentPolicy)
forall a b c. (a -> b) -> (b -> c) -> a -> c
.> CLayoutConfig Identity -> Identity (Last IndentPolicy)
forall (f :: * -> *). CLayoutConfig f -> f (Last IndentPolicy)
_lconfig_indentPolicy (Config -> Identity (Last IndentPolicy))
-> (Identity (Last IndentPolicy) -> IndentPolicy)
-> Config
-> IndentPolicy
forall a b c. (a -> b) -> (b -> c) -> a -> c
.> Identity (Last IndentPolicy) -> IndentPolicy
forall a b. Coercible a b => Identity a -> b
confUnpack
    let
      compact :: Bool
compact  = IndentPolicy
indentPolicy IndentPolicy -> IndentPolicy -> Bool
forall a. Eq a => a -> a -> Bool
/= IndentPolicy
IndentPolicyFree
      modNameT :: Text
modNameT = String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ModuleName -> String
moduleNameString ModuleName
modName
      pkgNameT :: Maybe Text
pkgNameT = String -> Text
Text.pack (String -> Text)
-> (StringLiteral -> String) -> StringLiteral -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceText -> String
prepPkg (SourceText -> String)
-> (StringLiteral -> SourceText) -> StringLiteral -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringLiteral -> SourceText
sl_st (StringLiteral -> Text) -> Maybe StringLiteral -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe StringLiteral
pkg
      masT :: Maybe Text
masT     = String -> Text
Text.pack (String -> Text)
-> (GenLocated SrcSpan ModuleName -> String)
-> GenLocated SrcSpan ModuleName
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> String
moduleNameString (ModuleName -> String)
-> (GenLocated SrcSpan ModuleName -> ModuleName)
-> GenLocated SrcSpan ModuleName
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpan ModuleName -> ModuleName
forall e. Located e -> e
prepModName (GenLocated SrcSpan ModuleName -> Text)
-> Maybe (GenLocated SrcSpan ModuleName) -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (GenLocated SrcSpan ModuleName)
mas
      hiding :: Bool
hiding   = 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])
mllies
      minQLength :: Int
minQLength = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
"import qualified "
      qLengthReal :: Int
qLengthReal =
#if MIN_VERSION_ghc(8,10,1)   /* ghc-8.10.1 */
        let qualifiedPart :: Int
qualifiedPart = if ImportDeclQualifiedStyle
q ImportDeclQualifiedStyle -> ImportDeclQualifiedStyle -> Bool
forall a. Eq a => a -> a -> Bool
/= ImportDeclQualifiedStyle
NotQualified then String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
"qualified " else Int
0
#else
        let qualifiedPart = if q then length "qualified " else 0
#endif
            safePart :: Int
safePart      = if Bool
safe then String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
"safe " else Int
0
            pkgPart :: Int
pkgPart       = Int -> (Text -> Int) -> Maybe Text -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 ((Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int -> Int) -> (Text -> Int) -> Text -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int
Text.length) Maybe Text
pkgNameT
            srcPart :: Int
srcPart       = if Bool
src then String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
"{-# SOURCE #-} " else Int
0
        in  String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
"import " Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
srcPart Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
safePart Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
qualifiedPart Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
pkgPart
      qLength :: Int
qLength          = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
minQLength Int
qLengthReal
      -- Cost in columns of importColumn
      asCost :: Int
asCost           = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
"as "
      hidingParenCost :: Int
hidingParenCost  = if Bool
hiding then String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
"hiding ( " else String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
"( "
      nameCost :: Int
nameCost         = Text -> Int
Text.length Text
modNameT Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
qLength
      importQualifiers :: MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
importQualifiers = [MultiRWST
   '[Config, Anns]
   '[[BrittanyError], Seq String]
   '[NodeAllocIndex]
   Identity
   BriDocNumbered]
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
docSeq
        [ MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
appSep (MultiRWST
   '[Config, Anns]
   '[[BrittanyError], Seq String]
   '[NodeAllocIndex]
   Identity
   BriDocNumbered
 -> MultiRWST
      '[Config, Anns]
      '[[BrittanyError], Seq String]
      '[NodeAllocIndex]
      Identity
      BriDocNumbered)
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
forall a b. (a -> b) -> a -> b
$ Text
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
docLit (Text
 -> MultiRWST
      '[Config, Anns]
      '[[BrittanyError], Seq String]
      '[NodeAllocIndex]
      Identity
      BriDocNumbered)
-> Text
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
"import"
        , if Bool
src then MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
appSep (MultiRWST
   '[Config, Anns]
   '[[BrittanyError], Seq String]
   '[NodeAllocIndex]
   Identity
   BriDocNumbered
 -> MultiRWST
      '[Config, Anns]
      '[[BrittanyError], Seq String]
      '[NodeAllocIndex]
      Identity
      BriDocNumbered)
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
forall a b. (a -> b) -> a -> b
$ Text
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
docLit (Text
 -> MultiRWST
      '[Config, Anns]
      '[[BrittanyError], Seq String]
      '[NodeAllocIndex]
      Identity
      BriDocNumbered)
-> Text
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
"{-# SOURCE #-}" else MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
docEmpty
        , if Bool
safe then MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
appSep (MultiRWST
   '[Config, Anns]
   '[[BrittanyError], Seq String]
   '[NodeAllocIndex]
   Identity
   BriDocNumbered
 -> MultiRWST
      '[Config, Anns]
      '[[BrittanyError], Seq String]
      '[NodeAllocIndex]
      Identity
      BriDocNumbered)
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
forall a b. (a -> b) -> a -> b
$ Text
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
docLit (Text
 -> MultiRWST
      '[Config, Anns]
      '[[BrittanyError], Seq String]
      '[NodeAllocIndex]
      Identity
      BriDocNumbered)
-> Text
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
"safe" else MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
docEmpty
#if MIN_VERSION_ghc(8,10,1)   /* ghc-8.10.1 */
        , if ImportDeclQualifiedStyle
q ImportDeclQualifiedStyle -> ImportDeclQualifiedStyle -> Bool
forall a. Eq a => a -> a -> Bool
/= ImportDeclQualifiedStyle
NotQualified then MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
appSep (MultiRWST
   '[Config, Anns]
   '[[BrittanyError], Seq String]
   '[NodeAllocIndex]
   Identity
   BriDocNumbered
 -> MultiRWST
      '[Config, Anns]
      '[[BrittanyError], Seq String]
      '[NodeAllocIndex]
      Identity
      BriDocNumbered)
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
forall a b. (a -> b) -> a -> b
$ Text
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
docLit (Text
 -> MultiRWST
      '[Config, Anns]
      '[[BrittanyError], Seq String]
      '[NodeAllocIndex]
      Identity
      BriDocNumbered)
-> Text
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
"qualified" else MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
docEmpty
#else
        , if q then appSep $ docLit $ Text.pack "qualified" else docEmpty
#endif
        , MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
-> (Text
    -> MultiRWST
         '[Config, Anns]
         '[[BrittanyError], Seq String]
         '[NodeAllocIndex]
         Identity
         BriDocNumbered)
-> Maybe Text
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
forall b a. b -> (a -> b) -> Maybe a -> b
maybe MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
docEmpty (MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
appSep (MultiRWST
   '[Config, Anns]
   '[[BrittanyError], Seq String]
   '[NodeAllocIndex]
   Identity
   BriDocNumbered
 -> MultiRWST
      '[Config, Anns]
      '[[BrittanyError], Seq String]
      '[NodeAllocIndex]
      Identity
      BriDocNumbered)
-> (Text
    -> MultiRWST
         '[Config, Anns]
         '[[BrittanyError], Seq String]
         '[NodeAllocIndex]
         Identity
         BriDocNumbered)
-> Text
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
docLit) Maybe Text
pkgNameT
        ]
      indentName :: MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
indentName =
        if Bool
compact then MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
forall a. a -> a
id else BrIndent
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
docEnsureIndent (Int -> BrIndent
BrIndentSpecial Int
qLength)
      modNameD :: MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
modNameD =
        MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
indentName (MultiRWST
   '[Config, Anns]
   '[[BrittanyError], Seq String]
   '[NodeAllocIndex]
   Identity
   BriDocNumbered
 -> MultiRWST
      '[Config, Anns]
      '[[BrittanyError], Seq String]
      '[NodeAllocIndex]
      Identity
      BriDocNumbered)
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
forall a b. (a -> b) -> a -> b
$ MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
appSep (MultiRWST
   '[Config, Anns]
   '[[BrittanyError], Seq String]
   '[NodeAllocIndex]
   Identity
   BriDocNumbered
 -> MultiRWST
      '[Config, Anns]
      '[[BrittanyError], Seq String]
      '[NodeAllocIndex]
      Identity
      BriDocNumbered)
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
forall a b. (a -> b) -> a -> b
$ Text
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
docLit Text
modNameT
      hidDocCol :: Int
hidDocCol = if Bool
hiding then Int
importCol Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
hidingParenCost else Int
importCol Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2
      hidDocColDiff :: Int
hidDocColDiff = Int
importCol Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
hidDocCol
      hidDoc :: MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
hidDoc = if Bool
hiding
        then MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
appSep (MultiRWST
   '[Config, Anns]
   '[[BrittanyError], Seq String]
   '[NodeAllocIndex]
   Identity
   BriDocNumbered
 -> MultiRWST
      '[Config, Anns]
      '[[BrittanyError], Seq String]
      '[NodeAllocIndex]
      Identity
      BriDocNumbered)
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
forall a b. (a -> b) -> a -> b
$ Text
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
docLit (Text
 -> MultiRWST
      '[Config, Anns]
      '[[BrittanyError], Seq String]
      '[NodeAllocIndex]
      Identity
      BriDocNumbered)
-> Text
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
"hiding"
        else MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
docEmpty
      importHead :: MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
importHead = [MultiRWST
   '[Config, Anns]
   '[[BrittanyError], Seq String]
   '[NodeAllocIndex]
   Identity
   BriDocNumbered]
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
docSeq [MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
importQualifiers, MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
modNameD]
      bindingsD :: MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
bindingsD  = case Maybe (Bool, Located [LIE GhcPs])
mllies of
        Maybe (Bool, Located [LIE GhcPs])
Nothing -> MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
docEmpty
        Just (Bool
_, Located [LIE GhcPs]
llies) -> do
          Bool
hasComments <- Located [LIE GhcPs] -> ToBriDocM Bool
forall ast. Data ast => Located ast -> ToBriDocM Bool
hasAnyCommentsBelow Located [LIE GhcPs]
llies
          if Bool
compact
          then [MultiRWST
   '[Config, Anns]
   '[[BrittanyError], Seq String]
   '[NodeAllocIndex]
   Identity
   BriDocNumbered]
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
docAlt
            [ [MultiRWST
   '[Config, Anns]
   '[[BrittanyError], Seq String]
   '[NodeAllocIndex]
   Identity
   BriDocNumbered]
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
docSeq [MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
hidDoc, MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
docForceSingleline (MultiRWST
   '[Config, Anns]
   '[[BrittanyError], Seq String]
   '[NodeAllocIndex]
   Identity
   BriDocNumbered
 -> MultiRWST
      '[Config, Anns]
      '[[BrittanyError], Seq String]
      '[NodeAllocIndex]
      Identity
      BriDocNumbered)
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
forall a b. (a -> b) -> a -> b
$ Bool
-> Located [LIE GhcPs]
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
layoutLLIEs Bool
True Located [LIE GhcPs]
llies]
            , let makeParIfHiding :: MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
makeParIfHiding = if Bool
hiding
                    then BrIndent
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
docAddBaseY BrIndent
BrIndentRegular (MultiRWST
   '[Config, Anns]
   '[[BrittanyError], Seq String]
   '[NodeAllocIndex]
   Identity
   BriDocNumbered
 -> MultiRWST
      '[Config, Anns]
      '[[BrittanyError], Seq String]
      '[NodeAllocIndex]
      Identity
      BriDocNumbered)
-> (MultiRWST
      '[Config, Anns]
      '[[BrittanyError], Seq String]
      '[NodeAllocIndex]
      Identity
      BriDocNumbered
    -> MultiRWST
         '[Config, Anns]
         '[[BrittanyError], Seq String]
         '[NodeAllocIndex]
         Identity
         BriDocNumbered)
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
docPar MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
hidDoc
                    else MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
forall a. a -> a
id
              in MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
makeParIfHiding (Bool
-> Located [LIE GhcPs]
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
layoutLLIEs Bool
True Located [LIE GhcPs]
llies)
            ]
          else do
            [MultiRWST
   '[Config, Anns]
   '[[BrittanyError], Seq String]
   '[NodeAllocIndex]
   Identity
   BriDocNumbered]
ieDs <- Located [LIE GhcPs]
-> ToBriDocM
     [MultiRWST
        '[Config, Anns]
        '[[BrittanyError], Seq String]
        '[NodeAllocIndex]
        Identity
        BriDocNumbered]
layoutAnnAndSepLLIEs Located [LIE GhcPs]
llies
            Located [LIE GhcPs]
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
forall a ast. (DocWrapable a, Data ast) => Located ast -> a -> a
docWrapNodeRest Located [LIE GhcPs]
llies
              (MultiRWST
   '[Config, Anns]
   '[[BrittanyError], Seq String]
   '[NodeAllocIndex]
   Identity
   BriDocNumbered
 -> MultiRWST
      '[Config, Anns]
      '[[BrittanyError], Seq String]
      '[NodeAllocIndex]
      Identity
      BriDocNumbered)
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
forall a b. (a -> b) -> a -> b
$ BrIndent
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
docEnsureIndent (Int -> BrIndent
BrIndentSpecial Int
hidDocCol)
              (MultiRWST
   '[Config, Anns]
   '[[BrittanyError], Seq String]
   '[NodeAllocIndex]
   Identity
   BriDocNumbered
 -> MultiRWST
      '[Config, Anns]
      '[[BrittanyError], Seq String]
      '[NodeAllocIndex]
      Identity
      BriDocNumbered)
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
forall a b. (a -> b) -> a -> b
$ case [MultiRWST
   '[Config, Anns]
   '[[BrittanyError], Seq String]
   '[NodeAllocIndex]
   Identity
   BriDocNumbered]
ieDs of
                -- ..[hiding].( )
                [] -> if Bool
hasComments
                  then MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
docPar
                    ([MultiRWST
   '[Config, Anns]
   '[[BrittanyError], Seq String]
   '[NodeAllocIndex]
   Identity
   BriDocNumbered]
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
docSeq [MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
hidDoc, MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
docParenLSep, Located [LIE GhcPs]
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
forall a ast. (DocWrapable a, Data ast) => Located ast -> a -> a
docWrapNode Located [LIE GhcPs]
llies MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
docEmpty])
                    (BrIndent
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
docEnsureIndent (Int -> BrIndent
BrIndentSpecial Int
hidDocColDiff) MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
docParenR)
                  else [MultiRWST
   '[Config, Anns]
   '[[BrittanyError], Seq String]
   '[NodeAllocIndex]
   Identity
   BriDocNumbered]
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
docSeq [MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
hidDoc, MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
docParenLSep, MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
docSeparator, MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
docParenR]
                -- ..[hiding].( b )
                [MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
ieD] -> CollectAltM ()
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
runFilteredAlternative (CollectAltM ()
 -> MultiRWST
      '[Config, Anns]
      '[[BrittanyError], Seq String]
      '[NodeAllocIndex]
      Identity
      BriDocNumbered)
-> CollectAltM ()
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
forall a b. (a -> b) -> a -> b
$ do
                  Bool
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
-> CollectAltM ()
addAlternativeCond (Bool -> Bool
not Bool
hasComments)
                    (MultiRWST
   '[Config, Anns]
   '[[BrittanyError], Seq String]
   '[NodeAllocIndex]
   Identity
   BriDocNumbered
 -> CollectAltM ())
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
-> CollectAltM ()
forall a b. (a -> b) -> a -> b
$ [MultiRWST
   '[Config, Anns]
   '[[BrittanyError], Seq String]
   '[NodeAllocIndex]
   Identity
   BriDocNumbered]
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
docSeq
                    [ MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
hidDoc
                    , MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
docParenLSep
                    , MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
docForceSingleline MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
ieD
                    , MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
docSeparator
                    , MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
docParenR
                    ]
                  MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
-> CollectAltM ()
addAlternative (MultiRWST
   '[Config, Anns]
   '[[BrittanyError], Seq String]
   '[NodeAllocIndex]
   Identity
   BriDocNumbered
 -> CollectAltM ())
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
-> CollectAltM ()
forall a b. (a -> b) -> a -> b
$ MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
docPar
                    ([MultiRWST
   '[Config, Anns]
   '[[BrittanyError], Seq String]
   '[NodeAllocIndex]
   Identity
   BriDocNumbered]
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
docSeq [MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
hidDoc, MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
docParenLSep, MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
docNonBottomSpacing MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
ieD])
                    (BrIndent
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
docEnsureIndent (Int -> BrIndent
BrIndentSpecial Int
hidDocColDiff) MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
docParenR)
                -- ..[hiding].( b
                --            , b'
                --            )
                (MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
ieD:[MultiRWST
   '[Config, Anns]
   '[[BrittanyError], Seq String]
   '[NodeAllocIndex]
   Identity
   BriDocNumbered]
ieDs') ->
                  MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
docPar
                    ([MultiRWST
   '[Config, Anns]
   '[[BrittanyError], Seq String]
   '[NodeAllocIndex]
   Identity
   BriDocNumbered]
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
docSeq [MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
hidDoc, MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
docSetBaseY (MultiRWST
   '[Config, Anns]
   '[[BrittanyError], Seq String]
   '[NodeAllocIndex]
   Identity
   BriDocNumbered
 -> MultiRWST
      '[Config, Anns]
      '[[BrittanyError], Seq String]
      '[NodeAllocIndex]
      Identity
      BriDocNumbered)
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
forall a b. (a -> b) -> a -> b
$ [MultiRWST
   '[Config, Anns]
   '[[BrittanyError], Seq String]
   '[NodeAllocIndex]
   Identity
   BriDocNumbered]
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
docSeq [MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
docParenLSep, MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
ieD]])
                    (  BrIndent
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
docEnsureIndent (Int -> BrIndent
BrIndentSpecial Int
hidDocColDiff)
                    (MultiRWST
   '[Config, Anns]
   '[[BrittanyError], Seq String]
   '[NodeAllocIndex]
   Identity
   BriDocNumbered
 -> MultiRWST
      '[Config, Anns]
      '[[BrittanyError], Seq String]
      '[NodeAllocIndex]
      Identity
      BriDocNumbered)
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
forall a b. (a -> b) -> a -> b
$  [MultiRWST
   '[Config, Anns]
   '[[BrittanyError], Seq String]
   '[NodeAllocIndex]
   Identity
   BriDocNumbered]
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
docLines
                    ([MultiRWST
    '[Config, Anns]
    '[[BrittanyError], Seq String]
    '[NodeAllocIndex]
    Identity
    BriDocNumbered]
 -> MultiRWST
      '[Config, Anns]
      '[[BrittanyError], Seq String]
      '[NodeAllocIndex]
      Identity
      BriDocNumbered)
-> [MultiRWST
      '[Config, Anns]
      '[[BrittanyError], Seq String]
      '[NodeAllocIndex]
      Identity
      BriDocNumbered]
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
forall a b. (a -> b) -> a -> b
$  [MultiRWST
   '[Config, Anns]
   '[[BrittanyError], Seq String]
   '[NodeAllocIndex]
   Identity
   BriDocNumbered]
ieDs'
                    [MultiRWST
   '[Config, Anns]
   '[[BrittanyError], Seq String]
   '[NodeAllocIndex]
   Identity
   BriDocNumbered]
-> [MultiRWST
      '[Config, Anns]
      '[[BrittanyError], Seq String]
      '[NodeAllocIndex]
      Identity
      BriDocNumbered]
-> [MultiRWST
      '[Config, Anns]
      '[[BrittanyError], Seq String]
      '[NodeAllocIndex]
      Identity
      BriDocNumbered]
forall a. [a] -> [a] -> [a]
++ [MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
docParenR]
                    )
      makeAsDoc :: Text
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
makeAsDoc Text
asT =
        [MultiRWST
   '[Config, Anns]
   '[[BrittanyError], Seq String]
   '[NodeAllocIndex]
   Identity
   BriDocNumbered]
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
docSeq [MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
appSep (MultiRWST
   '[Config, Anns]
   '[[BrittanyError], Seq String]
   '[NodeAllocIndex]
   Identity
   BriDocNumbered
 -> MultiRWST
      '[Config, Anns]
      '[[BrittanyError], Seq String]
      '[NodeAllocIndex]
      Identity
      BriDocNumbered)
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
forall a b. (a -> b) -> a -> b
$ Text
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
docLit (Text
 -> MultiRWST
      '[Config, Anns]
      '[[BrittanyError], Seq String]
      '[NodeAllocIndex]
      Identity
      BriDocNumbered)
-> Text
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
"as", MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
appSep (MultiRWST
   '[Config, Anns]
   '[[BrittanyError], Seq String]
   '[NodeAllocIndex]
   Identity
   BriDocNumbered
 -> MultiRWST
      '[Config, Anns]
      '[[BrittanyError], Seq String]
      '[NodeAllocIndex]
      Identity
      BriDocNumbered)
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
forall a b. (a -> b) -> a -> b
$ Text
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
docLit Text
asT]
    if Bool
compact
    then
      let asDoc :: MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
asDoc = MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
-> (Text
    -> MultiRWST
         '[Config, Anns]
         '[[BrittanyError], Seq String]
         '[NodeAllocIndex]
         Identity
         BriDocNumbered)
-> Maybe Text
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
forall b a. b -> (a -> b) -> Maybe a -> b
maybe MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
docEmpty Text
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
makeAsDoc Maybe Text
masT
      in [MultiRWST
   '[Config, Anns]
   '[[BrittanyError], Seq String]
   '[NodeAllocIndex]
   Identity
   BriDocNumbered]
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
docAlt
        [ MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
docForceSingleline (MultiRWST
   '[Config, Anns]
   '[[BrittanyError], Seq String]
   '[NodeAllocIndex]
   Identity
   BriDocNumbered
 -> MultiRWST
      '[Config, Anns]
      '[[BrittanyError], Seq String]
      '[NodeAllocIndex]
      Identity
      BriDocNumbered)
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
forall a b. (a -> b) -> a -> b
$ [MultiRWST
   '[Config, Anns]
   '[[BrittanyError], Seq String]
   '[NodeAllocIndex]
   Identity
   BriDocNumbered]
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
docSeq [MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
importHead, MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
asDoc, MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
bindingsD]
        , BrIndent
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
docAddBaseY BrIndent
BrIndentRegular (MultiRWST
   '[Config, Anns]
   '[[BrittanyError], Seq String]
   '[NodeAllocIndex]
   Identity
   BriDocNumbered
 -> MultiRWST
      '[Config, Anns]
      '[[BrittanyError], Seq String]
      '[NodeAllocIndex]
      Identity
      BriDocNumbered)
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
forall a b. (a -> b) -> a -> b
$
            MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
docPar ([MultiRWST
   '[Config, Anns]
   '[[BrittanyError], Seq String]
   '[NodeAllocIndex]
   Identity
   BriDocNumbered]
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
docSeq [MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
importHead, MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
asDoc]) MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
bindingsD
        ]
    else
      case Maybe Text
masT of
        Just Text
n -> if Bool
enoughRoom
          then [MultiRWST
   '[Config, Anns]
   '[[BrittanyError], Seq String]
   '[NodeAllocIndex]
   Identity
   BriDocNumbered]
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
docLines
                 [ [MultiRWST
   '[Config, Anns]
   '[[BrittanyError], Seq String]
   '[NodeAllocIndex]
   Identity
   BriDocNumbered]
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
docSeq [MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
importHead, MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
asDoc], MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
bindingsD]
          else [MultiRWST
   '[Config, Anns]
   '[[BrittanyError], Seq String]
   '[NodeAllocIndex]
   Identity
   BriDocNumbered]
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
docLines [MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
importHead, MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
asDoc, MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
bindingsD]
         where
          enoughRoom :: Bool
enoughRoom = Int
nameCost Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
importAsCol Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
asCost
          asDoc :: MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
asDoc =
            BrIndent
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
docEnsureIndent (Int -> BrIndent
BrIndentSpecial (Int
importAsCol Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
asCost))
              (MultiRWST
   '[Config, Anns]
   '[[BrittanyError], Seq String]
   '[NodeAllocIndex]
   Identity
   BriDocNumbered
 -> MultiRWST
      '[Config, Anns]
      '[[BrittanyError], Seq String]
      '[NodeAllocIndex]
      Identity
      BriDocNumbered)
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
forall a b. (a -> b) -> a -> b
$ Text
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
makeAsDoc Text
n
        Maybe Text
Nothing -> if Bool
enoughRoom
          then [MultiRWST
   '[Config, Anns]
   '[[BrittanyError], Seq String]
   '[NodeAllocIndex]
   Identity
   BriDocNumbered]
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
docSeq [MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
importHead, MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
bindingsD]
          else [MultiRWST
   '[Config, Anns]
   '[[BrittanyError], Seq String]
   '[NodeAllocIndex]
   Identity
   BriDocNumbered]
-> MultiRWST
     '[Config, Anns]
     '[[BrittanyError], Seq String]
     '[NodeAllocIndex]
     Identity
     BriDocNumbered
docLines [MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
importHead, MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
bindingsD]
          where enoughRoom :: Bool
enoughRoom = Int
nameCost Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
importCol Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
hidingParenCost
  ImportDecl GhcPs
_ -> MultiRWST
  '[Config, Anns]
  '[[BrittanyError], Seq String]
  '[NodeAllocIndex]
  Identity
  BriDocNumbered
docEmpty