Revert "Format Brittany with Brittany"

This reverts commit 4398b5880d.

brittany.yaml

@@ -1,5 +0,0 @@
-conf_layout:
-  lconfig_cols: 79
-  lconfig_columnAlignMode:
-    tag: ColumnAlignModeDisabled
-  lconfig_indentPolicy: IndentPolicyLeft

source/library/Language/Haskell/Brittany.hs

@@ -16,9 +16,13 @@ module Language.Haskell.Brittany
   , CForwardOptions(..)
   , CPreProcessorConfig(..)
   , BrittanyError(..)
-  ) where
+  )
+where
+
+
+
 
 import           Language.Haskell.Brittany.Internal
-import Language.Haskell.Brittany.Internal.Config
-import Language.Haskell.Brittany.Internal.Config.Types
 import           Language.Haskell.Brittany.Internal.Types
+import           Language.Haskell.Brittany.Internal.Config.Types
+import           Language.Haskell.Brittany.Internal.Config

source/library/Language/Haskell/Brittany/Internal.hs

@@ -12,52 +12,68 @@ module Language.Haskell.Brittany.Internal
   , parseModuleFromString
   , extractCommentConfigs
   , getTopLevelDeclNameMap
-  ) where
+  )
+where
 
-import Control.Monad.Trans.Except
+
+
+import Language.Haskell.Brittany.Internal.Prelude
+import Language.Haskell.Brittany.Internal.PreludeUtils
 import qualified Control.Monad.Trans.MultiRWS.Strict as MultiRWSS
 import qualified Data.ByteString.Char8
-import Data.CZipWith
-import Data.Char (isSpace)
-import Data.HList.HList
 import qualified Data.Map as Map
 import qualified Data.Maybe
 import qualified Data.Semigroup as Semigroup
 import qualified Data.Sequence as Seq
 import qualified Data.Text as Text
 import qualified Data.Text.Lazy as TextL
-import qualified Data.Text.Lazy.Builder as Text.Builder
-import qualified Data.Yaml
-import qualified GHC hiding (parseModule)
-import GHC (GenLocated(L))
-import GHC.Data.Bag
-import qualified GHC.Driver.Session as GHC
-import GHC.Hs
-import qualified GHC.LanguageExtensions.Type as GHC
 import qualified GHC.OldList as List
-import GHC.Parser.Annotation (AnnKeywordId(..))
-import GHC.Types.SrcLoc (SrcSpan)
-import Language.Haskell.Brittany.Internal.Backend
-import Language.Haskell.Brittany.Internal.BackendUtils
-import Language.Haskell.Brittany.Internal.Config
+
+-- brittany { lconfig_importAsColumn: 60, lconfig_importColumn: 60 }
+import qualified Language.Haskell.GHC.ExactPrint         as ExactPrint
+import qualified Language.Haskell.GHC.ExactPrint.Types   as ExactPrint
+import qualified Language.Haskell.GHC.ExactPrint.Parsers as ExactPrint.Parsers
+
+import           Control.Monad.Trans.Except
+import           Data.HList.HList
+import qualified Data.Yaml
+import           Data.CZipWith
+import qualified UI.Butcher.Monadic                      as Butcher
+
+import qualified Data.Text.Lazy.Builder                  as Text.Builder
+
+import           Language.Haskell.Brittany.Internal.Types
 import           Language.Haskell.Brittany.Internal.Config.Types
-import Language.Haskell.Brittany.Internal.ExactPrintUtils
+import           Language.Haskell.Brittany.Internal.Config
 import           Language.Haskell.Brittany.Internal.LayouterBasics
+
 import           Language.Haskell.Brittany.Internal.Layouters.Decl
 import           Language.Haskell.Brittany.Internal.Layouters.Module
-import Language.Haskell.Brittany.Internal.Prelude
-import Language.Haskell.Brittany.Internal.PreludeUtils
-import Language.Haskell.Brittany.Internal.Transformations.Alt
-import Language.Haskell.Brittany.Internal.Transformations.Columns
-import Language.Haskell.Brittany.Internal.Transformations.Floating
-import Language.Haskell.Brittany.Internal.Transformations.Indent
-import Language.Haskell.Brittany.Internal.Transformations.Par
-import Language.Haskell.Brittany.Internal.Types
 import           Language.Haskell.Brittany.Internal.Utils
-import qualified Language.Haskell.GHC.ExactPrint as ExactPrint
-import qualified Language.Haskell.GHC.ExactPrint.Parsers as ExactPrint.Parsers
-import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint
-import qualified UI.Butcher.Monadic as Butcher
+import           Language.Haskell.Brittany.Internal.Backend
+import           Language.Haskell.Brittany.Internal.BackendUtils
+import           Language.Haskell.Brittany.Internal.ExactPrintUtils
+
+import           Language.Haskell.Brittany.Internal.Transformations.Alt
+import           Language.Haskell.Brittany.Internal.Transformations.Floating
+import           Language.Haskell.Brittany.Internal.Transformations.Par
+import           Language.Haskell.Brittany.Internal.Transformations.Columns
+import           Language.Haskell.Brittany.Internal.Transformations.Indent
+
+import qualified GHC
+                                                   hiding ( parseModule )
+import           GHC.Parser.Annotation                            ( AnnKeywordId(..) )
+import           GHC                                      ( GenLocated(L)
+                                                          )
+import           GHC.Types.SrcLoc                                   ( SrcSpan )
+import           GHC.Hs
+import           GHC.Data.Bag
+import qualified GHC.Driver.Session                                as GHC
+import qualified GHC.LanguageExtensions.Type             as GHC
+
+import           Data.Char                                ( isSpace )
+
+
 
 data InlineConfigTarget
     = InlineConfigTargetModule
@@ -86,8 +102,7 @@ extractCommentConfigs anns (TopLevelDeclNameMap declNameMap) = do
         )
       | (k, ann) <- Map.toList anns
       ]
-  let
-    configLiness = commentLiness <&> second
+  let configLiness = commentLiness <&> second
         (Data.Maybe.mapMaybe $ \line -> do
           l1 <-
             List.stripPrefix "-- BRITTANY" line
@@ -123,22 +138,19 @@ extractCommentConfigs anns (TopLevelDeclNameMap declNameMap) = do
       ]
     parser = do -- we will (mis?)use butcher here to parse the inline config
                 -- line.
-      let
-        nextDecl = do
+      let nextDecl = do
             conf <- configParser
             Butcher.addCmdImpl (InlineConfigTargetNextDecl, conf)
       Butcher.addCmd "-next-declaration" nextDecl
       Butcher.addCmd "-Next-Declaration" nextDecl
       Butcher.addCmd "-NEXT-DECLARATION" nextDecl
-      let
-        nextBinding = do
+      let nextBinding = do
             conf <- configParser
             Butcher.addCmdImpl (InlineConfigTargetNextBinding, conf)
       Butcher.addCmd "-next-binding" nextBinding
       Butcher.addCmd "-Next-Binding" nextBinding
       Butcher.addCmd "-NEXT-BINDING" nextBinding
-      let
-        disableNextBinding = do
+      let disableNextBinding = do
             Butcher.addCmdImpl
               ( InlineConfigTargetNextBinding
               , mempty { _conf_roundtrip_exactprint_only = pure $ pure True }
@@ -146,8 +158,7 @@ extractCommentConfigs anns (TopLevelDeclNameMap declNameMap) = do
       Butcher.addCmd "-disable-next-binding" disableNextBinding
       Butcher.addCmd "-Disable-Next-Binding" disableNextBinding
       Butcher.addCmd "-DISABLE-NEXT-BINDING" disableNextBinding
-      let
-        disableNextDecl = do
+      let disableNextDecl = do
             Butcher.addCmdImpl
               ( InlineConfigTargetNextDecl
               , mempty { _conf_roundtrip_exactprint_only = pure $ pure True }
@@ -155,8 +166,7 @@ extractCommentConfigs anns (TopLevelDeclNameMap declNameMap) = do
       Butcher.addCmd "-disable-next-declaration" disableNextDecl
       Butcher.addCmd "-Disable-Next-Declaration" disableNextDecl
       Butcher.addCmd "-DISABLE-NEXT-DECLARATION" disableNextDecl
-      let
-        disableFormatting = do
+      let disableFormatting = do
             Butcher.addCmdImpl
               ( InlineConfigTargetModule
               , mempty { _conf_disable_formatting = pure $ pure True }
@@ -178,8 +188,7 @@ extractCommentConfigs anns (TopLevelDeclNameMap declNameMap) = do
       Right c   -> Right $ c
     pure (k, r)
 
-  let
-    perModule = foldl'
+  let perModule = foldl'
         (<>)
         mempty
         [ conf
@@ -194,8 +203,8 @@ extractCommentConfigs anns (TopLevelDeclNameMap declNameMap) = do
       , (target, conf       ) <- lineConfigs
       , n                     <- case target of
         InlineConfigTargetBinding s -> [s]
-        InlineConfigTargetNextBinding
-          | Just name <- Map.lookup k declNameMap -> [name]
+        InlineConfigTargetNextBinding | Just name <- Map.lookup k declNameMap ->
+          [name]
         _ -> []
       ]
   let
@@ -239,24 +248,20 @@ getTopLevelDeclNameMap (L _ (HsModule _ _name _exports _ decls _ _)) =
 -- won't do.
 parsePrintModule :: Config -> Text -> IO (Either [BrittanyError] Text)
 parsePrintModule configWithDebugs inputText = runExceptT $ do
-  let
-    config =
+  let config =
         configWithDebugs { _conf_debug = _conf_debug staticDefaultConfig }
   let ghcOptions         = config & _conf_forward & _options_ghc & runIdentity
   let config_pp          = config & _conf_preprocessor
   let cppMode            = config_pp & _ppconf_CPPMode & confUnpack
   let hackAroundIncludes = config_pp & _ppconf_hackAroundIncludes & confUnpack
   (anns, parsedSource, hasCPP) <- do
-    let
-      hackF s = if "#include" `isPrefixOf` s
+    let hackF s = if "#include" `isPrefixOf` s
           then "-- BRITANY_INCLUDE_HACK " ++ s
           else s
-    let
-      hackTransform = if hackAroundIncludes
+    let hackTransform = if hackAroundIncludes
           then List.intercalate "\n" . fmap hackF . lines'
           else id
-    let
-      cppCheckFunc dynFlags = if GHC.xopt GHC.Cpp dynFlags
+    let cppCheckFunc dynFlags = if GHC.xopt GHC.Cpp dynFlags
           then case cppMode of
             CPPModeAbort  -> return $ Left "Encountered -XCPP. Aborting."
             CPPModeWarn   -> return $ Right True
@@ -280,8 +285,7 @@ parsePrintModule configWithDebugs inputText = runExceptT $ do
       return inputText
     else do
       (errsWarns, outputTextL) <- do
-        let
-          omitCheck =
+        let omitCheck =
               moduleConfig
                 & _conf_errorHandling
                 & _econf_omit_output_valid_check
@@ -290,26 +294,23 @@ parsePrintModule configWithDebugs inputText = runExceptT $ do
           then return $ pPrintModule moduleConfig perItemConf anns parsedSource
           else lift
             $ pPrintModuleAndCheck moduleConfig perItemConf anns parsedSource
-        let
-          hackF s = fromMaybe s
+        let hackF s = fromMaybe s
               $ TextL.stripPrefix (TextL.pack "-- BRITANY_INCLUDE_HACK ") s
         pure $ if hackAroundIncludes
           then
             ( ews
-            , TextL.intercalate (TextL.pack "\n")
-            $ hackF
-            <$> TextL.splitOn (TextL.pack "\n") outRaw
+            , TextL.intercalate (TextL.pack "\n") $ hackF <$> TextL.splitOn
+              (TextL.pack "\n")
+              outRaw
             )
           else (ews, outRaw)
-      let
-        customErrOrder ErrorInput{} = 4
+      let customErrOrder ErrorInput{}         = 4
           customErrOrder LayoutWarning{}      = 0 :: Int
           customErrOrder ErrorOutputCheck{}   = 1
           customErrOrder ErrorUnusedComment{} = 2
           customErrOrder ErrorUnknownNode{}   = 3
           customErrOrder ErrorMacroConfig{}   = 5
-      let
-        hasErrors =
+      let hasErrors =
             if moduleConfig & _conf_errorHandling & _econf_Werror & confUnpack
             then not $ null errsWarns
             else 0 < maximum (-1 : fmap customErrOrder errsWarns)
@@ -330,8 +331,7 @@ pPrintModule
   -> GHC.ParsedSource
   -> ([BrittanyError], TextL.Text)
 pPrintModule conf inlineConf anns parsedModule =
-  let
-    ((out, errs), debugStrings) =
+  let ((out, errs), debugStrings) =
         runIdentity
           $ MultiRWSS.runMultiRWSTNil
           $ MultiRWSS.withMultiWriterAW
@@ -367,13 +367,11 @@ pPrintModuleAndCheck
 pPrintModuleAndCheck conf inlineConf anns parsedModule = do
   let ghcOptions     = conf & _conf_forward & _options_ghc & runIdentity
   let (errs, output) = pPrintModule conf inlineConf anns parsedModule
-  parseResult <- parseModuleFromString
-    ghcOptions
+  parseResult <- parseModuleFromString ghcOptions
                                        "output"
                                        (\_ -> return $ Right ())
                                        (TextL.unpack output)
-  let
-    errs' = errs ++ case parseResult of
+  let errs' = errs ++ case parseResult of
         Left{}  -> [ErrorOutputCheck]
         Right{} -> []
   return (errs', output)
@@ -386,18 +384,14 @@ parsePrintModuleTests conf filename input = do
   let inputStr = Text.unpack input
   parseResult <- ExactPrint.Parsers.parseModuleFromString filename inputStr
   case parseResult of
-    Left err ->
-      return $ Left $ "parsing error: " ++ show (bagToList (show <$> err))
+    Left  err                  -> return $ Left $ "parsing error: " ++ show (bagToList (show <$> err))
     Right (anns, parsedModule) -> runExceptT $ do
       (inlineConf, perItemConf) <-
-        case
-          extractCommentConfigs anns (getTopLevelDeclNameMap parsedModule)
-        of
+        case extractCommentConfigs anns (getTopLevelDeclNameMap parsedModule) of
           Left  err -> throwE $ "error in inline config: " ++ show err
           Right x   -> pure x
       let moduleConf = cZipWith fromOptionIdentity conf inlineConf
-      let
-        omitCheck =
+      let omitCheck =
             conf
               &  _conf_errorHandling
               .> _econf_omit_output_valid_check
@@ -474,26 +468,23 @@ ppModule lmod@(L _loc _m@(HsModule _ _name _exports _ decls _ _)) = do
     let declBindingNames = getDeclBindingNames decl
     inlineConf <- mAsk
     let mDeclConf = Map.lookup declAnnKey $ _icd_perKey inlineConf
-    let
-      mBindingConfs =
+    let mBindingConfs =
           declBindingNames <&> \n -> Map.lookup n $ _icd_perBinding inlineConf
-    filteredAnns <- mAsk <&> \annMap ->
-      Map.union (Map.findWithDefault Map.empty annKey annMap)
-        $ Map.findWithDefault Map.empty declAnnKey annMap
+    filteredAnns <- mAsk
+      <&> \annMap ->
+        Map.union (Map.findWithDefault Map.empty annKey annMap) $
+        Map.findWithDefault Map.empty declAnnKey annMap
 
-    traceIfDumpConf
-        "bridoc annotations filtered/transformed"
+    traceIfDumpConf "bridoc annotations filtered/transformed"
                     _dconf_dump_annotations
       $ annsDoc filteredAnns
 
     config <- mAsk
 
-    let
-      config' = cZipWith fromOptionIdentity config
+    let config' = cZipWith fromOptionIdentity config
           $ mconcat (catMaybes (mBindingConfs ++ [mDeclConf]))
 
-    let
-      exactprintOnly = config' & _conf_roundtrip_exactprint_only & confUnpack
+    let exactprintOnly = config' & _conf_roundtrip_exactprint_only & confUnpack
     toLocal config' filteredAnns $ do
       bd <- if exactprintOnly
         then briDocMToPPM $ briDocByExactNoComment decl
@@ -506,8 +497,7 @@ ppModule lmod@(L _loc _m@(HsModule _ _name _exports _ decls _ _)) = do
             else briDocMToPPM $ briDocByExactNoComment decl
       layoutBriDoc bd
 
-  let
-    finalComments = filter
+  let finalComments = filter
         (fst .> \case
           ExactPrint.AnnComment{} -> True
           _                       -> False
@@ -518,10 +508,10 @@ ppModule lmod@(L _loc _m@(HsModule _ _name _exports _ decls _ _)) = do
       ppmMoveToExactLoc l
       mTell $ Text.Builder.fromString cmStr
     (ExactPrint.AnnEofPos, (ExactPrint.DP (eofZ, eofX))) ->
-      let
-        folder (acc, _) (kw, ExactPrint.DP (y, x)) = case kw of
-          ExactPrint.AnnComment cm | span <- ExactPrint.commentIdentifier cm ->
-            ( acc + y + GHC.srcSpanEndLine span - GHC.srcSpanStartLine span
+      let folder (acc, _) (kw, ExactPrint.DP (y, x)) = case kw of
+            ExactPrint.AnnComment cm
+              | span <- ExactPrint.commentIdentifier cm
+              -> ( acc + y + GHC.srcSpanEndLine span - GHC.srcSpanStartLine span
                  , x + GHC.srcSpanEndCol span - GHC.srcSpanStartCol span
                  )
             _ -> (acc + y, x)
@@ -550,8 +540,7 @@ ppPreamble lmod@(L loc m@HsModule{}) = do
     -- attached annotations that come after the module's where
     -- from the module node
   config <- mAsk
-  let
-    shouldReformatPreamble =
+  let shouldReformatPreamble =
         config & _conf_layout & _lconfig_reformatModulePreamble & confUnpack
 
   let
@@ -575,9 +564,9 @@ ppPreamble lmod@(L loc m@HsModule{}) = do
             mAnn' = mAnn { ExactPrint.annsDP = pre }
             filteredAnns'' =
               Map.insert (ExactPrint.mkAnnKey lmod) mAnn' filteredAnns
-          in (filteredAnns'', post')
-  traceIfDumpConf
-      "bridoc annotations filtered/transformed"
+          in
+            (filteredAnns'', post')
+  traceIfDumpConf "bridoc annotations filtered/transformed"
                   _dconf_dump_annotations
     $ annsDoc filteredAnns'
 
@@ -623,8 +612,7 @@ layoutBriDoc briDoc = do
     mGet >>= transformSimplifyFloating .> mSet
     mGet
       >>= briDocToDoc
-      .> traceIfDumpConf
-           "bridoc post-floating"
+      .>  traceIfDumpConf "bridoc post-floating"
                           _dconf_dump_bridoc_simpl_floating
     -- bridoc transformation: par removal
     mGet >>= transformSimplifyPar .> mSet
@@ -650,9 +638,7 @@ layoutBriDoc briDoc = do
 
   anns :: ExactPrint.Anns <- mAsk
 
-  let
-    state = LayoutState
-      { _lstate_baseYs = [0]
+  let state = LayoutState { _lstate_baseYs           = [0]
                           , _lstate_curYOrAddNewline = Right 0 -- important that we dont use left
                                              -- here because moveToAnn stuff
                                              -- of the first node needs to do
@@ -667,8 +653,7 @@ layoutBriDoc briDoc = do
 
   state' <- MultiRWSS.withMultiStateS state $ layoutBriDocM briDoc'
 
-  let
-    remainingComments =
+  let remainingComments =
         [ c
         | (ExactPrint.AnnKey _ con, elemAnns) <- Map.toList
           (_lstate_comments state')

source/library/Language/Haskell/Brittany/Internal/Backend.hs

@@ -6,6 +6,10 @@
 
 module Language.Haskell.Brittany.Internal.Backend where
 
+
+
+import Language.Haskell.Brittany.Internal.Prelude
+import Language.Haskell.Brittany.Internal.PreludeUtils
 import qualified Control.Monad.Trans.State.Strict as StateS
 import qualified Data.Either as Either
 import qualified Data.Foldable as Foldable
@@ -17,18 +21,22 @@ import qualified Data.Semigroup as Semigroup
 import qualified Data.Sequence as Seq
 import qualified Data.Set as Set
 import qualified Data.Text as Text
-import qualified Data.Text.Lazy.Builder as Text.Builder
 import qualified GHC.OldList as List
-import Language.Haskell.Brittany.Internal.BackendUtils
-import Language.Haskell.Brittany.Internal.Config.Types
-import Language.Haskell.Brittany.Internal.LayouterBasics
-import Language.Haskell.Brittany.Internal.Prelude
-import Language.Haskell.Brittany.Internal.PreludeUtils
-import Language.Haskell.Brittany.Internal.Types
-import Language.Haskell.Brittany.Internal.Utils
+
 import qualified Language.Haskell.GHC.ExactPrint as ExactPrint
 import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint.Types
 
+import           Language.Haskell.Brittany.Internal.LayouterBasics
+import           Language.Haskell.Brittany.Internal.BackendUtils
+import           Language.Haskell.Brittany.Internal.Utils
+import           Language.Haskell.Brittany.Internal.Config.Types
+import           Language.Haskell.Brittany.Internal.Types
+
+
+import qualified Data.Text.Lazy.Builder as Text.Builder
+
+
+
 type ColIndex  = Int
 
 data ColumnSpacing
@@ -37,12 +45,8 @@ data ColumnSpacing
 
 type ColumnBlock  a = [a]
 type ColumnBlocks a = Seq [a]
-type ColMap1
-  = IntMapL.IntMap {- ColIndex -}
-                   (Bool, ColumnBlocks ColumnSpacing)
-type ColMap2
-  = IntMapL.IntMap {- ColIndex -}
-                   (Float, ColumnBlock Int, ColumnBlocks Int)
+type ColMap1 = IntMapL.IntMap {- ColIndex -} (Bool, ColumnBlocks ColumnSpacing)
+type ColMap2 = IntMapL.IntMap {- ColIndex -} (Float, ColumnBlock Int, ColumnBlocks Int)
                                           -- (ratio of hasSpace, maximum, raw)
 
 data ColInfo
@@ -52,18 +56,15 @@ data ColInfo
 
 instance Show ColInfo where
   show ColInfoStart = "ColInfoStart"
-  show (ColInfoNo bd) =
-    "ColInfoNo " ++ show (take 30 (show (briDocToDoc bd)) ++ "..")
-  show (ColInfo ind sig list) =
-    "ColInfo " ++ show ind ++ " " ++ show sig ++ " " ++ show list
+  show (ColInfoNo bd) = "ColInfoNo " ++ show (take 30 (show (briDocToDoc bd)) ++ "..")
+  show (ColInfo ind sig list) = "ColInfo " ++ show ind ++ " " ++ show sig ++ " " ++ show list
 
 data ColBuildState = ColBuildState
   { _cbs_map :: ColMap1
   , _cbs_index :: ColIndex
   }
 
-type LayoutConstraints m
-  = ( MonadMultiReader Config m
+type LayoutConstraints m = ( MonadMultiReader Config m
                            , MonadMultiReader ExactPrint.Types.Anns m
                            , MonadMultiWriter Text.Builder.Builder m
                            , MonadMultiWriter (Seq String) m
@@ -89,8 +90,7 @@ layoutBriDocM = \case
   BDSeparator -> do
     layoutAddSepSpace
   BDAddBaseY indent bd -> do
-    let
-      indentF = case indent of
+    let indentF = case indent of
           BrIndentNone      -> id
           BrIndentRegular   -> layoutWithAddBaseCol
           BrIndentSpecial i -> layoutWithAddBaseColN i
@@ -108,8 +108,7 @@ layoutBriDocM = \case
     layoutBriDocM bd
     layoutIndentLevelPop
   BDEnsureIndent indent bd -> do
-    let
-      indentF = case indent of
+    let indentF = case indent of
           BrIndentNone      -> id
           BrIndentRegular   -> layoutWithAddBaseCol
           BrIndentSpecial i -> layoutWithAddBaseColN i
@@ -118,8 +117,7 @@ layoutBriDocM = \case
       layoutBriDocM bd
   BDPar indent sameLine indented -> do
     layoutBriDocM sameLine
-    let
-      indentF = case indent of
+    let indentF = case indent of
           BrIndentNone      -> id
           BrIndentRegular   -> layoutWithAddBaseCol
           BrIndentSpecial i -> layoutWithAddBaseColN i
@@ -133,8 +131,7 @@ layoutBriDocM = \case
   BDForceSingleline bd                         -> layoutBriDocM bd
   BDForwardLineMode bd                         -> layoutBriDocM bd
   BDExternal annKey subKeys shouldAddComment t -> do
-    let
-      tlines = Text.lines $ t <> Text.pack "\n"
+    let tlines     = Text.lines $ t <> Text.pack "\n"
         tlineCount = length tlines
     anns :: ExactPrint.Anns <- mAsk
     when shouldAddComment $ do
@@ -157,8 +154,7 @@ layoutBriDocM = \case
   BDAnnotationPrior annKey bd -> do
     state <- mGet
     let m = _lstate_comments state
-    let
-      moveToExactLocationAction = case _lstate_curYOrAddNewline state of
+    let moveToExactLocationAction = case _lstate_curYOrAddNewline state of
           Left{} -> pure ()
           Right{} -> moveToExactAnn annKey
     mAnn <- do
@@ -180,8 +176,7 @@ layoutBriDocM = \case
                     when (comment /= "(" && comment /= ")") $ do
                       let commentLines = Text.lines $ Text.pack $ comment
                       case comment of
-                        ('#' : _) ->
-                          layoutMoveToCommentPos y (-999) (length commentLines)
+                        ('#':_) -> layoutMoveToCommentPos y (-999) (length commentLines)
                                    --  ^ evil hack for CPP
                         _       -> layoutMoveToCommentPos y x (length commentLines)
                       -- fixedX <- fixMoveToLineByIsNewline x
@@ -197,16 +192,14 @@ layoutBriDocM = \case
       state <- mGet
       let m    = _lstate_comments state
       let mAnn = ExactPrint.annsDP <$> Map.lookup annKey m
-      let
-        mToSpan = case mAnn of
+      let mToSpan = case mAnn of
             Just anns | Maybe.isNothing keyword -> Just anns
-          Just ((ExactPrint.Types.G kw1, _) : annR) | keyword == Just kw1 ->
-            Just annR
+            Just ((ExactPrint.Types.G kw1, _):annR) | keyword == Just kw1 -> Just
+              annR
             _ -> Nothing
       case mToSpan of
         Just anns -> do
-          let
-            (comments, rest) = flip spanMaybe anns $ \case
+          let (comments, rest) = flip spanMaybe anns $ \case
                 (ExactPrint.Types.AnnComment x, dp) -> Just (x, dp)
                 _ -> Nothing
           mSet $ state
@@ -220,14 +213,12 @@ layoutBriDocM = \case
     case mComments of
       Nothing -> pure ()
       Just comments -> do
-        comments
-          `forM_` \(ExactPrint.Types.Comment comment _ _, ExactPrint.Types.DP (y, x)) ->
+        comments `forM_` \(ExactPrint.Types.Comment comment _ _, ExactPrint.Types.DP (y, x)) ->
           when (comment /= "(" && comment /= ")") $ do
             let commentLines = Text.lines $ Text.pack $ comment
             -- evil hack for CPP:
             case comment of
-                        ('#' : _) ->
-                          layoutMoveToCommentPos y (-999) (length commentLines)
+              ('#':_) -> layoutMoveToCommentPos y (-999) (length commentLines)
               _       -> layoutMoveToCommentPos y x (length commentLines)
             -- fixedX <- fixMoveToLineByIsNewline x
             -- replicateM_ fixedX layoutWriteNewline
@@ -241,23 +232,18 @@ layoutBriDocM = \case
       let m = _lstate_comments state
       pure $ Map.lookup annKey m
     let mComments = nonEmpty . extractAllComments =<< annMay
-    let
-      semiCount = length
-        [ ()
+    let semiCount = length [ ()
                 | Just ann <- [ annMay ]
                 , (ExactPrint.Types.AnnSemiSep, _) <- ExactPrint.Types.annsDP ann
                 ]
-    shouldAddSemicolonNewlines <-
-      mAsk
-      <&> _conf_layout
-      .> _lconfig_experimentalSemicolonNewlines
-      .> confUnpack
+    shouldAddSemicolonNewlines <- mAsk <&>
+      _conf_layout .> _lconfig_experimentalSemicolonNewlines .> confUnpack
     mModify $ \state -> state
       { _lstate_comments = Map.adjust
-        (\ann -> ann
-          { ExactPrint.annFollowingComments = []
+        ( \ann -> ann { ExactPrint.annFollowingComments = []
                       , ExactPrint.annPriorComments     = []
-          , ExactPrint.annsDP = flip filter (ExactPrint.annsDP ann) $ \case
+                      , ExactPrint.annsDP               =
+                        flip filter (ExactPrint.annsDP ann) $ \case
                           (ExactPrint.Types.AnnComment{}, _) -> False
                           _                                  -> True
                       }
@@ -270,8 +256,7 @@ layoutBriDocM = \case
         when shouldAddSemicolonNewlines $ do
           [1..semiCount] `forM_` const layoutWriteNewline
       Just comments -> do
-        comments
-          `forM_` \(ExactPrint.Types.Comment comment _ _, ExactPrint.Types.DP (y, x)) ->
+        comments `forM_` \(ExactPrint.Types.Comment comment _ _, ExactPrint.Types.DP (y, x)) ->
           when (comment /= "(" && comment /= ")") $ do
             let commentLines = Text.lines $ Text.pack comment
             case comment of
@@ -291,9 +276,7 @@ layoutBriDocM = \case
       state <- mGet
       let m    = _lstate_comments state
       let mAnn = ExactPrint.annsDP <$> Map.lookup annKey m
-      let
-        relevant =
-          [ dp
+      let relevant = [ dp
                      | Just ann <- [mAnn]
                      , (ExactPrint.Types.G kw1, dp) <- ann
                      , keyword == kw1
@@ -501,15 +484,13 @@ alignColsLines bridocs = do -- colInfos `forM_` \colInfo -> do
         where alignMax' = max 0 alignMax
 
       processedMap :: ColMap2
-      processedMap = fix $ \result ->
-        _cbs_map finalState <&> \(lastFlag, colSpacingss) ->
+      processedMap =
+        fix $ \result -> _cbs_map finalState <&> \(lastFlag, colSpacingss) ->
           let
             colss = colSpacingss <&> \spss -> case reverse spss of
               [] -> []
               (xN:xR) ->
-                reverse
-                  $ (if lastFlag then fLast else fInit) xN
-                  : fmap fInit xR
+                reverse $ (if lastFlag then fLast else fInit) xN : fmap fInit xR
              where
               fLast (ColumnSpacingLeaf len ) = len
               fLast (ColumnSpacingRef len _) = len
@@ -526,7 +507,8 @@ alignColsLines bridocs = do -- colInfos `forM_` \colInfo -> do
               else count
             ratio = fromIntegral (foldl counter (0 :: Int) colss)
               / fromIntegral (length colss)
-          in (ratio, maxCols, colss)
+          in
+            (ratio, maxCols, colss)
 
       mergeBriDocs :: [BriDoc] -> StateS.State ColBuildState [ColInfo]
       mergeBriDocs bds = mergeBriDocsW ColInfoStart bds
@@ -563,7 +545,8 @@ alignColsLines bridocs = do -- colInfos `forM_` \colInfo -> do
       -- personal preference to not break alignment for those, even if
       -- multiline. Really, this should be configurable.. (TODO)
       shouldBreakAfter :: BriDoc -> Bool
-      shouldBreakAfter bd = alignBreak && briDocIsMultiLine bd && case bd of
+      shouldBreakAfter bd = alignBreak &&
+        briDocIsMultiLine bd && case bd of
           (BDCols ColTyOpPrefix         _) -> False
           (BDCols ColPatternsFuncPrefix _) -> True
           (BDCols ColPatternsFuncInfix  _) -> True
@@ -595,7 +578,8 @@ alignColsLines bridocs = do -- colInfos `forM_` \colInfo -> do
       mergeInfoBriDoc lastFlag (ColInfo infoInd infoSig subLengthsInfos) =
         \case
           brdc@(BDCols colSig subDocs)
-            | infoSig == colSig && length subLengthsInfos == length subDocs -> do
+            | infoSig == colSig && length subLengthsInfos == length subDocs
+            -> do
               let
                 isLastList = if lastFlag
                   then (==length subDocs) <$> [1 ..]
@@ -615,14 +599,14 @@ alignColsLines bridocs = do -- colInfos `forM_` \colInfo -> do
                     m
                   }
               return $ ColInfo infoInd colSig (zip curLengths infos)
-            | otherwise -> briDocToColInfo lastFlag brdc
+            | otherwise
+            -> briDocToColInfo lastFlag brdc
           brdc -> return $ ColInfoNo brdc
 
 briDocToColInfo :: Bool -> BriDoc -> StateS.State ColBuildState ColInfo
 briDocToColInfo lastFlag = \case
   BDCols sig list -> withAlloc lastFlag $ \ind -> do
-    let
-      isLastList =
+    let isLastList =
           if lastFlag then (==length list) <$> [1 ..] else repeat False
     subInfos <- zip isLastList list `forM` uncurry briDocToColInfo
     let lengthInfos  = zip (briDocLineLength <$> list) subInfos
@@ -657,8 +641,7 @@ processInfo maxSpace m = \case
   ColInfo ind _ list -> -- trace ("processInfo ind=" ++ show ind ++ ", list=" ++ show list ++ ", colmap=" ++ show m) $
                         do
     colMaxConf <- mAsk <&> _conf_layout .> _lconfig_cols .> confUnpack
-    alignMode <-
-      mAsk <&> _conf_layout .> _lconfig_columnAlignMode .> confUnpack
+    alignMode <- mAsk <&> _conf_layout .> _lconfig_columnAlignMode .> confUnpack
     curX      <- do
       state <- mGet
       -- tellDebugMess ("processInfo: " ++ show (_lstate_curYOrAddNewline state) ++ " - " ++ show ((_lstate_addSepSpace state)))
@@ -671,8 +654,7 @@ processInfo maxSpace m = \case
     let colMax = min colMaxConf (curX + maxSpace)
     -- tellDebugMess $ show curX
     let Just (ratio, maxCols1, _colss) = IntMapS.lookup ind m
-    let
-      maxCols2 = list <&> \case
+    let maxCols2 = list <&> \case
           (_, ColInfo i _ _) ->
             let Just (_, ms, _) = IntMapS.lookup i m in sum ms
           (l, _) -> l
@@ -686,8 +668,7 @@ processInfo maxSpace m = \case
     -- sizes in such a way that it works _if_ we have sizes (*factor)
     -- in each column. but in that line, in the last column, we will be
     -- forced to occupy the full vertical space, not reduced by any factor.
-    let
-      fixedPosXs = case alignMode of
+    let fixedPosXs = case alignMode of
           ColumnAlignModeAnimouslyScale i | maxX > colMax -> fixed <&> (+curX)
            where
             factor :: Float =
@@ -698,16 +679,15 @@ processInfo maxSpace m = \case
             offsets = (subtract curX) <$> posXs
             fixed   = offsets <&> fromIntegral .> (*factor) .> truncate
           _ -> posXs
-    let
-      spacings =
-        zipWith (-) (List.tail fixedPosXs ++ [min maxX colMax]) fixedPosXs
+    let spacings = zipWith (-)
+                           (List.tail fixedPosXs ++ [min maxX colMax])
+                           fixedPosXs
     -- tellDebugMess $ "ind = " ++ show ind
     -- tellDebugMess $ "maxCols = " ++ show maxCols
     -- tellDebugMess $ "fixedPosXs = " ++ show fixedPosXs
     -- tellDebugMess $ "list = " ++ show list
     -- tellDebugMess $ "maxSpace = " ++ show maxSpace
-    let
-      alignAct = zip3 fixedPosXs spacings list `forM_` \(destX, s, x) -> do
+    let alignAct = zip3 fixedPosXs spacings list `forM_` \(destX, s, x) -> do
           layoutWriteEnsureAbsoluteN destX
           processInfo s m (snd x)
         noAlignAct = list `forM_` (snd .> processInfoIgnore)

source/library/Language/Haskell/Brittany/Internal/BackendUtils.hs

@@ -3,29 +3,42 @@
 
 module Language.Haskell.Brittany.Internal.BackendUtils where
 
+
+import Language.Haskell.Brittany.Internal.Prelude
+import Language.Haskell.Brittany.Internal.PreludeUtils
 import qualified Data.Data
 import qualified Data.Either
 import qualified Data.Map as Map
 import qualified Data.Maybe
 import qualified Data.Semigroup as Semigroup
 import qualified Data.Text as Text
-import qualified Data.Text.Lazy.Builder as Text.Builder
-import GHC (Located)
 import qualified GHC.OldList as List
-import Language.Haskell.Brittany.Internal.Config.Types
-import Language.Haskell.Brittany.Internal.Prelude
-import Language.Haskell.Brittany.Internal.PreludeUtils
-import Language.Haskell.Brittany.Internal.Types
-import Language.Haskell.Brittany.Internal.Utils
-import Language.Haskell.GHC.ExactPrint.Types (AnnKey, Annotation)
-import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint
 
-traceLocal :: (MonadMultiState LayoutState m) => a -> m ()
+import           Language.Haskell.Brittany.Internal.Types
+import           Language.Haskell.Brittany.Internal.Config.Types
+import           Language.Haskell.GHC.ExactPrint.Types ( AnnKey
+                                                       , Annotation
+                                                       )
+
+import qualified Data.Text.Lazy.Builder as Text.Builder
+import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint
+import           Language.Haskell.Brittany.Internal.Utils
+
+import           GHC ( Located )
+
+
+
+traceLocal
+  :: (MonadMultiState LayoutState m)
+  => a
+  -> m ()
 traceLocal _ = return ()
 
 
 layoutWriteAppend
-  :: (MonadMultiWriter Text.Builder.Builder m, MonadMultiState LayoutState m)
+  :: ( MonadMultiWriter Text.Builder.Builder m
+     , MonadMultiState LayoutState m
+     )
   => Text
   -> m ()
 layoutWriteAppend t = do
@@ -47,7 +60,9 @@ layoutWriteAppend t = do
     }
 
 layoutWriteAppendSpaces
-  :: (MonadMultiWriter Text.Builder.Builder m, MonadMultiState LayoutState m)
+  :: ( MonadMultiWriter Text.Builder.Builder m
+     , MonadMultiState LayoutState m
+     )
   => Int
   -> m ()
 layoutWriteAppendSpaces i = do
@@ -59,7 +74,9 @@ layoutWriteAppendSpaces i = do
       }
 
 layoutWriteAppendMultiline
-  :: (MonadMultiWriter Text.Builder.Builder m, MonadMultiState LayoutState m)
+  :: ( MonadMultiWriter Text.Builder.Builder m
+     , MonadMultiState LayoutState m
+     )
   => [Text]
   -> m ()
 layoutWriteAppendMultiline ts = do
@@ -74,13 +91,14 @@ layoutWriteAppendMultiline ts = do
 
 -- adds a newline and adds spaces to reach the base column.
 layoutWriteNewlineBlock
-  :: (MonadMultiWriter Text.Builder.Builder m, MonadMultiState LayoutState m)
+  :: ( MonadMultiWriter Text.Builder.Builder m
+     , MonadMultiState LayoutState m
+     )
   => m ()
 layoutWriteNewlineBlock = do
   traceLocal ("layoutWriteNewlineBlock")
   state <- mGet
-  mSet $ state
-    { _lstate_curYOrAddNewline = Right 1
+  mSet $ state { _lstate_curYOrAddNewline = Right 1
                , _lstate_addSepSpace      = Just $ lstate_baseY state
                }
 
@@ -98,11 +116,11 @@ layoutWriteNewlineBlock = do
 --         else _lstate_indLevelLinger state + i - _lstate_curY state
 --     }
 
-layoutSetCommentCol :: (MonadMultiState LayoutState m) => m ()
+layoutSetCommentCol
+  :: (MonadMultiState LayoutState m) => m ()
 layoutSetCommentCol = do
   state <- mGet
-  let
-    col = case _lstate_curYOrAddNewline state of
+  let col = case _lstate_curYOrAddNewline state of
         Left i  -> i + fromMaybe 0 (_lstate_addSepSpace state)
         Right{} -> lstate_baseY state
   traceLocal ("layoutSetCommentCol", col)
@@ -112,7 +130,9 @@ layoutSetCommentCol = do
 -- This is also used to move to non-comments in a couple of places. Seems
 -- to be harmless so far..
 layoutMoveToCommentPos
-  :: (MonadMultiWriter Text.Builder.Builder m, MonadMultiState LayoutState m)
+  :: ( MonadMultiWriter Text.Builder.Builder m
+     , MonadMultiState LayoutState m
+     )
   => Int
   -> Int
   -> Int
@@ -130,7 +150,8 @@ layoutMoveToCommentPos y x commentLines = do
           Left{}  -> if y == 0 then x else _lstate_indLevelLinger state + x
           Right{} -> _lstate_indLevelLinger state + x
         else if y == 0 then x else _lstate_indLevelLinger state + x
-    , _lstate_commentCol = Just $ case _lstate_commentCol state of
+    , _lstate_commentCol       =
+      Just $ case _lstate_commentCol state of
         Just existing -> existing
         Nothing -> case _lstate_curYOrAddNewline state of
           Left i  -> i + fromMaybe 0 (_lstate_addSepSpace state)
@@ -141,7 +162,9 @@ layoutMoveToCommentPos y x commentLines = do
 
 -- | does _not_ add spaces to again reach the current base column.
 layoutWriteNewline
-  :: (MonadMultiWriter Text.Builder.Builder m, MonadMultiState LayoutState m)
+  :: ( MonadMultiWriter Text.Builder.Builder m
+     , MonadMultiState LayoutState m
+     )
   => m ()
 layoutWriteNewline = do
   traceLocal ("layoutWriteNewline")
@@ -158,7 +181,9 @@ _layoutResetCommentNewlines = do
   mModify $ \state -> state { _lstate_commentNewlines = 0 }
 
 layoutWriteEnsureNewlineBlock
-  :: (MonadMultiWriter Text.Builder.Builder m, MonadMultiState LayoutState m)
+  :: ( MonadMultiWriter Text.Builder.Builder m
+     , MonadMultiState LayoutState m
+     )
   => m ()
 layoutWriteEnsureNewlineBlock = do
   traceLocal ("layoutWriteEnsureNewlineBlock")
@@ -172,53 +197,61 @@ layoutWriteEnsureNewlineBlock = do
     }
 
 layoutWriteEnsureAbsoluteN
-  :: (MonadMultiWriter Text.Builder.Builder m, MonadMultiState LayoutState m)
+  :: ( MonadMultiWriter Text.Builder.Builder m
+     , MonadMultiState LayoutState m
+     )
   => Int
   -> m ()
 layoutWriteEnsureAbsoluteN n = do
   state <- mGet
-  let
-    diff = case (_lstate_commentCol state, _lstate_curYOrAddNewline state) of
+  let diff = case (_lstate_commentCol state, _lstate_curYOrAddNewline state) of
         (Just c , _      ) -> n - c
         (Nothing, Left i ) -> n - i
         (Nothing, Right{}) -> n
   traceLocal ("layoutWriteEnsureAbsoluteN", n, diff)
   when (diff > 0) $ do
-    mSet $ state { _lstate_addSepSpace = Just diff } -- this always sets to
+    mSet $ state { _lstate_addSepSpace = Just diff -- this always sets to
                                             -- at least (Just 1), so we won't
                                             -- overwrite any old value in any
                                             -- bad way.
+                 }
 
-layoutBaseYPushInternal :: (MonadMultiState LayoutState m) => Int -> m ()
+layoutBaseYPushInternal
+  :: (MonadMultiState LayoutState m)
+  => Int
+  -> m ()
 layoutBaseYPushInternal i = do
   traceLocal ("layoutBaseYPushInternal", i)
   mModify $ \s -> s { _lstate_baseYs = i : _lstate_baseYs s }
 
-layoutBaseYPopInternal :: (MonadMultiState LayoutState m) => m ()
+layoutBaseYPopInternal
+  :: (MonadMultiState LayoutState m) => m ()
 layoutBaseYPopInternal = do
   traceLocal ("layoutBaseYPopInternal")
   mModify $ \s -> s { _lstate_baseYs = List.tail $ _lstate_baseYs s }
 
 layoutIndentLevelPushInternal
-  :: (MonadMultiState LayoutState m) => Int -> m ()
+  :: (MonadMultiState LayoutState m)
+  => Int
+  -> m ()
 layoutIndentLevelPushInternal i = do
   traceLocal ("layoutIndentLevelPushInternal", i)
-  mModify $ \s -> s
-    { _lstate_indLevelLinger = lstate_indLevel s
+  mModify $ \s -> s { _lstate_indLevelLinger = lstate_indLevel s
                     , _lstate_indLevels      = i : _lstate_indLevels s
                     }
 
-layoutIndentLevelPopInternal :: (MonadMultiState LayoutState m) => m ()
+layoutIndentLevelPopInternal
+  :: (MonadMultiState LayoutState m) => m ()
 layoutIndentLevelPopInternal = do
   traceLocal ("layoutIndentLevelPopInternal")
-  mModify $ \s -> s
-    { _lstate_indLevelLinger = lstate_indLevel s
+  mModify $ \s -> s { _lstate_indLevelLinger = lstate_indLevel s
                     , _lstate_indLevels      = List.tail $ _lstate_indLevels s
                     }
 
 layoutRemoveIndentLevelLinger :: ( MonadMultiState LayoutState m) => m ()
 layoutRemoveIndentLevelLinger = do
-  mModify $ \s -> s { _lstate_indLevelLinger = lstate_indLevel s }
+  mModify $ \s -> s { _lstate_indLevelLinger = lstate_indLevel s
+                    }
 
 layoutWithAddBaseCol
   :: ( MonadMultiWriter Text.Builder.Builder m
@@ -250,7 +283,9 @@ layoutWithAddBaseColBlock m = do
   layoutBaseYPopInternal
 
 layoutWithAddBaseColNBlock
-  :: (MonadMultiWriter Text.Builder.Builder m, MonadMultiState LayoutState m)
+  :: ( MonadMultiWriter Text.Builder.Builder m
+     , MonadMultiState LayoutState m
+     )
   => Int
   -> m ()
   -> m ()
@@ -263,7 +298,9 @@ layoutWithAddBaseColNBlock amount m = do
   layoutBaseYPopInternal
 
 layoutWriteEnsureBlock
-  :: (MonadMultiWriter Text.Builder.Builder m, MonadMultiState LayoutState m)
+  :: ( MonadMultiWriter Text.Builder.Builder m
+     , MonadMultiState LayoutState m
+     )
   => m ()
 layoutWriteEnsureBlock = do
   traceLocal ("layoutWriteEnsureBlock")
@@ -279,7 +316,9 @@ layoutWriteEnsureBlock = do
     mSet $ state { _lstate_addSepSpace = Just $ diff }
 
 layoutWithAddBaseColN
-  :: (MonadMultiWriter Text.Builder.Builder m, MonadMultiState LayoutState m)
+  :: ( MonadMultiWriter Text.Builder.Builder m
+     , MonadMultiState LayoutState m
+     )
   => Int
   -> m ()
   -> m ()
@@ -289,7 +328,8 @@ layoutWithAddBaseColN amount m = do
   m
   layoutBaseYPopInternal
 
-layoutBaseYPushCur :: (MonadMultiState LayoutState m) => m ()
+layoutBaseYPushCur
+  :: (MonadMultiState LayoutState m) => m ()
 layoutBaseYPushCur = do
   traceLocal ("layoutBaseYPushCur")
   state <- mGet
@@ -301,24 +341,26 @@ layoutBaseYPushCur = do
         (Right{}, _      ) -> layoutBaseYPushInternal $ lstate_baseY state
     Just cCol -> layoutBaseYPushInternal cCol
 
-layoutBaseYPop :: (MonadMultiState LayoutState m) => m ()
+layoutBaseYPop
+  :: (MonadMultiState LayoutState m) => m ()
 layoutBaseYPop = do
   traceLocal ("layoutBaseYPop")
   layoutBaseYPopInternal
 
-layoutIndentLevelPushCur :: (MonadMultiState LayoutState m) => m ()
+layoutIndentLevelPushCur
+  :: (MonadMultiState LayoutState m) => m ()
 layoutIndentLevelPushCur = do
   traceLocal ("layoutIndentLevelPushCur")
   state <- mGet
-  let
-    y = case (_lstate_curYOrAddNewline state, _lstate_addSepSpace state) of
+  let y = case (_lstate_curYOrAddNewline state, _lstate_addSepSpace state) of
         (Left i , Just j ) -> i + j
         (Left i , Nothing) -> i
         (Right{}, Just j ) -> j
         (Right{}, Nothing) -> 0
   layoutIndentLevelPushInternal y
 
-layoutIndentLevelPop :: (MonadMultiState LayoutState m) => m ()
+layoutIndentLevelPop
+  :: (MonadMultiState LayoutState m) => m ()
 layoutIndentLevelPop = do
   traceLocal ("layoutIndentLevelPop")
   layoutIndentLevelPopInternal
@@ -328,12 +370,12 @@ layoutIndentLevelPop = do
   -- make sense.
   layoutRemoveIndentLevelLinger
 
-layoutAddSepSpace :: (MonadMultiState LayoutState m) => m ()
+layoutAddSepSpace :: (MonadMultiState LayoutState m)
+   => m ()
 layoutAddSepSpace = do
   state <- mGet
   mSet $ state
-    { _lstate_addSepSpace = Just $ fromMaybe 1 $ _lstate_addSepSpace state
-    }
+    { _lstate_addSepSpace = Just $ fromMaybe 1 $ _lstate_addSepSpace state }
 
 -- TODO: when refactoring is complete, the other version of this method
 -- can probably be removed.
@@ -357,16 +399,16 @@ moveToExactAnn annKey = do
 
 moveToY :: MonadMultiState LayoutState m => Int -> m ()
 moveToY y = mModify $ \state ->
-  let
-    upd = case _lstate_curYOrAddNewline state of
+  let upd = case _lstate_curYOrAddNewline state of
         Left  i -> if y == 0 then Left i else Right y
         Right i -> Right $ max y i
-  in
-    state
+  in  state
         { _lstate_curYOrAddNewline = upd
         , _lstate_addSepSpace      = if Data.Either.isRight upd
-        then _lstate_commentCol state <|> _lstate_addSepSpace state <|> Just
-          (lstate_baseY state)
+                                       then
+                                         _lstate_commentCol state
+                                         <|> _lstate_addSepSpace state
+                                         <|> Just (lstate_baseY state)
                                        else Nothing
         , _lstate_commentCol       = Nothing
         }
@@ -379,7 +421,9 @@ moveToY y = mModify $ \state ->
 --     else x
 
 ppmMoveToExactLoc
-  :: MonadMultiWriter Text.Builder.Builder m => ExactPrint.DeltaPos -> m ()
+  :: MonadMultiWriter Text.Builder.Builder m
+  => ExactPrint.DeltaPos
+  -> m ()
 ppmMoveToExactLoc (ExactPrint.DP (x, y)) = do
   replicateM_ x $ mTell $ Text.Builder.fromString "\n"
   replicateM_ y $ mTell $ Text.Builder.fromString " "
@@ -399,18 +443,17 @@ layoutWritePriorComments ast = do
     let anns = _lstate_comments state
     let mAnn = ExactPrint.annPriorComments <$> Map.lookup key anns
     mSet $ state
-      { _lstate_comments = Map.adjust
-        (\ann -> ann { ExactPrint.annPriorComments = [] })
-        key
-        anns
+      { _lstate_comments =
+          Map.adjust (\ann -> ann { ExactPrint.annPriorComments = [] }) key anns
       }
     return mAnn
   case mAnn of
     Nothing -> return ()
     Just priors -> do
       unless (null priors) $ layoutSetCommentCol
-      priors
-        `forM_` \(ExactPrint.Comment comment _ _, ExactPrint.DP (x, y)) -> do
+      priors `forM_` \( ExactPrint.Comment comment _ _
+                      , ExactPrint.DP (x, y)
+                      ) -> do
         replicateM_ x layoutWriteNewline
         layoutWriteAppendSpaces y
         layoutWriteAppendMultiline $ Text.lines $ Text.pack comment
@@ -419,13 +462,10 @@ layoutWritePriorComments ast = do
 -- this currently only extracs from the `annsDP` field of Annotations.
 -- per documentation, this seems sufficient, as the
 -- "..`annFollowingComments` are only added by AST transformations ..".
-layoutWritePostComments
-  :: ( Data.Data.Data ast
-     , MonadMultiWriter Text.Builder.Builder m
-     , MonadMultiState LayoutState m
-     )
-  => Located ast
-  -> m ()
+layoutWritePostComments :: (Data.Data.Data ast,
+                                               MonadMultiWriter Text.Builder.Builder m,
+                                               MonadMultiState LayoutState m)
+                         => Located ast -> m ()
 layoutWritePostComments ast = do
   mAnn <- do
     state <- mGet
@@ -433,8 +473,8 @@ layoutWritePostComments ast = do
     let anns = _lstate_comments state
     let mAnn = ExactPrint.annFollowingComments <$> Map.lookup key anns
     mSet $ state
-      { _lstate_comments = Map.adjust
-        (\ann -> ann { ExactPrint.annFollowingComments = [] })
+      { _lstate_comments =
+          Map.adjust (\ann -> ann { ExactPrint.annFollowingComments = [] })
                      key
                      anns
       }
@@ -443,28 +483,30 @@ layoutWritePostComments ast = do
     Nothing -> return ()
     Just posts -> do
       unless (null posts) $ layoutSetCommentCol
-      posts `forM_` \(ExactPrint.Comment comment _ _, ExactPrint.DP (x, y)) ->
-        do
+      posts `forM_` \( ExactPrint.Comment comment _ _
+                      , ExactPrint.DP (x, y)
+                      ) -> do
         replicateM_ x layoutWriteNewline
         layoutWriteAppend $ Text.pack $ replicate y ' '
         mModify $ \s -> s { _lstate_addSepSpace = Nothing }
         layoutWriteAppendMultiline $ Text.lines $ Text.pack $ comment
 
 layoutIndentRestorePostComment
-  :: (MonadMultiState LayoutState m, MonadMultiWriter Text.Builder.Builder m)
+  :: ( MonadMultiState LayoutState m
+     , MonadMultiWriter Text.Builder.Builder m
+     )
   => m ()
 layoutIndentRestorePostComment = do
   state <- mGet
   let mCommentCol = _lstate_commentCol state
   let eCurYAddNL  = _lstate_curYOrAddNewline state
-  mModify
-    $ \s -> s { _lstate_commentCol = Nothing, _lstate_commentNewlines = 0 }
+  mModify $ \s -> s { _lstate_commentCol = Nothing
+                    , _lstate_commentNewlines = 0
+                    }
   case (mCommentCol, eCurYAddNL) of
     (Just commentCol, Left{}) -> do
       layoutWriteEnsureNewlineBlock
-      layoutWriteEnsureAbsoluteN $ commentCol + fromMaybe
-        0
-        (_lstate_addSepSpace state)
+      layoutWriteEnsureAbsoluteN $ commentCol + fromMaybe 0 (_lstate_addSepSpace state)
     _                              -> return ()
 
 -- layoutWritePriorCommentsRestore :: (Data.Data.Data ast,

source/library/Language/Haskell/Brittany/Internal/Config.hs

@@ -3,27 +3,38 @@
 
 module Language.Haskell.Brittany.Internal.Config where
 
+
+
+import Language.Haskell.Brittany.Internal.Prelude
+import Language.Haskell.Brittany.Internal.PreludeUtils
 import qualified Data.Bool as Bool
 import qualified Data.ByteString as ByteString
 import qualified Data.ByteString.Char8
-import Data.CZipWith
-import Data.Coerce (coerce)
-import qualified Data.List.NonEmpty as NonEmpty
 import qualified Data.Semigroup as Semigroup
-import qualified Data.Yaml
 import qualified GHC.OldList as List
-import Language.Haskell.Brittany.Internal.Config.Types
-import Language.Haskell.Brittany.Internal.Config.Types.Instances ()
-import Language.Haskell.Brittany.Internal.Prelude
-import Language.Haskell.Brittany.Internal.PreludeUtils
-import Language.Haskell.Brittany.Internal.Utils
-import qualified System.Console.CmdArgs.Explicit as CmdArgs
 import qualified System.Directory
-import qualified System.Directory as Directory
-import qualified System.FilePath.Posix as FilePath
 import qualified System.IO
+
+import qualified Data.Yaml
+import           Data.CZipWith
+
 import           UI.Butcher.Monadic
 
+import qualified System.Console.CmdArgs.Explicit
+                                               as CmdArgs
+
+import           Language.Haskell.Brittany.Internal.Config.Types
+import           Language.Haskell.Brittany.Internal.Config.Types.Instances ()
+import           Language.Haskell.Brittany.Internal.Utils
+
+import           Data.Coerce                    ( coerce
+                                                )
+import qualified Data.List.NonEmpty            as NonEmpty
+
+import qualified System.Directory              as Directory
+import qualified System.FilePath.Posix         as FilePath
+
+-- brittany-next-binding { lconfig_indentPolicy: IndentPolicyLeft }
 staticDefaultConfig :: Config
 staticDefaultConfig = Config
   { _conf_version                   = coerce (1 :: Int)
@@ -94,7 +105,7 @@ forwardOptionsSyntaxExtsEnabled = ForwardOptions
                      ]
   }
 
--- brittany-next-binding --columns 200
+-- brittany-next-binding { lconfig_indentPolicy: IndentPolicyLeft, lconfig_cols: 200 }
 cmdlineConfigParser :: CmdParser Identity out (CConfig Maybe)
 cmdlineConfigParser = do
   -- TODO: why does the default not trigger; ind never should be []!!
@@ -234,8 +245,7 @@ userConfigPath = do
   userBritPathSimple <- Directory.getAppUserDataDirectory "brittany"
   userBritPathXdg    <- Directory.getXdgDirectory Directory.XdgConfig "brittany"
   let searchDirs = [userBritPathSimple, userBritPathXdg]
-  globalConfig <- Directory.findFileWith
-    Directory.doesFileExist
+  globalConfig <- Directory.findFileWith Directory.doesFileExist
                                          searchDirs
                                          "config.yaml"
   maybe (writeUserConfig userBritPathXdg) pure globalConfig
@@ -261,9 +271,8 @@ readConfigs
   -> MaybeT IO Config
 readConfigs cmdlineConfig configPaths = do
   configs <- readConfig `mapM` configPaths
-  let
-    merged =
-      Semigroup.sconcat $ NonEmpty.reverse (cmdlineConfig :| catMaybes configs)
+  let merged = Semigroup.sconcat
+        $ NonEmpty.reverse (cmdlineConfig :| catMaybes configs)
   return $ cZipWith fromOptionIdentity staticDefaultConfig merged
 
 -- | Reads provided configs

source/library/Language/Haskell/Brittany/Internal/Config/Types.hs

@@ -7,15 +7,24 @@
 
 module Language.Haskell.Brittany.Internal.Config.Types where
 
-import Data.CZipWith
-import Data.Coerce (Coercible, coerce)
-import Data.Data (Data)
-import qualified Data.Semigroup as Semigroup
-import Data.Semigroup (Last)
-import Data.Semigroup.Generic
-import GHC.Generics
+
+
 import Language.Haskell.Brittany.Internal.Prelude
 import Language.Haskell.Brittany.Internal.PreludeUtils ()
+import qualified Data.Semigroup as Semigroup
+
+import GHC.Generics
+
+import Data.Data ( Data )
+
+import Data.Coerce ( Coercible, coerce )
+
+import Data.Semigroup.Generic
+import Data.Semigroup ( Last )
+
+import Data.CZipWith
+
+
 
 confUnpack :: Coercible a b => Identity a -> b
 confUnpack (Identity x) = coerce x
@@ -34,7 +43,7 @@ data CDebugConfig f = DebugConfig
   , _dconf_dump_bridoc_final          :: f (Semigroup.Last Bool)
   , _dconf_roundtrip_exactprint_only  :: f (Semigroup.Last Bool)
   }
-  deriving Generic
+  deriving (Generic)
 
 data CLayoutConfig f = LayoutConfig
   { _lconfig_cols         :: f (Last Int) -- the thing that has default 80.
@@ -139,12 +148,12 @@ data CLayoutConfig f = LayoutConfig
   --   -- >   , y :: Double
   --   -- >   }
   }
-  deriving Generic
+  deriving (Generic)
 
 data CForwardOptions f = ForwardOptions
   { _options_ghc :: f [String]
   }
-  deriving Generic
+  deriving (Generic)
 
 data CErrorHandlingConfig f = ErrorHandlingConfig
   { _econf_produceOutputOnErrors   :: f (Semigroup.Last Bool)
@@ -159,13 +168,13 @@ data CErrorHandlingConfig f = ErrorHandlingConfig
     -- has different semantics than the code pre-transformation.
   , _econf_omit_output_valid_check :: f (Semigroup.Last Bool)
   }
-  deriving Generic
+  deriving (Generic)
 
 data CPreProcessorConfig f = PreProcessorConfig
   { _ppconf_CPPMode :: f (Semigroup.Last CPPMode)
   , _ppconf_hackAroundIncludes :: f (Semigroup.Last Bool)
   }
-  deriving Generic
+  deriving (Generic)
 
 data CConfig f = Config
   { _conf_version       :: f (Semigroup.Last Int)
@@ -185,8 +194,9 @@ data CConfig f = Config
     -- (`find -name "*.hs" | xargs brittany --write-mode inplace` or something
     -- in that direction).
   , _conf_obfuscate     :: f (Semigroup.Last Bool)
+
   }
-  deriving Generic
+  deriving (Generic)
 
 type DebugConfig = CDebugConfig Identity
 type LayoutConfig = CLayoutConfig Identity

source/library/Language/Haskell/Brittany/Internal/Config/Types/Instances.hs

@@ -18,11 +18,17 @@
 
 module Language.Haskell.Brittany.Internal.Config.Types.Instances where
 
+
+
+import Language.Haskell.Brittany.Internal.Prelude
+
+import Data.Yaml
 import qualified Data.Aeson.Key as Key
 import qualified Data.Aeson.Types as Aeson
-import Data.Yaml
+
 import Language.Haskell.Brittany.Internal.Config.Types
-import Language.Haskell.Brittany.Internal.Prelude
+
+
 
 aesonDecodeOptionsBrittany :: Aeson.Options
 aesonDecodeOptionsBrittany = Aeson.defaultOptions
@@ -102,17 +108,16 @@ instance ToJSON (CConfig Maybe) where
 -- leafs, but for nodes of the config as well. This way e.g. "{}" is valid
 -- config file content.
 instance FromJSON (CConfig Maybe) where
-  parseJSON (Object v) =
-    Config
-      <$> (v .:? Key.fromString "conf_version")
-      <*> (v .:?= Key.fromString "conf_debug")
-      <*> (v .:?= Key.fromString "conf_layout")
-      <*> (v .:?= Key.fromString "conf_errorHandling")
-      <*> (v .:?= Key.fromString "conf_forward")
-      <*> (v .:?= Key.fromString "conf_preprocessor")
-      <*> (v .:? Key.fromString "conf_roundtrip_exactprint_only")
-      <*> (v .:? Key.fromString "conf_disable_formatting")
-      <*> (v .:? Key.fromString "conf_obfuscate")
+  parseJSON (Object v) = Config
+    <$> v .:?  Key.fromString "conf_version"
+    <*> v .:?= Key.fromString "conf_debug"
+    <*> v .:?= Key.fromString "conf_layout"
+    <*> v .:?= Key.fromString "conf_errorHandling"
+    <*> v .:?= Key.fromString "conf_forward"
+    <*> v .:?= Key.fromString "conf_preprocessor"
+    <*> v .:?  Key.fromString "conf_roundtrip_exactprint_only"
+    <*> v .:?  Key.fromString "conf_disable_formatting"
+    <*> v .:?  Key.fromString "conf_obfuscate"
   parseJSON invalid    = Aeson.typeMismatch "Config" invalid
 
 -- Pretends that the value is {} when the key is not present.

source/library/Language/Haskell/Brittany/Internal/ExactPrintUtils.hs

@@ -7,35 +7,48 @@
 
 module Language.Haskell.Brittany.Internal.ExactPrintUtils where
 
-import Control.Exception
+
+
+import Language.Haskell.Brittany.Internal.Prelude
+import Language.Haskell.Brittany.Internal.PreludeUtils
 import qualified Control.Monad.State.Class as State.Class
 import qualified Control.Monad.Trans.Except as ExceptT
 import qualified Control.Monad.Trans.MultiRWS.Strict as MultiRWSS
-import Data.Data
 import qualified Data.Foldable as Foldable
-import qualified Data.Generics as SYB
-import Data.HList.HList
 import qualified Data.Map as Map
 import qualified Data.Maybe
 import qualified Data.Sequence as Seq
 import qualified Data.Set as Set
-import GHC (GenLocated(L))
-import qualified GHC hiding (parseModule)
-import GHC.Data.Bag
-import qualified GHC.Driver.CmdLine as GHC
-import qualified GHC.Driver.Session as GHC
-import GHC.Hs
-import qualified GHC.Types.SrcLoc as GHC
-import GHC.Types.SrcLoc (Located, SrcSpan)
-import Language.Haskell.Brittany.Internal.Config.Types
-import Language.Haskell.Brittany.Internal.Prelude
-import Language.Haskell.Brittany.Internal.PreludeUtils
-import qualified Language.Haskell.GHC.ExactPrint as ExactPrint
-import qualified Language.Haskell.GHC.ExactPrint.Delta as ExactPrint
-import qualified Language.Haskell.GHC.ExactPrint.Parsers as ExactPrint
-import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint
 import qualified System.IO
 
+import           Language.Haskell.Brittany.Internal.Config.Types
+import           Data.Data
+import           Data.HList.HList
+
+import           GHC ( GenLocated(L) )
+import qualified GHC.Driver.Session      as GHC
+import qualified GHC hiding (parseModule)
+import qualified GHC.Types.SrcLoc        as GHC
+import qualified GHC.Driver.CmdLine as GHC
+
+import           GHC.Hs
+import           GHC.Data.Bag
+
+import           GHC.Types.SrcLoc ( SrcSpan, Located )
+
+
+import qualified Language.Haskell.GHC.ExactPrint            as ExactPrint
+import qualified Language.Haskell.GHC.ExactPrint.Types      as ExactPrint
+import qualified Language.Haskell.GHC.ExactPrint.Parsers    as ExactPrint
+import qualified Language.Haskell.GHC.ExactPrint.Delta      as ExactPrint
+
+import qualified Data.Generics as SYB
+
+import           Control.Exception
+-- import           Data.Generics.Schemes
+
+
+
 parseModule
   :: [String]
   -> System.IO.FilePath
@@ -75,10 +88,7 @@ parseModuleWithCpp cpp opts args fp dynCheck =
       ++ show (warnings <&> warnExtractorCompat)
     x   <- ExceptT.ExceptT $ liftIO $ dynCheck dflags2
     res <- lift $ ExactPrint.parseModuleApiAnnsWithCppInternal cpp dflags2 fp
-    either
-        (\err -> ExceptT.throwE $ "transform error: " ++ show
-          (bagToList (show <$> err))
-        )
+    either (\err -> ExceptT.throwE $ "transform error: " ++ show (bagToList (show <$> err)))
            (\(a, m) -> pure (a, m, x))
       $ ExactPrint.postParseTransform res opts
 
@@ -111,23 +121,19 @@ parseModuleFromString args fp dynCheck str =
     dynCheckRes <- ExceptT.ExceptT $ liftIO $ dynCheck dflags1
     let res = ExactPrint.parseModuleFromStringInternal dflags1 fp str
     case res of
-      Left err ->
-        ExceptT.throwE $ "parse error: " ++ show (bagToList (show <$> err))
+      Left  err -> ExceptT.throwE $ "parse error: " ++ show (bagToList (show <$> err))
       Right (a   , m  ) -> pure (a, m, dynCheckRes)
 
 
 commentAnnFixTransformGlob :: SYB.Data ast => ast -> ExactPrint.Transform ()
 commentAnnFixTransformGlob ast = do
-  let
-    extract :: forall a . SYB.Data a => a -> Seq (SrcSpan, ExactPrint.AnnKey)
+  let extract :: forall a . SYB.Data a => a -> Seq (SrcSpan, ExactPrint.AnnKey)
       extract = -- traceFunctionWith "extract" (show . SYB.typeOf) show $
         const Seq.empty
-        `SYB.ext1Q` (\l@(L span _) ->
-                      Seq.singleton (span, ExactPrint.mkAnnKey l)
-                    )
+          `SYB.ext1Q`
+            (\l@(L span _) -> Seq.singleton (span, ExactPrint.mkAnnKey l))
   let nodes = SYB.everything (<>) extract ast
-  let
-    annsMap :: Map GHC.RealSrcLoc ExactPrint.AnnKey
+  let annsMap :: Map GHC.RealSrcLoc ExactPrint.AnnKey
       annsMap = Map.fromListWith
         (const id)
         [ (GHC.realSrcSpanEnd span, annKey)
@@ -138,8 +144,7 @@ commentAnnFixTransformGlob ast = do
   processComs annsMap annKey1 = do
     mAnn <- State.Class.gets fst <&> Map.lookup annKey1
     mAnn `forM_` \ann1 -> do
-      let
-        priors = ExactPrint.annPriorComments ann1
+      let priors  = ExactPrint.annPriorComments ann1
           follows = ExactPrint.annFollowingComments ann1
           assocs  = ExactPrint.annsDP ann1
       let
@@ -166,16 +171,15 @@ commentAnnFixTransformGlob ast = do
                       { ExactPrint.annFollowingComments =
                           ExactPrint.annFollowingComments ann2 ++ [comPair]
                       }
-                  in Map.insert annKey2 ann2' anns
+                  in
+                    Map.insert annKey2 ann2' anns
               _ -> return True -- retain comment at current node.
       priors'  <- filterM processCom priors
       follows' <- filterM processCom follows
       assocs'  <- flip filterM assocs $ \case
         (ExactPrint.AnnComment com, dp) -> processCom (com, dp)
         _                               -> return True
-      let
-        ann1' = ann1
-          { ExactPrint.annPriorComments = priors'
+      let ann1' = ann1 { ExactPrint.annPriorComments     = priors'
                        , ExactPrint.annFollowingComments = follows'
                        , ExactPrint.annsDP               = assocs'
                        }
@@ -270,8 +274,7 @@ extractToplevelAnns lmod anns = output
   output  = groupMap (\k _ -> Map.findWithDefault modKey k declMap) anns
 
 groupMap :: (Ord k, Ord l) => (k -> a -> l) -> Map k a -> Map l (Map k a)
-groupMap f = Map.foldlWithKey'
-  (\m k a -> Map.alter (insert k a) (f k a) m)
+groupMap f = Map.foldlWithKey' (\m k a -> Map.alter (insert k a) (f k a) m)
                                Map.empty
  where
   insert k a Nothing  = Just (Map.singleton k a)
@@ -286,10 +289,10 @@ foldedAnnKeys ast = SYB.everything
     [ SYB.gmapQi 1 (ExactPrint.mkAnnKey . L l) x
     | locTyCon == SYB.typeRepTyCon (SYB.typeOf x)
     , l :: SrcSpan <- SYB.gmapQi 0 SYB.cast x
-    ]
       -- for some reason, ghc-8.8 has forgotten how to infer the type of l,
       -- even though it is passed to mkAnnKey above, which only accepts
       -- SrcSpan.
+    ]
   )
   ast
   where locTyCon = SYB.typeRepTyCon (SYB.typeOf (L () ()))
@@ -309,8 +312,7 @@ withTransformedAnns ast m = MultiRWSS.mGetRawR >>= \case
     pure x
  where
   f anns =
-    let
-      ((), (annsBalanced, _), _) =
+    let ((), (annsBalanced, _), _) =
           ExactPrint.runTransform anns (commentAnnFixTransformGlob ast)
     in  annsBalanced
 

source/library/Language/Haskell/Brittany/Internal/LayouterBasics.hs

@@ -6,37 +6,50 @@
 
 module Language.Haskell.Brittany.Internal.LayouterBasics where
 
+
+
+import Language.Haskell.Brittany.Internal.Prelude
+import Language.Haskell.Brittany.Internal.PreludeUtils
 import qualified Control.Monad.Trans.MultiRWS.Strict as MultiRWSS
-import qualified Control.Monad.Writer.Strict as Writer
-import qualified Data.Char as Char
-import Data.Data
 import qualified Data.Map as Map
 import qualified Data.Semigroup as Semigroup
 import qualified Data.Sequence as Seq
 import qualified Data.Set as Set
 import qualified Data.Text as Text
-import qualified Data.Text.Lazy.Builder as Text.Builder
-import DataTreePrint
-import GHC (GenLocated(L), Located, moduleName, moduleNameString)
 import qualified GHC.OldList as List
-import GHC.Parser.Annotation (AnnKeywordId(..))
-import GHC.Types.Name (getOccString)
-import GHC.Types.Name.Occurrence (occNameString)
-import GHC.Types.Name.Reader (RdrName(..))
-import qualified GHC.Types.SrcLoc as GHC
-import Language.Haskell.Brittany.Internal.Config.Types
-import Language.Haskell.Brittany.Internal.ExactPrintUtils
-import Language.Haskell.Brittany.Internal.Prelude
-import Language.Haskell.Brittany.Internal.PreludeUtils
-import Language.Haskell.Brittany.Internal.Types
-import Language.Haskell.Brittany.Internal.Utils
+
+import qualified Control.Monad.Writer.Strict as Writer
+
 import qualified Language.Haskell.GHC.ExactPrint as ExactPrint
 import qualified Language.Haskell.GHC.ExactPrint.Annotate as ExactPrint.Annotate
 import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint.Types
 import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint
-import Language.Haskell.GHC.ExactPrint.Types (AnnKey, Annotation)
 import qualified Language.Haskell.GHC.ExactPrint.Utils as ExactPrint.Utils
 
+import Language.Haskell.GHC.ExactPrint.Types ( AnnKey, Annotation )
+
+import qualified Data.Text.Lazy.Builder as Text.Builder
+
+import Language.Haskell.Brittany.Internal.Config.Types
+import Language.Haskell.Brittany.Internal.Types
+import Language.Haskell.Brittany.Internal.Utils
+import Language.Haskell.Brittany.Internal.ExactPrintUtils
+
+import           GHC.Types.Name.Reader ( RdrName(..) )
+import           GHC ( Located, GenLocated(L), moduleName, moduleNameString )
+import qualified GHC.Types.SrcLoc        as GHC
+import           GHC.Types.Name.Occurrence ( occNameString )
+import           GHC.Types.Name ( getOccString )
+import           GHC.Parser.Annotation ( AnnKeywordId(..) )
+
+import           Data.Data
+
+import qualified Data.Char as Char
+
+import           DataTreePrint
+
+
+
 processDefault
   :: ( ExactPrint.Annotate.Annotate ast
      , MonadMultiWriter Text.Builder.Builder m
@@ -66,8 +79,7 @@ briDocByExact
   -> ToBriDocM BriDocNumbered
 briDocByExact ast = do
   anns <- mAsk
-  traceIfDumpConf
-    "ast"
+  traceIfDumpConf "ast"
                   _dconf_dump_ast_unknown
                   (printTreeWithCustom 100 (customLayouterF anns) ast)
   docExt ast anns True
@@ -83,8 +95,7 @@ briDocByExactNoComment
   -> ToBriDocM BriDocNumbered
 briDocByExactNoComment ast = do
   anns <- mAsk
-  traceIfDumpConf
-    "ast"
+  traceIfDumpConf "ast"
                   _dconf_dump_ast_unknown
                   (printTreeWithCustom 100 (customLayouterF anns) ast)
   docExt ast anns False
@@ -99,23 +110,21 @@ briDocByExactInlineOnly
   -> ToBriDocM BriDocNumbered
 briDocByExactInlineOnly infoStr ast = do
   anns <- mAsk
-  traceIfDumpConf
-    "ast"
+  traceIfDumpConf "ast"
                   _dconf_dump_ast_unknown
                   (printTreeWithCustom 100 (customLayouterF anns) ast)
   let exactPrinted = Text.pack $ ExactPrint.exactPrint ast anns
   fallbackMode <-
     mAsk <&> _conf_errorHandling .> _econf_ExactPrintFallback .> confUnpack
-  let
-    exactPrintNode t = allocateNode $ BDFExternal
+  let exactPrintNode t = allocateNode $ BDFExternal
         (ExactPrint.Types.mkAnnKey ast)
         (foldedAnnKeys ast)
         False
         t
-  let
-    errorAction = do
+  let errorAction = do
         mTell [ErrorUnknownNode infoStr ast]
-      docLit $ Text.pack "{- BRITTANY ERROR UNHANDLED SYNTACTICAL CONSTRUCT -}"
+        docLit
+          $ Text.pack "{- BRITTANY ERROR UNHANDLED SYNTACTICAL CONSTRUCT -}"
   case (fallbackMode, Text.lines exactPrinted) of
     (ExactPrintFallbackModeNever, _  ) -> errorAction
     (_                          , [t]) -> exactPrintNode
@@ -143,8 +152,7 @@ lrdrNameToTextAnnGen
 lrdrNameToTextAnnGen f ast@(L _ n) = do
   anns <- mAsk
   let t = f $ rdrNameToText n
-  let
-    hasUni x (ExactPrint.Types.G y, _) = x == y
+  let hasUni x (ExactPrint.Types.G y, _) = x == y
       hasUni _ _                         = False
   -- TODO: in general: we should _always_ process all annotaiton stuff here.
   --       whatever we don't probably should have had some effect on the
@@ -170,8 +178,7 @@ lrdrNameToTextAnnTypeEqualityIsSpecial
   => Located RdrName
   -> m Text
 lrdrNameToTextAnnTypeEqualityIsSpecial ast = do
-  let
-    f x = if x == Text.pack "Data.Type.Equality~"
+  let f x = if x == Text.pack "Data.Type.Equality~"
         then Text.pack "~" -- rraaaahhh special casing rraaahhhhhh
         else x
   lrdrNameToTextAnnGen f ast
@@ -192,8 +199,7 @@ lrdrNameToTextAnnTypeEqualityIsSpecialAndRespectTick
 lrdrNameToTextAnnTypeEqualityIsSpecialAndRespectTick ast1 ast2 = do
   hasQuote <- hasAnnKeyword ast1 AnnSimpleQuote
   x        <- lrdrNameToTextAnn ast2
-  let
-    lit = if x == Text.pack "Data.Type.Equality~"
+  let lit = if x == Text.pack "Data.Type.Equality~"
         then Text.pack "~" -- rraaaahhh special casing rraaahhhhhh
         else x
   return $ if hasQuote then Text.cons '\'' lit else lit
@@ -217,7 +223,8 @@ extractRestComments ann =
        )
 
 filterAnns :: Data.Data.Data ast => ast -> ExactPrint.Anns -> ExactPrint.Anns
-filterAnns ast = Map.filterWithKey (\k _ -> k `Set.member` foldedAnnKeys ast)
+filterAnns ast =
+  Map.filterWithKey (\k _ -> k `Set.member` foldedAnnKeys ast)
 
 -- | True if there are any comments that are
 -- a) connected to any node below (in AST sense) the given node AND
@@ -235,8 +242,7 @@ hasCommentsBetween
   -> ToBriDocM Bool
 hasCommentsBetween ast leftKey rightKey = do
   mAnn <- astAnn ast
-  let
-    go1 [] = False
+  let go1 []         = False
       go1 ((ExactPrint.G kw, _dp) : rest) | kw == leftKey = go2 rest
       go1 (_ : rest) = go1 rest
       go2 []         = False
@@ -254,8 +260,7 @@ hasAnyCommentsConnected ast = not . null <$> astConnectedComments ast
 
 -- | True if there are any regular comments connected to any node below (in AST
 --   sense) the given node
-hasAnyRegularCommentsConnected
-  :: Data ast => GHC.Located ast -> ToBriDocM Bool
+hasAnyRegularCommentsConnected :: Data ast => GHC.Located ast -> ToBriDocM Bool
 hasAnyRegularCommentsConnected ast =
   any isRegularComment <$> astConnectedComments ast
 
@@ -455,10 +460,12 @@ newtype CollectAltM a = CollectAltM (Writer.Writer [ToBriDocM BriDocNumbered] a)
   deriving (Functor, Applicative, Monad)
 
 addAlternativeCond :: Bool -> ToBriDocM BriDocNumbered -> CollectAltM ()
-addAlternativeCond cond doc = when cond (addAlternative doc)
+addAlternativeCond cond doc =
+  when cond (addAlternative doc)
 
 addAlternative :: ToBriDocM BriDocNumbered -> CollectAltM ()
-addAlternative = CollectAltM . Writer.tell . (: [])
+addAlternative =
+  CollectAltM . Writer.tell . (: [])
 
 runFilteredAlternative :: CollectAltM () -> ToBriDocM BriDocNumbered
 runFilteredAlternative (CollectAltM action) =
@@ -475,8 +482,7 @@ docLines l = allocateNode . BDFLines =<< sequence l
 docCols :: ColSig -> [ToBriDocM BriDocNumbered] -> ToBriDocM BriDocNumbered
 docCols sig l = allocateNode . BDFCols sig =<< sequence l
 
-docAddBaseY
-  :: BrIndent -> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
+docAddBaseY :: BrIndent -> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
 docAddBaseY ind bdm = allocateNode . BDFAddBaseY ind =<< bdm
 
 docSetBaseY :: ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
@@ -511,8 +517,7 @@ docAnnotationKW
   -> Maybe AnnKeywordId
   -> ToBriDocM BriDocNumbered
   -> ToBriDocM BriDocNumbered
-docAnnotationKW annKey kw bdm =
-  allocateNode . BDFAnnotationKW annKey kw =<< bdm
+docAnnotationKW annKey kw bdm = allocateNode . BDFAnnotationKW annKey kw =<< bdm
 
 docMoveToKWDP
   :: AnnKey
@@ -626,11 +631,17 @@ instance DocWrapable (ToBriDocM BriDocNumbered) where
   docWrapNodePrior ast bdm = do
     bd <- bdm
     i1 <- allocNodeIndex
-    return $ (,) i1 $ BDFAnnotationPrior (ExactPrint.Types.mkAnnKey ast) $ bd
+    return
+      $ (,) i1
+      $ BDFAnnotationPrior (ExactPrint.Types.mkAnnKey ast)
+      $ bd
   docWrapNodeRest ast bdm = do
     bd <- bdm
     i2 <- allocNodeIndex
-    return $ (,) i2 $ BDFAnnotationRest (ExactPrint.Types.mkAnnKey ast) $ bd
+    return
+      $ (,) i2
+      $ BDFAnnotationRest (ExactPrint.Types.mkAnnKey ast)
+      $ bd
 
 instance DocWrapable (ToBriDocM a) => DocWrapable [ToBriDocM a] where
   docWrapNode ast bdms = case bdms of
@@ -767,8 +778,7 @@ briDocMToPPM m = do
 briDocMToPPMInner :: ToBriDocM a -> PPMLocal (a, [BrittanyError], Seq String)
 briDocMToPPMInner m = do
   readers <- MultiRWSS.mGetRawR
-  let
-    ((x, errs), debugs) =
+  let ((x, errs), debugs) =
         runIdentity
           $ MultiRWSS.runMultiRWSTNil
           $ MultiRWSS.withMultiStateA (NodeAllocIndex 1)

source/library/Language/Haskell/Brittany/Internal/Layouters/DataDecl.hs

@@ -3,19 +3,26 @@
 
 module Language.Haskell.Brittany.Internal.Layouters.DataDecl where
 
+
+
+import Language.Haskell.Brittany.Internal.Prelude
+import Language.Haskell.Brittany.Internal.PreludeUtils
 import qualified Data.Data
 import qualified Data.Semigroup as Semigroup
 import qualified Data.Text as Text
-import GHC (GenLocated(L), Located)
+import qualified GHC.OldList as List
+
+import           Language.Haskell.Brittany.Internal.Types
+import           Language.Haskell.Brittany.Internal.LayouterBasics
+import           Language.Haskell.Brittany.Internal.Config.Types
+
+import           GHC ( Located, GenLocated(L) )
 import qualified GHC
 import           GHC.Hs
-import qualified GHC.OldList as List
-import Language.Haskell.Brittany.Internal.Config.Types
-import Language.Haskell.Brittany.Internal.LayouterBasics
+
 import           Language.Haskell.Brittany.Internal.Layouters.Type
-import Language.Haskell.Brittany.Internal.Prelude
-import Language.Haskell.Brittany.Internal.PreludeUtils
-import Language.Haskell.Brittany.Internal.Types
+
+
 
 layoutDataDecl
   :: Located (TyClDecl GhcPs)
@@ -25,10 +32,9 @@ layoutDataDecl
   -> ToBriDocM BriDocNumbered
 layoutDataDecl ltycl name (HsQTvs _ bndrs) defn = case defn of
   -- newtype MyType a b = MyType ..
-  HsDataDefn _ext NewType (L _ []) _ctype Nothing [cons] mDerivs ->
-    case cons of
-      (L _ (ConDeclH98 _ext consName (L _ False) _qvars (Just (L _ [])) details _conDoc))
-        -> docWrapNode ltycl $ do
+  HsDataDefn _ext NewType (L _ []) _ctype Nothing [cons] mDerivs -> case cons of
+    (L _ (ConDeclH98 _ext consName (L _ False) _qvars (Just (L _ [])) details _conDoc)) ->
+      docWrapNode ltycl $ do
         nameStr     <- lrdrNameToTextAnn name
         consNameStr <- lrdrNameToTextAnn consName
         tyVarLine   <- return <$> createBndrDoc bndrs
@@ -68,8 +74,8 @@ layoutDataDecl ltycl name (HsQTvs _ bndrs) defn = case defn of
   -- data MyData = MyData { .. }
   HsDataDefn _ext DataType (L _ lhsContext) _ctype Nothing [cons] mDerivs ->
     case cons of
-      (L _ (ConDeclH98 _ext consName (L _ _hasExt) qvars mRhsContext details _conDoc))
-        -> docWrapNode ltycl $ do
+      (L _ (ConDeclH98 _ext consName (L _ _hasExt) qvars mRhsContext details _conDoc)) ->
+        docWrapNode ltycl $ do
           lhsContextDoc <- docSharedWrapper createContextDoc lhsContext
           nameStr       <- lrdrNameToTextAnn name
           consNameStr   <- lrdrNameToTextAnn consName
@@ -81,23 +87,19 @@ layoutDataDecl ltycl name (HsQTvs _ bndrs) defn = case defn of
             Nothing         -> pure Nothing
             Just (L _ ctxt) -> Just . pure <$> createContextDoc ctxt
           rhsDoc        <- return <$> createDetailsDoc consNameStr details
-          consDoc <-
-            fmap pure
+          consDoc <- fmap pure
             $ docNonBottomSpacing
             $ case (forallDocMay, rhsContextDocMay) of
                 (Just forallDoc, Just rhsContextDoc) -> docLines
-                  [ docSeq
-                    [docLitS "=", docSeparator, docForceSingleline forallDoc]
+                  [ docSeq [docLitS "=", docSeparator, docForceSingleline forallDoc]
                   , docSeq
                     [ docLitS "."
                     , docSeparator
-                    , docSetBaseY
-                      $ docLines [rhsContextDoc, docSetBaseY rhsDoc]
+                    , docSetBaseY $ docLines [rhsContextDoc, docSetBaseY rhsDoc]
                     ]
                   ]
                 (Just forallDoc, Nothing) -> docLines
-                  [ docSeq
-                    [docLitS "=", docSeparator, docForceSingleline forallDoc]
+                  [ docSeq [docLitS "=", docSeparator, docForceSingleline forallDoc]
                   , docSeq [docLitS ".", docSeparator, rhsDoc]
                   ]
                 (Nothing, Just rhsContextDoc) -> docSeq
@@ -105,12 +107,12 @@ layoutDataDecl ltycl name (HsQTvs _ bndrs) defn = case defn of
                   , docSeparator
                   , docSetBaseY $ docLines [rhsContextDoc, docSetBaseY rhsDoc]
                   ]
-                (Nothing, Nothing) ->
-                  docSeq [docLitS "=", docSeparator, rhsDoc]
+                (Nothing, Nothing) -> docSeq [docLitS "=", docSeparator, rhsDoc]
           createDerivingPar mDerivs $ docAlt
             [ -- data D = forall a . Show a => D a
               docSeq
-              [ docNodeAnnKW ltycl (Just GHC.AnnData) $ docSeq
+              [ docNodeAnnKW ltycl (Just GHC.AnnData)
+              $ docSeq
                 [ appSep $ docLitS "data"
                 , docForceSingleline $ lhsContextDoc
                 , appSep $ docLit nameStr
@@ -122,8 +124,7 @@ layoutDataDecl ltycl name (HsQTvs _ bndrs) defn = case defn of
               , docSetIndentLevel $ docSeq
                 [ case forallDocMay of
                   Nothing -> docEmpty
-                  Just forallDoc ->
-                    docSeq
+                  Just forallDoc -> docSeq
                     [ docForceSingleline forallDoc
                     , docSeparator
                     , docLitS "."
@@ -136,7 +137,8 @@ layoutDataDecl ltycl name (HsQTvs _ bndrs) defn = case defn of
             , -- data D
               --   = forall a . Show a => D a
               docAddBaseY BrIndentRegular $ docPar
-              (docNodeAnnKW ltycl (Just GHC.AnnData) $ docSeq
+              ( docNodeAnnKW ltycl (Just GHC.AnnData)
+              $ docSeq
                 [ appSep $ docLitS "data"
                 , docForceSingleline lhsContextDoc
                 , appSep $ docLit nameStr
@@ -149,8 +151,7 @@ layoutDataDecl ltycl name (HsQTvs _ bndrs) defn = case defn of
                 , docSetIndentLevel $ docSeq
                   [ case forallDocMay of
                     Nothing -> docEmpty
-                    Just forallDoc ->
-                      docSeq
+                    Just forallDoc -> docSeq
                       [ docForceSingleline forallDoc
                       , docSeparator
                       , docLitS "."
@@ -166,7 +167,8 @@ layoutDataDecl ltycl name (HsQTvs _ bndrs) defn = case defn of
               --   . Show a =>
               --     D a
               docAddBaseY BrIndentRegular $ docPar
-              (docNodeAnnKW ltycl (Just GHC.AnnData) $ docSeq
+              ( docNodeAnnKW ltycl (Just GHC.AnnData)
+              $ docSeq
                 [ appSep $ docLitS "data"
                 , docForceSingleline lhsContextDoc
                 , appSep $ docLit nameStr
@@ -190,7 +192,10 @@ layoutDataDecl ltycl name (HsQTvs _ bndrs) defn = case defn of
               ( docLines
                 [ lhsContextDoc
                 , docNodeAnnKW ltycl (Just GHC.AnnData)
-                  $ docSeq [appSep $ docLit nameStr, tyVarLine]
+                $ docSeq
+                  [ appSep $ docLit nameStr
+                  , tyVarLine
+                  ]
                 , consDoc
                 ]
               )
@@ -209,15 +214,15 @@ createContextDoc (t1 : tR) = do
   docAlt
     [ docSeq
       [ docLitS "("
-      , docForceSingleline $ docSeq $ List.intersperse
-        docCommaSep
+      , docForceSingleline $ docSeq $ List.intersperse docCommaSep
                                                        (t1Doc : tRDocs)
       , docLitS ") =>"
       , docSeparator
       ]
     , docLines $ join
       [ [docSeq [docLitS "(", docSeparator, t1Doc]]
-      , tRDocs <&> \tRDoc -> docSeq [docLitS ",", docSeparator, tRDoc]
+      , tRDocs
+        <&> \tRDoc -> docSeq [docLitS ",", docSeparator, tRDoc]
       , [docLitS ") =>", docSeparator]
       ]
     ]
@@ -229,8 +234,10 @@ createBndrDoc bs = do
     (L _ (KindedTyVar _ _ext lrdrName kind)) -> do
       d <- docSharedWrapper layoutType kind
       return $ (lrdrNameToText lrdrName, Just $ d)
-  docSeq $ List.intersperse docSeparator $ tyVarDocs <&> \(vname, mKind) ->
-    case mKind of
+  docSeq
+    $   List.intersperse docSeparator
+    $   tyVarDocs
+    <&> \(vname, mKind) -> case mKind of
           Nothing   -> docLit vname
           Just kind -> docSeq
             [ docLitS "("
@@ -256,17 +263,16 @@ createDerivingPar derivs mainDoc = do
         <$> types
 
 derivingClauseDoc :: LHsDerivingClause GhcPs -> ToBriDocM BriDocNumbered
-derivingClauseDoc (L _ (HsDerivingClause _ext mStrategy types)) =
-  case types of
+derivingClauseDoc (L _ (HsDerivingClause _ext mStrategy types)) = case types of
   (L _ []) -> docSeq []
   (L _ ts) ->
     let
       tsLength = length ts
       whenMoreThan1Type val =
         if tsLength > 1 then docLitS val else docLitS ""
-        (lhsStrategy, rhsStrategy) =
-          maybe (docEmpty, docEmpty) strategyLeftRight mStrategy
-      in docSeq
+      (lhsStrategy, rhsStrategy) = maybe (docEmpty, docEmpty) strategyLeftRight mStrategy
+    in
+      docSeq
         [ docDeriving
         , docWrapNodePrior types $ lhsStrategy
         , docSeparator
@@ -274,8 +280,7 @@ derivingClauseDoc (L _ (HsDerivingClause _ext mStrategy types)) =
         , docWrapNodeRest types
           $ docSeq
           $ List.intersperse docCommaSep
-        $ ts
-        <&> \case
+          $ ts <&> \case
             HsIB _ t -> layoutType t
         , whenMoreThan1Type ")"
         , rhsStrategy
@@ -289,7 +294,10 @@ derivingClauseDoc (L _ (HsDerivingClause _ext mStrategy types)) =
       ( docEmpty
       , case viaTypes of
           HsIB _ext t -> docSeq
-          [docWrapNode lVia $ docLitS " via", docSeparator, layoutType t]
+            [ docWrapNode lVia $ docLitS " via"
+            , docSeparator
+            , layoutType t
+            ]
       )
 
 docDeriving :: ToBriDocM BriDocNumbered
@@ -299,8 +307,7 @@ createDetailsDoc
   :: Text -> HsConDeclDetails GhcPs -> (ToBriDocM BriDocNumbered)
 createDetailsDoc consNameStr details = case details of
   PrefixCon args -> do
-    indentPolicy <-
-      mAsk <&> _conf_layout .> _lconfig_indentPolicy .> confUnpack
+    indentPolicy <- mAsk <&> _conf_layout .> _lconfig_indentPolicy .>  confUnpack
     let
       singleLine = docSeq
         [ docLit consNameStr
@@ -308,16 +315,13 @@ createDetailsDoc consNameStr details = case details of
         , docForceSingleline
           $ docSeq
           $ List.intersperse docSeparator
-        $ fmap hsScaledThing args
-        <&> layoutType
+          $ fmap hsScaledThing args <&> layoutType
         ]
-      leftIndented =
-        docSetParSpacing
+      leftIndented = docSetParSpacing
         . docAddBaseY BrIndentRegular
         . docPar (docLit consNameStr)
         . docLines
-          $ layoutType
-          <$> fmap hsScaledThing args
+        $ layoutType <$> fmap hsScaledThing args
       multiAppended = docSeq
         [ docLit consNameStr
         , docSeparator
@@ -331,13 +335,14 @@ createDetailsDoc consNameStr details = case details of
       IndentPolicyMultiple -> docAlt [singleLine, multiAppended, leftIndented]
       IndentPolicyFree ->
         docAlt [singleLine, multiAppended, multiIndented, leftIndented]
-  RecCon (L _ []) ->
-    docSeq [docLit consNameStr, docSeparator, docLit $ Text.pack "{}"]
+  RecCon (L _ []) -> docSeq [docLit consNameStr, docSeparator, docLit $ Text.pack "{}"]
   RecCon lRec@(L _ fields@(_:_)) -> do
     let ((fName1, fType1) : fDocR) = mkFieldDocs fields
     -- allowSingleline <- mAsk <&> _conf_layout .> _lconfig_allowSinglelineRecord .> confUnpack
     let allowSingleline = False
-    docAddBaseY BrIndentRegular $ runFilteredAlternative $ do
+    docAddBaseY BrIndentRegular
+      $ runFilteredAlternative
+      $ do
         -- single-line: { i :: Int, b :: Bool }
         addAlternativeCond allowSingleline $ docSeq
           [ docLit consNameStr
@@ -366,8 +371,7 @@ createDetailsDoc consNameStr details = case details of
           (docLit consNameStr)
           (docWrapNodePrior lRec $ docNonBottomSpacingS $ docLines
             [ docAlt
-            [ docCols
-              ColRecDecl
+              [ docCols ColRecDecl
                 [ appSep (docLitS "{")
                 , appSep $ docForceSingleline fName1
                 , docSeq [docLitS "::", docSeparator]
@@ -383,8 +387,7 @@ createDetailsDoc consNameStr details = case details of
               ]
             , docWrapNodeRest lRec $ docLines $ fDocR <&> \(fName, fType) ->
                 docAlt
-              [ docCols
-                ColRecDecl
+                [ docCols ColRecDecl
                   [ docCommaSep
                   , appSep $ docForceSingleline fName
                   , docSeq [docLitS "::", docSeparator]
@@ -415,11 +418,10 @@ createDetailsDoc consNameStr details = case details of
   mkFieldDocs = fmap $ \lField -> case lField of
     L _ (ConDeclField _ext names t _) -> createNamesAndTypeDoc lField names t
 
-createForallDoc
-  :: [LHsTyVarBndr flag GhcPs] -> Maybe (ToBriDocM BriDocNumbered)
+createForallDoc :: [LHsTyVarBndr flag GhcPs] -> Maybe (ToBriDocM BriDocNumbered)
 createForallDoc []            = Nothing
-createForallDoc lhsTyVarBndrs =
-  Just $ docSeq [docLitS "forall ", createBndrDoc lhsTyVarBndrs]
+createForallDoc lhsTyVarBndrs = Just $ docSeq
+  [docLitS "forall ", createBndrDoc lhsTyVarBndrs]
 
 createNamesAndTypeDoc
   :: Data.Data.Data ast
@@ -429,8 +431,12 @@ createNamesAndTypeDoc
   -> (ToBriDocM BriDocNumbered, ToBriDocM BriDocNumbered)
 createNamesAndTypeDoc lField names t =
   ( docNodeAnnKW lField Nothing $ docWrapNodePrior lField $ docSeq
-    [ docSeq $ List.intersperse docCommaSep $ names <&> \case
-        L _ (FieldOcc _ fieldName) -> docLit =<< lrdrNameToTextAnn fieldName
+    [ docSeq
+      $   List.intersperse docCommaSep
+      $   names
+      <&> \case
+        L _ (FieldOcc _ fieldName) ->
+            docLit =<< lrdrNameToTextAnn fieldName
     ]
   , docWrapNodeRest lField $ layoutType t
   )

source/library/Language/Haskell/Brittany/Internal/Layouters/Decl.hs

@@ -5,38 +5,48 @@
 
 module Language.Haskell.Brittany.Internal.Layouters.Decl where
 
+
+
+import Language.Haskell.Brittany.Internal.Prelude
+import Language.Haskell.Brittany.Internal.PreludeUtils
 import qualified Data.Data
 import qualified Data.Foldable
 import qualified Data.Maybe
 import qualified Data.Semigroup as Semigroup
 import qualified Data.Text as Text
-import GHC (AnnKeywordId(..), GenLocated(L))
-import GHC.Data.Bag (bagToList, emptyBag)
+import qualified GHC.OldList as List
+
+import           Language.Haskell.Brittany.Internal.Types
+import           Language.Haskell.Brittany.Internal.LayouterBasics
+import           Language.Haskell.Brittany.Internal.Config.Types
+import           Language.Haskell.Brittany.Internal.Layouters.Type
+
+import qualified Language.Haskell.GHC.ExactPrint as ExactPrint
+import qualified Language.Haskell.GHC.ExactPrint.Utils as ExactPrint
+import           Language.Haskell.Brittany.Internal.ExactPrintUtils
+
+import           GHC                            ( GenLocated(L)
+                                                , AnnKeywordId(..)
+                                                )
+import           GHC.Types.SrcLoc ( SrcSpan, Located , getLoc, unLoc )
 import qualified GHC.Data.FastString as FastString
 import           GHC.Hs
-import qualified GHC.OldList as List
-import GHC.Types.Basic
-  ( Activation(..)
-  , InlinePragma(..)
+import           GHC.Types.Basic ( InlinePragma(..)
+                            , Activation(..)
                             , InlineSpec(..)
-  , LexicalFixity(..)
                             , RuleMatchInfo(..)
+                            , LexicalFixity(..)
                             )
-import GHC.Types.SrcLoc (Located, SrcSpan, getLoc, unLoc)
-import Language.Haskell.Brittany.Internal.Config.Types
-import Language.Haskell.Brittany.Internal.ExactPrintUtils
-import Language.Haskell.Brittany.Internal.LayouterBasics
-import Language.Haskell.Brittany.Internal.Layouters.DataDecl
-import {-# SOURCE #-} Language.Haskell.Brittany.Internal.Layouters.Expr
-import Language.Haskell.Brittany.Internal.Layouters.Pattern
-import {-# SOURCE #-} Language.Haskell.Brittany.Internal.Layouters.Stmt
-import Language.Haskell.Brittany.Internal.Layouters.Type
-import Language.Haskell.Brittany.Internal.Prelude
-import Language.Haskell.Brittany.Internal.PreludeUtils
-import Language.Haskell.Brittany.Internal.Types
-import qualified Language.Haskell.GHC.ExactPrint as ExactPrint
 import           Language.Haskell.GHC.ExactPrint.Types ( mkAnnKey )
-import qualified Language.Haskell.GHC.ExactPrint.Utils as ExactPrint
+
+import {-# SOURCE #-} Language.Haskell.Brittany.Internal.Layouters.Expr
+import {-# SOURCE #-} Language.Haskell.Brittany.Internal.Layouters.Stmt
+import           Language.Haskell.Brittany.Internal.Layouters.Pattern
+import           Language.Haskell.Brittany.Internal.Layouters.DataDecl
+
+import           GHC.Data.Bag ( bagToList, emptyBag )
+
+
 
 layoutDecl :: ToBriDoc HsDecl
 layoutDecl d@(L loc decl) = case decl of
@@ -57,53 +67,44 @@ layoutDecl d@(L loc decl) = case decl of
 
 layoutSig :: ToBriDoc Sig
 layoutSig lsig@(L _loc sig) = case sig of
-  TypeSig _ names (HsWC _ (HsIB _ typ)) ->
-    layoutNamesAndType Nothing names typ
+  TypeSig _ names (HsWC _ (HsIB _ typ)) -> layoutNamesAndType Nothing names typ
   InlineSig _ name (InlinePragma _ spec _arity phaseAct conlike) ->
     docWrapNode lsig $ do
       nameStr <- lrdrNameToTextAnn name
       specStr <- specStringCompat lsig spec
-      let
-        phaseStr = case phaseAct of
+      let phaseStr = case phaseAct of
             NeverActive      -> "" -- not [] - for NOINLINE NeverActive is
                                    -- in fact the default
             AlwaysActive     -> ""
             ActiveBefore _ i -> "[~" ++ show i ++ "] "
             ActiveAfter  _ i -> "[" ++ show i ++ "] "
             FinalActive      -> error "brittany internal error: FinalActive"
-      let
-        conlikeStr = case conlike of
+      let conlikeStr = case conlike of
             FunLike -> ""
             ConLike -> "CONLIKE "
       docLit
         $  Text.pack ("{-# " ++ specStr ++ conlikeStr ++ phaseStr)
         <> nameStr
         <> Text.pack " #-}"
-  ClassOpSig _ False names (HsIB _ typ) ->
-    layoutNamesAndType Nothing names typ
-  PatSynSig _ names (HsIB _ typ) ->
-    layoutNamesAndType (Just "pattern") names typ
+  ClassOpSig _ False names (HsIB _ typ) -> layoutNamesAndType Nothing names typ
+  PatSynSig _ names (HsIB _ typ) -> layoutNamesAndType (Just "pattern") names typ
   _ -> briDocByExactNoComment lsig -- TODO
  where
   layoutNamesAndType mKeyword names typ = docWrapNode lsig $ do
-    let
-      keyDoc = case mKeyword of
+    let keyDoc = case mKeyword of
           Just key -> [appSep . docLit $ Text.pack key]
           Nothing -> []
     nameStrs <- names `forM` lrdrNameToTextAnn
     let nameStr = Text.intercalate (Text.pack ", ") $ nameStrs
     typeDoc     <- docSharedWrapper layoutType typ
     hasComments <- hasAnyCommentsBelow lsig
-    shouldBeHanging <-
-      mAsk <&> _conf_layout .> _lconfig_hangingTypeSignature .> confUnpack
+    shouldBeHanging <- mAsk
+      <&> _conf_layout
+      .>  _lconfig_hangingTypeSignature
+      .>  confUnpack
     if shouldBeHanging
-      then
-        docSeq
-          $ [ appSep
-            $ docWrapNodeRest lsig
-            $ docSeq
-            $ keyDoc
-            <> [docLit nameStr]
+      then docSeq $
+        [ appSep $ docWrapNodeRest lsig $ docSeq $ keyDoc <> [docLit nameStr]
         , docSetBaseY $ docLines
           [ docCols
             ColTyOpPrefix
@@ -132,8 +133,7 @@ layoutGuardLStmt lgstmt@(L _ stmtLR) = docWrapNode lgstmt $ case stmtLR of
   BindStmt _ lPat expr -> do
     patDoc <- docSharedWrapper layoutPat lPat
     expDoc <- docSharedWrapper layoutExpr expr
-    docCols
-      ColBindStmt
+    docCols ColBindStmt
             [ appSep $ colsWrapPat =<< patDoc
             , docSeq [appSep $ docLit $ Text.pack "<-", expDoc]
             ]
@@ -145,7 +145,9 @@ layoutGuardLStmt lgstmt@(L _ stmtLR) = docWrapNode lgstmt $ case stmtLR of
 --------------------------------------------------------------------------------
 
 layoutBind
-  :: ToBriDocC (HsBindLR GhcPs GhcPs) (Either [BriDocNumbered] BriDocNumbered)
+  :: ToBriDocC
+       (HsBindLR GhcPs GhcPs)
+       (Either [BriDocNumbered] BriDocNumbered)
 layoutBind lbind@(L _ bind) = case bind of
   FunBind _ fId (MG _ lmatches@(L _ matches) _) [] -> do
     idStr       <- lrdrNameToTextAnn fId
@@ -163,15 +165,17 @@ layoutBind lbind@(L _ bind) = case bind of
     let mWhereArg = mWhereDocs <&> (,) (mkAnnKey lbind) -- TODO: is this the right AnnKey?
     binderDoc  <- docLit $ Text.pack "="
     hasComments <- hasAnyCommentsBelow lbind
-    fmap Right $ docWrapNode lbind $ layoutPatternBindFinal
-      Nothing
+    fmap Right $ docWrapNode lbind $ layoutPatternBindFinal Nothing
                                                             binderDoc
                                                             (Just patDocs)
                                                             clauseDocs
                                                             mWhereArg
                                                             hasComments
   PatSynBind _ (PSB _ patID lpat rpat dir) -> do
-    fmap Right $ docWrapNode lbind $ layoutPatSynBind patID lpat dir rpat
+    fmap Right $ docWrapNode lbind $ layoutPatSynBind patID
+                                                      lpat
+                                                      dir
+                                                      rpat
   _ -> Right <$> unknownNodeError "" lbind
 layoutIPBind :: ToBriDoc IPBind
 layoutIPBind lipbind@(L _ bind) = case bind of
@@ -181,13 +185,7 @@ layoutIPBind lipbind@(L _ bind) = case bind of
     binderDoc <- docLit $ Text.pack "="
     exprDoc <- layoutExpr expr
     hasComments <- hasAnyCommentsBelow lipbind
-    layoutPatternBindFinal
-      Nothing
-      binderDoc
-      (Just ipName)
-      [([], exprDoc, expr)]
-      Nothing
-      hasComments
+    layoutPatternBindFinal Nothing binderDoc (Just ipName) [([], exprDoc, expr)] Nothing hasComments
 
 
 data BagBindOrSig = BagBind (LHsBindLR GhcPs GhcPs)
@@ -205,8 +203,7 @@ layoutLocalBinds lbinds@(L _ binds) = case binds of
   -- x@(HsValBinds (ValBindsIn{})) ->
   --   Just . (:[]) <$> unknownNodeError "HsValBinds (ValBindsIn _ (_:_))" x
   HsValBinds _ (ValBinds _ bindlrs sigs) -> do
-    let
-      unordered =
+    let unordered =
           [ BagBind b | b <- Data.Foldable.toList bindlrs ]
             ++ [ BagSig s | s <- sigs ]
         ordered = List.sortOn (ExactPrint.rs . bindOrSigtoSrcSpan) unordered
@@ -216,7 +213,8 @@ layoutLocalBinds lbinds@(L _ binds) = case binds of
     return $ Just $ docs
 --  x@(HsValBinds (ValBindsOut _binds _lsigs)) ->
   HsValBinds _ (XValBindsLR{}) -> error "brittany internal error: XValBindsLR"
-  HsIPBinds _ (IPBinds _ bb) -> Just <$> mapM layoutIPBind bb
+  HsIPBinds _ (IPBinds _ bb) ->
+    Just <$> mapM layoutIPBind bb
   EmptyLocalBinds{} -> return $ Nothing
 
 -- TODO: we don't need the `LHsExpr GhcPs` anymore, now that there is
@@ -245,16 +243,15 @@ layoutPatternBind funId binderDoc lmatch@(L _ match) = do
   let mIdStr' = fixPatternBindIdentifier match <$> mIdStr
   patDoc <- docWrapNodePrior lmatch $ case (mIdStr', patDocs) of
     (Just idStr, p1:p2:pr) | isInfix -> if null pr
-      then docCols
-        ColPatternsFuncInfix
+      then
+        docCols ColPatternsFuncInfix
           [ appSep $ docForceSingleline p1
           , appSep $ docLit $ idStr
           , docForceSingleline p2
           ]
-      else docCols
-        ColPatternsFuncInfix
-        ([ docCols
-             ColPatterns
+      else
+        docCols ColPatternsFuncInfix
+          (  [docCols ColPatterns
                [ docParenL
                , appSep $ docForceSingleline p1
                , appSep $ docLit $ idStr
@@ -277,15 +274,15 @@ layoutPatternBind funId binderDoc lmatch@(L _ match) = do
   let mWhereArg = mWhereDocs <&> (,) (mkAnnKey lmatch)
   let alignmentToken = if null pats then Nothing else funId
   hasComments <- hasAnyCommentsBelow lmatch
-  layoutPatternBindFinal
-    alignmentToken
+  layoutPatternBindFinal alignmentToken
                          binderDoc
                          (Just patDoc)
                          clauseDocs
                          mWhereArg
                          hasComments
 
-fixPatternBindIdentifier :: Match GhcPs (LHsExpr GhcPs) -> Text -> Text
+fixPatternBindIdentifier
+  :: Match GhcPs (LHsExpr GhcPs) -> Text -> Text
 fixPatternBindIdentifier match idStr = go $ m_ctxt match
  where
   go = \case
@@ -311,20 +308,22 @@ layoutPatternBindFinal
      -- ^ AnnKey for the node that contains the AnnWhere position annotation
   -> Bool
   -> ToBriDocM BriDocNumbered
-layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs hasComments
-  = do
-    let
-      patPartInline = case mPatDoc of
+layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs hasComments = do
+  let patPartInline  = case mPatDoc of
         Nothing     -> []
         Just patDoc -> [appSep $ docForceSingleline $ return patDoc]
       patPartParWrap = case mPatDoc of
         Nothing     -> id
         Just patDoc -> docPar (return patDoc)
   whereIndent <- do
-      shouldSpecial <-
-        mAsk <&> _conf_layout .> _lconfig_indentWhereSpecial .> confUnpack
-      regularIndentAmount <-
-        mAsk <&> _conf_layout .> _lconfig_indentAmount .> confUnpack
+    shouldSpecial <- mAsk
+      <&> _conf_layout
+      .>  _lconfig_indentWhereSpecial
+      .>  confUnpack
+    regularIndentAmount <- mAsk
+      <&> _conf_layout
+      .>  _lconfig_indentAmount
+      .>  confUnpack
     pure $ if shouldSpecial
       then BrIndentSpecial (max 1 (regularIndentAmount `div` 2))
       else BrIndentRegular
@@ -333,7 +332,8 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha
   wherePartMultiLine :: [ToBriDocM BriDocNumbered] <- case mWhereDocs of
     Nothing  -> return $ []
     Just (annKeyWhere, [w]) -> pure . pure <$> docAlt
-        [ docEnsureIndent BrIndentRegular $ docSeq
+      [ docEnsureIndent BrIndentRegular
+        $ docSeq
             [ docLit $ Text.pack "where"
             , docSeparator
             , docForceSingleline $ return w
@@ -361,16 +361,13 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha
             $   return
             <$> ws
           ]
-    let
-      singleLineGuardsDoc guards = appSep $ case guards of
+  let singleLineGuardsDoc guards = appSep $ case guards of
         []  -> docEmpty
         [g] -> docSeq
                [appSep $ docLit $ Text.pack "|", docForceSingleline $ return g]
-        gs ->
-          docSeq
+        gs  -> docSeq
             $  [appSep $ docLit $ Text.pack "|"]
-            ++ (List.intersperse
-                 docCommaSep
+            ++ (List.intersperse docCommaSep
                                  (docForceSingleline . return <$> gs)
                )
       wherePart = case mWhereDocs of
@@ -382,8 +379,10 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha
           ]
         _        -> Nothing
 
-    indentPolicy <-
-      mAsk <&> _conf_layout .> _lconfig_indentPolicy .> confUnpack
+  indentPolicy <- mAsk
+    <&> _conf_layout
+    .>  _lconfig_indentPolicy
+    .>  confUnpack
 
   runFilteredAlternative $ do
 
@@ -409,8 +408,7 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha
                [ docSeq (patPartInline ++ [guardPart])
                , docSeq
                  [ appSep $ return binderDoc
-                    , docForceParSpacing $ docAddBaseY BrIndentRegular $ return
-                      body
+                 , docForceParSpacing $ docAddBaseY BrIndentRegular $ return body
                  ]
                ]
              ]
@@ -420,8 +418,7 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha
           $ docLines
           $  [ docForceSingleline
              $ docSeq (patPartInline ++ [guardPart, return binderDoc])
-              , docEnsureIndent BrIndentRegular $ docForceSingleline $ return
-                body
+             , docEnsureIndent BrIndentRegular $ docForceSingleline $ return body
              ]
           ++ wherePartMultiLine
         -- pattern and exactly one clause in single line, body as par;
@@ -433,8 +430,7 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha
                [ docSeq (patPartInline ++ [guardPart])
                , docSeq
                  [ appSep $ return binderDoc
-                    , docForceParSpacing $ docAddBaseY BrIndentRegular $ return
-                      body
+                 , docForceParSpacing $ docAddBaseY BrIndentRegular $ return body
                  ]
                ]
              ]
@@ -526,8 +522,8 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha
                  $ ( case guardDocs of
                      [] -> []
                      [g] ->
-                          [ docForceSingleline $ docSeq
-                              [appSep $ docLit $ Text.pack "|", return g]
+                       [ docForceSingleline
+                       $ docSeq [appSep $ docLit $ Text.pack "|", return g]
                        ]
                      gs ->
                        [  docForceSingleline
@@ -560,8 +556,8 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha
                  ( case guardDocs of
                    [] -> []
                    [g] ->
-                        [ docForceSingleline $ docSeq
-                            [appSep $ docLit $ Text.pack "|", return g]
+                     [ docForceSingleline
+                     $ docSeq [appSep $ docLit $ Text.pack "|", return g]
                      ]
                    gs ->
                      [  docForceSingleline
@@ -596,7 +592,8 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha
                      (g1:gr) ->
                        ( docSeq [appSep $ docLit $ Text.pack "|", return g1]
                        : (   gr
-                          <&> \g -> docSeq
+                         <&> \g ->
+                               docSeq
                                  [appSep $ docLit $ Text.pack ",", return g]
                          )
                        )
@@ -618,50 +615,43 @@ layoutPatSynBind
   -> LPat GhcPs
   -> ToBriDocM BriDocNumbered
 layoutPatSynBind name patSynDetails patDir rpat = do
-  let
-    patDoc = docLit $ Text.pack "pattern"
+  let patDoc = docLit $ Text.pack "pattern"
       binderDoc = case patDir of
         ImplicitBidirectional -> docLit $ Text.pack "="
         _ -> docLit $ Text.pack "<-"
       body = colsWrapPat =<< layoutPat rpat
       whereDoc = docLit $ Text.pack "where"
   mWhereDocs <- layoutPatSynWhere patDir
-  headDoc <-
-    fmap pure
-    $ docSeq
-    $ [ patDoc
+  headDoc <- fmap pure $ docSeq $
+    [ patDoc
     , docSeparator
     , layoutLPatSyn name patSynDetails
     , docSeparator
     , binderDoc
     ]
   runFilteredAlternative $ do
-    addAlternative
-      $
+    addAlternative $
       -- pattern .. where
       --   ..
       --   ..
-        docAddBaseY BrIndentRegular
-      $ docSeq
-          ([headDoc, docSeparator, body] ++ case mWhereDocs of
+      docAddBaseY BrIndentRegular $ docSeq
+        (  [headDoc, docSeparator, body]
+        ++ case mWhereDocs of
             Just ds -> [docSeparator, docPar whereDoc (docLines ds)]
             Nothing -> []
         )
-    addAlternative
-      $
+    addAlternative $
       -- pattern .. =
       --   ..
       -- pattern .. <-
       --   .. where
       --   ..
       --   ..
-        docAddBaseY BrIndentRegular
-      $ docPar
+      docAddBaseY BrIndentRegular $ docPar
         headDoc
         (case mWhereDocs of
           Nothing -> body
-            Just ds ->
-              docLines ([docSeq [body, docSeparator, whereDoc]] ++ ds)
+          Just ds -> docLines ([ docSeq [body, docSeparator, whereDoc] ] ++ ds)
         )
 
 -- | Helper method for the left hand side of a pattern synonym
@@ -681,21 +671,18 @@ layoutLPatSyn name (InfixCon left right) = do
 layoutLPatSyn name (RecCon recArgs) = do
   docName <- lrdrNameToTextAnn name
   args <- mapM (lrdrNameToTextAnn . recordPatSynSelectorId) recArgs
-  docSeq
-    . fmap docLit
+  docSeq . fmap docLit
     $  [docName, Text.pack " { " ]
     <> intersperse (Text.pack ", ") args
     <> [Text.pack " }"]
 
 -- | Helper method to get the where clause from of explicitly bidirectional
 -- pattern synonyms
-layoutPatSynWhere
-  :: HsPatSynDir GhcPs -> ToBriDocM (Maybe [ToBriDocM BriDocNumbered])
+layoutPatSynWhere :: HsPatSynDir GhcPs -> ToBriDocM (Maybe [ToBriDocM BriDocNumbered])
 layoutPatSynWhere hs = case hs of
   ExplicitBidirectional (MG _ (L _ lbinds) _) -> do
     binderDoc <- docLit $ Text.pack "="
-    Just
-      <$> mapM (docSharedWrapper $ layoutPatternBind Nothing binderDoc) lbinds
+    Just <$> mapM (docSharedWrapper $ layoutPatternBind Nothing binderDoc) lbinds
   _ -> pure Nothing
 
 --------------------------------------------------------------------------------
@@ -705,8 +692,7 @@ layoutPatSynWhere hs = case hs of
 layoutTyCl :: ToBriDoc TyClDecl
 layoutTyCl ltycl@(L _loc tycl) = case tycl of
   SynDecl _ name vars fixity typ -> do
-    let
-      isInfix = case fixity of
+    let isInfix = case fixity of
           Prefix -> False
           Infix  -> True
     -- hasTrailingParen <- hasAnnKeywordComment ltycl AnnCloseP
@@ -737,7 +723,9 @@ layoutSynDecl isInfix wrapNodeRest name vars typ = do
         -- This isn't quite right, but does give syntactically valid results
         let needsParens = not (null rest) || hasOwnParens
         docSeq
-          $ [docLit $ Text.pack "type", docSeparator]
+          $  [ docLit $ Text.pack "type"
+             , docSeparator
+             ]
           ++ [ docParenL | needsParens ]
           ++ [ layoutTyVarBndr False a
              , docSeparator
@@ -819,16 +807,14 @@ layoutTyFamInstDecl inClass outerNode tfid = do
           ++ [appSep $ docWrapNode name $ docLit nameStr]
           ++ intersperse docSeparator (layoutHsTyPats pats)
           ++ [ docParenR | needsParens ]
-    hasComments <-
-      (||)
+    hasComments <- (||)
       <$> hasAnyRegularCommentsConnected outerNode
       <*> hasAnyRegularCommentsRest innerNode
     typeDoc <- docSharedWrapper layoutType typ
     layoutLhsAndType hasComments lhs "=" typeDoc
 
 
-layoutHsTyPats
-  :: [HsArg (LHsType GhcPs) (LHsKind GhcPs)] -> [ToBriDocM BriDocNumbered]
+layoutHsTyPats :: [HsArg (LHsType GhcPs) (LHsKind GhcPs)] -> [ToBriDocM BriDocNumbered]
 layoutHsTyPats pats = pats <&> \case
   HsValArg tm     -> layoutType tm
   HsTypeArg _l ty -> docSeq [docLit $ Text.pack "@", layoutType ty]
@@ -878,11 +864,7 @@ layoutClsInst lcid@(L _ cid) = docLines
   docSortedLines
     :: [ToBriDocM (Located BriDocNumbered)] -> ToBriDocM BriDocNumbered
   docSortedLines l =
-    allocateNode
-      . BDFLines
-      . fmap unLoc
-      . List.sortOn (ExactPrint.rs . getLoc)
-      =<< sequence l
+    allocateNode . BDFLines . fmap unLoc . List.sortOn (ExactPrint.rs . getLoc) =<< sequence l
 
   layoutAndLocateSig :: ToBriDocC (Sig GhcPs) (Located BriDocNumbered)
   layoutAndLocateSig lsig@(L loc _) = L loc <$> layoutSig lsig
@@ -963,8 +945,7 @@ layoutClsInst lcid@(L _ cid) = docLines
    where
     go []              = []
     go (line1 : lineR) = case Text.stripStart line1 of
-      st
-        | isTypeOrData st -> st : lineR
+      st | isTypeOrData st -> st : lineR
          | otherwise       -> st : go lineR
     isTypeOrData t' =
       (Text.pack "type" `Text.isPrefixOf` t')
@@ -988,12 +969,7 @@ layoutLhsAndType hasComments lhs sep typeDoc = do
     -- lhs = type
     -- lhs :: type
     addAlternativeCond (not hasComments) $ docSeq
-      [ lhs
-      , docSeparator
-      , docLitS sep
-      , docSeparator
-      , docForceSingleline typeDoc
-      ]
+      [lhs, docSeparator, docLitS sep, docSeparator, docForceSingleline typeDoc]
     -- lhs
     --   :: typeA
     --   -> typeB

source/library/Language/Haskell/Brittany/Internal/Layouters/Expr.hs-boot

@@ -2,11 +2,20 @@
 
 module Language.Haskell.Brittany.Internal.Layouters.Expr where
 
-import GHC.Hs
+
+
+import Language.Haskell.Brittany.Internal.Prelude
+
 import           Language.Haskell.Brittany.Internal.Types
 
+import           GHC.Hs
+
+
+
 layoutExpr :: ToBriDoc HsExpr
 
+-- layoutStmt :: ToBriDoc' (StmtLR GhcPs GhcPs (LHsExpr GhcPs))
+
 litBriDoc :: HsLit GhcPs -> BriDocFInt
 
 overLitValBriDoc :: OverLitVal -> BriDocFInt

source/library/Language/Haskell/Brittany/Internal/Layouters/IE.hs

@@ -4,23 +4,27 @@
 
 module Language.Haskell.Brittany.Internal.Layouters.IE where
 
+import Language.Haskell.Brittany.Internal.Prelude
 import qualified Data.List.Extra
 import qualified Data.Text as Text
-import GHC
-  ( AnnKeywordId(..)
+import qualified GHC.OldList as List
+
+import           Language.Haskell.Brittany.Internal.Types
+import           Language.Haskell.Brittany.Internal.LayouterBasics
+
+import           GHC     ( unLoc
                          , GenLocated(L)
+                         , moduleNameString
+                         , AnnKeywordId(..)
                          , Located
                          , ModuleName
-  , moduleNameString
-  , unLoc
                          )
 import           GHC.Hs
-import qualified GHC.OldList as List
-import Language.Haskell.Brittany.Internal.LayouterBasics
-import Language.Haskell.Brittany.Internal.Prelude
-import Language.Haskell.Brittany.Internal.Types
+
 import           Language.Haskell.Brittany.Internal.Utils
 
+
+
 prepareName :: LIEWrappedName name -> Located name
 prepareName = ieLWrappedName
 
@@ -47,27 +51,22 @@ layoutIE lie@(L _ ie) = docWrapNode lie $ case ie of
       addAlternative
         $ docWrapNodeRest lie
         $ docAddBaseY BrIndentRegular
-        $ docPar (layoutWrapped lie x) (layoutItems (splitFirstLast sortedNs))
+        $ docPar
+            (layoutWrapped lie x)
+            (layoutItems (splitFirstLast sortedNs))
    where
     nameDoc = docLit <=< lrdrNameToTextAnn . prepareName
     layoutItem n = docSeq [docCommaSep, docWrapNode n $ nameDoc n]
     layoutItems FirstLastEmpty = docSetBaseY $ docLines
-      [ docSeq [docParenLSep, docNodeAnnKW lie (Just AnnOpenP) docEmpty]
-      , docParenR
-      ]
+      [docSeq [docParenLSep, docNodeAnnKW lie (Just AnnOpenP) docEmpty], docParenR]
     layoutItems (FirstLastSingleton n) = docSetBaseY $ docLines
-      [ docSeq [docParenLSep, docNodeAnnKW lie (Just AnnOpenP) $ nameDoc n]
-      , docParenR
-      ]
+      [docSeq [docParenLSep, docNodeAnnKW lie (Just AnnOpenP) $ nameDoc n], docParenR]
     layoutItems (FirstLast n1 nMs nN) =
       docSetBaseY
         $  docLines
         $  [docSeq [docParenLSep, docWrapNode n1 $ nameDoc n1]]
         ++ map layoutItem nMs
-        ++ [ docSeq
-             [docCommaSep, docNodeAnnKW lie (Just AnnOpenP) $ nameDoc nN]
-           , docParenR
-           ]
+        ++ [docSeq [docCommaSep, docNodeAnnKW lie (Just AnnOpenP) $ nameDoc nN], docParenR]
   IEModuleContents _ n -> docSeq
     [ docLit $ Text.pack "module"
     , docSeparator
@@ -93,19 +92,16 @@ data SortItemsFlag = ShouldSortItems | KeepItemsUnsorted
 -- handling of the resulting list. Adding parens is
 -- left to the caller since that is context sensitive
 layoutAnnAndSepLLIEs
-  :: SortItemsFlag
-  -> Located [LIE GhcPs]
-  -> ToBriDocM [ToBriDocM BriDocNumbered]
+  :: SortItemsFlag -> Located [LIE GhcPs] -> ToBriDocM [ToBriDocM BriDocNumbered]
 layoutAnnAndSepLLIEs shouldSort llies@(L _ lies) = do
   let makeIENode ie = docSeq [docCommaSep, ie]
-  let
-    sortedLies =
+  let sortedLies =
         [ items
-      | group <- Data.List.Extra.groupOn lieToText $ List.sortOn lieToText lies
+        | group <- Data.List.Extra.groupOn lieToText
+          $ List.sortOn lieToText lies
         , items <- mergeGroup group
         ]
-  let
-    ieDocs = fmap layoutIE $ case shouldSort of
+  let ieDocs = fmap layoutIE $ case shouldSort of
         ShouldSortItems -> sortedLies
         KeepItemsUnsorted -> lies
   ieCommaDocs <-
@@ -145,8 +141,7 @@ layoutAnnAndSepLLIEs shouldSort llies@(L _ lies) = do
   thingFolder (L l (IEThingWith x wn _ consItems1 fieldLbls1)) (L _ (IEThingWith _ _ _ consItems2 fieldLbls2))
     = L
       l
-      (IEThingWith
-        x
+      (IEThingWith x
                    wn
                    NoIEWildcard
                    (consItems1 ++ consItems2)
@@ -169,8 +164,7 @@ layoutAnnAndSepLLIEs shouldSort llies@(L _ lies) = do
 -- () -- no comments
 -- ( -- a comment
 -- )
-layoutLLIEs
-  :: Bool -> SortItemsFlag -> Located [LIE GhcPs] -> ToBriDocM BriDocNumbered
+layoutLLIEs :: Bool -> SortItemsFlag -> Located [LIE GhcPs] -> ToBriDocM BriDocNumbered
 layoutLLIEs enableSingleline shouldSort llies = do
   ieDs        <- layoutAnnAndSepLLIEs shouldSort llies
   hasComments <- hasAnyCommentsBelow llies
@@ -219,5 +213,4 @@ lieToText = \case
   L _ IEDocNamed{}           -> Text.pack "@IEDocNamed"
  where
   moduleNameToText :: Located ModuleName -> Text
-  moduleNameToText (L _ name) =
-    Text.pack ("@IEModuleContents" ++ moduleNameString name)
+  moduleNameToText (L _ name) = Text.pack ("@IEModuleContents" ++ moduleNameString name)

source/library/Language/Haskell/Brittany/Internal/Layouters/Import.hs

@@ -2,18 +2,26 @@
 
 module Language.Haskell.Brittany.Internal.Layouters.Import where
 
+import Language.Haskell.Brittany.Internal.Prelude
+import Language.Haskell.Brittany.Internal.PreludeUtils
 import qualified Data.Semigroup as Semigroup
 import qualified Data.Text as Text
-import GHC (GenLocated(L), Located, moduleNameString, unLoc)
+
+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
+                                                          )
 import           GHC.Hs
 import           GHC.Types.Basic
 import GHC.Unit.Types (IsBootInterface(..))
-import Language.Haskell.Brittany.Internal.Config.Types
-import Language.Haskell.Brittany.Internal.LayouterBasics
-import Language.Haskell.Brittany.Internal.Layouters.IE
-import Language.Haskell.Brittany.Internal.Prelude
-import Language.Haskell.Brittany.Internal.PreludeUtils
-import Language.Haskell.Brittany.Internal.Types
+
+
 
 prepPkg :: SourceText -> String
 prepPkg rawN = case rawN of
@@ -28,10 +36,8 @@ layoutImport :: ImportDecl GhcPs -> ToBriDocM BriDocNumbered
 layoutImport importD = case importD of
   ImportDecl _ _ (L _ modName) pkg src safe q False mas mllies -> do
     importCol <- mAsk <&> _conf_layout .> _lconfig_importColumn .> confUnpack
-    importAsCol <-
-      mAsk <&> _conf_layout .> _lconfig_importAsColumn .> confUnpack
-    indentPolicy <-
-      mAsk <&> _conf_layout .> _lconfig_indentPolicy .> confUnpack
+    importAsCol <- mAsk <&> _conf_layout .> _lconfig_importAsColumn .> confUnpack
+    indentPolicy <- mAsk <&>  _conf_layout .> _lconfig_indentPolicy .> confUnpack
     let
       compact  = indentPolicy /= IndentPolicyFree
       modNameT = Text.pack $ moduleNameString modName
@@ -40,13 +46,10 @@ layoutImport importD = case importD of
       hiding   = maybe False fst mllies
       minQLength = length "import qualified "
       qLengthReal =
-        let
-          qualifiedPart = if q /= NotQualified then length "qualified " else 0
+        let qualifiedPart = if q /= NotQualified then length "qualified " else 0
             safePart      = if safe then length "safe " else 0
             pkgPart       = maybe 0 ((+ 1) . Text.length) pkgNameT
-          srcPart = case src of
-            IsBoot -> length "{-# SOURCE #-} "
-            NotBoot -> 0
+            srcPart = case src of { IsBoot -> length "{-# SOURCE #-} "; NotBoot -> 0 }
         in  length "import " + srcPart + safePart + qualifiedPart + pkgPart
       qLength          = max minQLength qLengthReal
       -- Cost in columns of importColumn
@@ -55,23 +58,20 @@ layoutImport importD = case importD of
       nameCost         = Text.length modNameT + qLength
       importQualifiers = docSeq
         [ appSep $ docLit $ Text.pack "import"
-        , case src of
-          IsBoot -> appSep $ docLit $ Text.pack "{-# SOURCE #-}"
-          NotBoot -> docEmpty
+        , case src of { IsBoot -> appSep $ docLit $ Text.pack "{-# SOURCE #-}"; NotBoot -> docEmpty }
         , if safe then appSep $ docLit $ Text.pack "safe" else docEmpty
-        , if q /= NotQualified
-          then appSep $ docLit $ Text.pack "qualified"
-          else docEmpty
+        , if q /= NotQualified then appSep $ docLit $ Text.pack "qualified" else docEmpty
         , maybe docEmpty (appSep . docLit) pkgNameT
         ]
       indentName =
         if compact then id else docEnsureIndent (BrIndentSpecial qLength)
-      modNameD = indentName $ appSep $ docLit modNameT
-      hidDocCol =
-        if hiding then importCol - hidingParenCost else importCol - 2
+      modNameD =
+        indentName $ appSep $ docLit modNameT
+      hidDocCol = if hiding then importCol - hidingParenCost else importCol - 2
       hidDocColDiff = importCol - 2 - hidDocCol
-      hidDoc =
-        if hiding then appSep $ docLit $ Text.pack "hiding" else docEmpty
+      hidDoc = if hiding
+        then appSep $ docLit $ Text.pack "hiding"
+        else docEmpty
       importHead = docSeq [importQualifiers, modNameD]
       bindingsD  = case mllies of
         Nothing -> docEmpty
@@ -79,12 +79,8 @@ layoutImport importD = case importD of
           hasComments <- hasAnyCommentsBelow llies
           if compact
           then docAlt
-              [ docSeq
-                [ hidDoc
-                , docForceSingleline $ layoutLLIEs True ShouldSortItems llies
-                ]
-              , let
-                  makeParIfHiding = if hiding
+            [ docSeq [hidDoc, docForceSingleline $ layoutLLIEs True ShouldSortItems llies]
+            , let makeParIfHiding = if hiding
                     then docAddBaseY BrIndentRegular . docPar hidDoc
                     else id
               in makeParIfHiding (layoutLLIEs True ShouldSortItems llies)
@@ -97,15 +93,9 @@ layoutImport importD = case importD of
                 -- ..[hiding].( )
                 [] -> if hasComments
                   then docPar
-                        (docSeq
-                          [hidDoc, docParenLSep, docWrapNode llies docEmpty]
-                        )
-                        (docEnsureIndent
-                          (BrIndentSpecial hidDocColDiff)
-                          docParenR
-                        )
-                      else docSeq
-                        [hidDoc, docParenLSep, docSeparator, docParenR]
+                    (docSeq [hidDoc, docParenLSep, docWrapNode llies docEmpty])
+                    (docEnsureIndent (BrIndentSpecial hidDocColDiff) docParenR)
+                  else docSeq [hidDoc, docParenLSep, docSeparator, docParenR]
                 -- ..[hiding].( b )
                 [ieD] -> runFilteredAlternative $ do
                   addAlternativeCond (not hasComments)
@@ -117,19 +107,14 @@ layoutImport importD = case importD of
                     , docParenR
                     ]
                   addAlternative $ docPar
-                        (docSeq [hidDoc, docParenLSep, docNonBottomSpacing ieD]
-                        )
-                        (docEnsureIndent
-                          (BrIndentSpecial hidDocColDiff)
-                          docParenR
-                        )
+                    (docSeq [hidDoc, docParenLSep, docNonBottomSpacing ieD])
+                    (docEnsureIndent (BrIndentSpecial hidDocColDiff) docParenR)
                 -- ..[hiding].( b
                 --            , b'
                 --            )
-                    (ieD : ieDs') -> docPar
-                      (docSeq
-                        [hidDoc, docSetBaseY $ docSeq [docParenLSep, ieD]]
-                      )
+                (ieD:ieDs') ->
+                  docPar
+                    (docSeq [hidDoc, docSetBaseY $ docSeq [docParenLSep, ieD]])
                     (  docEnsureIndent (BrIndentSpecial hidDocColDiff)
                     $  docLines
                     $  ieDs'
@@ -140,19 +125,21 @@ layoutImport importD = case importD of
     if compact
     then
       let asDoc = maybe docEmpty makeAsDoc masT
-        in
-          docAlt
+      in docAlt
         [ docForceSingleline $ docSeq [importHead, asDoc, bindingsD]
-            , docAddBaseY BrIndentRegular
-              $ docPar (docSeq [importHead, asDoc]) bindingsD
+        , docAddBaseY BrIndentRegular $
+            docPar (docSeq [importHead, asDoc]) bindingsD
         ]
-      else case masT of
+    else
+      case masT of
         Just n -> if enoughRoom
-          then docLines [docSeq [importHead, asDoc], bindingsD]
+          then docLines
+                 [ docSeq [importHead, asDoc], bindingsD]
           else docLines [importHead, asDoc, bindingsD]
          where
           enoughRoom = nameCost < importAsCol - asCost
-          asDoc = docEnsureIndent (BrIndentSpecial (importAsCol - asCost))
+          asDoc =
+            docEnsureIndent (BrIndentSpecial (importAsCol - asCost))
               $ makeAsDoc n
         Nothing -> if enoughRoom
           then docSeq [importHead, bindingsD]

source/library/Language/Haskell/Brittany/Internal/Layouters/Module.hs

@@ -3,22 +3,29 @@
 
 module Language.Haskell.Brittany.Internal.Layouters.Module where
 
+import Language.Haskell.Brittany.Internal.Prelude
+import Language.Haskell.Brittany.Internal.PreludeUtils
 import qualified Data.Maybe
 import qualified Data.Semigroup as Semigroup
 import qualified Data.Text as Text
-import GHC (AnnKeywordId(..), GenLocated(L), moduleNameString, unLoc)
-import GHC.Hs
 import qualified GHC.OldList as List
-import Language.Haskell.Brittany.Internal.Config.Types
+
+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.Prelude
-import Language.Haskell.Brittany.Internal.PreludeUtils
-import Language.Haskell.Brittany.Internal.Types
+import           Language.Haskell.Brittany.Internal.Config.Types
+
+import GHC (unLoc, GenLocated(L), moduleNameString, AnnKeywordId(..))
+import           GHC.Hs
 import           Language.Haskell.GHC.ExactPrint as ExactPrint
 import           Language.Haskell.GHC.ExactPrint.Types
-  (DeltaPos(..), commentContents, deltaRow)
+                                                ( DeltaPos(..)
+                                                , deltaRow
+                                                , commentContents
+                                                )
+
+
 
 layoutModule :: ToBriDoc' HsModule
 layoutModule lmod@(L _ mod') = case mod' of
@@ -34,19 +41,22 @@ layoutModule lmod@(L _ mod') = case mod' of
     -- groupify commentedImports `forM_` tellDebugMessShow
     -- sortedImports <- sortImports imports
     let tn = Text.pack $ moduleNameString $ unLoc n
-    allowSingleLineExportList <-
-      mAsk <&> _conf_layout .> _lconfig_allowSingleLineExportList .> confUnpack
+    allowSingleLineExportList <- mAsk
+      <&> _conf_layout
+      .>  _lconfig_allowSingleLineExportList
+      .>  confUnpack
     -- the config should not prevent single-line layout when there is no
     -- export list
-    let
-      allowSingleLine = allowSingleLineExportList || Data.Maybe.isNothing les
+    let allowSingleLine = allowSingleLineExportList || Data.Maybe.isNothing les
     docLines
       $ docSeq
           [ docNodeAnnKW lmod Nothing docEmpty
              -- A pseudo node that serves merely to force documentation
              -- before the node
           , docNodeMoveToKWDP lmod AnnModule True $ runFilteredAlternative $ do
-            addAlternativeCond allowSingleLine $ docForceSingleline $ docSeq
+            addAlternativeCond allowSingleLine $
+              docForceSingleline
+                $ docSeq
                 [ appSep $ docLit $ Text.pack "module"
                 , appSep $ docLit tn
                 , docWrapNode lmod $ appSep $ case les of
@@ -55,11 +65,13 @@ layoutModule lmod@(L _ mod') = case mod' of
                 , docSeparator
                 , docLit $ Text.pack "where"
                 ]
-            addAlternative $ docLines
+            addAlternative
+              $ docLines
               [ docAddBaseY BrIndentRegular $ docPar
-                  (docSeq [appSep $ docLit $ Text.pack "module", docLit tn])
-                  (docSeq
-                    [ docWrapNode lmod $ case les of
+                (docSeq [appSep $ docLit $ Text.pack "module", docLit tn]
+                )
+                (docSeq [
+                          docWrapNode lmod $ case les of
                            Nothing -> docEmpty
                            Just x  -> layoutLLIEs False KeepItemsUnsorted x
                         , docSeparator
@@ -90,8 +102,7 @@ data ImportStatementRecord = ImportStatementRecord
   }
 
 instance Show ImportStatementRecord where
-  show r =
-    "ImportStatement " ++ show (length $ commentsBefore r) ++ " " ++ show
+  show r = "ImportStatement " ++ show (length $ commentsBefore r) ++ " " ++ show
         (length $ commentsAfter r)
 
 transformToCommentedImport
@@ -110,8 +121,7 @@ transformToCommentedImport is = do
     accumF accConnectedComm (annMay, decl) = case annMay of
       Nothing ->
         ( []
-        , [ ImportStatement ImportStatementRecord
-              { commentsBefore = []
+        , [ ImportStatement ImportStatementRecord { commentsBefore  = []
                                                   , commentsAfter   = []
                                                   , importStatement = decl
                                                   }
@@ -190,8 +200,10 @@ commentedImportsToDoc :: CommentedImport -> ToBriDocM BriDocNumbered
 commentedImportsToDoc = \case
   EmptyLine -> docLitS ""
   IndependentComment c -> commentToDoc c
-  ImportStatement r -> docSeq
-    (layoutImport (importStatement r) : map commentToDoc (commentsAfter r))
+  ImportStatement r ->
+    docSeq
+      ( layoutImport (importStatement r)
+      : map commentToDoc (commentsAfter r)
+      )
  where
-  commentToDoc (c, DP (_y, x)) =
-    docLitS (replicate x ' ' ++ commentContents c)
+  commentToDoc (c, DP (_y, x)) = docLitS (replicate x ' ' ++ commentContents c)

source/library/Language/Haskell/Brittany/Internal/Layouters/Pattern.hs

@@ -3,19 +3,28 @@
 
 module Language.Haskell.Brittany.Internal.Layouters.Pattern where
 
+
+
+import Language.Haskell.Brittany.Internal.Prelude
+import Language.Haskell.Brittany.Internal.PreludeUtils
 import qualified Data.Foldable as Foldable
 import qualified Data.Sequence as Seq
 import qualified Data.Text as Text
-import GHC (GenLocated(L), ol_val)
-import GHC.Hs
 import qualified GHC.OldList as List
-import GHC.Types.Basic
+
+import           Language.Haskell.Brittany.Internal.Types
 import           Language.Haskell.Brittany.Internal.LayouterBasics
+
+import           GHC                            ( GenLocated(L)
+                                                , ol_val
+                                                )
+import           GHC.Hs
+import           GHC.Types.Basic
+
 import {-# SOURCE #-} Language.Haskell.Brittany.Internal.Layouters.Expr
 import           Language.Haskell.Brittany.Internal.Layouters.Type
-import Language.Haskell.Brittany.Internal.Prelude
-import Language.Haskell.Brittany.Internal.PreludeUtils
-import Language.Haskell.Brittany.Internal.Types
+
+
 
 -- | layouts patterns (inside function bindings, case alternatives, let
 -- bindings or do notation). E.g. for input
@@ -31,9 +40,11 @@ layoutPat :: LPat GhcPs -> ToBriDocM (Seq BriDocNumbered)
 layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of
   WildPat _  -> fmap Seq.singleton $ docLit $ Text.pack "_"
     -- _ -> expr
-  VarPat _ n -> fmap Seq.singleton $ docLit $ lrdrNameToText n
+  VarPat _ n ->
+    fmap Seq.singleton $ docLit $ lrdrNameToText n
     -- abc -> expr
-  LitPat _ lit -> fmap Seq.singleton $ allocateNode $ litBriDoc lit
+  LitPat _ lit ->
+    fmap Seq.singleton $ allocateNode $ litBriDoc lit
     -- 0 -> expr
   ParPat _ inner -> do
     -- (nestedpat) -> expr
@@ -63,9 +74,10 @@ layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of
       then return <$> docLit nameDoc
       else do
         x1 <- appSep (docLit nameDoc)
-        xR <- fmap Seq.fromList $ sequence $ spacifyDocs $ fmap
-          colsWrapPat
-          argDocs
+        xR <- fmap Seq.fromList
+          $ sequence
+          $ spacifyDocs
+          $ fmap colsWrapPat argDocs
         return $ x1 Seq.<| xR
   ConPat _ lname (InfixCon left right) -> do
     -- a :< b -> expr
@@ -91,7 +103,8 @@ layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of
     Seq.singleton <$> docSeq
       [ appSep $ docLit t
       , appSep $ docLit $ Text.pack "{"
-      , docSeq $ List.intersperse docCommaSep $ fds <&> \case
+      , docSeq $ List.intersperse docCommaSep
+               $ fds <&> \case
           (fieldName, Just fieldDoc) -> docSeq
             [ appSep $ docLit fieldName
             , appSep $ docLit $ Text.pack "="
@@ -104,9 +117,11 @@ layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of
   ConPat _ lname (RecCon (HsRecFields [] (Just (L _ 0)))) -> do
     -- Abc { .. } -> expr
     let t = lrdrNameToText lname
-    Seq.singleton <$> docSeq [appSep $ docLit t, docLit $ Text.pack "{..}"]
-  ConPat _ lname (RecCon (HsRecFields fs@(_ : _) (Just (L _ dotdoti))))
-    | dotdoti == length fs -> do
+    Seq.singleton <$> docSeq
+      [ appSep $ docLit t
+      , docLit $ Text.pack "{..}"
+      ]
+  ConPat _ lname (RecCon (HsRecFields fs@(_:_) (Just (L _ dotdoti)))) | dotdoti == length fs -> do
     -- Abc { a = locA, .. }
     let t = lrdrNameToText lname
     fds <- fs `forM` \(L _ (HsRecField (L _ fieldOcc) fPat pun)) -> do
@@ -169,8 +184,7 @@ layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of
     wrapPatPrepend pat1 (docLit $ Text.pack "~")
   NPat _ llit@(L _ ol) mNegative _ -> do
     -- -13 -> expr
-    litDoc <- docWrapNode llit $ allocateNode $ overLitValBriDoc $ GHC.ol_val
-      ol
+    litDoc <- docWrapNode llit $ allocateNode $ overLitValBriDoc $ GHC.ol_val ol
     negDoc <- docLit $ Text.pack "-"
     pure $ case mNegative of
       Just{}  -> Seq.fromList [negDoc, litDoc]
@@ -182,7 +196,9 @@ colsWrapPat :: Seq BriDocNumbered -> ToBriDocM BriDocNumbered
 colsWrapPat = docCols ColPatterns . fmap return . Foldable.toList
 
 wrapPatPrepend
-  :: LPat GhcPs -> ToBriDocM BriDocNumbered -> ToBriDocM (Seq BriDocNumbered)
+  :: LPat GhcPs
+  -> ToBriDocM BriDocNumbered
+  -> ToBriDocM (Seq BriDocNumbered)
 wrapPatPrepend pat prepElem = do
   patDocs <- layoutPat pat
   case Seq.viewl patDocs of
@@ -204,5 +220,8 @@ wrapPatListy elems both start end = do
     x1 Seq.:< rest -> do
       sDoc <- start
       eDoc <- end
-      rest' <- rest `forM` \bd -> docSeq [docCommaSep, return bd]
+      rest' <- rest `forM` \bd -> docSeq
+        [ docCommaSep
+        , return bd
+        ]
       return $ (sDoc Seq.<| x1 Seq.<| rest') Seq.|> eDoc

source/library/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs

@@ -4,19 +4,26 @@
 
 module Language.Haskell.Brittany.Internal.Layouters.Stmt where
 
-import qualified Data.Semigroup as Semigroup
-import qualified Data.Text as Text
-import GHC (GenLocated(L))
-import GHC.Hs
-import Language.Haskell.Brittany.Internal.Config.Types
-import Language.Haskell.Brittany.Internal.LayouterBasics
+
+
 import Language.Haskell.Brittany.Internal.Prelude
 import Language.Haskell.Brittany.Internal.PreludeUtils
-import Language.Haskell.Brittany.Internal.Types
+import qualified Data.Semigroup as Semigroup
+import qualified Data.Text as Text
 
+import           Language.Haskell.Brittany.Internal.Types
+import           Language.Haskell.Brittany.Internal.LayouterBasics
+import           Language.Haskell.Brittany.Internal.Config.Types
+
+import           GHC                            ( GenLocated(L)
+                                                )
+import           GHC.Hs
+
+import           Language.Haskell.Brittany.Internal.Layouters.Pattern
 import           Language.Haskell.Brittany.Internal.Layouters.Decl
 import {-# SOURCE #-} Language.Haskell.Brittany.Internal.Layouters.Expr
-import Language.Haskell.Brittany.Internal.Layouters.Pattern
+
+
 
 layoutStmt :: ToBriDoc' (StmtLR GhcPs GhcPs (LHsExpr GhcPs))
 layoutStmt lstmt@(L _ stmt) = do
@@ -61,8 +68,7 @@ layoutStmt lstmt@(L _ stmt) = do
                 f = case indentPolicy of
                   IndentPolicyFree -> docSetBaseAndIndent
                   IndentPolicyLeft -> docForceSingleline
-                  IndentPolicyMultiple
-                    | indentFourPlus -> docSetBaseAndIndent
+                  IndentPolicyMultiple | indentFourPlus -> docSetBaseAndIndent
                                        | otherwise      -> docForceSingleline
               in  f $ return bindDoc
             ]
@@ -78,8 +84,7 @@ layoutStmt lstmt@(L _ stmt) = do
           --     ccc = exprc
           addAlternativeCond (isFree || indentFourPlus) $ docSeq
             [ appSep $ docLit $ Text.pack "let"
-            , let
-                f = if indentFourPlus
+            , let f = if indentFourPlus
                     then docEnsureIndent BrIndentRegular
                     else docSetBaseAndIndent
               in  f $ docLines $ return <$> bindDocs
@@ -90,8 +95,7 @@ layoutStmt lstmt@(L _ stmt) = do
           --   ccc = exprc
           addAlternativeCond (not indentFourPlus)
             $ docAddBaseY BrIndentRegular
-            $ docPar
-                (docLit $ Text.pack "let")
+            $ docPar (docLit $ Text.pack "let")
                      (docSetBaseAndIndent $ docLines $ return <$> bindDocs)
     RecStmt _ stmts _ _ _ _ _ -> runFilteredAlternative $ do
       -- rec stmt1

source/library/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs-boot

@@ -2,7 +2,14 @@
 
 module Language.Haskell.Brittany.Internal.Layouters.Stmt where
 
-import GHC.Hs
+
+
+import Language.Haskell.Brittany.Internal.Prelude
+
 import           Language.Haskell.Brittany.Internal.Types
 
+import           GHC.Hs
+
+
+
 layoutStmt :: ToBriDoc' (StmtLR GhcPs GhcPs (LHsExpr GhcPs))

source/library/Language/Haskell/Brittany/Internal/Layouters/Type.hs

@@ -3,18 +3,28 @@
 
 module Language.Haskell.Brittany.Internal.Layouters.Type where
 
-import qualified Data.Text as Text
-import GHC (AnnKeywordId(..), GenLocated(L))
-import GHC.Hs
-import qualified GHC.OldList as List
-import GHC.Types.Basic
-import GHC.Utils.Outputable (ftext, showSDocUnsafe)
-import Language.Haskell.Brittany.Internal.LayouterBasics
+
+
 import Language.Haskell.Brittany.Internal.Prelude
 import Language.Haskell.Brittany.Internal.PreludeUtils
+import qualified Data.Text as Text
+import qualified GHC.OldList as List
+
 import           Language.Haskell.Brittany.Internal.Types
+import           Language.Haskell.Brittany.Internal.LayouterBasics
 import           Language.Haskell.Brittany.Internal.Utils
-  (FirstLastView(..), splitFirstLast)
+                                                ( splitFirstLast
+                                                , FirstLastView(..)
+                                                )
+
+import           GHC ( GenLocated(L)
+                     , AnnKeywordId (..)
+                     )
+import           GHC.Hs
+import           GHC.Utils.Outputable ( ftext, showSDocUnsafe )
+import           GHC.Types.Basic
+
+
 
 layoutType :: ToBriDoc HsType
 layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
@@ -22,33 +32,43 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
   HsTyVar _ promoted name -> do
     t <- lrdrNameToTextAnnTypeEqualityIsSpecial name
     case promoted of
-      IsPromoted ->
-        docSeq [docSeparator, docTick, docWrapNode name $ docLit t]
+      IsPromoted -> docSeq
+        [ docSeparator
+        , docTick
+        , docWrapNode name $ docLit t
+        ]
       NotPromoted -> docWrapNode name $ docLit t
   HsForAllTy _ hsf (L _ (HsQualTy _ (L _ cntxts) typ2)) -> do
     let bndrs = getBinders hsf
     typeDoc <- docSharedWrapper layoutType typ2
     tyVarDocs <- layoutTyVarBndrs bndrs
     cntxtDocs <- cntxts `forM` docSharedWrapper layoutType
-    let
-      maybeForceML = case typ2 of
+    let maybeForceML = case typ2 of
           (L _ HsFunTy{}) -> docForceMultiline
           _               -> id
     let
       tyVarDocLineList = processTyVarBndrsSingleline tyVarDocs
       forallDoc = docAlt
-        [ let open = docLit $ Text.pack "forall"
+        [ let
+            open = docLit $ Text.pack "forall"
             in docSeq ([open]++tyVarDocLineList)
         , docPar
             (docLit (Text.pack "forall"))
-          (docLines $ tyVarDocs <&> \case
+            (docLines
+            $ tyVarDocs <&> \case
                 (tname, Nothing) -> docEnsureIndent BrIndentRegular $ docLit tname
-            (tname, Just doc) -> docEnsureIndent BrIndentRegular $ docLines
-              [ docCols ColTyOpPrefix [docParenLSep, docLit tname]
-              , docCols ColTyOpPrefix [docLit $ Text.pack ":: ", doc]
-              , docLit $ Text.pack ")"
+                (tname, Just doc) -> docEnsureIndent BrIndentRegular
+                  $ docLines
+                    [ docCols ColTyOpPrefix
+                      [ docParenLSep
+                      , docLit tname
                       ]
-          )
+                    , docCols ColTyOpPrefix
+                      [ docLit $ Text.pack ":: "
+                      , doc
+                      ]
+                    , docLit $ Text.pack ")"
+                    ])
         ]
       contextDoc = case cntxtDocs of
         [] -> docLit $ Text.pack "()"
@@ -57,19 +77,20 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
           [ let
               open  = docLit $ Text.pack "("
               close = docLit $ Text.pack ")"
-              list =
-                List.intersperse docCommaSep $ docForceSingleline <$> cntxtDocs
+              list  = List.intersperse docCommaSep
+                    $ docForceSingleline <$> cntxtDocs
               in docSeq ([open]++list++[close])
           , let
-              open = docCols
-                ColTyOpPrefix
+              open = docCols ColTyOpPrefix
                       [ docParenLSep
                       , docAddBaseY (BrIndentSpecial 2) $ head cntxtDocs
                       ]
               close = docLit $ Text.pack ")"
-              list = List.tail cntxtDocs <&> \cntxtDoc -> docCols
-                ColTyOpPrefix
-                [docCommaSep, docAddBaseY (BrIndentSpecial 2) cntxtDoc]
+              list = List.tail cntxtDocs <&> \cntxtDoc ->
+                     docCols ColTyOpPrefix
+                      [ docCommaSep
+                      , docAddBaseY (BrIndentSpecial 2) cntxtDoc
+                      ]
             in docPar open $ docLines $ list ++ [close]
           ]
     docAlt
@@ -77,8 +98,7 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
       [ docSeq
         [ if null bndrs
             then docEmpty
-          else
-            let
+            else let
               open = docLit $ Text.pack "forall"
               close = docLit $ Text.pack " . "
               in docSeq ([open, docSeparator]++tyVarDocLineList++[close])
@@ -93,13 +113,12 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
       , docPar
           forallDoc
           ( docLines
-          [ docCols
-            ColTyOpPrefix
+            [ docCols ColTyOpPrefix
               [ docWrapNodeRest ltype $ docLit $ Text.pack " . "
-            , docAddBaseY (BrIndentSpecial 3) $ contextDoc
+              , docAddBaseY (BrIndentSpecial 3)
+              $ contextDoc
               ]
-          , docCols
-            ColTyOpPrefix
+            , docCols ColTyOpPrefix
               [ docLit $ Text.pack "=> "
               , docAddBaseY (BrIndentSpecial 3) $ maybeForceML $ typeDoc
               ]
@@ -110,8 +129,7 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
     let bndrs = getBinders hsf
     typeDoc <- layoutType typ2
     tyVarDocs <- layoutTyVarBndrs bndrs
-    let
-      maybeForceML = case typ2 of
+    let maybeForceML = case typ2 of
           (L _ HsFunTy{}) -> docForceMultiline
           _               -> id
     let tyVarDocLineList = processTyVarBndrsSingleline tyVarDocs
@@ -120,8 +138,7 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
       [ docSeq
         [ if null bndrs
             then docEmpty
-          else
-            let
+            else let
               open = docLit $ Text.pack "forall"
               close = docLit $ Text.pack " . "
               in docSeq ([open]++tyVarDocLineList++[close])
@@ -131,8 +148,7 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
       --  . x
       , docPar
           (docSeq $ docLit (Text.pack "forall") : tyVarDocLineList)
-        (docCols
-          ColTyOpPrefix
+          ( docCols ColTyOpPrefix
             [ docWrapNodeRest ltype $ docLit $ Text.pack " . "
             , maybeForceML $ return typeDoc
             ]
@@ -144,16 +160,21 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
           (docLit (Text.pack "forall"))
           (docLines
           $ (tyVarDocs <&> \case
-            (tname, Nothing) ->
-              docEnsureIndent BrIndentRegular $ docLit tname
-            (tname, Just doc) -> docEnsureIndent BrIndentRegular $ docLines
-              [ docCols ColTyOpPrefix [docParenLSep, docLit tname]
-              , docCols ColTyOpPrefix [docLit $ Text.pack ":: ", doc]
+              (tname, Nothing) -> docEnsureIndent BrIndentRegular $ docLit tname
+              (tname, Just doc) -> docEnsureIndent BrIndentRegular
+                $ docLines
+                  [ docCols ColTyOpPrefix
+                    [ docParenLSep
+                    , docLit tname
+                    ]
+                  , docCols ColTyOpPrefix
+                    [ docLit $ Text.pack ":: "
+                    , doc
+                    ]
                   , docLit $ Text.pack ")"
                   ]
             )
-        ++ [ docCols
-               ColTyOpPrefix
+          ++[ docCols ColTyOpPrefix
               [ docWrapNodeRest ltype $ docLit $ Text.pack " . "
               , maybeForceML $ return typeDoc
               ]
@@ -171,23 +192,25 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
           [ let
               open  = docLit $ Text.pack "("
               close = docLit $ Text.pack ")"
-              list =
-                List.intersperse docCommaSep $ docForceSingleline <$> cntxtDocs
+              list  = List.intersperse docCommaSep
+                    $ docForceSingleline <$> cntxtDocs
               in docSeq ([open]++list++[close])
           , let
-              open = docCols
-                ColTyOpPrefix
+              open = docCols ColTyOpPrefix
                       [ docParenLSep
-                , docAddBaseY (BrIndentSpecial 2) $ head cntxtDocs
+                      , docAddBaseY (BrIndentSpecial 2)
+                      $ head cntxtDocs
                       ]
               close = docLit $ Text.pack ")"
-              list = List.tail cntxtDocs <&> \cntxtDoc -> docCols
-                ColTyOpPrefix
-                [docCommaSep, docAddBaseY (BrIndentSpecial 2) $ cntxtDoc]
+              list = List.tail cntxtDocs <&> \cntxtDoc ->
+                     docCols ColTyOpPrefix
+                      [ docCommaSep
+                      , docAddBaseY (BrIndentSpecial 2)
+                      $ cntxtDoc
+                      ]
             in docPar open $ docLines $ list ++ [close]
           ]
-    let
-      maybeForceML = case typ1 of
+    let maybeForceML = case typ1 of
           (L _ HsFunTy{}) -> docForceMultiline
           _               -> id
     docAlt
@@ -202,8 +225,7 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
       -- -> c
       , docPar
           (docForceSingleline contextDoc)
-        (docCols
-          ColTyOpPrefix
+          ( docCols ColTyOpPrefix
             [ docLit $ Text.pack "=> "
             , docAddBaseY (BrIndentSpecial 3) $ maybeForceML typeDoc
             ]
@@ -212,25 +234,24 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
   HsFunTy _ _ typ1 typ2 -> do
     typeDoc1 <- docSharedWrapper layoutType typ1
     typeDoc2 <- docSharedWrapper layoutType typ2
-    let
-      maybeForceML = case typ2 of
+    let maybeForceML = case typ2 of
           (L _ HsFunTy{}) -> docForceMultiline
           _               -> id
     hasComments <- hasAnyCommentsBelow ltype
-    docAlt
-      $ [ docSeq
+    docAlt $
+      [ docSeq
         [ appSep $ docForceSingleline typeDoc1
         , appSep $ docLit $ Text.pack "->"
         , docForceSingleline typeDoc2
         ]
       | not hasComments
-        ]
-      ++ [ docPar
+      ] ++
+      [ docPar
         (docNodeAnnKW ltype Nothing typeDoc1)
-             (docCols
-               ColTyOpPrefix
+        ( docCols ColTyOpPrefix
           [ docWrapNodeRest ltype $ appSep $ docLit $ Text.pack "->"
-               , docAddBaseY (BrIndentSpecial 3) $ maybeForceML typeDoc2
+          , docAddBaseY (BrIndentSpecial 3)
+          $ maybeForceML typeDoc2
           ]
         )
       ]
@@ -243,18 +264,14 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
         , docLit $ Text.pack ")"
         ]
       , docPar
-        (docCols
-          ColTyOpPrefix
+          ( docCols ColTyOpPrefix
             [ docWrapNodeRest ltype $ docParenLSep
             , docAddBaseY (BrIndentSpecial 2) $ typeDoc1
-          ]
-        )
+            ])
           (docLit $ Text.pack ")")
       ]
   HsAppTy _ typ1@(L _ HsAppTy{}) typ2 -> do
-    let
-      gather
-        :: [LHsType GhcPs] -> LHsType GhcPs -> (LHsType GhcPs, [LHsType GhcPs])
+    let gather :: [LHsType GhcPs] -> LHsType GhcPs -> (LHsType GhcPs, [LHsType GhcPs])
         gather list = \case
           L _ (HsAppTy _ ty1 ty2) -> gather (ty2:list) ty1
           final -> (final, list)
@@ -263,8 +280,8 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
     docRest <- docSharedWrapper layoutType `mapM` typRest
     docAlt
       [ docSeq
-      $ docForceSingleline docHead
-      : (docRest >>= \d -> [docSeparator, docForceSingleline d])
+      $ docForceSingleline docHead : (docRest >>= \d ->
+        [ docSeparator, docForceSingleline d ])
       , docPar docHead (docLines $ docEnsureIndent BrIndentRegular <$> docRest)
       ]
   HsAppTy _ typ1 typ2 -> do
@@ -276,7 +293,9 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
         , docSeparator
         , docForceSingleline typeDoc2
         ]
-      , docPar typeDoc1 (docEnsureIndent BrIndentRegular typeDoc2)
+      , docPar
+          typeDoc1
+          (docEnsureIndent BrIndentRegular typeDoc2)
       ]
   HsListTy _ typ1 -> do
     typeDoc1 <- docSharedWrapper layoutType typ1
@@ -287,12 +306,10 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
         , docLit $ Text.pack "]"
         ]
       , docPar
-        (docCols
-          ColTyOpPrefix
+          ( docCols ColTyOpPrefix
             [ docWrapNodeRest ltype $ docLit $ Text.pack "[ "
             , docAddBaseY (BrIndentSpecial 2) $ typeDoc1
-          ]
-        )
+            ])
           (docLit $ Text.pack "]")
       ]
   HsTupleTy _ tupleSort typs -> case tupleSort of
@@ -301,46 +318,38 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
     HsConstraintTuple        -> simple
     HsBoxedOrConstraintTuple -> simple
    where
-    unboxed = if null typs
-      then error "brittany internal error: unboxed unit"
+    unboxed = if null typs then error "brittany internal error: unboxed unit"
                            else unboxedL
     simple = if null typs then unitL else simpleL
     unitL = docLit $ Text.pack "()"
     simpleL = do
       docs <- docSharedWrapper layoutType `mapM` typs
-      let
-        end = docLit $ Text.pack ")"
-        lines =
-          List.tail docs
-            <&> \d -> docAddBaseY (BrIndentSpecial 2)
+      let end = docLit $ Text.pack ")"
+          lines = List.tail docs <&> \d ->
+            docAddBaseY (BrIndentSpecial 2)
               $ docCols ColTyOpPrefix [docCommaSep, d]
           commaDocs = List.intersperse docCommaSep (docForceSingleline <$> docs)
       docAlt
-        [ docSeq
-        $ [docLit $ Text.pack "("]
+        [ docSeq $ [docLit $ Text.pack "("]
                ++ docWrapNodeRest ltype commaDocs
                ++ [end]
         , let line1 = docCols ColTyOpPrefix [docParenLSep, head docs]
-          in
-            docPar
+          in docPar
             (docAddBaseY (BrIndentSpecial 2) $ line1)
             (docLines $ docWrapNodeRest ltype lines ++ [end])
         ]
     unboxedL = do
       docs <- docSharedWrapper layoutType `mapM` typs
-      let
-        start = docParenHashLSep
+      let start = docParenHashLSep
           end   = docParenHashRSep
       docAlt
-        [ docSeq
-        $ [start]
+        [ docSeq $ [start]
                 ++ docWrapNodeRest ltype (List.intersperse docCommaSep docs)
                 ++ [end]
         , let
             line1 = docCols ColTyOpPrefix [start, head docs]
-            lines =
-              List.tail docs
-                <&> \d -> docAddBaseY (BrIndentSpecial 2)
+            lines  = List.tail docs <&> \d ->
+              docAddBaseY (BrIndentSpecial 2)
                 $ docCols ColTyOpPrefix [docCommaSep, d]
           in docPar
             (docAddBaseY (BrIndentSpecial 2) line1)
@@ -410,18 +419,20 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
     typeDoc1 <- docSharedWrapper layoutType typ1
     docAlt
       [ docSeq
-        [ docWrapNodeRest ltype $ docLit $ Text.pack
-          ("?" ++ showSDocUnsafe (ftext ipName) ++ "::")
+        [ docWrapNodeRest ltype
+        $ docLit
+        $ Text.pack ("?" ++ showSDocUnsafe (ftext ipName) ++ "::")
         , docForceSingleline typeDoc1
         ]
       , docPar
-        (docLit $ Text.pack ("?" ++ showSDocUnsafe (ftext ipName)))
-        (docCols
-          ColTyOpPrefix
-          [ docWrapNodeRest ltype $ docLit $ Text.pack ":: "
-          , docAddBaseY (BrIndentSpecial 2) typeDoc1
-          ]
+          ( docLit
+          $ Text.pack ("?" ++ showSDocUnsafe (ftext ipName))
           )
+          (docCols ColTyOpPrefix
+            [ docWrapNodeRest ltype
+            $ docLit $ Text.pack ":: "
+            , docAddBaseY (BrIndentSpecial 2) typeDoc1
+            ])
       ]
   -- TODO: test KindSig
   HsKindSig _ typ1 kind1 -> do
@@ -560,19 +571,15 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
           addAlternativeCond (not hasComments)
             $  docSeq
             $  [docLit $ Text.pack "'["]
-            ++ List.intersperse
-                 specialCommaSep
-                 (docForceSingleline
-                 <$> (e1 : ems ++ [docNodeAnnKW ltype (Just AnnOpenS) eN])
-                 )
+            ++ List.intersperse specialCommaSep (docForceSingleline <$> (e1:ems ++ [docNodeAnnKW ltype (Just AnnOpenS) eN]))
             ++ [docLit $ Text.pack " ]"]
-          addAlternative
-            $ let
-                start = docCols ColList [appSep $ docLit $ Text.pack "'[", e1]
-                linesM = ems <&> \d -> docCols ColList [specialCommaSep, d]
-                lineN = docCols
-                  ColList
-                  [specialCommaSep, docNodeAnnKW ltype (Just AnnOpenS) eN]
+          addAlternative $
+            let
+              start = docCols ColList
+                        [appSep $ docLit $ Text.pack "'[", e1]
+              linesM = ems <&> \d ->
+                      docCols ColList [specialCommaSep, d]
+              lineN = docCols ColList [specialCommaSep, docNodeAnnKW ltype (Just AnnOpenS) eN]
               end   = docLit $ Text.pack " ]"
             in docSetBaseY $ docLines $ [start] ++ linesM ++ [lineN] ++ [end]
       ]
@@ -585,7 +592,8 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
     HsStrTy (SourceText srctext) _ -> docLit $ Text.pack srctext
     HsStrTy NoSourceText _ ->
       error "overLitValBriDoc: literal with no SourceText"
-  HsWildCardTy _ -> docLit $ Text.pack "_"
+  HsWildCardTy _ ->
+    docLit $ Text.pack "_"
   HsSumTy{} -> -- TODO
     briDocByExactInlineOnly "HsSumTy{}" ltype
   HsStarTy _ isUnicode -> do
@@ -603,7 +611,9 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
           , docLit $ Text.pack "@"
           , docForceSingleline k
           ]
-      , docPar t (docSeq [docLit $ Text.pack "@", k])
+      , docPar
+          t
+          (docSeq [docLit $ Text.pack "@", k ])
       ]
 
 layoutTyVarBndrs

source/library/Language/Haskell/Brittany/Internal/Obfuscation.hs

@@ -2,22 +2,26 @@
 
 module Language.Haskell.Brittany.Internal.Obfuscation where
 
-import Data.Char
+
+
+import Language.Haskell.Brittany.Internal.Prelude
+import Language.Haskell.Brittany.Internal.PreludeUtils
 import qualified Data.Map as Map
 import qualified Data.Set as Set
 import qualified Data.Text as Text
 import qualified GHC.OldList as List
-import Language.Haskell.Brittany.Internal.Prelude
-import Language.Haskell.Brittany.Internal.PreludeUtils
+
+import           Data.Char
 import           System.Random
 
+
+
 obfuscate :: Text -> IO Text
 obfuscate input = do
   let predi x = isAlphaNum x || x `elem` "_'"
   let groups = List.groupBy (\a b -> predi a && predi b) (Text.unpack input)
   let idents = Set.toList $ Set.fromList $ filter (all predi) groups
-  let
-    exceptionFilter x | x `elem` keywords = False
+  let exceptionFilter x | x `elem` keywords = False
       exceptionFilter x | x `elem` extraKWs = False
       exceptionFilter x                     = not $ null $ drop 1 x
   let filtered = filter exceptionFilter idents

source/library/Language/Haskell/Brittany/Internal/Prelude.hs

@@ -1,195 +1,346 @@
-module Language.Haskell.Brittany.Internal.Prelude
-  ( module E
-  ) where
+module Language.Haskell.Brittany.Internal.Prelude ( module E ) where
 
+
+
+-- rather project-specific stuff:
+---------------------------------
 import GHC.Hs.Extension               as E ( GhcPs )
+
 import GHC.Types.Name.Reader          as E ( RdrName )
 
-import Control.Applicative as E (Alternative(..), Applicative(..))
-import Control.Arrow as E ((&&&), (***), (<<<), (>>>), first, second)
-import Control.Concurrent as E (forkIO, forkOS, threadDelay)
+
+-- more general:
+----------------
+
+import Data.Functor.Identity         as E ( Identity(..) )
 import Control.Concurrent.Chan       as E ( Chan )
-import Control.Concurrent.MVar as E
-  (MVar, newEmptyMVar, newMVar, putMVar, readMVar, swapMVar, takeMVar)
-import Control.Exception as E (assert, bracket, evaluate)
-import Control.Monad as E
-  ( (<$!>)
-  , (<=<)
-  , (=<<)
-  , (>=>)
-  , Functor(..)
+import Control.Concurrent.MVar       as E ( MVar
+                                          , newEmptyMVar
+                                          , newMVar
+                                          , putMVar
+                                          , readMVar
+                                          , takeMVar
+                                          , swapMVar
+                                          )
+import Data.Int                      as E ( Int )
+import Data.Word                     as E ( Word
+                                          , Word32
+                                          )
+import Prelude                       as E ( Integer
+                                          , Float
+                                          , Double
+                                          , undefined
+                                          , Eq (..)
+                                          , Ord (..)
+                                          , Enum (..)
+                                          , Bounded (..)
+                                          , (<$>)
+                                          , (.)
+                                          , ($)
+                                          , ($!)
+                                          , Num (..)
+                                          , Integral (..)
+                                          , Fractional (..)
+                                          , Floating (..)
+                                          , RealFrac (..)
+                                          , RealFloat (..)
+                                          , fromIntegral
+                                          , error
+                                          , foldr
+                                          , foldl
+                                          , foldr1
+                                          , id
+                                          , map
+                                          , subtract
+                                          , putStrLn
+                                          , putStr
+                                          , Show (..)
+                                          , print
+                                          , fst
+                                          , snd
+                                          , (++)
+                                          , not
+                                          , (&&)
+                                          , (||)
+                                          , curry
+                                          , uncurry
+                                          , flip
+                                          , const
+                                          , seq
+                                          , reverse
+                                          , otherwise
+                                          , traverse
+                                          , realToFrac
+                                          , or
+                                          , and
+                                          , head
+                                          , any
+                                          , (^)
+                                          , Foldable
+                                          , Traversable
+                                          )
+import Control.Monad.ST              as E ( ST )
+import Data.Bool                     as E ( Bool(..) )
+import Data.Char                     as E ( Char
+                                          , ord
+                                          , chr
+                                          )
+import Data.Either                   as E ( Either(..)
+                                          , either
+                                          )
+import Data.IORef                    as E ( IORef )
+import Data.Maybe                    as E ( Maybe(..)
+                                          , fromMaybe
+                                          , maybe
+                                          , listToMaybe
+                                          , maybeToList
+                                          , catMaybes
+                                          )
+import Data.Monoid                   as E ( Endo(..)
+                                          , All(..)
+                                          , Any(..)
+                                          , Sum(..)
+                                          , Product(..)
+                                          , Alt(..)
+                                          , mconcat
+                                          , Monoid (..)
+                                          )
+import Data.Ord                      as E ( Ordering(..)
+                                          , Down(..)
+                                          , comparing
+                                          )
+import Data.Ratio                    as E ( Ratio
+                                          , Rational
+                                          , (%)
+                                          , numerator
+                                          , denominator
+                                          )
+import Data.String                   as E ( String )
+import Data.Void                     as E ( Void )
+import System.IO                     as E ( IO
+                                          , hFlush
+                                          , stdout
+                                          )
+import Data.Proxy                    as E ( Proxy(..) )
+import Data.Sequence                 as E ( Seq )
+
+import Data.Map                      as E ( Map )
+import Data.Set                      as E ( Set )
+
+import Data.Text                     as E ( Text )
+
+import Data.Function                 as E ( fix
+                                          , (&)
+                                          )
+
+import Data.Foldable                 as E ( foldl'
+                                          , foldr'
+                                          , fold
+                                          , asum
+                                          )
+
+import Data.List                     as E ( partition
+                                          , null
+                                          , elem
+                                          , notElem
+                                          , minimum
+                                          , maximum
+                                          , length
+                                          , all
+                                          , take
+                                          , drop
+                                          , find
+                                          , sum
+                                          , zip
+                                          , zip3
+                                          , zipWith
+                                          , repeat
+                                          , replicate
+                                          , iterate
+                                          , nub
+                                          , filter
+                                          , intersperse
+                                          , intercalate
+                                          , isSuffixOf
+                                          , isPrefixOf
+                                          , dropWhile
+                                          , takeWhile
+                                          , unzip
+                                          , break
+                                          , transpose
+                                          , sortBy
+                                          , mapAccumL
+                                          , mapAccumR
+                                          , uncons
+                                          )
+
+import Data.List.NonEmpty            as E ( NonEmpty(..)
+                                          , nonEmpty
+                                          )
+
+import Data.Tuple                    as E ( swap
+                                          )
+
+import Text.Read                     as E ( readMaybe
+                                          )
+
+import Control.Monad                 as E ( Functor (..)
                                           , Monad (..)
                                           , MonadPlus (..)
-  , filterM
+                                          , mapM
+                                          , mapM_
                                           , forM
                                           , forM_
+                                          , sequence
+                                          , sequence_
+                                          , (=<<)
+                                          , (>=>)
+                                          , (<=<)
                                           , forever
-  , guard
+                                          , void
                                           , join
+                                          , replicateM
+                                          , replicateM_
+                                          , guard
+                                          , when
+                                          , unless
                                           , liftM
                                           , liftM2
                                           , liftM3
                                           , liftM4
                                           , liftM5
-  , mapM
-  , mapM_
-  , replicateM
-  , replicateM_
-  , sequence
-  , sequence_
-  , unless
-  , void
-  , when
+                                          , filterM
+                                          , (<$!>)
                                           )
-import Control.Monad.Extra as E
-  (allM, andM, anyM, ifM, notM, orM, unlessM, whenM)
-import Control.Monad.IO.Class as E (MonadIO(..))
-import Control.Monad.ST as E (ST)
-import Control.Monad.Trans.Class as E (lift)
-import Control.Monad.Trans.Maybe as E (MaybeT(..))
-import Control.Monad.Trans.MultiRWS as E
-  (MonadMultiReader(..), MonadMultiState(..), MonadMultiWriter(..), mGet)
-import Data.Bifunctor as E (bimap)
-import Data.Bool as E (Bool(..))
-import Data.Char as E (Char, chr, ord)
-import Data.Data as E (toConstr)
-import Data.Either as E (Either(..), either)
-import Data.Foldable as E (asum, fold, foldl', foldr')
-import Data.Function as E ((&), fix)
-import Data.Functor as E (($>))
-import Data.Functor.Identity as E (Identity(..))
-import Data.IORef as E (IORef)
-import Data.Int as E (Int)
-import Data.List as E
-  ( all
-  , break
-  , drop
-  , dropWhile
-  , elem
-  , filter
-  , find
-  , intercalate
-  , intersperse
-  , isPrefixOf
-  , isSuffixOf
-  , iterate
-  , length
-  , mapAccumL
-  , mapAccumR
-  , maximum
-  , minimum
-  , notElem
-  , nub
-  , null
-  , partition
-  , repeat
-  , replicate
-  , sortBy
-  , sum
-  , take
-  , takeWhile
-  , transpose
-  , uncons
-  , unzip
-  , zip
-  , zip3
-  , zipWith
+
+import Control.Applicative           as E ( Applicative (..)
+                                          , Alternative (..)
                                           )
-import Data.List.Extra as E (nubOrd, stripSuffix)
-import Data.List.NonEmpty as E (NonEmpty(..), nonEmpty)
-import Data.Map as E (Map)
-import Data.Maybe as E
-  (Maybe(..), catMaybes, fromMaybe, listToMaybe, maybe, maybeToList)
-import Data.Monoid as E
-  ( All(..)
-  , Alt(..)
-  , Any(..)
-  , Endo(..)
-  , Monoid(..)
-  , Product(..)
-  , Sum(..)
-  , mconcat
-  )
-import Data.Ord as E (Down(..), Ordering(..), comparing)
-import Data.Proxy as E (Proxy(..))
-import Data.Ratio as E ((%), Ratio, Rational, denominator, numerator)
-import Data.Semigroup as E ((<>), Semigroup(..))
-import Data.Sequence as E (Seq)
-import Data.Set as E (Set)
-import Data.String as E (String)
-import Data.Text as E (Text)
-import Data.Tree as E (Tree(..))
-import Data.Tuple as E (swap)
-import Data.Typeable as E (Typeable)
-import Data.Version as E (showVersion)
-import Data.Void as E (Void)
-import Data.Word as E (Word, Word32)
-import Debug.Trace as E
-  ( trace
-  , traceIO
-  , traceId
-  , traceM
-  , traceShow
-  , traceShowId
-  , traceShowM
-  , traceStack
-  )
-import Foreign.ForeignPtr as E (ForeignPtr)
+
 import Foreign.Storable              as E ( Storable )
 import GHC.Exts                      as E ( Constraint )
-import Prelude as E
-  ( ($)
-  , ($!)
-  , (&&)
-  , (++)
-  , (.)
-  , (<$>)
-  , Bounded(..)
-  , Double
-  , Enum(..)
-  , Eq(..)
-  , Float
-  , Floating(..)
-  , Foldable
-  , Fractional(..)
-  , Integer
-  , Integral(..)
-  , Num(..)
-  , Ord(..)
-  , RealFloat(..)
-  , RealFrac(..)
-  , Show(..)
-  , Traversable
-  , (^)
-  , and
-  , any
-  , const
-  , curry
-  , error
-  , flip
-  , foldl
-  , foldr
-  , foldr1
-  , fromIntegral
-  , fst
-  , head
-  , id
-  , map
-  , not
-  , or
-  , otherwise
-  , print
-  , putStr
-  , putStrLn
-  , realToFrac
-  , reverse
-  , seq
-  , snd
-  , subtract
-  , traverse
-  , uncurry
-  , undefined
-  , (||)
+
+import Control.Concurrent            as E ( threadDelay
+                                          , forkIO
+                                          , forkOS
+                                          )
+
+import Control.Exception             as E ( evaluate
+                                          , bracket
+                                          , assert
+                                          )
+
+import Debug.Trace                   as E ( trace
+                                          , traceId
+                                          , traceShowId
+                                          , traceShow
+                                          , traceStack
+                                          , traceShowId
+                                          , traceIO
+                                          , traceM
+                                          , traceShowM
+                                          )
+
+import Foreign.ForeignPtr            as E ( ForeignPtr
+                                          )
+
+import Data.Bifunctor                as E ( bimap )
+import Data.Functor                  as E ( ($>) )
+import Data.Semigroup                as E ( (<>)
+                                          , Semigroup(..)
+                                          )
+
+import Data.Typeable                 as E ( Typeable
+                                          )
+
+import Control.Arrow                 as E ( first
+                                          , second
+                                          , (***)
+                                          , (&&&)
+                                          , (>>>)
+                                          , (<<<)
+                                          )
+
+import Data.Version                  as E ( showVersion
+                                          )
+
+import Data.List.Extra               as E ( nubOrd
+                                          , stripSuffix
+                                          )
+import Control.Monad.Extra           as E ( whenM
+                                          , unlessM
+                                          , ifM
+                                          , notM
+                                          , orM
+                                          , andM
+                                          , anyM
+                                          , allM
+                                          )
+
+import Data.Tree                     as E ( Tree(..)
+                                          )
+
+import Control.Monad.Trans.MultiRWS  as E ( -- MultiRWST (..)
+                                          -- , MultiRWSTNull
+                                          -- , MultiRWS
+                                          -- ,
+                                            MonadMultiReader(..)
+                                          , MonadMultiWriter(..)
+                                          , MonadMultiState(..)
+                                          , mGet
+                                          -- , runMultiRWST
+                                          -- , runMultiRWSTASW
+                                          -- , runMultiRWSTW
+                                          -- , runMultiRWSTAW
+                                          -- , runMultiRWSTSW
+                                          -- , runMultiRWSTNil
+                                          -- , runMultiRWSTNil_
+                                          -- , withMultiReader
+                                          -- , withMultiReader_
+                                          -- , withMultiReaders
+                                          -- , withMultiReaders_
+                                          -- , withMultiWriter
+                                          -- , withMultiWriterAW
+                                          -- , withMultiWriterWA
+                                          -- , withMultiWriterW
+                                          -- , withMultiWriters
+                                          -- , withMultiWritersAW
+                                          -- , withMultiWritersWA
+                                          -- , withMultiWritersW
+                                          -- , withMultiState
+                                          -- , withMultiStateAS
+                                          -- , withMultiStateSA
+                                          -- , withMultiStateA
+                                          -- , withMultiStateS
+                                          -- , withMultiState_
+                                          -- , withMultiStates
+                                          -- , withMultiStatesAS
+                                          -- , withMultiStatesSA
+                                          -- , withMultiStatesA
+                                          -- , withMultiStatesS
+                                          -- , withMultiStates_
+                                          -- , inflateReader
+                                          -- , inflateMultiReader
+                                          -- , inflateWriter
+                                          -- , inflateMultiWriter
+                                          -- , inflateState
+                                          -- , inflateMultiState
+                                          -- , mapMultiRWST
+                                          -- , mGetRawR
+                                          -- , mGetRawW
+                                          -- , mGetRawS
+                                          -- , mPutRawR
+                                          -- , mPutRawW
+                                          -- , mPutRawS
+                                          )
+
+import Control.Monad.IO.Class        as E ( MonadIO (..)
+                                          )
+
+import Control.Monad.Trans.Class     as E ( lift
+                                          )
+import Control.Monad.Trans.Maybe     as E ( MaybeT (..)
+                                          )
+
+import Data.Data                     as E ( toConstr
                                           )
-import System.IO as E (IO, hFlush, stdout)
-import Text.Read as E (readMaybe)

source/library/Language/Haskell/Brittany/Internal/PreludeUtils.hs

@@ -1,15 +1,21 @@
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 module Language.Haskell.Brittany.Internal.PreludeUtils where
 
-import Control.Applicative
-import Control.DeepSeq (NFData, force)
-import Control.Exception.Base (evaluate)
-import Control.Monad
+
+
+import Prelude
 import qualified Data.Strict.Maybe as Strict
 import Debug.Trace
-import Prelude
+import Control.Monad
 import System.IO
 
+import Control.DeepSeq ( NFData, force )
+import Control.Exception.Base ( evaluate )
+
+import Control.Applicative
+
+
+
 instance Applicative Strict.Maybe where
   pure = Strict.Just
   Strict.Just f <*> Strict.Just x = Strict.Just (f x)
@@ -24,12 +30,12 @@ instance Alternative Strict.Maybe where
   x <|> Strict.Nothing = x
   _ <|> x = x
 
-traceFunctionWith
-  :: String -> (a -> String) -> (b -> String) -> (a -> b) -> (a -> b)
+traceFunctionWith :: String -> (a -> String) -> (b -> String) -> (a -> b) -> (a -> b)
 traceFunctionWith name s1 s2 f x = trace traceStr y
  where
   y = f x
-  traceStr = name ++ "\nBEFORE:\n" ++ s1 x ++ "\nAFTER:\n" ++ s2 y
+  traceStr =
+    name ++ "\nBEFORE:\n" ++ s1 x ++ "\nAFTER:\n" ++ s2 y
 
 (<&!>) :: Monad m => m a -> (a -> b) -> m b
 (<&!>) = flip (<$!>)

source/library/Language/Haskell/Brittany/Internal/Transformations/Alt.hs

@@ -9,18 +9,25 @@
 
 module Language.Haskell.Brittany.Internal.Transformations.Alt where
 
-import qualified Control.Monad.Memo as Memo
+
+
+import Language.Haskell.Brittany.Internal.Prelude
+import Language.Haskell.Brittany.Internal.PreludeUtils
 import qualified Control.Monad.Trans.MultiRWS.Strict as MultiRWSS
-import Data.HList.ContainsType
 import qualified Data.List.Extra
 import qualified Data.Semigroup as Semigroup
 import qualified Data.Text as Text
 import qualified GHC.OldList as List
-import Language.Haskell.Brittany.Internal.Config.Types
-import Language.Haskell.Brittany.Internal.Prelude
-import Language.Haskell.Brittany.Internal.PreludeUtils
-import Language.Haskell.Brittany.Internal.Types
+
+import           Data.HList.ContainsType
+
 import           Language.Haskell.Brittany.Internal.Utils
+import           Language.Haskell.Brittany.Internal.Config.Types
+import           Language.Haskell.Brittany.Internal.Types
+
+import qualified Control.Monad.Memo as Memo
+
+
 
 data AltCurPos = AltCurPos
   { _acp_line :: Int -- chars in the current line
@@ -28,7 +35,7 @@ data AltCurPos = AltCurPos
   , _acp_indentPrep :: Int -- indentChange affecting the next Par
   , _acp_forceMLFlag :: AltLineModeState
   }
-  deriving Show
+  deriving (Show)
 
 data AltLineModeState
   = AltLineModeStateNone
@@ -42,13 +49,11 @@ altLineModeRefresh :: AltLineModeState -> AltLineModeState
 altLineModeRefresh AltLineModeStateNone          = AltLineModeStateNone
 altLineModeRefresh AltLineModeStateForceML{}     = AltLineModeStateForceML False
 altLineModeRefresh AltLineModeStateForceSL       = AltLineModeStateForceSL
-altLineModeRefresh AltLineModeStateContradiction =
-  AltLineModeStateContradiction
+altLineModeRefresh AltLineModeStateContradiction = AltLineModeStateContradiction
 
 altLineModeDecay :: AltLineModeState -> AltLineModeState
 altLineModeDecay AltLineModeStateNone            = AltLineModeStateNone
-altLineModeDecay (AltLineModeStateForceML False) =
-  AltLineModeStateForceML True
+altLineModeDecay (AltLineModeStateForceML False) = AltLineModeStateForceML True
 altLineModeDecay (AltLineModeStateForceML True ) = AltLineModeStateNone
 altLineModeDecay AltLineModeStateForceSL         = AltLineModeStateForceSL
 altLineModeDecay AltLineModeStateContradiction   = AltLineModeStateContradiction
@@ -114,13 +119,7 @@ transformAlts =
 
 
 
-  rec
-    :: BriDocNumbered
-    -> Memo.MemoT
-         Int
-         [VerticalSpacing]
-         (MultiRWSS.MultiRWS r w (AltCurPos ': s))
-         BriDocNumbered
+    rec :: BriDocNumbered -> Memo.MemoT Int [VerticalSpacing] (MultiRWSS.MultiRWS r w (AltCurPos ': s)) BriDocNumbered
     rec bdX@(brDcId, brDc) = do
       let reWrap = (,) brDcId
       -- debugAcp :: AltCurPos <- mGet
@@ -131,8 +130,10 @@ transformAlts =
         --   BDWrapAnnKey annKey <$> rec bd
         BDFEmpty{}    -> processSpacingSimple bdX $> bdX
         BDFLit{}      -> processSpacingSimple bdX $> bdX
-      BDFSeq list -> reWrap . BDFSeq <$> list `forM` rec
-      BDFCols sig list -> reWrap . BDFCols sig <$> list `forM` rec
+        BDFSeq list      ->
+          reWrap . BDFSeq <$> list `forM` rec
+        BDFCols sig list ->
+          reWrap . BDFCols sig <$> list `forM` rec
         BDFSeparator  -> processSpacingSimple bdX $> bdX
         BDFAddBaseY indent bd -> do
           acp <- mGet
@@ -161,18 +162,22 @@ transformAlts =
         BDFIndentLevelPop bd -> do
           reWrap . BDFIndentLevelPop <$> rec bd
         BDFPar indent sameLine indented -> do
-        indAmount <-
-          mAsk <&> _conf_layout .> _lconfig_indentAmount .> confUnpack
-        let
-          indAdd = case indent of
+          indAmount <- mAsk <&> _conf_layout .> _lconfig_indentAmount .> confUnpack
+          let indAdd = case indent of
                 BrIndentNone -> 0
                 BrIndentRegular -> indAmount
                 BrIndentSpecial i -> i
           acp <- mGet
           let ind = _acp_indent acp + _acp_indentPrep acp + indAdd
-        mSet $ acp { _acp_indent = ind, _acp_indentPrep = 0 }
+          mSet $ acp
+            { _acp_indent = ind
+            , _acp_indentPrep = 0
+            }
           sameLine' <- rec sameLine
-        mModify $ \acp' -> acp' { _acp_line = ind, _acp_indent = ind }
+          mModify $ \acp' -> acp'
+            { _acp_line   = ind
+            , _acp_indent = ind
+            }
           indented' <- rec indented
           return $ reWrap $ BDFPar indent sameLine' indented'
         BDFAlt [] -> error "empty BDAlt" -- returning BDEmpty instead is a
@@ -180,16 +185,14 @@ transformAlts =
                                         -- fail-early approach; BDEmpty does not
                                         -- make sense semantically for Alt[].
         BDFAlt alts -> do
-        altChooser <-
-          mAsk <&> _conf_layout .> _lconfig_altChooser .> confUnpack
+          altChooser <- mAsk <&> _conf_layout .> _lconfig_altChooser .> confUnpack
           case altChooser of
             AltChooserSimpleQuick -> do
               rec $ head alts
             AltChooserShallowBest -> do
               spacings <- alts `forM` getSpacing
               acp <- mGet
-            let
-              lineCheck LineModeInvalid = False
+              let lineCheck LineModeInvalid = False
                   lineCheck (LineModeValid (VerticalSpacing _ p _)) =
                     case _acp_forceMLFlag acp of
                       AltLineModeStateNone      -> True
@@ -199,41 +202,35 @@ transformAlts =
                   -- TODO: use COMPLETE pragma instead?
                   lineCheck _ = error "ghc exhaustive check is insufficient"
               lconf <- _conf_layout <$> mAsk
-            let
-              options = -- trace ("considering options:" ++ show (length alts, acp)) $
+              let options = -- trace ("considering options:" ++ show (length alts, acp)) $
                             (zip spacings alts
                              <&> \(vs, bd) -> -- trace ("spacing=" ++ show vs ++ ",hasSpace=" ++ show (hasSpace lconf acp vs) ++ ",lineCheck=" ++ show (lineCheck vs))
-                                 (hasSpace1 lconf acp vs && lineCheck vs, bd)
-                )
+                               ( hasSpace1 lconf acp vs && lineCheck vs, bd))
               rec
                  $ fromMaybe (-- trace ("choosing last") $
                               List.last alts)
-              $ Data.List.Extra.firstJust
-                  (\(_i :: Int, (b, x)) ->
+                 $ Data.List.Extra.firstJust (\(_i::Int, (b,x)) ->
                      [ -- traceShow ("choosing option " ++ show i) $
                        x
                      | b
-                    ]
-                  )
+                     ])
                  $ zip [1..] options
             AltChooserBoundedSearch limit -> do
               spacings <- alts `forM` getSpacings limit
               acp <- mGet
-            let
-              lineCheck (VerticalSpacing _ p _) = case _acp_forceMLFlag acp of
+              let lineCheck (VerticalSpacing _ p _) =
+                    case _acp_forceMLFlag acp of
                       AltLineModeStateNone      -> True
                       AltLineModeStateForceSL{} -> p == VerticalSpacingParNone
                       AltLineModeStateForceML{} -> p /= VerticalSpacingParNone
                       AltLineModeStateContradiction -> False
               lconf <- _conf_layout <$> mAsk
-            let
-              options = -- trace ("considering options:" ++ show (length alts, acp)) $
+              let options = -- trace ("considering options:" ++ show (length alts, acp)) $
                             (zip spacings alts
                              <&> \(vs, bd) -> -- trace ("spacing=" ++ show vs ++ ",hasSpace=" ++ show (hasSpace lconf acp vs) ++ ",lineCheck=" ++ show (lineCheck vs))
-                      (any (hasSpace2 lconf acp) vs && any lineCheck vs, bd)
-                )
-            let
-              checkedOptions :: [Maybe (Int, BriDocNumbered)] =
+                               (  any (hasSpace2 lconf acp) vs
+                               && any lineCheck vs, bd))
+              let checkedOptions :: [Maybe (Int, BriDocNumbered)] =
                     zip [1..] options <&> (\(i, (b,x)) -> [ (i, x) | b ])
               rec
                  $ fromMaybe (-- trace ("choosing last") $
@@ -258,9 +255,7 @@ transformAlts =
         BDFForwardLineMode bd -> do
           acp <- mGet
           x <- do
-          mSet $ acp
-            { _acp_forceMLFlag = altLineModeRefresh $ _acp_forceMLFlag acp
-            }
+            mSet $ acp { _acp_forceMLFlag = altLineModeRefresh $ _acp_forceMLFlag acp }
             rec bd
           acp' <- mGet
           mSet $ acp' { _acp_forceMLFlag = _acp_forceMLFlag acp }
@@ -269,9 +264,7 @@ transformAlts =
         BDFPlain{}    -> processSpacingSimple bdX $> bdX
         BDFAnnotationPrior annKey bd -> do
           acp <- mGet
-        mSet $ acp
-          { _acp_forceMLFlag = altLineModeDecay $ _acp_forceMLFlag acp
-          }
+          mSet $ acp { _acp_forceMLFlag = altLineModeDecay $ _acp_forceMLFlag acp }
           bd' <- rec bd
           return $ reWrap $ BDFAnnotationPrior annKey bd'
         BDFAnnotationRest annKey bd ->
@@ -285,7 +278,10 @@ transformAlts =
           ind <- _acp_indent <$> mGet
           l' <- rec l
           lr' <- lr `forM` \x -> do
-          mModify $ \acp -> acp { _acp_line = ind, _acp_indent = ind }
+            mModify $ \acp -> acp
+              { _acp_line   = ind
+              , _acp_indent = ind
+              }
             rec x
           return $ reWrap $ BDFLines (l':lr')
         BDFEnsureIndent indent bd -> do
@@ -306,21 +302,14 @@ transformAlts =
           mSet $ acp' { _acp_indent = _acp_indent acp }
           return $ case indent of
             BrIndentNone -> r
-          BrIndentRegular ->
-            reWrap $ BDFEnsureIndent (BrIndentSpecial indAdd) r
+            BrIndentRegular ->   reWrap $ BDFEnsureIndent (BrIndentSpecial indAdd) r
             BrIndentSpecial i -> reWrap $ BDFEnsureIndent (BrIndentSpecial i) r
         BDFNonBottomSpacing _ bd -> rec bd
         BDFSetParSpacing bd -> rec bd
         BDFForceParSpacing bd -> rec bd
         BDFDebug s bd -> do
           acp :: AltCurPos <- mGet
-        tellDebugMess
-          $ "transformAlts: BDFDEBUG "
-          ++ s
-          ++ " (node-id="
-          ++ show brDcId
-          ++ "): acp="
-          ++ show acp
+          tellDebugMess $ "transformAlts: BDFDEBUG " ++ s ++ " (node-id=" ++ show brDcId ++ "): acp=" ++ show acp
           reWrap . BDFDebug s <$> rec bd
     processSpacingSimple
       :: ( MonadMultiReader Config m
@@ -336,8 +325,7 @@ transformAlts =
         mSet $ acp { _acp_line = _acp_line acp + i }
       LineModeValid VerticalSpacing{}  -> error "processSpacingSimple par"
       _ -> error "ghc exhaustive check is insufficient"
-  hasSpace1
-    :: LayoutConfig -> AltCurPos -> LineModeValidity VerticalSpacing -> Bool
+    hasSpace1 :: LayoutConfig -> AltCurPos -> LineModeValidity VerticalSpacing -> Bool
     hasSpace1 _ _ LineModeInvalid = False
     hasSpace1 lconf acp (LineModeValid vs) = hasSpace2 lconf acp vs
     hasSpace1 _ _ _ = error "ghc exhaustive check is insufficient"
@@ -345,13 +333,8 @@ transformAlts =
     hasSpace2 lconf (AltCurPos line _indent _ _) (VerticalSpacing sameLine VerticalSpacingParNone _)
       = line + sameLine <= confUnpack (_lconfig_cols lconf)
     hasSpace2 lconf (AltCurPos line indent indentPrep _) (VerticalSpacing sameLine (VerticalSpacingParSome par) _)
-    = line
-      + sameLine
-      <= confUnpack (_lconfig_cols lconf)
-      && indent
-      + indentPrep
-      + par
-      <= confUnpack (_lconfig_cols lconf)
+      = line + sameLine <= confUnpack (_lconfig_cols lconf)
+        && indent + indentPrep + par <= confUnpack (_lconfig_cols lconf)
     hasSpace2 lconf (AltCurPos line _indent _ _) (VerticalSpacing sameLine VerticalSpacingParAlways{} _)
       = line + sameLine <= confUnpack (_lconfig_cols lconf)
 
@@ -370,11 +353,10 @@ getSpacing !bridoc = rec bridoc
       -- BDWrapAnnKey _annKey bd -> rec bd
       BDFEmpty ->
         return $ LineModeValid $ VerticalSpacing 0 VerticalSpacingParNone False
-      BDFLit t -> return $ LineModeValid $ VerticalSpacing
-        (Text.length t)
-        VerticalSpacingParNone
-        False
-      BDFSeq list -> sumVs <$> rec `mapM` list
+      BDFLit t ->
+        return $ LineModeValid $ VerticalSpacing (Text.length t) VerticalSpacingParNone False
+      BDFSeq list ->
+        sumVs <$> rec `mapM` list
       BDFCols _sig list -> sumVs <$> rec `mapM` list
       BDFSeparator ->
         return $ LineModeValid $ VerticalSpacing 1 VerticalSpacingParNone False
@@ -383,23 +365,17 @@ getSpacing !bridoc = rec bridoc
         return $ mVs <&> \vs -> vs
           { _vs_paragraph = case _vs_paragraph vs of
               VerticalSpacingParNone -> VerticalSpacingParNone
-            VerticalSpacingParAlways i ->
-              VerticalSpacingParAlways $ case indent of
+              VerticalSpacingParAlways i -> VerticalSpacingParAlways $ case indent of
                 BrIndentNone      -> i
-                BrIndentRegular ->
-                  i
-                    + (confUnpack
+                BrIndentRegular   -> i + ( confUnpack
                                          $ _lconfig_indentAmount
                                          $ _conf_layout
                                          $ config
                                          )
                 BrIndentSpecial j -> i + j
-            VerticalSpacingParSome i ->
-              VerticalSpacingParSome $ case indent of
+              VerticalSpacingParSome i -> VerticalSpacingParSome $ case indent of
                 BrIndentNone      -> i
-                BrIndentRegular ->
-                  i
-                    + (confUnpack
+                BrIndentRegular   -> i + ( confUnpack
                                          $ _lconfig_indentAmount
                                          $ _conf_layout
                                          $ config
@@ -414,13 +390,11 @@ getSpacing !bridoc = rec bridoc
           -- the reason is that we really want to _keep_ it Just if it is
           -- just so we properly communicate the is-multiline fact.
           -- An alternative would be setting to (Just 0).
-          { _vs_sameLine = max
-            (_vs_sameLine vs)
+          { _vs_sameLine = max (_vs_sameLine vs)
                                (case _vs_paragraph vs of
                                   VerticalSpacingParNone -> 0
                                   VerticalSpacingParSome i -> i
-              VerticalSpacingParAlways i -> min colMax i
-            )
+                                  VerticalSpacingParAlways i -> min colMax i)
           , _vs_paragraph = VerticalSpacingParSome 0
           }
       BDFBaseYPop bd -> rec bd
@@ -434,19 +408,12 @@ getSpacing !bridoc = rec bridoc
             | VerticalSpacing lsp mPsp _ <- mVs
             , indSp <- mIndSp
             , lineMax <- getMaxVS $ mIndSp
-            , let
-              pspResult = case mPsp of
-                VerticalSpacingParSome psp ->
-                  VerticalSpacingParSome $ max psp lineMax
+            , let pspResult = case mPsp of
+                    VerticalSpacingParSome psp   -> VerticalSpacingParSome $ max psp lineMax
                     VerticalSpacingParNone       -> VerticalSpacingParSome $ lineMax
-                VerticalSpacingParAlways psp ->
-                  VerticalSpacingParAlways $ max psp lineMax
-            , let
-              parFlagResult =
-                mPsp
-                  == VerticalSpacingParNone
-                  && _vs_paragraph indSp
-                  == VerticalSpacingParNone
+                    VerticalSpacingParAlways psp -> VerticalSpacingParAlways $ max psp lineMax
+            , let parFlagResult =  mPsp == VerticalSpacingParNone
+                                && _vs_paragraph indSp ==  VerticalSpacingParNone
                                 && _vs_parFlag indSp
             ]
       BDFPar{} -> error "BDPar with indent in getSpacing"
@@ -473,33 +440,35 @@ getSpacing !bridoc = rec bridoc
       BDFAnnotationKW _annKey _kw bd -> rec bd
       BDFAnnotationRest  _annKey bd -> rec bd
       BDFMoveToKWDP _annKey _kw _b bd -> rec bd
-      BDFLines [] ->
-        return $ LineModeValid $ VerticalSpacing 0 VerticalSpacingParNone False
+      BDFLines [] -> return
+        $ LineModeValid
+        $ VerticalSpacing 0 VerticalSpacingParNone False
       BDFLines ls@(_:_) -> do
         lSps <- rec `mapM` ls
         let (mVs:_) = lSps -- separated into let to avoid MonadFail
-        return
-          $ [ VerticalSpacing lsp (VerticalSpacingParSome $ lineMax) False
+        return $ [ VerticalSpacing lsp (VerticalSpacingParSome $ lineMax) False
                  | VerticalSpacing lsp _ _ <- mVs
                  , lineMax <- getMaxVS $ maxVs $ lSps
                  ]
       BDFEnsureIndent indent bd -> do
         mVs <- rec bd
-        let
-          addInd = case indent of
+        let addInd = case indent of
               BrIndentNone      -> 0
-            BrIndentRegular ->
-              confUnpack $ _lconfig_indentAmount $ _conf_layout $ config
+              BrIndentRegular   -> confUnpack
+                                 $ _lconfig_indentAmount
+                                 $ _conf_layout
+                                 $ config
               BrIndentSpecial i -> i
         return $ mVs <&> \(VerticalSpacing lsp psp pf) ->
           VerticalSpacing (lsp + addInd) psp pf
       BDFNonBottomSpacing b bd -> do
         mVs <- rec bd
-        return $ mVs <|> LineModeValid
+        return
+          $   mVs
+          <|> LineModeValid
                 (VerticalSpacing
                   0
-            (if b
-              then VerticalSpacingParSome 0
+                  (if b then VerticalSpacingParSome 0
                         else VerticalSpacingParAlways colMax
                   )
                   False
@@ -509,29 +478,16 @@ getSpacing !bridoc = rec bridoc
         return $ mVs <&> \vs -> vs { _vs_parFlag = True }
       BDFForceParSpacing bd -> do
         mVs <- rec bd
-        return
-          $ [ vs
-            | vs <- mVs
-            , _vs_parFlag vs || _vs_paragraph vs == VerticalSpacingParNone
-            ]
+        return $ [ vs | vs <- mVs, _vs_parFlag vs || _vs_paragraph vs == VerticalSpacingParNone ]
       BDFDebug s bd -> do
         r <- rec bd
-        tellDebugMess
-          $ "getSpacing: BDFDebug "
-          ++ show s
-          ++ " (node-id="
-          ++ show brDcId
-          ++ "): mVs="
-          ++ show r
+        tellDebugMess $ "getSpacing: BDFDebug " ++ show s ++ " (node-id=" ++ show brDcId ++ "): mVs=" ++ show r
         return r
     return result
-  maxVs
-    :: [LineModeValidity VerticalSpacing] -> LineModeValidity VerticalSpacing
+  maxVs :: [LineModeValidity VerticalSpacing] -> LineModeValidity VerticalSpacing
   maxVs = foldl'
-    (liftM2
-      (\(VerticalSpacing x1 x2 _) (VerticalSpacing y1 y2 _) -> VerticalSpacing
-        (max x1 y1)
-        (case (x2, y2) of
+    (liftM2 (\(VerticalSpacing x1 x2 _) (VerticalSpacing y1 y2 _) ->
+        VerticalSpacing (max x1 y1) (case (x2, y2) of
           (x, VerticalSpacingParNone) -> x
           (VerticalSpacingParNone, x) -> x
           (VerticalSpacingParAlways i, VerticalSpacingParAlways j) ->
@@ -541,14 +497,9 @@ getSpacing !bridoc = rec bridoc
           (VerticalSpacingParSome j, VerticalSpacingParAlways i) ->
             VerticalSpacingParAlways $ max i j
           (VerticalSpacingParSome x, VerticalSpacingParSome y) ->
-            VerticalSpacingParSome $ max x y
-        )
-        False
-      )
-    )
+            VerticalSpacingParSome $ max x y) False))
     (LineModeValid $ VerticalSpacing 0 VerticalSpacingParNone False)
-  sumVs
-    :: [LineModeValidity VerticalSpacing] -> LineModeValidity VerticalSpacing
+  sumVs :: [LineModeValidity VerticalSpacing] -> LineModeValidity VerticalSpacing
   sumVs sps = foldl' (liftM2 go) initial sps
    where
     go (VerticalSpacing x1 x2 x3) (VerticalSpacing y1 y2 _) = VerticalSpacing
@@ -563,8 +514,7 @@ getSpacing !bridoc = rec bridoc
         (VerticalSpacingParSome i, VerticalSpacingParAlways j) ->
           VerticalSpacingParAlways $ i+j
         (VerticalSpacingParSome x, VerticalSpacingParSome y) ->
-          VerticalSpacingParSome $ x + y
-      )
+          VerticalSpacingParSome $ x + y)
       x3
     singleline (LineModeValid x) = _vs_paragraph x == VerticalSpacingParNone
     singleline _                 = False
@@ -599,19 +549,16 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc
     preFilterLimit = take (3*limit)
     memoWithKey :: Memo.MonadMemo k v m1 => k -> m1 v -> m1 v
     memoWithKey k v = Memo.memo (const v) k
-  rec
-    :: BriDocNumbered -> Memo.MemoT Int [VerticalSpacing] m [VerticalSpacing]
+    rec :: BriDocNumbered -> Memo.MemoT Int [VerticalSpacing] m [VerticalSpacing]
     rec (brDcId, brdc) = memoWithKey brDcId $ do
       config <- mAsk
       let colMax = config & _conf_layout & _lconfig_cols & confUnpack
-    let
-      hasOkColCount (VerticalSpacing lsp psp _) =
+      let hasOkColCount (VerticalSpacing lsp psp _) =
             lsp <= colMax && case psp of
               VerticalSpacingParNone -> True
               VerticalSpacingParSome i -> i <= colMax
               VerticalSpacingParAlways{} -> True
-    let
-      specialCompare vs1 vs2 =
+      let specialCompare vs1 vs2 =
             if (  (_vs_sameLine vs1 == _vs_sameLine vs2)
                && (_vs_parFlag vs1 == _vs_parFlag vs2)
                )
@@ -620,9 +567,11 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc
                   if i1 < i2 then Smaller else Bigger
                 (p1, p2) -> if p1 == p2 then Smaller else Unequal
               else Unequal
-    let
-      allowHangingQuasiQuotes =
-        config & _conf_layout & _lconfig_allowHangingQuasiQuotes & confUnpack
+      let allowHangingQuasiQuotes =
+            config
+              & _conf_layout
+              & _lconfig_allowHangingQuasiQuotes
+              & confUnpack
       let -- this is like List.nub, with one difference: if two elements
           -- are unequal only in _vs_paragraph, with both ParAlways, we
           -- treat them like equals and replace the first occurence with the
@@ -642,8 +591,7 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc
           -- applied whenever in a parent the combination of spacings from
           -- its children might cause excess of the upper bound.
           filterAndLimit :: [VerticalSpacing] -> [VerticalSpacing]
-      filterAndLimit =
-        take limit
+          filterAndLimit = take limit
                            -- prune so we always consider a constant
                            -- amount of spacings per node of the BriDoc.
                          . specialNub
@@ -675,11 +623,12 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc
                          . preFilterLimit
       result <- case brdc of
         -- BDWrapAnnKey _annKey bd -> rec bd
-      BDFEmpty -> return $ [VerticalSpacing 0 VerticalSpacingParNone False]
+        BDFEmpty ->
+          return $ [VerticalSpacing 0 VerticalSpacingParNone False]
         BDFLit t ->
-        return
-          $ [VerticalSpacing (Text.length t) VerticalSpacingParNone False]
-      BDFSeq list -> fmap sumVs . mapM filterAndLimit <$> rec `mapM` list
+          return $ [VerticalSpacing (Text.length t) VerticalSpacingParNone False]
+        BDFSeq list ->
+          fmap sumVs . mapM filterAndLimit <$> rec `mapM` list
         BDFCols _sig list ->
           fmap sumVs . mapM filterAndLimit <$> rec `mapM` list
         BDFSeparator ->
@@ -689,23 +638,17 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc
           return $ mVs <&> \vs -> vs
             { _vs_paragraph = case _vs_paragraph vs of
                 VerticalSpacingParNone -> VerticalSpacingParNone
-            VerticalSpacingParAlways i ->
-              VerticalSpacingParAlways $ case indent of
+                VerticalSpacingParAlways i -> VerticalSpacingParAlways $ case indent of
                   BrIndentNone      -> i
-                BrIndentRegular ->
-                  i
-                    + (confUnpack
+                  BrIndentRegular   -> i + ( confUnpack
                                            $ _lconfig_indentAmount
                                            $ _conf_layout
                                            $ config
                                            )
                   BrIndentSpecial j -> i + j
-            VerticalSpacingParSome i ->
-              VerticalSpacingParSome $ case indent of
+                VerticalSpacingParSome i -> VerticalSpacingParSome $ case indent of
                   BrIndentNone      -> i
-                BrIndentRegular ->
-                  i
-                    + (confUnpack
+                  BrIndentRegular   -> i + ( confUnpack
                                            $ _lconfig_indentAmount
                                            $ _conf_layout
                                            $ config
@@ -720,13 +663,11 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc
             -- the reason is that we really want to _keep_ it Just if it is
             -- just so we properly communicate the is-multiline fact.
             -- An alternative would be setting to (Just 0).
-          { _vs_sameLine = max
-            (_vs_sameLine vs)
+            { _vs_sameLine = max (_vs_sameLine vs)
                                  (case _vs_paragraph vs of
                                   VerticalSpacingParNone -> 0
                                   VerticalSpacingParSome i -> i
-              VerticalSpacingParAlways i -> min colMax i
-            )
+                                  VerticalSpacingParAlways i -> min colMax i)
             , _vs_paragraph = case _vs_paragraph vs of
                 VerticalSpacingParNone -> VerticalSpacingParNone
                 VerticalSpacingParSome i -> VerticalSpacingParSome i
@@ -738,8 +679,13 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc
         BDFPar BrIndentNone sameLine indented -> do
           mVss   <- filterAndLimit <$> rec sameLine
           indSps <- filterAndLimit <$> rec indented
-        let mVsIndSp = take limit $ [ (x, y) | x <- mVss, y <- indSps ]
-        return $ mVsIndSp <&> \(VerticalSpacing lsp mPsp _, indSp) ->
+          let mVsIndSp = take limit
+                       $ [ (x,y)
+                         | x<-mVss
+                         , y<-indSps
+                         ]
+          return $ mVsIndSp <&>
+            \(VerticalSpacing lsp mPsp _, indSp) ->
               VerticalSpacing
                 lsp
                 (case mPsp of
@@ -747,12 +693,9 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc
                     VerticalSpacingParSome $ max psp $ getMaxVS indSp -- TODO
                   VerticalSpacingParNone -> spMakePar indSp
                   VerticalSpacingParAlways psp ->
-                VerticalSpacingParAlways $ max psp $ getMaxVS indSp
-            )
-            (mPsp
-            == VerticalSpacingParNone
-            && _vs_paragraph indSp
-            == VerticalSpacingParNone
+                    VerticalSpacingParAlways $ max psp $ getMaxVS indSp)
+                (  mPsp == VerticalSpacingParNone
+                && _vs_paragraph indSp == VerticalSpacingParNone
                 && _vs_parFlag indSp
                 )
 
@@ -770,15 +713,17 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc
           return $ filter ((==VerticalSpacingParNone) . _vs_paragraph) mVs
         BDFForwardLineMode bd -> rec bd
         BDFExternal _ _ _ txt | [t] <- Text.lines txt ->
-        return
-          $ [VerticalSpacing (Text.length t) VerticalSpacingParNone False]
-      BDFExternal{} -> return $ [] -- yes, we just assume that we cannot properly layout
+          return $ [VerticalSpacing (Text.length t) VerticalSpacingParNone False]
+        BDFExternal{} ->
+          return $ [] -- yes, we just assume that we cannot properly layout
                       -- this.
         BDFPlain t -> return
           [ case Text.lines t of
               []       -> VerticalSpacing 0 VerticalSpacingParNone False
-            [t1] ->
-              VerticalSpacing (Text.length t1) VerticalSpacingParNone False
+              [t1    ] -> VerticalSpacing
+                (Text.length t1)
+                VerticalSpacingParNone
+                False
               (t1 : _) -> VerticalSpacing
                 (Text.length t1)
                 (VerticalSpacingParAlways 0)
@@ -789,8 +734,7 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc
         BDFAnnotationKW _annKey _kw bd -> rec bd
         BDFAnnotationRest  _annKey bd -> rec bd
         BDFMoveToKWDP _annKey _kw _b bd -> rec bd
-      BDFLines [] ->
-        return $ [VerticalSpacing 0 VerticalSpacingParNone False]
+        BDFLines [] -> return $ [VerticalSpacing 0 VerticalSpacingParNone False]
         BDFLines ls@(_:_) -> do
           -- we simply assume that lines is only used "properly", i.e. in
           -- such a way that the first line can be treated "as a part of the
@@ -798,13 +742,14 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc
           -- be inserted anywhere but at the start of the line. A
           -- counterexample would be anything like Seq[Lit "foo", Lines].
           lSpss <- map filterAndLimit <$> rec `mapM` ls
-        let
-          worbled = fmap reverse $ sequence $ reverse $ lSpss
-          sumF lSps@(lSp1 : _) =
-            VerticalSpacing (_vs_sameLine lSp1) (spMakePar $ maxVs lSps) False
-          sumF [] =
-            error
-              $ "should not happen. if my logic does not fail"
+          let worbled = fmap reverse
+                      $ sequence
+                      $ reverse
+                      $ lSpss
+              sumF lSps@(lSp1:_) = VerticalSpacing (_vs_sameLine lSp1)
+                                                   (spMakePar $ maxVs lSps)
+                                                   False
+              sumF [] = error $ "should not happen. if my logic does not fail"
                              ++ "me, this follows from not (null ls)."
           return $ sumF <$> worbled
           -- lSpss@(mVs:_) <- rec `mapM` ls
@@ -820,11 +765,12 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc
           --     VerticalSpacing lsp $ VerticalSpacingParSome $ getMaxVS $ maxVs lSps
         BDFEnsureIndent indent bd -> do
           mVs <- rec bd
-        let
-          addInd = case indent of
+          let addInd = case indent of
                 BrIndentNone      -> 0
-            BrIndentRegular ->
-              confUnpack $ _lconfig_indentAmount $ _conf_layout $ config
+                BrIndentRegular   -> confUnpack
+                                   $ _lconfig_indentAmount
+                                   $ _conf_layout
+                                   $ config
                 BrIndentSpecial i -> i
           return $ mVs <&> \(VerticalSpacing lsp psp parFlag) ->
             VerticalSpacing (lsp + addInd) psp parFlag
@@ -835,11 +781,9 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc
           -- problem but breaks certain other cases.
           mVs <- rec bd
           return $ if null mVs
-          then
-            [ VerticalSpacing
+            then [VerticalSpacing
                     0
-                (if b
-                  then VerticalSpacingParSome 0
+                    (if b then VerticalSpacingParSome 0
                           else VerticalSpacingParAlways colMax
                     )
                     False
@@ -888,25 +832,16 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc
           return $ mVs <&> \vs -> vs { _vs_parFlag = True }
         BDFForceParSpacing bd -> do
           mVs <- preFilterLimit <$> rec bd
-        return
-          $ [ vs
-            | vs <- mVs
-            , _vs_parFlag vs || _vs_paragraph vs == VerticalSpacingParNone
-            ]
+          return $ [ vs | vs <- mVs, _vs_parFlag vs || _vs_paragraph vs == VerticalSpacingParNone ]
         BDFDebug s bd -> do
           r <- rec bd
-        tellDebugMess
-          $ "getSpacings: BDFDebug "
-          ++ show s
-          ++ " (node-id="
-          ++ show brDcId
-          ++ "): vs="
-          ++ show (take 9 r)
+          tellDebugMess $ "getSpacings: BDFDebug " ++ show s ++ " (node-id=" ++ show brDcId ++ "): vs=" ++ show (take 9 r)
           return r
       return result
     maxVs :: [VerticalSpacing] -> VerticalSpacing
     maxVs = foldl'
-    (\(VerticalSpacing x1 x2 _) (VerticalSpacing y1 y2 _) -> VerticalSpacing
+      (\(VerticalSpacing x1 x2 _) (VerticalSpacing y1 y2 _) ->
+          VerticalSpacing
             (max x1 y1)
             (case (x2, y2) of
               (x, VerticalSpacingParNone) -> x
@@ -918,10 +853,8 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc
               (VerticalSpacingParSome i, VerticalSpacingParAlways j) ->
                 VerticalSpacingParAlways $ max i j
               (VerticalSpacingParSome x, VerticalSpacingParSome y) ->
-          VerticalSpacingParSome $ max x y
-      )
-      False
-    )
+                VerticalSpacingParSome $ max x y)
+            False)
       (VerticalSpacing 0 VerticalSpacingParNone False)
     sumVs :: [VerticalSpacing] -> VerticalSpacing
     sumVs sps = foldl' go initial sps
@@ -937,9 +870,7 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc
             VerticalSpacingParAlways $ i+j
           (VerticalSpacingParSome i, VerticalSpacingParAlways j) ->
             VerticalSpacingParAlways $ i+j
-        (VerticalSpacingParSome x, VerticalSpacingParSome y) ->
-          VerticalSpacingParSome $ x + y
-      )
+          (VerticalSpacingParSome x, VerticalSpacingParSome y) -> VerticalSpacingParSome $ x + y)
         x3
       singleline x = _vs_paragraph x == VerticalSpacingParNone
       isPar      x = _vs_parFlag x
@@ -962,8 +893,7 @@ fixIndentationForMultiple
   :: (MonadMultiReader (CConfig Identity) m) => AltCurPos -> BrIndent -> m Int
 fixIndentationForMultiple acp indent = do
   indAmount <- mAsk <&> _conf_layout .> _lconfig_indentAmount .> confUnpack
-  let
-    indAddRaw = case indent of
+  let indAddRaw = case indent of
         BrIndentNone      -> 0
         BrIndentRegular   -> indAmount
         BrIndentSpecial i -> i
@@ -973,8 +903,7 @@ fixIndentationForMultiple acp indent = do
   indPolicy <- mAsk <&> _conf_layout .> _lconfig_indentPolicy .> confUnpack
   pure $ if indPolicy == IndentPolicyMultiple
     then
-      let
-        indAddMultiple1 =
+      let indAddMultiple1 =
             indAddRaw - ((_acp_indent acp + indAddRaw) `mod` indAmount)
           indAddMultiple2 = if indAddMultiple1 <= 0
             then indAddMultiple1 + indAmount

source/library/Language/Haskell/Brittany/Internal/Transformations/Columns.hs

@@ -3,46 +3,36 @@
 
 module Language.Haskell.Brittany.Internal.Transformations.Columns where
 
-import qualified Data.Generics.Uniplate.Direct as Uniplate
-import qualified GHC.OldList as List
+
+
 import Language.Haskell.Brittany.Internal.Prelude
+import qualified GHC.OldList as List
+
 import           Language.Haskell.Brittany.Internal.Types
 
+import qualified Data.Generics.Uniplate.Direct as Uniplate
+
+
+
 transformSimplifyColumns :: BriDoc -> BriDoc
 transformSimplifyColumns = Uniplate.rewrite $ \case
   -- BDWrapAnnKey annKey bd ->
   --   BDWrapAnnKey annKey $ transformSimplify bd
   BDEmpty -> Nothing
   BDLit{} -> Nothing
-  BDSeq list
-    | any
-      (\case
-        BDSeq{} -> True
+  BDSeq list | any (\case BDSeq{} -> True
                           BDEmpty{} -> True
-        _ -> False
-      )
-      list
-    -> Just $ BDSeq $ list >>= \case
+                          _ -> False) list -> Just $ BDSeq $ list >>= \case
                             BDEmpty -> []
                             BDSeq l -> l
                             x -> [x]
   BDSeq (BDCols sig1 cols1@(_:_):rest)
-    | all
-      (\case
-        BDSeparator -> True
-        _ -> False
-      )
-      rest
-    -> Just $ BDCols sig1 (List.init cols1 ++ [BDSeq (List.last cols1 : rest)])
-  BDLines lines
-    | any
-      (\case
-        BDLines{} -> True
+    | all (\case BDSeparator -> True; _ -> False) rest ->
+    Just $ BDCols sig1 (List.init cols1 ++ [BDSeq (List.last cols1:rest)])
+  BDLines lines | any (\case BDLines{} -> True
                              BDEmpty{} -> True
-        _ -> False
-      )
-      lines
-    -> Just $ BDLines $ filter isNotEmpty $ lines >>= \case
+                             _ -> False) lines ->
+    Just $ BDLines $ filter isNotEmpty $ lines >>= \case
       BDLines l -> l
       x -> [x]
   -- prior floating in
@@ -54,35 +44,17 @@ transformSimplifyColumns = Uniplate.rewrite $ \case
     Just $ BDCols sig (BDAnnotationPrior annKey1 l:lr)
   -- post floating in
   BDAnnotationRest annKey1 (BDSeq list) ->
-    Just
-      $ BDSeq
-      $ List.init list
-      ++ [BDAnnotationRest annKey1 $ List.last list]
+    Just $ BDSeq $ List.init list ++ [BDAnnotationRest annKey1 $ List.last list]
   BDAnnotationRest annKey1 (BDLines list) ->
-    Just
-      $ BDLines
-      $ List.init list
-      ++ [BDAnnotationRest annKey1 $ List.last list]
+    Just $ BDLines $ List.init list ++ [BDAnnotationRest annKey1 $ List.last list]
   BDAnnotationRest annKey1 (BDCols sig cols) ->
-    Just
-      $ BDCols sig
-      $ List.init cols
-      ++ [BDAnnotationRest annKey1 $ List.last cols]
+    Just $ BDCols sig $ List.init cols ++ [BDAnnotationRest annKey1 $ List.last cols]
   BDAnnotationKW annKey1 kw (BDSeq list) ->
-    Just
-      $ BDSeq
-      $ List.init list
-      ++ [BDAnnotationKW annKey1 kw $ List.last list]
+    Just $ BDSeq $ List.init list ++ [BDAnnotationKW annKey1 kw $ List.last list]
   BDAnnotationKW annKey1 kw (BDLines list) ->
-    Just
-      $ BDLines
-      $ List.init list
-      ++ [BDAnnotationKW annKey1 kw $ List.last list]
+    Just $ BDLines $ List.init list ++ [BDAnnotationKW annKey1 kw $ List.last list]
   BDAnnotationKW annKey1 kw (BDCols sig cols) ->
-    Just
-      $ BDCols sig
-      $ List.init cols
-      ++ [BDAnnotationKW annKey1 kw $ List.last cols]
+    Just $ BDCols sig $ List.init cols ++ [BDAnnotationKW annKey1 kw $ List.last cols]
   -- ensureIndent float-in
   -- not sure if the following rule is necessary; tests currently are
   -- unaffected.
@@ -92,46 +64,48 @@ transformSimplifyColumns = Uniplate.rewrite $ \case
   BDCols sig1 cols1@(_:_)
     | BDLines lines@(_:_:_) <- List.last cols1
     , BDCols sig2 cols2 <- List.last lines
-    , sig1 == sig2
-    -> Just $ BDLines
+    , sig1==sig2 ->
+        Just $ BDLines
           [ BDCols sig1 $ List.init cols1 ++ [BDLines $ List.init lines]
           , BDCols sig2 cols2
           ]
   BDCols sig1 cols1@(_:_)
     | BDLines lines@(_:_:_) <- List.last cols1
     , BDEnsureIndent _ (BDCols sig2 cols2) <- List.last lines
-    , sig1 == sig2
-    -> Just $ BDLines
+    , sig1==sig2 ->
+        Just $ BDLines
           [ BDCols sig1 $ List.init cols1 ++ [BDLines $ List.init lines]
           , BDCols sig2 cols2
           ]
   BDPar ind col1@(BDCols sig1 _) col2@(BDCols sig2 _) | sig1==sig2 ->
     Just $ BDAddBaseY ind (BDLines [col1, col2])
   BDPar ind col1@(BDCols sig1 _) (BDLines (col2@(BDCols sig2 _):rest))
-    | sig1 == sig2 -> Just $ BDPar ind (BDLines [col1, col2]) (BDLines rest)
+    | sig1==sig2 ->
+    Just $ BDPar ind (BDLines [col1, col2]) (BDLines rest)
   BDPar ind (BDLines lines1) col2@(BDCols sig2 _)
-    | BDCols sig1 _ <- List.last lines1, sig1 == sig2 -> Just
-    $ BDAddBaseY ind (BDLines $ lines1 ++ [col2])
+    | BDCols sig1 _ <- List.last lines1
+    , sig1==sig2 ->
+    Just $ BDAddBaseY ind (BDLines $ lines1 ++ [col2])
   BDPar ind (BDLines lines1) (BDLines (col2@(BDCols sig2 _):rest))
-    | BDCols sig1 _ <- List.last lines1, sig1 == sig2 -> Just
-    $ BDPar ind (BDLines $ lines1 ++ [col2]) (BDLines rest)
+    | BDCols sig1 _ <- List.last lines1
+    , sig1==sig2 ->
+    Just $ BDPar ind (BDLines $ lines1 ++ [col2]) (BDLines rest)
   -- BDPar ind1 (BDCols sig1 cols1) (BDPar ind2 line (BDCols sig2 cols2))
   --   | sig1==sig2 ->
   --       Just $ BDPar
   --         ind1
   --         (BDLines [BDCols sig1 cols1, BDCols sig])
-  BDCols sig1 cols
-    | BDPar _ind line (BDCols sig2 cols2) <- List.last cols, sig1 == sig2
-    -> Just
-      $ BDLines [BDCols sig1 (List.init cols ++ [line]), BDCols sig2 cols2]
-  BDCols sig1 cols
-    | BDPar ind line (BDLines lines) <- List.last cols
+  BDCols sig1 cols | BDPar _ind line (BDCols sig2 cols2) <- List.last cols
+                   , sig1==sig2 ->
+    Just $ BDLines
+      [ BDCols sig1 (List.init cols ++ [line])
+      , BDCols sig2 cols2
+      ]
+  BDCols sig1 cols | BDPar ind line (BDLines lines) <- List.last cols
                    , BDCols sig2 cols2 <- List.last lines
-    , sig1 == sig2
-    -> Just $ BDLines
-      [ BDCols sig1
-      $ List.init cols
-      ++ [BDPar ind line (BDLines $ List.init lines)]
+                   , sig1==sig2 ->
+    Just $ BDLines
+      [ BDCols sig1 $ List.init cols ++ [BDPar ind line (BDLines $ List.init lines)]
       , BDCols sig2 cols2
       ]
   BDLines [x]         -> Just $ x

source/library/Language/Haskell/Brittany/Internal/Transformations/Floating.hs

@@ -3,19 +3,24 @@
 
 module Language.Haskell.Brittany.Internal.Transformations.Floating where
 
-import qualified Data.Generics.Uniplate.Direct as Uniplate
-import qualified GHC.OldList as List
+
+
 import Language.Haskell.Brittany.Internal.Prelude
 import Language.Haskell.Brittany.Internal.PreludeUtils
-import Language.Haskell.Brittany.Internal.Types
+import qualified GHC.OldList as List
+
 import           Language.Haskell.Brittany.Internal.Utils
+import           Language.Haskell.Brittany.Internal.Types
+
+import qualified Data.Generics.Uniplate.Direct as Uniplate
+
+
 
 -- note that this is not total, and cannot be with that exact signature.
 mergeIndents :: BrIndent -> BrIndent -> BrIndent
 mergeIndents BrIndentNone        x                   = x
 mergeIndents x                   BrIndentNone        = x
-mergeIndents (BrIndentSpecial i) (BrIndentSpecial j) =
-  BrIndentSpecial (max i j)
+mergeIndents (BrIndentSpecial i) (BrIndentSpecial j) = BrIndentSpecial (max i j)
 mergeIndents _                   _                   = error "mergeIndents"
 
 
@@ -47,20 +52,11 @@ transformSimplifyFloating = stepBO .> stepFull
       BDAnnotationRest annKey1 (BDPar ind line indented) ->
         Just $ BDPar ind line $ BDAnnotationRest annKey1 indented
       BDAnnotationRest annKey1 (BDSeq list) ->
-      Just
-        $ BDSeq
-        $ List.init list
-        ++ [BDAnnotationRest annKey1 $ List.last list]
+        Just $ BDSeq $ List.init list ++ [BDAnnotationRest annKey1 $ List.last list]
       BDAnnotationRest annKey1 (BDLines list) ->
-      Just
-        $ BDLines
-        $ List.init list
-        ++ [BDAnnotationRest annKey1 $ List.last list]
+        Just $ BDLines $ List.init list ++ [BDAnnotationRest annKey1 $ List.last list]
       BDAnnotationRest annKey1 (BDCols sig cols) ->
-      Just
-        $ BDCols sig
-        $ List.init cols
-        ++ [BDAnnotationRest annKey1 $ List.last cols]
+        Just $ BDCols sig $ List.init cols ++ [BDAnnotationRest annKey1 $ List.last cols]
       BDAnnotationRest annKey1 (BDAddBaseY indent x) ->
         Just $ BDAddBaseY indent $ BDAnnotationRest annKey1 x
       BDAnnotationRest annKey1 (BDDebug s x) ->
@@ -71,20 +67,11 @@ transformSimplifyFloating = stepBO .> stepFull
       BDAnnotationKW annKey1 kw (BDPar ind line indented) ->
         Just $ BDPar ind line $ BDAnnotationKW annKey1 kw indented
       BDAnnotationKW annKey1 kw (BDSeq list) ->
-      Just
-        $ BDSeq
-        $ List.init list
-        ++ [BDAnnotationKW annKey1 kw $ List.last list]
+        Just $ BDSeq $ List.init list ++ [BDAnnotationKW annKey1 kw $ List.last list]
       BDAnnotationKW annKey1 kw (BDLines list) ->
-      Just
-        $ BDLines
-        $ List.init list
-        ++ [BDAnnotationKW annKey1 kw $ List.last list]
+        Just $ BDLines $ List.init list ++ [BDAnnotationKW annKey1 kw $ List.last list]
       BDAnnotationKW annKey1 kw (BDCols sig cols) ->
-      Just
-        $ BDCols sig
-        $ List.init cols
-        ++ [BDAnnotationKW annKey1 kw $ List.last cols]
+        Just $ BDCols sig $ List.init cols ++ [BDAnnotationKW annKey1 kw $ List.last cols]
       BDAnnotationKW annKey1 kw (BDAddBaseY indent x) ->
         Just $ BDAddBaseY indent $ BDAnnotationKW annKey1 kw x
       BDAnnotationKW annKey1 kw (BDDebug s x) ->
@@ -93,35 +80,36 @@ transformSimplifyFloating = stepBO .> stepFull
     descendBYPush = transformDownMay $ \case
       BDBaseYPushCur (BDCols sig cols@(_:_)) ->
         Just $ BDCols sig (BDBaseYPushCur (List.head cols) : List.tail cols)
-    BDBaseYPushCur (BDDebug s x) -> Just $ BDDebug s (BDBaseYPushCur x)
+      BDBaseYPushCur (BDDebug s x) ->
+        Just $ BDDebug s (BDBaseYPushCur x)
       _ -> Nothing
     descendBYPop = transformDownMay $ \case
       BDBaseYPop (BDCols sig cols@(_:_)) ->
         Just $ BDCols sig (List.init cols ++ [BDBaseYPop (List.last cols)])
-    BDBaseYPop (BDDebug s x) -> Just $ BDDebug s (BDBaseYPop x)
+      BDBaseYPop (BDDebug s x) ->
+        Just $ BDDebug s (BDBaseYPop x)
       _ -> Nothing
     descendILPush = transformDownMay $ \case
-    BDIndentLevelPushCur (BDCols sig cols@(_ : _)) -> Just
-      $ BDCols sig (BDIndentLevelPushCur (List.head cols) : List.tail cols)
+      BDIndentLevelPushCur (BDCols sig cols@(_:_)) ->
+        Just $ BDCols sig (BDIndentLevelPushCur (List.head cols) : List.tail cols)
       BDIndentLevelPushCur (BDDebug s x) ->
         Just $ BDDebug s (BDIndentLevelPushCur x)
       _ -> Nothing
     descendILPop = transformDownMay $ \case
       BDIndentLevelPop (BDCols sig cols@(_:_)) ->
         Just $ BDCols sig (List.init cols ++ [BDIndentLevelPop (List.last cols)])
-    BDIndentLevelPop (BDDebug s x) -> Just $ BDDebug s (BDIndentLevelPop x)
+      BDIndentLevelPop (BDDebug s x) ->
+        Just $ BDDebug s (BDIndentLevelPop x)
       _ -> Nothing
     descendAddB = transformDownMay $ \case
-    BDAddBaseY BrIndentNone x -> Just x
+      BDAddBaseY BrIndentNone x ->
+        Just x
       -- AddIndent floats into Lines.
       BDAddBaseY indent (BDLines lines) ->
         Just $ BDLines $ BDAddBaseY indent <$> lines
       -- AddIndent floats into last column
       BDAddBaseY indent (BDCols sig cols) ->
-      Just
-        $ BDCols sig
-        $ List.init cols
-        ++ [BDAddBaseY indent $ List.last cols]
+        Just $ BDCols sig $ List.init cols ++ [BDAddBaseY indent $ List.last cols]
       -- merge AddIndent and Par
       BDAddBaseY ind1 (BDPar ind2 line indented) ->
         Just $ BDPar (mergeIndents ind1 ind2) line indented
@@ -133,11 +121,14 @@ transformSimplifyFloating = stepBO .> stepFull
         Just $ BDAnnotationKW annKey1 kw (BDAddBaseY ind x)
       BDAddBaseY ind (BDSeq list) ->
         Just $ BDSeq $ List.init list ++ [BDAddBaseY ind (List.last list)]
-    BDAddBaseY _ lit@BDLit{} -> Just $ lit
+      BDAddBaseY _ lit@BDLit{} ->
+        Just $ lit
       BDAddBaseY ind (BDBaseYPushCur x) ->
         Just $ BDBaseYPushCur (BDAddBaseY ind x)
-    BDAddBaseY ind (BDBaseYPop x) -> Just $ BDBaseYPop (BDAddBaseY ind x)
-    BDAddBaseY ind (BDDebug s x) -> Just $ BDDebug s (BDAddBaseY ind x)
+      BDAddBaseY ind (BDBaseYPop x) ->
+        Just $ BDBaseYPop (BDAddBaseY ind x)
+      BDAddBaseY ind (BDDebug s x) ->
+        Just $ BDDebug s (BDAddBaseY ind x)
       BDAddBaseY ind (BDIndentLevelPop x) ->
         Just $ BDIndentLevelPop (BDAddBaseY ind x)
       BDAddBaseY ind (BDIndentLevelPushCur x) ->
@@ -161,25 +152,25 @@ transformSimplifyFloating = stepBO .> stepFull
           x -> x
     stepFull = -- traceFunctionWith "stepFull" (show . briDocToDocWithAnns) (show . briDocToDocWithAnns) $
                Uniplate.rewrite $ \case
-    BDAddBaseY BrIndentNone x -> Just $ x
+      BDAddBaseY BrIndentNone x ->
+        Just $ x
       -- AddIndent floats into Lines.
       BDAddBaseY indent (BDLines lines) ->
         Just $ BDLines $ BDAddBaseY indent <$> lines
       -- AddIndent floats into last column
       BDAddBaseY indent (BDCols sig cols) ->
-      Just
-        $ BDCols sig
-        $ List.init cols
-        ++ [BDAddBaseY indent $ List.last cols]
+        Just $ BDCols sig $ List.init cols ++ [BDAddBaseY indent $ List.last cols]
       BDAddBaseY ind (BDSeq list) ->
         Just $ BDSeq $ List.init list ++ [BDAddBaseY ind (List.last list)]
       -- merge AddIndent and Par
       BDAddBaseY ind1 (BDPar ind2 line indented) ->
         Just $ BDPar (mergeIndents ind1 ind2) line indented
-    BDAddBaseY _ lit@BDLit{} -> Just $ lit
+      BDAddBaseY _ lit@BDLit{} ->
+        Just $ lit
       BDAddBaseY ind (BDBaseYPushCur x) ->
         Just $ BDBaseYPushCur (BDAddBaseY ind x)
-    BDAddBaseY ind (BDBaseYPop x) -> Just $ BDBaseYPop (BDAddBaseY ind x)
+      BDAddBaseY ind (BDBaseYPop x) ->
+        Just $ BDBaseYPop (BDAddBaseY ind x)
       -- prior floating in
       BDAnnotationPrior annKey1 (BDPar ind line indented) ->
         Just $ BDPar ind (BDAnnotationPrior annKey1 line) indented
@@ -200,18 +191,9 @@ transformSimplifyFloating = stepBO .> stepFull
       BDAnnotationRest annKey1 (BDPar ind line indented) ->
         Just $ BDPar ind line $ BDAnnotationRest annKey1 indented
       BDAnnotationRest annKey1 (BDSeq list) ->
-      Just
-        $ BDSeq
-        $ List.init list
-        ++ [BDAnnotationRest annKey1 $ List.last list]
+        Just $ BDSeq $ List.init list ++ [BDAnnotationRest annKey1 $ List.last list]
       BDAnnotationRest annKey1 (BDLines list) ->
-      Just
-        $ BDLines
-        $ List.init list
-        ++ [BDAnnotationRest annKey1 $ List.last list]
+        Just $ BDLines $ List.init list ++ [BDAnnotationRest annKey1 $ List.last list]
       BDAnnotationRest annKey1 (BDCols sig cols) ->
-      Just
-        $ BDCols sig
-        $ List.init cols
-        ++ [BDAnnotationRest annKey1 $ List.last cols]
+        Just $ BDCols sig $ List.init cols ++ [BDAnnotationRest annKey1 $ List.last cols]
       _ -> Nothing

source/library/Language/Haskell/Brittany/Internal/Transformations/Indent.hs

@@ -3,11 +3,17 @@
 
 module Language.Haskell.Brittany.Internal.Transformations.Indent where
 
-import qualified Data.Generics.Uniplate.Direct as Uniplate
-import qualified GHC.OldList as List
+
+
 import Language.Haskell.Brittany.Internal.Prelude
+import qualified GHC.OldList as List
+
 import           Language.Haskell.Brittany.Internal.Types
 
+import qualified Data.Generics.Uniplate.Direct as Uniplate
+
+
+
 -- prepare layouting by translating BDPar's, replacing them with Indents and
 -- floating those in. This gives a more clear picture of what exactly is
 -- affected by what amount of indentation.
@@ -25,15 +31,13 @@ transformSimplifyIndent = Uniplate.rewrite $ \case
   --     [ BDAddBaseY ind x
   --     , BDEnsureIndent ind indented
   --     ]
-  BDLines lines
-    | any
-      (\case
+  BDLines lines | any ( \case
                         BDLines{} -> True
                         BDEmpty{} -> True
                         _         -> False
                       )
-      lines
-    -> Just $ BDLines $ filter isNotEmpty $ lines >>= \case
+                      lines ->
+    Just $ BDLines $ filter isNotEmpty $ lines >>= \case
       BDLines l -> l
       x         -> [x]
   BDLines [l] -> Just l

source/library/Language/Haskell/Brittany/Internal/Transformations/Par.hs

@@ -3,9 +3,14 @@
 
 module Language.Haskell.Brittany.Internal.Transformations.Par where
 
+
+
 import Language.Haskell.Brittany.Internal.Prelude
-import Language.Haskell.Brittany.Internal.Types
+
 import           Language.Haskell.Brittany.Internal.Utils
+import           Language.Haskell.Brittany.Internal.Types
+
+
 
 transformSimplifyPar :: BriDoc -> BriDoc
 transformSimplifyPar = transformUp $ \case
@@ -19,15 +24,12 @@ transformSimplifyPar = transformUp $ \case
     BDPar ind1 line (BDLines (BDEnsureIndent ind2 p1 : indenteds))
   BDPar ind1 (BDPar ind2 line p1) p2 ->
     BDPar ind1 line (BDLines [BDEnsureIndent ind2 p1, p2])
-  BDLines lines
-    | any
-      (\case
+  BDLines lines | any ( \case
                         BDLines{} -> True
                         BDEmpty{} -> True
                         _         -> False
                       )
-      lines
-    -> case go lines of
+                      lines  -> case go lines of
     []  -> BDEmpty
     [x] -> x
     xs  -> BDLines xs

source/library/Language/Haskell/Brittany/Internal/Types.hs

@@ -12,39 +12,44 @@
 
 module Language.Haskell.Brittany.Internal.Types where
 
+
+
+import Language.Haskell.Brittany.Internal.Prelude
 import qualified Control.Monad.Trans.MultiRWS.Strict as MultiRWSS
 import qualified Data.Data
-import Data.Generics.Uniplate.Direct as Uniplate
-import qualified Data.Kind as Kind
 import qualified Data.Strict.Maybe as Strict
-import qualified Data.Text.Lazy.Builder as Text.Builder
-import GHC (AnnKeywordId, GenLocated, Located, SrcSpan)
-import Language.Haskell.Brittany.Internal.Config.Types
-import Language.Haskell.Brittany.Internal.Prelude
-import qualified Language.Haskell.GHC.ExactPrint as ExactPrint
-import Language.Haskell.GHC.ExactPrint (AnnKey)
-import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint.Types
-import Language.Haskell.GHC.ExactPrint.Types (Anns)
 import qualified Safe
 
+import qualified Language.Haskell.GHC.ExactPrint as ExactPrint
+import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint.Types
+
+import qualified Data.Text.Lazy.Builder as Text.Builder
+
+import           GHC ( Located, GenLocated, AnnKeywordId, SrcSpan )
+
+import           Language.Haskell.GHC.ExactPrint ( AnnKey )
+import           Language.Haskell.GHC.ExactPrint.Types ( Anns )
+
+import           Language.Haskell.Brittany.Internal.Config.Types
+
+import           Data.Generics.Uniplate.Direct as Uniplate
+
+import qualified Data.Kind as Kind
+
+
+
 data PerItemConfig = PerItemConfig
   { _icd_perBinding :: Map String (CConfig Maybe)
   , _icd_perKey :: Map ExactPrint.Types.AnnKey (CConfig Maybe)
   }
   deriving Data.Data.Data
 
-type PPM
-  = MultiRWSS.MultiRWS
-      '[ Map ExactPrint.AnnKey ExactPrint.Anns
-       , PerItemConfig
-       , Config
-       , ExactPrint.Anns
-       ]
+type PPM = MultiRWSS.MultiRWS
+  '[Map ExactPrint.AnnKey ExactPrint.Anns, PerItemConfig, Config, ExactPrint.Anns]
   '[Text.Builder.Builder, [BrittanyError], Seq String]
   '[]
 
-type PPMLocal
-  = MultiRWSS.MultiRWS
+type PPMLocal = MultiRWSS.MultiRWS
   '[Config, ExactPrint.Anns]
   '[Text.Builder.Builder, [BrittanyError], Seq String]
   '[]
@@ -110,20 +115,13 @@ lstate_indLevel = Safe.headNote "lstate_baseY" . _lstate_indLevels
 instance Show LayoutState where
   show state =
     "LayoutState"
-      ++ "{baseYs="
-      ++ show (_lstate_baseYs state)
-      ++ ",curYOrAddNewline="
-      ++ show (_lstate_curYOrAddNewline state)
-      ++ ",indLevels="
-      ++ show (_lstate_indLevels state)
-      ++ ",indLevelLinger="
-      ++ show (_lstate_indLevelLinger state)
-      ++ ",commentCol="
-      ++ show (_lstate_commentCol state)
-      ++ ",addSepSpace="
-      ++ show (_lstate_addSepSpace state)
-      ++ ",commentNewlines="
-      ++ show (_lstate_commentNewlines state)
+    ++ "{baseYs=" ++ show (_lstate_baseYs state)
+    ++ ",curYOrAddNewline=" ++ show (_lstate_curYOrAddNewline state)
+    ++ ",indLevels=" ++ show (_lstate_indLevels state)
+    ++ ",indLevelLinger=" ++ show (_lstate_indLevelLinger state)
+    ++ ",commentCol=" ++ show (_lstate_commentCol state)
+    ++ ",addSepSpace=" ++ show (_lstate_addSepSpace state)
+    ++ ",commentNewlines=" ++ show (_lstate_commentNewlines state)
     ++ "}"
 
 -- data NewLineState = NewLineStateInit -- initial state. we do not know if in a
@@ -225,14 +223,12 @@ data BrIndent = BrIndentNone
               | BrIndentSpecial Int
   deriving (Eq, Ord, Data.Data.Data, Show)
 
-type ToBriDocM
-  = MultiRWSS.MultiRWS
+type ToBriDocM = MultiRWSS.MultiRWS
                    '[Config, Anns] -- reader
                    '[[BrittanyError], Seq String] -- writer
                    '[NodeAllocIndex] -- state
 
-type ToBriDoc (sym :: Kind.Type -> Kind.Type)
-  = Located (sym GhcPs) -> ToBriDocM BriDocNumbered
+type ToBriDoc (sym :: Kind.Type -> Kind.Type) = Located (sym GhcPs) -> ToBriDocM BriDocNumbered
 type ToBriDoc' sym            = Located sym         -> ToBriDocM BriDocNumbered
 type ToBriDocC sym c          = Located sym         -> ToBriDocM c
 
@@ -425,8 +421,7 @@ briDocSeqSpine = \case
   BDBaseYPop           bd        -> briDocSeqSpine bd
   BDIndentLevelPushCur bd        -> briDocSeqSpine bd
   BDIndentLevelPop     bd        -> briDocSeqSpine bd
-  BDPar _ind line indented ->
-    briDocSeqSpine line `seq` briDocSeqSpine indented
+  BDPar _ind line indented -> briDocSeqSpine line `seq` briDocSeqSpine indented
   BDAlt             alts         -> foldl' (\() -> briDocSeqSpine) () alts
   BDForwardLineMode bd           -> briDocSeqSpine bd
   BDExternal{}                   -> ()
@@ -461,7 +456,8 @@ data VerticalSpacingPar
     -- product like (Normal|Always, None|Some Int).
   deriving (Eq, Show)
 
-data VerticalSpacing = VerticalSpacing
+data VerticalSpacing
+  = VerticalSpacing
     { _vs_sameLine  :: !Int
     , _vs_paragraph :: !VerticalSpacingPar
     , _vs_parFlag   :: !Bool
@@ -472,8 +468,6 @@ newtype LineModeValidity a = LineModeValidity (Strict.Maybe a)
   deriving (Functor, Applicative, Monad, Show, Alternative)
 
 pattern LineModeValid :: forall t. t -> LineModeValidity t
-pattern LineModeValid x =
-  LineModeValidity (Strict.Just x) :: LineModeValidity t
+pattern LineModeValid x = LineModeValidity (Strict.Just x) :: LineModeValidity t
 pattern LineModeInvalid :: forall t. LineModeValidity t
-pattern LineModeInvalid =
-  LineModeValidity Strict.Nothing :: LineModeValidity t
+pattern LineModeInvalid = LineModeValidity Strict.Nothing :: LineModeValidity t

source/library/Language/Haskell/Brittany/Internal/Utils.hs

@@ -7,29 +7,40 @@
 
 module Language.Haskell.Brittany.Internal.Utils where
 
-import qualified Data.ByteString as B
-import qualified Data.Coerce
-import Data.Data
-import Data.Generics.Aliases
-import qualified Data.Generics.Uniplate.Direct as Uniplate
-import qualified Data.Semigroup as Semigroup
-import qualified Data.Sequence as Seq
-import DataTreePrint
-import qualified GHC.Data.FastString as GHC
-import qualified GHC.Driver.Session as GHC
-import qualified GHC.Hs.Extension as HsExtension
-import qualified GHC.OldList as List
-import GHC.Types.Name.Occurrence as OccName (occNameString)
-import qualified GHC.Types.SrcLoc as GHC
-import qualified GHC.Utils.Outputable as GHC
-import Language.Haskell.Brittany.Internal.Config.Types
+
+
 import Language.Haskell.Brittany.Internal.Prelude
 import Language.Haskell.Brittany.Internal.PreludeUtils
-import Language.Haskell.Brittany.Internal.Types
+import qualified Data.Coerce
+import qualified Data.Semigroup as Semigroup
+import qualified Data.Sequence as Seq
+import qualified GHC.OldList as List
+
 import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint.Types
 import qualified Language.Haskell.GHC.ExactPrint.Utils as ExactPrint.Utils
+
+import           Data.Data
+import           Data.Generics.Aliases
+
 import qualified Text.PrettyPrint as PP
 
+import qualified GHC.Utils.Outputable as GHC
+import qualified GHC.Driver.Session   as GHC
+import qualified GHC.Data.FastString  as GHC
+import qualified GHC.Types.SrcLoc     as GHC
+import           GHC.Types.Name.Occurrence as OccName ( occNameString )
+import qualified Data.ByteString as B
+
+import           DataTreePrint
+
+import           Language.Haskell.Brittany.Internal.Config.Types
+import           Language.Haskell.Brittany.Internal.Types
+
+import qualified Data.Generics.Uniplate.Direct as Uniplate
+import qualified GHC.Hs.Extension as HsExtension
+
+
+
 parDoc :: String -> PP.Doc
 parDoc = PP.fsep . fmap PP.text . List.words
 
@@ -44,8 +55,7 @@ showOutputable :: (GHC.Outputable a) => a -> String
 showOutputable = GHC.showPpr GHC.unsafeGlobalDynFlags
 
 fromMaybeIdentity :: Identity a -> Maybe a -> Identity a
-fromMaybeIdentity x y =
-  Data.Coerce.coerce $ fromMaybe (Data.Coerce.coerce x) y
+fromMaybeIdentity x y = Data.Coerce.coerce $ fromMaybe (Data.Coerce.coerce x) y
 
 fromOptionIdentity :: Identity a -> Maybe a -> Identity a
 fromOptionIdentity x y =
@@ -65,11 +75,9 @@ instance (Num a, Ord a) => Monoid (Max a) where
 
 newtype ShowIsId = ShowIsId String deriving Data
 
-instance Show ShowIsId where
-  show (ShowIsId x) = x
+instance Show ShowIsId where show (ShowIsId x) = x
 
-data A x = A ShowIsId x
-  deriving Data
+data A x = A ShowIsId x deriving Data
 
 customLayouterF :: ExactPrint.Types.Anns -> LayouterF
 customLayouterF anns layoutF =
@@ -94,15 +102,11 @@ customLayouterF anns layoutF =
     simpleLayouter . ("{FastString: "++) . (++"}") . show :: GHC.FastString
       -> NodeLayouter
   bytestring = simpleLayouter . show :: B.ByteString -> NodeLayouter
-  occName =
-    simpleLayouter . ("{OccName: " ++) . (++ "}") . OccName.occNameString
+  occName = simpleLayouter . ("{OccName: "++) . (++"}") . OccName.occNameString
   srcSpan :: GHC.SrcSpan -> NodeLayouter
-  srcSpan ss =
-    simpleLayouter
+  srcSpan ss = simpleLayouter
              -- - $ "{"++ showSDoc_ (GHC.ppr ss)++"}"
-      $ "{"
-      ++ showOutputable ss
-      ++ "}"
+                              $ "{" ++ showOutputable ss ++ "}"
   located :: (Data b, Data loc) => GHC.GenLocated loc b -> NodeLayouter
   located (GHC.L ss a) = runDataToLayouter layoutF $ A annStr a
    where
@@ -134,8 +138,7 @@ customLayouterNoAnnsF layoutF =
     simpleLayouter . ("{FastString: "++) . (++"}") . show :: GHC.FastString
       -> NodeLayouter
   bytestring = simpleLayouter . show :: B.ByteString -> NodeLayouter
-  occName =
-    simpleLayouter . ("{OccName: " ++) . (++ "}") . OccName.occNameString
+  occName = simpleLayouter . ("{OccName: "++) . (++"}") . OccName.occNameString
   srcSpan :: GHC.SrcSpan -> NodeLayouter
   srcSpan ss = simpleLayouter $ "{" ++ showSDoc_ (GHC.ppr ss) ++ "}"
   located :: (Data b) => GHC.GenLocated loc b -> NodeLayouter
@@ -199,11 +202,12 @@ traceIfDumpConf s accessor val = do
   whenM (mAsk <&> _conf_debug .> accessor .> confUnpack) $ do
     trace ("---- " ++ s ++ " ----\n" ++ show val) $ return ()
 
-tellDebugMess :: MonadMultiWriter (Seq String) m => String -> m ()
+tellDebugMess :: MonadMultiWriter
+  (Seq String) m => String -> m ()
 tellDebugMess s = mTell $ Seq.singleton s
 
-tellDebugMessShow
-  :: forall a m . (MonadMultiWriter (Seq String) m, Show a) => a -> m ()
+tellDebugMessShow :: forall a m . (MonadMultiWriter
+  (Seq String) m, Show a) => a -> m ()
 tellDebugMessShow = tellDebugMess . show
 
 -- i should really put that into multistate..
@@ -226,19 +230,20 @@ briDocToDocWithAnns :: BriDoc -> PP.Doc
 briDocToDocWithAnns = astToDoc
 
 annsDoc :: ExactPrint.Types.Anns -> PP.Doc
-annsDoc =
-  printTreeWithCustom 100 customLayouterNoAnnsF . fmap (ShowIsId . show)
+annsDoc = printTreeWithCustom 100 customLayouterNoAnnsF . fmap (ShowIsId . show)
 
 breakEither :: (a -> Either b c) -> [a] -> ([b], [c])
 breakEither _  []      = ([], [])
 breakEither fn (a1:aR) = case fn a1 of
   Left  b -> (b : bs, cs)
   Right c -> (bs, c : cs)
-  where (bs, cs) = breakEither fn aR
+ where
+  (bs, cs) = breakEither fn aR
 
 spanMaybe :: (a -> Maybe b) -> [a] -> ([b], [a])
 spanMaybe f (x1:xR) | Just y <- f x1 = (y : ys, xs)
-  where (ys, xs) = spanMaybe f xR
+ where
+  (ys, xs) = spanMaybe f xR
 spanMaybe _ xs                       = ([], xs)
 
 data FirstLastView a

source/library/Language/Haskell/Brittany/Main.hs

@@ -4,42 +4,59 @@
 
 module Language.Haskell.Brittany.Main where
 
-import Control.Monad (zipWithM)
+
+
+import Language.Haskell.Brittany.Internal.Prelude
+import Language.Haskell.Brittany.Internal.PreludeUtils
 import qualified Control.Monad.Trans.Except as ExceptT
-import Data.CZipWith
 import qualified Data.Either
 import qualified Data.List.Extra
-import qualified Data.Monoid
 import qualified Data.Semigroup as Semigroup
 import qualified Data.Text as Text
 import qualified Data.Text.IO as Text.IO
 import qualified Data.Text.Lazy as TextL
-import DataTreePrint
-import GHC (GenLocated(L))
-import qualified GHC.Driver.Session as GHC
-import qualified GHC.LanguageExtensions.Type as GHC
 import qualified GHC.OldList as List
-import GHC.Utils.Outputable (Outputable(..), showSDocUnsafe)
+import qualified System.IO
+
+-- brittany { lconfig_importAsColumn: 60, lconfig_importColumn: 60 }
+import qualified Language.Haskell.GHC.ExactPrint         as ExactPrint
+import qualified Data.Monoid
+
+import           GHC                                      ( GenLocated(L) )
+import           GHC.Utils.Outputable                               ( Outputable(..)
+                                                          , showSDocUnsafe
+                                                          )
+
+import           Text.Read                                ( Read(..) )
+import qualified Text.ParserCombinators.ReadP            as ReadP
+import qualified Text.ParserCombinators.ReadPrec         as ReadPrec
+
+import           Control.Monad                            ( zipWithM )
+import           Data.CZipWith
+
+import           Language.Haskell.Brittany.Internal.Types
 import           Language.Haskell.Brittany.Internal
 import           Language.Haskell.Brittany.Internal.Config
 import           Language.Haskell.Brittany.Internal.Config.Types
-import Language.Haskell.Brittany.Internal.Obfuscation
-import Language.Haskell.Brittany.Internal.Prelude
-import Language.Haskell.Brittany.Internal.PreludeUtils
-import Language.Haskell.Brittany.Internal.Types
 import           Language.Haskell.Brittany.Internal.Utils
-import qualified Language.Haskell.GHC.ExactPrint as ExactPrint
-import Paths_brittany
-import qualified System.Directory as Directory
-import qualified System.Exit
-import qualified System.FilePath.Posix as FilePath
-import qualified System.IO
-import qualified Text.ParserCombinators.ReadP as ReadP
-import qualified Text.ParserCombinators.ReadPrec as ReadPrec
+import           Language.Haskell.Brittany.Internal.Obfuscation
+
 import qualified Text.PrettyPrint                        as PP
-import Text.Read (Read(..))
+
+import           DataTreePrint
 import           UI.Butcher.Monadic
 
+import qualified System.Exit
+import qualified System.Directory                        as Directory
+import qualified System.FilePath.Posix                   as FilePath
+
+import qualified GHC.Driver.Session                                as GHC
+import qualified GHC.LanguageExtensions.Type             as GHC
+
+import           Paths_brittany
+
+
+
 data WriteMode = Display | Inplace
 
 instance Read WriteMode where
@@ -134,8 +151,7 @@ mainCmdParser helpDesc = do
   printVersion <- addSimpleBoolFlag "" ["version"] mempty
   printLicense <- addSimpleBoolFlag "" ["license"] mempty
   noUserConfig <- addSimpleBoolFlag "" ["no-user-config"] mempty
-  configPaths <- addFlagStringParams
-    ""
+  configPaths  <- addFlagStringParams ""
                                       ["config-file"]
                                       "PATH"
                                       (flagHelpStr "path to config file") -- TODO: allow default on addFlagStringParam ?
@@ -195,11 +211,9 @@ mainCmdParser helpDesc = do
         $ ppHelpShallow helpDesc
       System.Exit.exitSuccess
 
-    let
-      inputPaths =
+    let inputPaths =
           if null inputParams then [Nothing] else map Just inputParams
-    let
-      outputPaths = case writeMode of
+    let outputPaths = case writeMode of
           Display -> repeat Nothing
           Inplace -> inputPaths
 
@@ -221,8 +235,7 @@ mainCmdParser helpDesc = do
       $ trace (showConfigYaml config)
       $ return ()
 
-    results <- zipWithM
-      (coreIO putStrErrLn config suppressOutput checkMode)
+    results <- zipWithM (coreIO putStrErrLn config suppressOutput checkMode)
                         inputPaths
                         outputPaths
 
@@ -253,8 +266,7 @@ coreIO
   -> IO (Either Int ChangeStatus)      -- ^ Either an errorNo, or the change status.
 coreIO putErrorLnIO config suppressOutput checkMode inputPathM outputPathM =
   ExceptT.runExceptT $ do
-    let
-      putErrorLn = liftIO . putErrorLnIO :: String -> ExceptT.ExceptT e IO ()
+    let putErrorLn = liftIO . putErrorLnIO :: String -> ExceptT.ExceptT e IO ()
     let ghcOptions = config & _conf_forward & _options_ghc & runIdentity
     -- there is a good of code duplication between the following code and the
     -- `pureModuleTransform` function. Unfortunately, there are also a good
@@ -268,18 +280,15 @@ coreIO putErrorLnIO config suppressOutput checkMode inputPathM outputPathM =
     -- string from the transformation output.
     -- The flag is intentionally misspelled to prevent clashing with
     -- inline-config stuff.
-    let
-      hackAroundIncludes =
+    let hackAroundIncludes =
           config & _conf_preprocessor & _ppconf_hackAroundIncludes & confUnpack
-    let
-      exactprintOnly = viaGlobal || viaDebug
+    let exactprintOnly = viaGlobal || viaDebug
          where
           viaGlobal = config & _conf_roundtrip_exactprint_only & confUnpack
           viaDebug =
             config & _conf_debug & _dconf_roundtrip_exactprint_only & confUnpack
 
-    let
-      cppCheckFunc dynFlags = if GHC.xopt GHC.Cpp dynFlags
+    let cppCheckFunc dynFlags = if GHC.xopt GHC.Cpp dynFlags
           then case cppMode of
             CPPModeAbort -> do
               return $ Left "Encountered -XCPP. Aborting."
@@ -295,17 +304,14 @@ coreIO putErrorLnIO config suppressOutput checkMode inputPathM outputPathM =
     (parseResult, originalContents) <- case inputPathM of
       Nothing -> do
         -- TODO: refactor this hack to not be mixed into parsing logic
-        let
-          hackF s = if "#include" `isPrefixOf` s
+        let hackF s = if "#include" `isPrefixOf` s
               then "-- BRITANY_INCLUDE_HACK " ++ s
               else s
-        let
-          hackTransform = if hackAroundIncludes && not exactprintOnly
+        let hackTransform = if hackAroundIncludes && not exactprintOnly
               then List.intercalate "\n" . fmap hackF . lines'
               else id
         inputString <- liftIO System.IO.getContents
-        parseRes <- liftIO $ parseModuleFromString
-          ghcOptions
+        parseRes <- liftIO $ parseModuleFromString ghcOptions
                                                    "stdin"
                                                    cppCheckFunc
                                                    (hackTransform inputString)
@@ -340,11 +346,9 @@ coreIO putErrorLnIO config suppressOutput checkMode inputPathM outputPathM =
               pure c
         let moduleConf = cZipWith fromOptionIdentity config inlineConf
         when (config & _conf_debug & _dconf_dump_ast_full & confUnpack) $ do
-          let
-            val = printTreeWithCustom 100 (customLayouterF anns) parsedSource
+          let val = printTreeWithCustom 100 (customLayouterF anns) parsedSource
           trace ("---- ast ----\n" ++ show val) $ return ()
-        let
-          disableFormatting =
+        let disableFormatting =
               moduleConf & _conf_disable_formatting & confUnpack
         (errsWarns, outSText, hasChanges) <- do
           if
@@ -354,8 +358,7 @@ coreIO putErrorLnIO config suppressOutput checkMode inputPathM outputPathM =
               let r = Text.pack $ ExactPrint.exactPrint parsedSource anns
               pure ([], r, r /= originalContents)
             | otherwise -> do
-              let
-                omitCheck =
+              let omitCheck =
                     moduleConf
                       &  _conf_errorHandling
                       .> _econf_omit_output_valid_check
@@ -363,17 +366,14 @@ coreIO putErrorLnIO config suppressOutput checkMode inputPathM outputPathM =
               (ews, outRaw) <- if hasCPP || omitCheck
                 then return
                   $ pPrintModule moduleConf perItemConf anns parsedSource
-                else liftIO $ pPrintModuleAndCheck
-                  moduleConf
+                else liftIO $ pPrintModuleAndCheck moduleConf
                                                    perItemConf
                                                    anns
                                                    parsedSource
-              let
-                hackF s = fromMaybe s $ TextL.stripPrefix
+              let hackF s = fromMaybe s $ TextL.stripPrefix
                     (TextL.pack "-- BRITANY_INCLUDE_HACK ")
                     s
-              let
-                out = TextL.toStrict $ if hackAroundIncludes
+              let out = TextL.toStrict $ if hackAroundIncludes
                     then
                       TextL.intercalate (TextL.pack "\n")
                       $ hackF
@@ -383,16 +383,14 @@ coreIO putErrorLnIO config suppressOutput checkMode inputPathM outputPathM =
                 then lift $ obfuscate out
                 else pure out
               pure $ (ews, out', out' /= originalContents)
-        let
-          customErrOrder ErrorInput{} = 4
+        let customErrOrder ErrorInput{}         = 4
             customErrOrder LayoutWarning{}      = -1 :: Int
             customErrOrder ErrorOutputCheck{}   = 1
             customErrOrder ErrorUnusedComment{} = 2
             customErrOrder ErrorUnknownNode{}   = -2 :: Int
             customErrOrder ErrorMacroConfig{}   = 5
         unless (null errsWarns) $ do
-          let
-            groupedErrsWarns =
+          let groupedErrsWarns =
                 Data.List.Extra.groupOn customErrOrder
                   $ List.sortOn customErrOrder
                   $ errsWarns
@@ -408,8 +406,7 @@ coreIO putErrorLnIO config suppressOutput checkMode inputPathM outputPathM =
                 $ "WARNING: encountered unknown syntactical constructs:"
               uns `forM_` \case
                 ErrorUnknownNode str ast@(L loc _) -> do
-                  putErrorLn $ "  " <> str <> " at " <> showSDocUnsafe
-                    (ppr loc)
+                  putErrorLn $ "  " <> str <> " at " <> showSDocUnsafe (ppr loc)
                   when
                       ( config
                       & _conf_debug
@@ -463,8 +460,7 @@ coreIO putErrorLnIO config suppressOutput checkMode inputPathM outputPathM =
           $ case outputPathM of
               Nothing -> liftIO $ Text.IO.putStr $ outSText
               Just p  -> liftIO $ do
-                let
-                  isIdentical = case inputPathM of
+                let isIdentical = case inputPathM of
                       Nothing -> False
                       Just _  -> not hasChanges
                 unless isIdentical $ Text.IO.writeFile p $ outSText

source/test-suite/Main.hs

@@ -2,25 +2,36 @@
 {-# LANGUAGE MonadComprehensions #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
-import Data.Coerce (coerce)
-import Data.List (groupBy)
+import Language.Haskell.Brittany.Internal.Prelude
 import qualified Data.Maybe
 import qualified Data.Semigroup as Semigroup
 import qualified Data.Text as Text
-import qualified Data.Text.IO as Text.IO
 import qualified GHC.OldList as List
-import Language.Haskell.Brittany.Internal
-import Language.Haskell.Brittany.Internal.Config
-import Language.Haskell.Brittany.Internal.Config.Types
-import Language.Haskell.Brittany.Internal.Prelude
-import Language.Haskell.Brittany.Internal.PreludeUtils
 import qualified System.Directory
-import System.FilePath ((</>))
-import System.Timeout (timeout)
+
 import           Test.Hspec
+
 import qualified Text.Parsec                   as Parsec
 import           Text.Parsec.Text               ( Parser )
 
+import           Data.List                      ( groupBy )
+
+import           Language.Haskell.Brittany.Internal
+
+import           Language.Haskell.Brittany.Internal.Config.Types
+import           Language.Haskell.Brittany.Internal.Config
+
+import           Data.Coerce                    ( coerce )
+
+import qualified Data.Text.IO                  as Text.IO
+import           System.FilePath                ( (</>) )
+
+import System.Timeout ( timeout )
+
+
+
+import Language.Haskell.Brittany.Internal.PreludeUtils
+
 hush :: Either a b -> Maybe b
 hush = either (const Nothing) Just
 
@@ -36,7 +47,8 @@ asymptoticPerfTest = do
     $  roundTripEqualWithTimeout 4000000
     $  (Text.pack "func = ")
     <> mconcat
-         ([1 .. 10] <&> \(i :: Int) ->
+         (   [1 .. 10]
+         <&> \(i :: Int) ->
                (Text.replicate (2 * i) (Text.pack " ") <> Text.pack "do\n")
          )
     <> Text.replicate 2000 (Text.pack " ")
@@ -52,8 +64,7 @@ roundTripEqualWithTimeout :: Int -> Text -> Expectation
 roundTripEqualWithTimeout time t =
   timeout time (action >>= evaluate) >>= (`shouldSatisfy`Data.Maybe.isJust)
  where
-  action = fmap
-    (fmap PPTextWrapper)
+  action = fmap (fmap PPTextWrapper)
                 (parsePrintModuleTests defaultTestConfig "TestFakeFileName.hs" t)
 
 
@@ -74,8 +85,7 @@ data TestCase = TestCase
 main :: IO ()
 main = do
   files <- System.Directory.listDirectory "data/"
-  let
-    blts =
+  let blts =
         List.sort
           $ filter (\x -> not ("tests-context-free.blt" `isSuffixOf` x))
           $ filter (".blt" `isSuffixOf`) files
@@ -89,10 +99,8 @@ main = do
       it "gives properly formatted result for valid input" $ do
         let
           input = Text.pack $ unlines
-            [ "func = [00000000000000000000000, 00000000000000000000000, 00000000000000000000000, 00000000000000000000000]"
-            ]
-        let
-          expected = Text.pack $ unlines
+            ["func = [00000000000000000000000, 00000000000000000000000, 00000000000000000000000, 00000000000000000000000]"]
+        let expected = Text.pack $ unlines
               [ "func ="
               , "  [ 00000000000000000000000"
               , "  , 00000000000000000000000"
@@ -146,16 +154,13 @@ main = do
     testProcessor = \case
       HeaderLine n : rest ->
         let normalLines = Data.Maybe.mapMaybe extractNormal rest
-        in
-          TestCase
+        in  TestCase
               { testName      = n
               , isPending     = any isPendingLine rest
               , content       = Text.unlines normalLines
               }
       l ->
-        error
-          $ "first non-empty line must start with #test footest\n"
-          ++ show l
+        error $ "first non-empty line must start with #test footest\n" ++ show l
     extractNormal (NormalLine l) = Just l
     extractNormal _              = Nothing
     isPendingLine PendingLine{} = True
@@ -220,6 +225,7 @@ instance Show PPTextWrapper where
   show (PPTextWrapper t) = "\n" ++ Text.unpack t
 
 -- brittany-next-binding --columns 160
+-- brittany-next-binding { lconfig_indentPolicy: IndentPolicyLeft }
 defaultTestConfig :: Config
 defaultTestConfig = Config
   { _conf_version                   = _conf_version staticDefaultConfig