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

@@ -86,7 +86,8 @@ 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
@@ -122,19 +123,22 @@ 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 }
@@ -142,7 +146,8 @@ 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 }
@@ -150,7 +155,8 @@ 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 }
@@ -172,7 +178,8 @@ extractCommentConfigs anns (TopLevelDeclNameMap declNameMap) = do
       Right c -> Right $ c
     pure (k, r)
 
-  let perModule = foldl'
+  let
+    perModule = foldl'
       (<>)
       mempty
       [ conf
@@ -232,20 +239,22 @@ getTopLevelDeclNameMap (L _ (HsModule _ _name _exports _ decls _ _)) =
 -- won't do.
 parsePrintModule :: Config -> Text -> IO (Either [BrittanyError] Text)
 parsePrintModule configWithDebugs inputText = runExceptT $ do
-  let config =
+  let
-        configWithDebugs { _conf_debug = _conf_debug staticDefaultConfig }
+    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
-          then "-- BRITANY_INCLUDE_HACK " ++ s
+      hackF s =
-          else 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
@@ -269,7 +278,8 @@ parsePrintModule configWithDebugs inputText = runExceptT $ do
       return inputText
     else do
       (errsWarns, outputTextL) <- do
-        let omitCheck =
+        let
+          omitCheck =
             moduleConfig
               & _conf_errorHandling
               & _econf_omit_output_valid_check
@@ -278,23 +288,26 @@ 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.intercalate (TextL.pack "\n")
-              (TextL.pack "\n")
+            $ hackF
-              outRaw
+            <$> 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)
@@ -315,7 +328,8 @@ pPrintModule
   -> GHC.ParsedSource
   -> ([BrittanyError], TextL.Text)
 pPrintModule conf inlineConf anns parsedModule =
-  let ((out, errs), debugStrings) =
+  let
+    ((out, errs), debugStrings) =
       runIdentity
         $ MultiRWSS.runMultiRWSTNil
         $ MultiRWSS.withMultiWriterAW
@@ -351,11 +365,13 @@ 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)
@@ -379,7 +395,8 @@ parsePrintModuleTests conf filename input = do
           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
@@ -458,20 +475,21 @@ 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
+    filteredAnns <- mAsk <&> \annMap ->
-      <&> \annMap ->
+      Map.union defaultAnns $ Map.findWithDefault Map.empty declAnnKey annMap
-        Map.union defaultAnns $
-        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
@@ -487,7 +505,8 @@ 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
@@ -498,10 +517,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
+      let
-            ExactPrint.AnnComment cm
+        folder (acc, _) (kw, ExactPrint.DP (y, x)) = case kw of
-              | span <- ExactPrint.commentIdentifier cm
+          ExactPrint.AnnComment cm | span <- ExactPrint.commentIdentifier cm ->
-              -> ( acc + y + GHC.srcSpanEndLine span - GHC.srcSpanStartLine span
+            ( acc + y + GHC.srcSpanEndLine span - GHC.srcSpanStartLine span
             , x + GHC.srcSpanEndCol span - GHC.srcSpanStartCol span
             )
           _ -> (acc + y, x)
@@ -530,7 +549,8 @@ 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
@@ -554,9 +574,9 @@ ppPreamble lmod@(L loc m@HsModule{}) = do
             mAnn' = mAnn { ExactPrint.annsDP = pre }
             filteredAnns'' =
               Map.insert (ExactPrint.mkAnnKey lmod) mAnn' filteredAnns
-          in
+          in (filteredAnns'', post')
-            (filteredAnns'', post')
+  traceIfDumpConf
-  traceIfDumpConf "bridoc annotations filtered/transformed"
+      "bridoc annotations filtered/transformed"
       _dconf_dump_annotations
     $ annsDoc filteredAnns'
 
@@ -602,7 +622,8 @@ 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
@@ -628,7 +649,9 @@ 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
@@ -643,7 +666,8 @@ 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

@@ -39,8 +39,12 @@ data ColumnSpacing
 
 type ColumnBlock a = [a]
 type ColumnBlocks a = Seq [a]
-type ColMap1 = IntMapL.IntMap {- ColIndex -} (Bool, ColumnBlocks ColumnSpacing)
+type ColMap1
-type ColMap2 = IntMapL.IntMap {- ColIndex -} (Float, ColumnBlock Int, ColumnBlocks Int)
+  = IntMapL.IntMap {- ColIndex -}
+                   (Bool, ColumnBlocks ColumnSpacing)
+type ColMap2
+  = IntMapL.IntMap {- ColIndex -}
+                   (Float, ColumnBlock Int, ColumnBlocks Int)
                                           -- (ratio of hasSpace, maximum, raw)
 
 data ColInfo
@@ -50,15 +54,18 @@ data ColInfo
 
 instance Show ColInfo where
   show ColInfoStart = "ColInfoStart"
-  show (ColInfoNo bd) = "ColInfoNo " ++ show (take 30 (show (briDocToDoc bd)) ++ "..")
+  show (ColInfoNo bd) =
-  show (ColInfo ind sig list) = "ColInfo " ++ show ind ++ " " ++ show sig ++ " " ++ show list
+    "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
@@ -84,7 +91,8 @@ 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
@@ -102,7 +110,8 @@ 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
@@ -111,7 +120,8 @@ 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
@@ -125,7 +135,8 @@ 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
@@ -148,7 +159,8 @@ 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
@@ -170,7 +182,8 @@ 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
@@ -186,14 +199,16 @@ 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
+          Just ((ExactPrint.Types.G kw1, _) : annR) | keyword == Just kw1 ->
-              annR
+            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
@@ -207,12 +222,14 @@ 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
@@ -226,18 +243,23 @@ 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 <&>
+    shouldAddSemicolonNewlines <-
-      _conf_layout .> _lconfig_experimentalSemicolonNewlines .> confUnpack
+      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               =
+          , ExactPrint.annsDP = flip filter (ExactPrint.annsDP ann) $ \case
-                        flip filter (ExactPrint.annsDP ann) $ \case
             (ExactPrint.Types.AnnComment{}, _) -> False
             _ -> True
           }
@@ -250,7 +272,8 @@ 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
@@ -270,7 +293,9 @@ 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
@@ -478,8 +503,8 @@ alignColsLines bridocs = do -- colInfos `forM_` \colInfo -> do
         where alignMax' = max 0 alignMax
 
       processedMap :: ColMap2
-      processedMap =
+      processedMap = fix $ \result ->
-        fix $ \result -> _cbs_map finalState <&> \(lastFlag, colSpacingss) ->
+        _cbs_map finalState <&> \(lastFlag, colSpacingss) ->
           let
             colss = colSpacingss <&> \spss -> case reverse spss of
               [] -> []
@@ -501,8 +526,7 @@ alignColsLines bridocs = do -- colInfos `forM_` \colInfo -> do
               else count
             ratio = fromIntegral (foldl counter (0 :: Int) colss)
               / fromIntegral (length colss)
-          in
+          in (ratio, maxCols, colss)
-            (ratio, maxCols, colss)
 
       mergeBriDocs :: [BriDoc] -> StateS.State ColBuildState [ColInfo]
       mergeBriDocs bds = mergeBriDocsW ColInfoStart bds
@@ -539,8 +563,7 @@ 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 &&
+      shouldBreakAfter bd = alignBreak && briDocIsMultiLine bd && case bd of
-        briDocIsMultiLine bd && case bd of
         (BDCols ColTyOpPrefix _) -> False
         (BDCols ColPatternsFuncPrefix _) -> True
         (BDCols ColPatternsFuncInfix _) -> True
@@ -572,8 +595,7 @@ alignColsLines bridocs = do -- colInfos `forM_` \colInfo -> do
       mergeInfoBriDoc lastFlag (ColInfo infoInd infoSig subLengthsInfos) =
         \case
           brdc@(BDCols colSig subDocs)
-            | infoSig == colSig && length subLengthsInfos == length subDocs
+            | infoSig == colSig && length subLengthsInfos == length subDocs -> do
-            -> do
               let
                 isLastList = if lastFlag
                   then (== length subDocs) <$> [1 ..]
@@ -593,14 +615,14 @@ alignColsLines bridocs = do -- colInfos `forM_` \colInfo -> do
                     m
                   }
               return $ ColInfo infoInd colSig (zip curLengths infos)
-            | otherwise
+            | otherwise -> briDocToColInfo lastFlag brdc
-            -> 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
@@ -648,7 +670,8 @@ 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
@@ -662,7 +685,8 @@ 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 =
@@ -673,15 +697,16 @@ processInfo maxSpace m = \case
           offsets = (subtract curX) <$> posXs
           fixed = offsets <&> fromIntegral .> (* factor) .> truncate
         _ -> posXs
-    let spacings = zipWith (-)
+    let
-                           (List.tail fixedPosXs ++ [min maxX colMax])
+      spacings =
-                           fixedPosXs
+        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

@@ -22,17 +22,12 @@ import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint
 
 
 
-traceLocal
+traceLocal :: (MonadMultiState LayoutState m) => a -> m ()
-  :: (MonadMultiState LayoutState m)
-  => a
-  -> m ()
 traceLocal _ = return ()
 
 
 layoutWriteAppend
-  :: ( MonadMultiWriter Text.Builder.Builder m
+  :: (MonadMultiWriter Text.Builder.Builder m, MonadMultiState LayoutState m)
-     , MonadMultiState LayoutState m
-     )
   => Text
   -> m ()
 layoutWriteAppend t = do
@@ -54,9 +49,7 @@ layoutWriteAppend t = do
     }
 
 layoutWriteAppendSpaces
-  :: ( MonadMultiWriter Text.Builder.Builder m
+  :: (MonadMultiWriter Text.Builder.Builder m, MonadMultiState LayoutState m)
-     , MonadMultiState LayoutState m
-     )
   => Int
   -> m ()
 layoutWriteAppendSpaces i = do
@@ -68,9 +61,7 @@ layoutWriteAppendSpaces i = do
       }
 
 layoutWriteAppendMultiline
-  :: ( MonadMultiWriter Text.Builder.Builder m
+  :: (MonadMultiWriter Text.Builder.Builder m, MonadMultiState LayoutState m)
-     , MonadMultiState LayoutState m
-     )
   => [Text]
   -> m ()
 layoutWriteAppendMultiline ts = do
@@ -85,14 +76,13 @@ layoutWriteAppendMultiline ts = do
 
 -- adds a newline and adds spaces to reach the base column.
 layoutWriteNewlineBlock
-  :: ( MonadMultiWriter Text.Builder.Builder m
+  :: (MonadMultiWriter Text.Builder.Builder m, MonadMultiState LayoutState 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
     }
 
@@ -110,11 +100,11 @@ layoutWriteNewlineBlock = do
 --         else _lstate_indLevelLinger state + i - _lstate_curY state
 --     }
 
-layoutSetCommentCol
+layoutSetCommentCol :: (MonadMultiState LayoutState m) => m ()
-  :: (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)
@@ -124,9 +114,7 @@ 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
+  :: (MonadMultiWriter Text.Builder.Builder m, MonadMultiState LayoutState m)
-     , MonadMultiState LayoutState m
-     )
   => Int
   -> Int
   -> Int
@@ -144,8 +132,7 @@ 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       =
+    , _lstate_commentCol = Just $ case _lstate_commentCol state of
-      Just $ case _lstate_commentCol state of
       Just existing -> existing
       Nothing -> case _lstate_curYOrAddNewline state of
         Left i -> i + fromMaybe 0 (_lstate_addSepSpace state)
@@ -156,9 +143,7 @@ layoutMoveToCommentPos y x commentLines = do
 
 -- | does _not_ add spaces to again reach the current base column.
 layoutWriteNewline
-  :: ( MonadMultiWriter Text.Builder.Builder m
+  :: (MonadMultiWriter Text.Builder.Builder m, MonadMultiState LayoutState m)
-     , MonadMultiState LayoutState m
-     )
   => m ()
 layoutWriteNewline = do
   traceLocal ("layoutWriteNewline")
@@ -175,9 +160,7 @@ _layoutResetCommentNewlines = do
   mModify $ \state -> state { _lstate_commentNewlines = 0 }
 
 layoutWriteEnsureNewlineBlock
-  :: ( MonadMultiWriter Text.Builder.Builder m
+  :: (MonadMultiWriter Text.Builder.Builder m, MonadMultiState LayoutState m)
-     , MonadMultiState LayoutState m
-     )
   => m ()
 layoutWriteEnsureNewlineBlock = do
   traceLocal ("layoutWriteEnsureNewlineBlock")
@@ -191,61 +174,52 @@ layoutWriteEnsureNewlineBlock = do
     }
 
 layoutWriteEnsureAbsoluteN
-  :: ( MonadMultiWriter Text.Builder.Builder m
+  :: (MonadMultiWriter Text.Builder.Builder m, MonadMultiState LayoutState 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
+layoutBaseYPushInternal :: (MonadMultiState LayoutState m) => Int -> m ()
-  :: (MonadMultiState LayoutState m)
-  => Int
-  -> m ()
 layoutBaseYPushInternal i = do
   traceLocal ("layoutBaseYPushInternal", i)
   mModify $ \s -> s { _lstate_baseYs = i : _lstate_baseYs s }
 
-layoutBaseYPopInternal
+layoutBaseYPopInternal :: (MonadMultiState LayoutState m) => m ()
-  :: (MonadMultiState LayoutState m) => m ()
 layoutBaseYPopInternal = do
   traceLocal ("layoutBaseYPopInternal")
   mModify $ \s -> s { _lstate_baseYs = List.tail $ _lstate_baseYs s }
 
-layoutIndentLevelPushInternal
+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
+layoutIndentLevelPopInternal :: (MonadMultiState LayoutState m) => m ()
-  :: (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
@@ -277,9 +251,7 @@ layoutWithAddBaseColBlock m = do
   layoutBaseYPopInternal
 
 layoutWithAddBaseColNBlock
-  :: ( MonadMultiWriter Text.Builder.Builder m
+  :: (MonadMultiWriter Text.Builder.Builder m, MonadMultiState LayoutState m)
-     , MonadMultiState LayoutState m
-     )
   => Int
   -> m ()
   -> m ()
@@ -292,9 +264,7 @@ layoutWithAddBaseColNBlock amount m = do
   layoutBaseYPopInternal
 
 layoutWriteEnsureBlock
-  :: ( MonadMultiWriter Text.Builder.Builder m
+  :: (MonadMultiWriter Text.Builder.Builder m, MonadMultiState LayoutState m)
-     , MonadMultiState LayoutState m
-     )
   => m ()
 layoutWriteEnsureBlock = do
   traceLocal ("layoutWriteEnsureBlock")
@@ -310,9 +280,7 @@ layoutWriteEnsureBlock = do
     mSet $ state { _lstate_addSepSpace = Just $ diff }
 
 layoutWithAddBaseColN
-  :: ( MonadMultiWriter Text.Builder.Builder m
+  :: (MonadMultiWriter Text.Builder.Builder m, MonadMultiState LayoutState m)
-     , MonadMultiState LayoutState m
-     )
   => Int
   -> m ()
   -> m ()
@@ -322,8 +290,7 @@ layoutWithAddBaseColN amount m = do
   m
   layoutBaseYPopInternal
 
-layoutBaseYPushCur
+layoutBaseYPushCur :: (MonadMultiState LayoutState m) => m ()
-  :: (MonadMultiState LayoutState m) => m ()
 layoutBaseYPushCur = do
   traceLocal ("layoutBaseYPushCur")
   state <- mGet
@@ -335,26 +302,24 @@ layoutBaseYPushCur = do
         (Right{}, _) -> layoutBaseYPushInternal $ lstate_baseY state
     Just cCol -> layoutBaseYPushInternal cCol
 
-layoutBaseYPop
+layoutBaseYPop :: (MonadMultiState LayoutState m) => m ()
-  :: (MonadMultiState LayoutState m) => m ()
 layoutBaseYPop = do
   traceLocal ("layoutBaseYPop")
   layoutBaseYPopInternal
 
-layoutIndentLevelPushCur
+layoutIndentLevelPushCur :: (MonadMultiState LayoutState m) => m ()
-  :: (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
+layoutIndentLevelPop :: (MonadMultiState LayoutState m) => m ()
-  :: (MonadMultiState LayoutState m) => m ()
 layoutIndentLevelPop = do
   traceLocal ("layoutIndentLevelPop")
   layoutIndentLevelPopInternal
@@ -364,12 +329,12 @@ layoutIndentLevelPop = do
   -- make sense.
   layoutRemoveIndentLevelLinger
 
-layoutAddSepSpace :: (MonadMultiState LayoutState m)
+layoutAddSepSpace :: (MonadMultiState LayoutState m) => 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.
@@ -393,16 +358,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
+        then _lstate_commentCol state <|> _lstate_addSepSpace state <|> Just
-                                         _lstate_commentCol state
+          (lstate_baseY state)
-                                         <|> _lstate_addSepSpace state
-                                         <|> Just (lstate_baseY state)
         else Nothing
       , _lstate_commentCol = Nothing
       }
@@ -415,9 +380,7 @@ moveToY y = mModify $ \state ->
 --     else x
 
 ppmMoveToExactLoc
-  :: MonadMultiWriter Text.Builder.Builder m
+  :: MonadMultiWriter Text.Builder.Builder m => ExactPrint.DeltaPos -> m ()
-  => ExactPrint.DeltaPos
-  -> m ()
 ppmMoveToExactLoc (ExactPrint.DP (x, y)) = do
   replicateM_ x $ mTell $ Text.Builder.fromString "\n"
   replicateM_ y $ mTell $ Text.Builder.fromString " "
@@ -437,17 +400,18 @@ layoutWritePriorComments ast = do
     let anns = _lstate_comments state
     let mAnn = ExactPrint.annPriorComments <$> Map.lookup key anns
     mSet $ state
-      { _lstate_comments =
+      { _lstate_comments = Map.adjust
-          Map.adjust (\ann -> ann { ExactPrint.annPriorComments = [] }) key anns
+        (\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 _ _
+      priors `forM_` \(ExactPrint.Comment comment _ _, ExactPrint.DP (x, y)) ->
-                      , ExactPrint.DP (x, y)
+        do
-                      ) -> do
           replicateM_ x layoutWriteNewline
           layoutWriteAppendSpaces y
           layoutWriteAppendMultiline $ Text.lines $ Text.pack comment
@@ -456,10 +420,13 @@ 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,
+layoutWritePostComments
-                                               MonadMultiWriter Text.Builder.Builder m,
+  :: ( Data.Data.Data ast
-                                               MonadMultiState LayoutState m)
+     , MonadMultiWriter Text.Builder.Builder m
-                         => Located ast -> m ()
+     , MonadMultiState LayoutState m
+     )
+  => Located ast
+  -> m ()
 layoutWritePostComments ast = do
   mAnn <- do
     state <- mGet
@@ -467,8 +434,8 @@ layoutWritePostComments ast = do
     let anns = _lstate_comments state
     let mAnn = ExactPrint.annFollowingComments <$> Map.lookup key anns
     mSet $ state
-      { _lstate_comments =
+      { _lstate_comments = Map.adjust
-          Map.adjust (\ann -> ann { ExactPrint.annFollowingComments = [] })
+        (\ann -> ann { ExactPrint.annFollowingComments = [] })
         key
         anns
       }
@@ -477,30 +444,28 @@ layoutWritePostComments ast = do
     Nothing -> return ()
     Just posts -> do
       unless (null posts) $ layoutSetCommentCol
-      posts `forM_` \( ExactPrint.Comment comment _ _
+      posts `forM_` \(ExactPrint.Comment comment _ _, ExactPrint.DP (x, y)) ->
-                      , ExactPrint.DP (x, y)
+        do
-                      ) -> 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
+  :: (MonadMultiState LayoutState m, MonadMultiWriter Text.Builder.Builder 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
+  mModify
-                    , _lstate_commentNewlines = 0
+    $ \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

@@ -235,7 +235,8 @@ 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,8 +262,9 @@ readConfigs
   -> MaybeT IO Config
 readConfigs cmdlineConfig configPaths = do
   configs <- readConfig `mapM` configPaths
-  let merged = Semigroup.sconcat
+  let
-        $ NonEmpty.reverse (cmdlineConfig :| catMaybes configs)
+    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

@@ -36,7 +36,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.
@@ -141,12 +141,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)
@@ -161,13 +161,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)
@@ -187,9 +187,8 @@ 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

@@ -104,16 +104,26 @@ 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
+  parseJSON (Object v) =
-    <$> v .:?  Key.fromString "conf_version"
+    Config
-    <*> v .:?= Key.fromString "conf_debug"
+      <$> v
-    <*> v .:?= Key.fromString "conf_layout"
+      .:? Key.fromString "conf_version"
-    <*> v .:?= Key.fromString "conf_errorHandling"
+      <*> v
-    <*> v .:?= Key.fromString "conf_forward"
+      .:?= Key.fromString "conf_debug"
-    <*> v .:?= Key.fromString "conf_preprocessor"
+      <*> v
-    <*> v .:?  Key.fromString "conf_roundtrip_exactprint_only"
+      .:?= Key.fromString "conf_layout"
-    <*> v .:?  Key.fromString "conf_disable_formatting"
+      <*> v
-    <*> v .:?  Key.fromString "conf_obfuscate"
+      .:?= 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

@@ -53,13 +53,16 @@ parseModuleFromString = ParseModule.parseModule
 
 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`
+        `SYB.ext1Q` (\l@(L span _) ->
-            (\l@(L span _) -> Seq.singleton (span, ExactPrint.mkAnnKey l))
+                      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)
@@ -70,7 +73,8 @@ 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
@@ -97,15 +101,16 @@ commentAnnFixTransformGlob ast = do
                       { ExactPrint.annFollowingComments =
                         ExactPrint.annFollowingComments ann2 ++ [comPair]
                       }
-                  in
+                  in Map.insert annKey2 ann2' anns
-                    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'
           }
@@ -200,7 +205,8 @@ 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)
@@ -215,10 +221,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 () ()))
@@ -238,7 +244,8 @@ 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

@@ -68,7 +68,8 @@ 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
@@ -84,7 +85,8 @@ 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,21 +101,23 @@ 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
+      docLit $ Text.pack "{- BRITTANY ERROR UNHANDLED SYNTACTICAL CONSTRUCT -}"
-          $ Text.pack "{- BRITTANY ERROR UNHANDLED SYNTACTICAL CONSTRUCT -}"
   case (fallbackMode, Text.lines exactPrinted) of
     (ExactPrintFallbackModeNever, _) -> errorAction
     (_, [t]) -> exactPrintNode
@@ -141,7 +145,8 @@ 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
@@ -167,7 +172,8 @@ 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
@@ -188,7 +194,8 @@ 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
@@ -212,8 +219,7 @@ extractRestComments ann =
        )
 
 filterAnns :: Data.Data.Data ast => ast -> ExactPrint.Anns -> ExactPrint.Anns
-filterAnns ast =
+filterAnns ast = Map.filterWithKey (\k _ -> k `Set.member` foldedAnnKeys 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
@@ -231,7 +237,8 @@ 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
@@ -449,16 +456,13 @@ newtype CollectAltM a = CollectAltM (Writer.Writer [ToBriDocM BriDocNumbered] a)
   deriving (Functor, Applicative, Monad)
 
 addAlternativeCond :: Bool -> ToBriDocM BriDocNumbered -> CollectAltM ()
-addAlternativeCond cond doc =
+addAlternativeCond cond doc = when cond (addAlternative doc)
-  when cond (addAlternative doc)
 
 addAlternative :: ToBriDocM BriDocNumbered -> CollectAltM ()
-addAlternative =
+addAlternative = CollectAltM . Writer.tell . (: [])
-  CollectAltM . Writer.tell . (: [])
 
 runFilteredAlternative :: CollectAltM () -> ToBriDocM BriDocNumbered
-runFilteredAlternative (CollectAltM action) =
+runFilteredAlternative (CollectAltM action) = docAlt $ Writer.execWriter action
-  docAlt $ Writer.execWriter action
 
 
 docSeq :: [ToBriDocM BriDocNumbered] -> ToBriDocM BriDocNumbered
@@ -506,7 +510,8 @@ 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
@@ -620,17 +625,11 @@ instance DocWrapable (ToBriDocM BriDocNumbered) where
   docWrapNodePrior ast bdm = do
     bd <- bdm
     i1 <- allocNodeIndex
-    return
+    return $ (,) i1 $ BDFAnnotationPrior (ExactPrint.Types.mkAnnKey ast) $ bd
-      $ (,) i1
-      $ BDFAnnotationPrior (ExactPrint.Types.mkAnnKey ast)
-      $ bd
   docWrapNodeRest ast bdm = do
     bd <- bdm
     i2 <- allocNodeIndex
-    return
+    return $ (,) i2 $ BDFAnnotationRest (ExactPrint.Types.mkAnnKey ast) $ bd
-      $ (,) i2
-      $ BDFAnnotationRest (ExactPrint.Types.mkAnnKey ast)
-      $ bd
 
 instance DocWrapable (ToBriDocM a) => DocWrapable [ToBriDocM a] where
   docWrapNode ast bdms = case bdms of
@@ -767,7 +766,8 @@ 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

@@ -27,9 +27,10 @@ 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
+  HsDataDefn _ext NewType (L _ []) _ctype Nothing [cons] mDerivs ->
-    (L _ (ConDeclH98 _ext consName (L _ False) _qvars (Just (L _ [])) details _conDoc)) ->
+    case cons of
-      docWrapNode ltycl $ do
+      (L _ (ConDeclH98 _ext consName (L _ False) _qvars (Just (L _ [])) details _conDoc))
+        -> docWrapNode ltycl $ do
           nameStr <- lrdrNameToTextAnn name
           consNameStr <- lrdrNameToTextAnn consName
           tyVarLine <- return <$> createBndrDoc bndrs
@@ -69,8 +70,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)) ->
+      (L _ (ConDeclH98 _ext consName (L _ _hasExt) qvars mRhsContext details _conDoc))
-        docWrapNode ltycl $ do
+        -> docWrapNode ltycl $ do
           lhsContextDoc <- docSharedWrapper createContextDoc lhsContext
           nameStr <- lrdrNameToTextAnn name
           consNameStr <- lrdrNameToTextAnn consName
@@ -82,11 +83,13 @@ 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
@@ -94,7 +97,8 @@ layoutDataDecl ltycl name (HsQTvs _ bndrs) defn = case defn of
                     ]
                   ]
                 (Just forallDoc, Nothing) -> docLines
-                  [ docSeq [docLitS "=", docSeparator, docForceSingleline forallDoc]
+                  [ docSeq
+                    [docLitS "=", docSeparator, docForceSingleline forallDoc]
                   , docSeq [docLitS ".", docSeparator, rhsDoc]
                   ]
                 (Nothing, Just rhsContextDoc) -> docSeq
@@ -102,12 +106,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)
+              [ docNodeAnnKW ltycl (Just GHC.AnnData) $ docSeq
-              $ docSeq
                 [ appSep $ docLitS "data"
                 , docForceSingleline $ lhsContextDoc
                 , appSep $ docLit nameStr
@@ -119,7 +123,8 @@ 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 "."
@@ -132,8 +137,7 @@ 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)
+              (docNodeAnnKW ltycl (Just GHC.AnnData) $ docSeq
-              $ docSeq
                 [ appSep $ docLitS "data"
                 , docForceSingleline lhsContextDoc
                 , appSep $ docLit nameStr
@@ -146,7 +150,8 @@ 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 "."
@@ -162,8 +167,7 @@ layoutDataDecl ltycl name (HsQTvs _ bndrs) defn = case defn of
               --   . Show a =>
               --     D a
               docAddBaseY BrIndentRegular $ docPar
-              ( docNodeAnnKW ltycl (Just GHC.AnnData)
+              (docNodeAnnKW ltycl (Just GHC.AnnData) $ docSeq
-              $ docSeq
                 [ appSep $ docLitS "data"
                 , docForceSingleline lhsContextDoc
                 , appSep $ docLit nameStr
@@ -187,10 +191,7 @@ layoutDataDecl ltycl name (HsQTvs _ bndrs) defn = case defn of
               (docLines
                 [ lhsContextDoc
                 , docNodeAnnKW ltycl (Just GHC.AnnData)
-                $ docSeq
+                  $ docSeq [appSep $ docLit nameStr, tyVarLine]
-                  [ appSep $ docLit nameStr
-                  , tyVarLine
-                  ]
                 , consDoc
                 ]
               )
@@ -209,15 +210,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
+      , tRDocs <&> \tRDoc -> docSeq [docLitS ",", docSeparator, tRDoc]
-        <&> \tRDoc -> docSeq [docLitS ",", docSeparator, tRDoc]
       , [docLitS ") =>", docSeparator]
       ]
     ]
@@ -229,10 +230,8 @@ createBndrDoc bs = do
     (L _ (KindedTyVar _ _ext lrdrName kind)) -> do
       d <- docSharedWrapper layoutType kind
       return $ (lrdrNameToText lrdrName, Just $ d)
-  docSeq
+  docSeq $ List.intersperse docSeparator $ tyVarDocs <&> \(vname, mKind) ->
-    $   List.intersperse docSeparator
+    case mKind of
-    $   tyVarDocs
-    <&> \(vname, mKind) -> case mKind of
       Nothing -> docLit vname
       Just kind -> docSeq
         [ docLitS "("
@@ -263,11 +262,10 @@ derivingClauseDoc (L _ (HsDerivingClause _ext mStrategy types)) = case types of
   (L _ ts) ->
     let
       tsLength = length ts
-      whenMoreThan1Type val =
+      whenMoreThan1Type val = if tsLength > 1 then docLitS val else docLitS ""
-        if tsLength > 1 then docLitS val else docLitS ""
+      (lhsStrategy, rhsStrategy) =
-      (lhsStrategy, rhsStrategy) = maybe (docEmpty, docEmpty) strategyLeftRight mStrategy
+        maybe (docEmpty, docEmpty) strategyLeftRight mStrategy
-    in
+    in docSeq
-      docSeq
       [ docDeriving
       , docWrapNodePrior types $ lhsStrategy
       , docSeparator
@@ -275,7 +273,8 @@ derivingClauseDoc (L _ (HsDerivingClause _ext mStrategy types)) = case types of
       , docWrapNodeRest types
       $ docSeq
       $ List.intersperse docCommaSep
-          $ ts <&> \case
+      $ ts
+      <&> \case
             HsIB _ t -> layoutType t
       , whenMoreThan1Type ")"
       , rhsStrategy
@@ -288,11 +287,8 @@ derivingClauseDoc (L _ (HsDerivingClause _ext mStrategy types)) = case types of
     lVia@(L _ (ViaStrategy viaTypes)) ->
       ( docEmpty
       , case viaTypes of
-          HsIB _ext t -> docSeq
+        HsIB _ext t ->
-            [ docWrapNode lVia $ docLitS " via"
+          docSeq [docWrapNode lVia $ docLitS " via", docSeparator, layoutType t]
-            , docSeparator
-            , layoutType t
-            ]
       )
 
 docDeriving :: ToBriDocM BriDocNumbered
@@ -310,13 +306,16 @@ 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
@@ -330,14 +329,13 @@ 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
+    docAddBaseY BrIndentRegular $ runFilteredAlternative $ do
-      $ runFilteredAlternative
-      $ do
         -- single-line: { i :: Int, b :: Bool }
       addAlternativeCond allowSingleline $ docSeq
         [ docLit consNameStr
@@ -366,7 +364,8 @@ 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]
@@ -382,7 +381,8 @@ createDetailsDoc consNameStr details = case details of
             ]
           , docWrapNodeRest lRec $ docLines $ fDocR <&> \(fName, fType) ->
             docAlt
-                [ docCols ColRecDecl
+              [ docCols
+                ColRecDecl
                 [ docCommaSep
                 , appSep $ docForceSingleline fName
                 , docSeq [docLitS "::", docSeparator]
@@ -413,10 +413,11 @@ 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
+createForallDoc lhsTyVarBndrs =
-  [docLitS "forall ", createBndrDoc lhsTyVarBndrs]
+  Just $ docSeq [docLitS "forall ", createBndrDoc lhsTyVarBndrs]
 
 createNamesAndTypeDoc
   :: Data.Data.Data ast
@@ -426,12 +427,8 @@ createNamesAndTypeDoc
   -> (ToBriDocM BriDocNumbered, ToBriDocM BriDocNumbered)
 createNamesAndTypeDoc lField names t =
   ( docNodeAnnKW lField Nothing $ docWrapNodePrior lField $ docSeq
-    [ docSeq
+    [ docSeq $ List.intersperse docCommaSep $ names <&> \case
-      $   List.intersperse docCommaSep
+        L _ (FieldOcc _ fieldName) -> docLit =<< lrdrNameToTextAnn fieldName
-      $   names
-      <&> \case
-        L _ (FieldOcc _ fieldName) ->
-            docLit =<< lrdrNameToTextAnn fieldName
     ]
   , docWrapNodeRest lField $ layoutType t
   )

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

@@ -64,14 +64,16 @@ layoutSig lsig@(L _loc sig) = case sig of
     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
@@ -79,24 +81,29 @@ layoutSig lsig@(L _loc sig) = case sig of
         <> nameStr
         <> Text.pack " #-}"
   ClassOpSig _ False names (HsIB _ typ) -> layoutNamesAndType Nothing names typ
-  PatSynSig _ names (HsIB _ typ) -> layoutNamesAndType (Just "pattern") 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
+    shouldBeHanging <-
-      <&> _conf_layout
+      mAsk <&> _conf_layout .> _lconfig_hangingTypeSignature .> confUnpack
-      .>  _lconfig_hangingTypeSignature
-      .>  confUnpack
     if shouldBeHanging
-      then docSeq $
+      then
-        [ appSep $ docWrapNodeRest lsig $ docSeq $ keyDoc <> [docLit nameStr]
+        docSeq
+          $ [ appSep
+            $ docWrapNodeRest lsig
+            $ docSeq
+            $ keyDoc
+            <> [docLit nameStr]
             , docSetBaseY $ docLines
               [ docCols
                   ColTyOpPrefix
@@ -125,7 +132,8 @@ 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]
       ]
@@ -137,9 +145,7 @@ layoutGuardLStmt lgstmt@(L _ stmtLR) = docWrapNode lgstmt $ case stmtLR of
 --------------------------------------------------------------------------------
 
 layoutBind
-  :: ToBriDocC
+  :: ToBriDocC (HsBindLR GhcPs GhcPs) (Either [BriDocNumbered] BriDocNumbered)
-       (HsBindLR GhcPs GhcPs)
-       (Either [BriDocNumbered] BriDocNumbered)
 layoutBind lbind@(L _ bind) = case bind of
   FunBind _ fId (MG _ lmatches@(L _ matches) _) [] -> do
     idStr <- lrdrNameToTextAnn fId
@@ -157,17 +163,15 @@ 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
+    fmap Right $ docWrapNode lbind $ layoutPatSynBind patID lpat dir rpat
-                                                      lpat
-                                                      dir
-                                                      rpat
   _ -> Right <$> unknownNodeError "" lbind
 layoutIPBind :: ToBriDoc IPBind
 layoutIPBind lipbind@(L _ bind) = case bind of
@@ -177,7 +181,13 @@ 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)
@@ -195,7 +205,8 @@ 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
@@ -205,8 +216,7 @@ 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) ->
+  HsIPBinds _ (IPBinds _ bb) -> Just <$> mapM layoutIPBind bb
-    Just <$> mapM layoutIPBind bb
   EmptyLocalBinds{} -> return $ Nothing
 
 -- TODO: we don't need the `LHsExpr GhcPs` anymore, now that there is
@@ -235,15 +245,16 @@ 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
+      then docCols
-        docCols ColPatternsFuncInfix
+        ColPatternsFuncInfix
         [ appSep $ docForceSingleline p1
         , appSep $ docLit $ idStr
         , docForceSingleline p2
         ]
-      else
+      else docCols
-        docCols ColPatternsFuncInfix
+        ColPatternsFuncInfix
-          (  [docCols ColPatterns
+        ([ docCols
+             ColPatterns
              [ docParenL
              , appSep $ docForceSingleline p1
              , appSep $ docLit $ idStr
@@ -266,15 +277,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
+fixPatternBindIdentifier :: Match GhcPs (LHsExpr GhcPs) -> Text -> Text
-  :: Match GhcPs (LHsExpr GhcPs) -> Text -> Text
 fixPatternBindIdentifier match idStr = go $ m_ctxt match
  where
   go = \case
@@ -300,22 +311,20 @@ layoutPatternBindFinal
      -- ^ AnnKey for the node that contains the AnnWhere position annotation
   -> Bool
   -> ToBriDocM BriDocNumbered
-layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs hasComments = do
+layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs hasComments
-  let patPartInline  = case mPatDoc of
+  = 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
+      shouldSpecial <-
-      <&> _conf_layout
+        mAsk <&> _conf_layout .> _lconfig_indentWhereSpecial .> confUnpack
-      .>  _lconfig_indentWhereSpecial
+      regularIndentAmount <-
-      .>  confUnpack
+        mAsk <&> _conf_layout .> _lconfig_indentAmount .> confUnpack
-    regularIndentAmount <- mAsk
-      <&> _conf_layout
-      .>  _lconfig_indentAmount
-      .>  confUnpack
       pure $ if shouldSpecial
         then BrIndentSpecial (max 1 (regularIndentAmount `div` 2))
         else BrIndentRegular
@@ -353,13 +362,16 @@ 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
@@ -371,10 +383,7 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha
           ]
         _ -> Nothing
 
-  indentPolicy <- mAsk
+    indentPolicy <- mAsk <&> _conf_layout .> _lconfig_indentPolicy .> confUnpack
-    <&> _conf_layout
-    .>  _lconfig_indentPolicy
-    .>  confUnpack
 
     runFilteredAlternative $ do
 
@@ -400,7 +409,8 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha
                   [ docSeq (patPartInline ++ [guardPart])
                   , docSeq
                     [ appSep $ return binderDoc
-                 , docForceParSpacing $ docAddBaseY BrIndentRegular $ return body
+                    , docForceParSpacing $ docAddBaseY BrIndentRegular $ return
+                      body
                     ]
                   ]
               ]
@@ -410,7 +420,8 @@ 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;
@@ -422,7 +433,8 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha
                   [ docSeq (patPartInline ++ [guardPart])
                   , docSeq
                     [ appSep $ return binderDoc
-                 , docForceParSpacing $ docAddBaseY BrIndentRegular $ return body
+                    , docForceParSpacing $ docAddBaseY BrIndentRegular $ return
+                      body
                     ]
                   ]
               ]
@@ -514,8 +526,8 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha
                     $ (case guardDocs of
                         [] -> []
                         [g] ->
-                       [ docForceSingleline
+                          [ docForceSingleline $ docSeq
-                       $ docSeq [appSep $ docLit $ Text.pack "|", return g]
+                              [appSep $ docLit $ Text.pack "|", return g]
                           ]
                         gs ->
                           [ docForceSingleline
@@ -579,14 +591,11 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha
             >>= \(guardDocs, bodyDoc, _) ->
                   (case guardDocs of
                       [] -> []
-                     [g] ->
+                      [g] -> [docSeq [appSep $ docLit $ Text.pack "|", return g]]
-                       [docSeq [appSep $ docLit $ Text.pack "|", return g]]
                       (g1 : gr) ->
                         (docSeq [appSep $ docLit $ Text.pack "|", return g1]
-                       : (   gr
+                        : (gr <&> \g ->
-                         <&> \g ->
+                            docSeq [appSep $ docLit $ Text.pack ",", return g]
-                               docSeq
-                                 [appSep $ docLit $ Text.pack ",", return g]
                           )
                         )
                     )
@@ -607,39 +616,45 @@ 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 $
+  headDoc <-
-    [ patDoc
+    fmap pure
+    $ docSeq
+    $ [ patDoc
       , docSeparator
       , layoutLPatSyn name patSynDetails
       , docSeparator
       , binderDoc
       ]
   runFilteredAlternative $ do
-    addAlternative $
+    addAlternative
+      $
       -- pattern .. where
       --   ..
       --   ..
-      docAddBaseY BrIndentRegular $ docSeq
+        docAddBaseY BrIndentRegular
-        (  [headDoc, docSeparator, body]
+      $ docSeq
-        ++ case mWhereDocs of
+          ([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
@@ -663,18 +678,21 @@ 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
 
 --------------------------------------------------------------------------------
@@ -684,7 +702,8 @@ 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
@@ -715,9 +734,7 @@ 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"
+          $ [docLit $ Text.pack "type", docSeparator]
-             , docSeparator
-             ]
           ++ [ docParenL | needsParens ]
           ++ [ layoutTyVarBndr False a
              , docSeparator
@@ -787,8 +804,7 @@ layoutTyFamInstDecl inClass outerNode tfid = do
       makeForallDoc bndrs = do
         bndrDocs <- layoutTyVarBndrs bndrs
         docSeq
-          (  [docLit (Text.pack "forall")]
+          ([docLit (Text.pack "forall")] ++ processTyVarBndrsSingleline bndrDocs
-          ++ processTyVarBndrsSingleline bndrDocs
           )
       lhs =
         docWrapNode innerNode
@@ -799,14 +815,16 @@ 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]
@@ -856,7 +874,11 @@ 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
@@ -937,7 +959,8 @@ 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')

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

@@ -49,22 +49,26 @@ layoutIE lie@(L _ ie) = docWrapNode lie $ case ie of
       addAlternative
         $ docWrapNodeRest lie
         $ docAddBaseY BrIndentRegular
-        $ docPar
+        $ docPar (layoutWrapped lie x) (layoutItems (splitFirstLast sortedNs))
-            (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
@@ -90,16 +94,19 @@ 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
+      | group <- Data.List.Extra.groupOn lieToText $ List.sortOn lieToText lies
-          $ 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 <-
@@ -139,7 +146,8 @@ 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)
@@ -162,7 +170,8 @@ 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
@@ -211,4 +220,5 @@ 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

@@ -30,7 +30,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
+    importAsCol <-
+      mAsk <&> _conf_layout .> _lconfig_importAsColumn .> confUnpack
     indentPolicy <- mAsk <&> _conf_layout .> _lconfig_indentPolicy .> confUnpack
     let
       compact = indentPolicy /= IndentPolicyFree
@@ -40,10 +41,13 @@ 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
@@ -52,20 +56,22 @@ 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 =
+      modNameD = indentName $ appSep $ docLit modNameT
-        indentName $ appSep $ docLit modNameT
       hidDocCol = if hiding then importCol - hidingParenCost else importCol - 2
       hidDocColDiff = importCol - 2 - hidDocCol
-      hidDoc = if hiding
+      hidDoc =
-        then appSep $ docLit $ Text.pack "hiding"
+        if hiding then appSep $ docLit $ Text.pack "hiding" else docEmpty
-        else docEmpty
       importHead = docSeq [importQualifiers, modNameD]
       bindingsD = case mllies of
         Nothing -> docEmpty
@@ -73,8 +79,12 @@ layoutImport importD = case importD of
           hasComments <- hasAnyCommentsBelow llies
           if compact
             then docAlt
-            [ docSeq [hidDoc, docForceSingleline $ layoutLLIEs True ShouldSortItems llies]
+              [ docSeq
-            , let makeParIfHiding = if hiding
+                [ hidDoc
+                , docForceSingleline $ layoutLLIEs True ShouldSortItems llies
+                ]
+              , let
+                  makeParIfHiding = if hiding
                     then docAddBaseY BrIndentRegular . docPar hidDoc
                     else id
                 in makeParIfHiding (layoutLLIEs True ShouldSortItems llies)
@@ -87,9 +97,15 @@ layoutImport importD = case importD of
                   -- ..[hiding].( )
                     [] -> if hasComments
                       then docPar
-                    (docSeq [hidDoc, docParenLSep, docWrapNode llies docEmpty])
+                        (docSeq
-                    (docEnsureIndent (BrIndentSpecial hidDocColDiff) docParenR)
+                          [hidDoc, docParenLSep, docWrapNode llies docEmpty]
-                  else docSeq [hidDoc, docParenLSep, docSeparator, docParenR]
+                        )
+                        (docEnsureIndent
+                          (BrIndentSpecial hidDocColDiff)
+                          docParenR
+                        )
+                      else docSeq
+                        [hidDoc, docParenLSep, docSeparator, docParenR]
                     -- ..[hiding].( b )
                     [ieD] -> runFilteredAlternative $ do
                       addAlternativeCond (not hasComments)
@@ -102,13 +118,16 @@ layoutImport importD = case importD of
                             ]
                       addAlternative $ docPar
                         (docSeq [hidDoc, docParenLSep, docNonBottomSpacing ieD])
-                    (docEnsureIndent (BrIndentSpecial hidDocColDiff) docParenR)
+                        (docEnsureIndent
+                          (BrIndentSpecial hidDocColDiff)
+                          docParenR
+                        )
                     -- ..[hiding].( b
                     --            , b'
                     --            )
-                (ieD:ieDs') ->
+                    (ieD : ieDs') -> docPar
-                  docPar
+                      (docSeq [hidDoc, docSetBaseY $ docSeq [docParenLSep, ieD]]
-                    (docSeq [hidDoc, docSetBaseY $ docSeq [docParenLSep, ieD]])
+                      )
                       (docEnsureIndent (BrIndentSpecial hidDocColDiff)
                       $ docLines
                       $ ieDs'
@@ -119,21 +138,19 @@ 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 $
+            , docAddBaseY BrIndentRegular
-            docPar (docSeq [importHead, asDoc]) bindingsD
+              $ docPar (docSeq [importHead, asDoc]) bindingsD
             ]
-    else
+      else case masT of
-      case masT of
         Just n -> if enoughRoom
-          then docLines
+          then docLines [docSeq [importHead, asDoc], bindingsD]
-                 [ docSeq [importHead, asDoc], bindingsD]
           else docLines [importHead, asDoc, bindingsD]
          where
           enoughRoom = nameCost < importAsCol - asCost
-          asDoc =
+          asDoc = docEnsureIndent (BrIndentSpecial (importAsCol - asCost))
-            docEnsureIndent (BrIndentSpecial (importAsCol - asCost))
             $ makeAsDoc n
         Nothing -> if enoughRoom
           then docSeq [importHead, bindingsD]

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

@@ -36,10 +36,8 @@ layoutModule lmod@(L _ mod') = case mod' of
     -- groupify commentedImports `forM_` tellDebugMessShow
     -- sortedImports <- sortImports imports
     let tn = Text.pack $ moduleNameString $ unLoc n
-    allowSingleLineExportList <- mAsk
+    allowSingleLineExportList <-
-      <&> _conf_layout
+      mAsk <&> _conf_layout .> _lconfig_allowSingleLineExportList .> confUnpack
-      .>  _lconfig_allowSingleLineExportList
-      .>  confUnpack
     -- the config should not prevent single-line layout when there is no
     -- export list
     let allowSingleLine = allowSingleLineExportList || Data.Maybe.isNothing les
@@ -49,9 +47,7 @@ layoutModule lmod@(L _ mod') = case mod' of
              -- A pseudo node that serves merely to force documentation
              -- before the node
           , docNodeMoveToKWDP lmod AnnModule True $ runFilteredAlternative $ do
-            addAlternativeCond allowSingleLine $
+            addAlternativeCond allowSingleLine $ docForceSingleline $ docSeq
-              docForceSingleline
-                $ docSeq
               [ appSep $ docLit $ Text.pack "module"
               , appSep $ docLit tn
               , docWrapNode lmod $ appSep $ case les of
@@ -60,13 +56,11 @@ layoutModule lmod@(L _ mod') = case mod' of
               , docSeparator
               , docLit $ Text.pack "where"
               ]
-            addAlternative
+            addAlternative $ docLines
-              $ docLines
               [ docAddBaseY BrIndentRegular $ docPar
-                (docSeq [appSep $ docLit $ Text.pack "module", docLit tn]
+                  (docSeq [appSep $ docLit $ Text.pack "module", docLit tn])
-                )
+                  (docSeq
-                (docSeq [
+                    [ docWrapNode lmod $ case les of
-                          docWrapNode lmod $ case les of
                       Nothing -> docEmpty
                       Just x -> layoutLLIEs False KeepItemsUnsorted x
                     , docSeparator
@@ -97,7 +91,8 @@ 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
@@ -116,7 +111,8 @@ transformToCommentedImport is = do
     accumF accConnectedComm (annMay, decl) = case annMay of
       Nothing ->
         ( []
-        , [ ImportStatement ImportStatementRecord { commentsBefore  = []
+        , [ ImportStatement ImportStatementRecord
+              { commentsBefore = []
               , commentsAfter = []
               , importStatement = decl
               }
@@ -195,10 +191,7 @@ commentedImportsToDoc :: CommentedImport -> ToBriDocM BriDocNumbered
 commentedImportsToDoc = \case
   EmptyLine -> docLitS ""
   IndependentComment c -> commentToDoc c
-  ImportStatement r ->
+  ImportStatement r -> docSeq
-    docSeq
+    (layoutImport (importStatement r) : map commentToDoc (commentsAfter r))
-      ( layoutImport (importStatement r)
-      : map commentToDoc (commentsAfter r)
-      )
  where
   commentToDoc (c, DP (_y, x)) = docLitS (replicate x ' ' ++ commentContents c)

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

@@ -33,11 +33,9 @@ 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 ->
+  VarPat _ n -> fmap Seq.singleton $ docLit $ lrdrNameToText n
-    fmap Seq.singleton $ docLit $ lrdrNameToText n
     -- abc -> expr
-  LitPat _ lit ->
+  LitPat _ lit -> fmap Seq.singleton $ allocateNode $ litBriDoc lit
-    fmap Seq.singleton $ allocateNode $ litBriDoc lit
     -- 0 -> expr
   ParPat _ inner -> do
     -- (nestedpat) -> expr
@@ -67,10 +65,9 @@ layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of
       then return <$> docLit nameDoc
       else do
         x1 <- appSep (docLit nameDoc)
-        xR <- fmap Seq.fromList
+        xR <- fmap Seq.fromList $ sequence $ spacifyDocs $ fmap
-          $ sequence
+          colsWrapPat
-          $ spacifyDocs
+          argDocs
-          $ fmap colsWrapPat argDocs
         return $ x1 Seq.<| xR
   ConPat _ lname (InfixCon left right) -> do
     -- a :< b -> expr
@@ -96,8 +93,7 @@ layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of
     Seq.singleton <$> docSeq
       [ appSep $ docLit t
       , appSep $ docLit $ Text.pack "{"
-      , docSeq $ List.intersperse docCommaSep
+      , docSeq $ List.intersperse docCommaSep $ fds <&> \case
-               $ fds <&> \case
         (fieldName, Just fieldDoc) -> docSeq
           [ appSep $ docLit fieldName
           , appSep $ docLit $ Text.pack "="
@@ -110,11 +106,9 @@ 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
+    Seq.singleton <$> docSeq [appSep $ docLit t, docLit $ Text.pack "{..}"]
-      [ appSep $ docLit t
+  ConPat _ lname (RecCon (HsRecFields fs@(_ : _) (Just (L _ dotdoti))))
-      , docLit $ Text.pack "{..}"
+    | dotdoti == length fs -> do
-      ]
-  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
@@ -189,9 +183,7 @@ colsWrapPat :: Seq BriDocNumbered -> ToBriDocM BriDocNumbered
 colsWrapPat = docCols ColPatterns . fmap return . Foldable.toList
 
 wrapPatPrepend
-  :: LPat GhcPs
+  :: LPat GhcPs -> ToBriDocM BriDocNumbered -> ToBriDocM (Seq BriDocNumbered)
-  -> ToBriDocM BriDocNumbered
-  -> ToBriDocM (Seq BriDocNumbered)
 wrapPatPrepend pat prepElem = do
   patDocs <- layoutPat pat
   case Seq.viewl patDocs of
@@ -213,8 +205,5 @@ wrapPatListy elems both start end = do
     x1 Seq.:< rest -> do
       sDoc <- start
       eDoc <- end
-      rest' <- rest `forM` \bd -> docSeq
+      rest' <- rest `forM` \bd -> docSeq [docCommaSep, return bd]
-        [ docCommaSep
-        , return bd
-        ]
       return $ (sDoc Seq.<| x1 Seq.<| rest') Seq.|> eDoc

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

@@ -62,7 +62,8 @@ 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,7 +79,8 @@ 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
@@ -89,7 +91,8 @@ 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/Type.hs

@@ -24,43 +24,32 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
   HsTyVar _ promoted name -> do
     t <- lrdrNameToTextAnnTypeEqualityIsSpecial name
     case promoted of
-      IsPromoted -> docSeq
+      IsPromoted -> docSeq [docSeparator, docTick, docWrapNode name $ docLit t]
-        [ 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
+        [ let open = docLit $ Text.pack "forall"
-            open = docLit $ Text.pack "forall"
           in docSeq ([open] ++ tyVarDocLineList)
         , docPar
           (docLit (Text.pack "forall"))
-            (docLines
+          (docLines $ tyVarDocs <&> \case
-            $ tyVarDocs <&> \case
             (tname, Nothing) -> docEnsureIndent BrIndentRegular $ docLit tname
-                (tname, Just doc) -> docEnsureIndent BrIndentRegular
+            (tname, Just doc) -> docEnsureIndent BrIndentRegular $ docLines
-                  $ docLines
+              [ docCols ColTyOpPrefix [docParenLSep, docLit tname]
-                    [ docCols ColTyOpPrefix
+              , docCols ColTyOpPrefix [docLit $ Text.pack ":: ", doc]
-                      [ docParenLSep
-                      , docLit tname
-                      ]
-                    , docCols ColTyOpPrefix
-                      [ docLit $ Text.pack ":: "
-                      , doc
-                      ]
               , docLit $ Text.pack ")"
-                    ])
+              ]
+          )
         ]
       contextDoc = case cntxtDocs of
         [] -> docLit $ Text.pack "()"
@@ -69,20 +58,17 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
           [ let
               open = docLit $ Text.pack "("
               close = docLit $ Text.pack ")"
-              list  = List.intersperse docCommaSep
+              list =
-                    $ docForceSingleline <$> cntxtDocs
+                List.intersperse docCommaSep $ docForceSingleline <$> cntxtDocs
             in docSeq ([open] ++ list ++ [close])
           , let
-              open = docCols ColTyOpPrefix
+              open = docCols
-                      [ docParenLSep
+                ColTyOpPrefix
-                      , docAddBaseY (BrIndentSpecial 2) $ head cntxtDocs
+                [docParenLSep, docAddBaseY (BrIndentSpecial 2) $ head cntxtDocs]
-                      ]
               close = docLit $ Text.pack ")"
-              list = List.tail cntxtDocs <&> \cntxtDoc ->
+              list = List.tail cntxtDocs <&> \cntxtDoc -> docCols
-                     docCols ColTyOpPrefix
+                ColTyOpPrefix
-                      [ docCommaSep
+                [docCommaSep, docAddBaseY (BrIndentSpecial 2) cntxtDoc]
-                      , docAddBaseY (BrIndentSpecial 2) cntxtDoc
-                      ]
             in docPar open $ docLines $ list ++ [close]
           ]
     docAlt
@@ -90,7 +76,8 @@ 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])
@@ -105,12 +92,13 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
       , docPar
         forallDoc
         (docLines
-            [ docCols ColTyOpPrefix
+          [ docCols
+            ColTyOpPrefix
             [ docWrapNodeRest ltype $ docLit $ Text.pack " . "
-              , docAddBaseY (BrIndentSpecial 3)
+            , docAddBaseY (BrIndentSpecial 3) $ contextDoc
-              $ contextDoc
             ]
-            , docCols ColTyOpPrefix
+          , docCols
+            ColTyOpPrefix
             [ docLit $ Text.pack "=> "
             , docAddBaseY (BrIndentSpecial 3) $ maybeForceML $ typeDoc
             ]
@@ -121,7 +109,8 @@ 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
@@ -130,7 +119,8 @@ 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])
@@ -140,7 +130,8 @@ 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
           ]
@@ -152,21 +143,16 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
         (docLit (Text.pack "forall"))
         (docLines
         $ (tyVarDocs <&> \case
-              (tname, Nothing) -> docEnsureIndent BrIndentRegular $ docLit tname
+            (tname, Nothing) ->
-              (tname, Just doc) -> docEnsureIndent BrIndentRegular
+              docEnsureIndent BrIndentRegular $ docLit tname
-                $ docLines
+            (tname, Just doc) -> docEnsureIndent BrIndentRegular $ docLines
-                  [ docCols ColTyOpPrefix
+              [ docCols ColTyOpPrefix [docParenLSep, docLit tname]
-                    [ docParenLSep
+              , docCols ColTyOpPrefix [docLit $ Text.pack ":: ", doc]
-                    , docLit tname
-                    ]
-                  , docCols ColTyOpPrefix
-                    [ docLit $ Text.pack ":: "
-                    , doc
-                    ]
               , docLit $ Text.pack ")"
               ]
           )
-          ++[ docCols ColTyOpPrefix
+        ++ [ docCols
+               ColTyOpPrefix
                [ docWrapNodeRest ltype $ docLit $ Text.pack " . "
                , maybeForceML $ return typeDoc
                ]
@@ -184,25 +170,21 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
           [ let
               open = docLit $ Text.pack "("
               close = docLit $ Text.pack ")"
-              list  = List.intersperse docCommaSep
+              list =
-                    $ docForceSingleline <$> cntxtDocs
+                List.intersperse docCommaSep $ docForceSingleline <$> cntxtDocs
             in docSeq ([open] ++ list ++ [close])
           , let
-              open = docCols ColTyOpPrefix
+              open = docCols
-                      [ docParenLSep
+                ColTyOpPrefix
-                      , docAddBaseY (BrIndentSpecial 2)
+                [docParenLSep, docAddBaseY (BrIndentSpecial 2) $ head cntxtDocs]
-                      $ head cntxtDocs
-                      ]
               close = docLit $ Text.pack ")"
-              list = List.tail cntxtDocs <&> \cntxtDoc ->
+              list = List.tail cntxtDocs <&> \cntxtDoc -> docCols
-                     docCols ColTyOpPrefix
+                ColTyOpPrefix
-                      [ docCommaSep
+                [docCommaSep, docAddBaseY (BrIndentSpecial 2) $ cntxtDoc]
-                      , 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
@@ -217,7 +199,8 @@ 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
           ]
@@ -226,24 +209,25 @@ 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 $
+    docAlt
-      [ docSeq
+      $ [ 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)
+               , docAddBaseY (BrIndentSpecial 3) $ maybeForceML typeDoc2
-          $ maybeForceML typeDoc2
                ]
              )
          ]
@@ -256,14 +240,18 @@ 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)
@@ -272,8 +260,8 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
     docRest <- docSharedWrapper layoutType `mapM` typRest
     docAlt
       [ docSeq
-      $ docForceSingleline docHead : (docRest >>= \d ->
+      $ docForceSingleline docHead
-        [ docSeparator, docForceSingleline d ])
+      : (docRest >>= \d -> [docSeparator, docForceSingleline d])
       , docPar docHead (docLines $ docEnsureIndent BrIndentRegular <$> docRest)
       ]
   HsAppTy _ typ1 typ2 -> do
@@ -281,13 +269,8 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
     typeDoc2 <- docSharedWrapper layoutType typ2
     docAlt
       [ docSeq
-        [ docForceSingleline typeDoc1
+        [docForceSingleline typeDoc1, docSeparator, docForceSingleline typeDoc2]
-        , docSeparator
+      , docPar typeDoc1 (docEnsureIndent BrIndentRegular typeDoc2)
-        , docForceSingleline typeDoc2
-        ]
-      , docPar
-          typeDoc1
-          (docEnsureIndent BrIndentRegular typeDoc2)
       ]
   HsListTy _ typ1 -> do
     typeDoc1 <- docSharedWrapper layoutType typ1
@@ -298,10 +281,12 @@ 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
@@ -310,38 +295,46 @@ 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 ")"
+      let
-          lines = List.tail docs <&> \d ->
+        end = docLit $ Text.pack ")"
-            docAddBaseY (BrIndentSpecial 2)
+        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 ->
+            lines =
-              docAddBaseY (BrIndentSpecial 2)
+              List.tail docs
+                <&> \d -> docAddBaseY (BrIndentSpecial 2)
                       $ docCols ColTyOpPrefix [docCommaSep, d]
           in docPar
             (docAddBaseY (BrIndentSpecial 2) line1)
@@ -411,20 +404,18 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
     typeDoc1 <- docSharedWrapper layoutType typ1
     docAlt
       [ docSeq
-        [ docWrapNodeRest ltype
+        [ docWrapNodeRest ltype $ docLit $ Text.pack
-        $ docLit
+          ("?" ++ showSDocUnsafe (ftext ipName) ++ "::")
-        $ Text.pack ("?" ++ showSDocUnsafe (ftext ipName) ++ "::")
         , docForceSingleline typeDoc1
         ]
       , docPar
-          ( docLit
+        (docLit $ Text.pack ("?" ++ showSDocUnsafe (ftext ipName)))
-          $ Text.pack ("?" ++ showSDocUnsafe (ftext ipName))
+        (docCols
-          )
+          ColTyOpPrefix
-          (docCols ColTyOpPrefix
+          [ docWrapNodeRest ltype $ docLit $ Text.pack ":: "
-            [ docWrapNodeRest ltype
-            $ docLit $ Text.pack ":: "
           , docAddBaseY (BrIndentSpecial 2) typeDoc1
-            ])
+          ]
+        )
       ]
   -- TODO: test KindSig
   HsKindSig _ typ1 kind1 -> do
@@ -563,15 +554,19 @@ 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 $
+          addAlternative
-            let
+            $ let
-              start = docCols ColList
+                start = docCols ColList [appSep $ docLit $ Text.pack "'[", e1]
-                        [appSep $ docLit $ Text.pack "'[", e1]
+                linesM = ems <&> \d -> docCols ColList [specialCommaSep, d]
-              linesM = ems <&> \d ->
+                lineN = docCols
-                      docCols ColList [specialCommaSep, d]
+                  ColList
-              lineN = docCols ColList [specialCommaSep, docNodeAnnKW ltype (Just AnnOpenS) eN]
+                  [specialCommaSep, docNodeAnnKW ltype (Just AnnOpenS) eN]
                 end = docLit $ Text.pack " ]"
               in docSetBaseY $ docLines $ [start] ++ linesM ++ [lineN] ++ [end]
       ]
@@ -584,8 +579,7 @@ 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 _ ->
+  HsWildCardTy _ -> docLit $ Text.pack "_"
-    docLit $ Text.pack "_"
   HsSumTy{} -> -- TODO
     briDocByExactInlineOnly "HsSumTy{}" ltype
   HsStarTy _ isUnicode -> do
@@ -603,9 +597,7 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
         , docLit $ Text.pack "@"
         , docForceSingleline k
         ]
-      , docPar
+      , docPar t (docSeq [docLit $ Text.pack "@", k])
-          t
-          (docSeq [docLit $ Text.pack "@", k ])
       ]
 
 layoutTyVarBndrs

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

@@ -18,7 +18,8 @@ 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/PreludeUtils.hs

@@ -27,12 +27,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 =
+  traceStr = name ++ "\nBEFORE:\n" ++ s1 x ++ "\nAFTER:\n" ++ s2 y
-    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

@@ -30,7 +30,7 @@ data AltCurPos = AltCurPos
   , _acp_indentPrep :: Int -- indentChange affecting the next Par
   , _acp_forceMLFlag :: AltLineModeState
   }
-  deriving (Show)
+  deriving Show
 
 data AltLineModeState
   = AltLineModeStateNone
@@ -44,7 +44,8 @@ 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
@@ -114,7 +115,13 @@ 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
@@ -125,10 +132,8 @@ transformAlts =
       --   BDWrapAnnKey annKey <$> rec bd
       BDFEmpty{} -> processSpacingSimple bdX $> bdX
       BDFLit{} -> processSpacingSimple bdX $> bdX
-        BDFSeq list      ->
+      BDFSeq list -> reWrap . BDFSeq <$> list `forM` rec
-          reWrap . BDFSeq <$> list `forM` rec
+      BDFCols sig list -> reWrap . BDFCols sig <$> list `forM` rec
-        BDFCols sig list ->
-          reWrap . BDFCols sig <$> list `forM` rec
       BDFSeparator -> processSpacingSimple bdX $> bdX
       BDFAddBaseY indent bd -> do
         acp <- mGet
@@ -157,22 +162,18 @@ transformAlts =
       BDFIndentLevelPop bd -> do
         reWrap . BDFIndentLevelPop <$> rec bd
       BDFPar indent sameLine indented -> do
-          indAmount <- mAsk <&> _conf_layout .> _lconfig_indentAmount .> confUnpack
+        indAmount <-
-          let indAdd = case indent of
+          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
+        mSet $ acp { _acp_indent = ind, _acp_indentPrep = 0 }
-            { _acp_indent = ind
-            , _acp_indentPrep = 0
-            }
         sameLine' <- rec sameLine
-          mModify $ \acp' -> acp'
+        mModify $ \acp' -> acp' { _acp_line = ind, _acp_indent = ind }
-            { _acp_line   = ind
-            , _acp_indent = ind
-            }
         indented' <- rec indented
         return $ reWrap $ BDFPar indent sameLine' indented'
       BDFAlt [] -> error "empty BDAlt" -- returning BDEmpty instead is a
@@ -187,7 +188,8 @@ transformAlts =
           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
@@ -197,35 +199,41 @@ 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 _) =
+            let
-                    case _acp_forceMLFlag acp of
+              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 (hasSpace2 lconf acp) vs && any lineCheck vs, bd)
-                               && any lineCheck vs, bd))
+                )
-              let checkedOptions :: [Maybe (Int, BriDocNumbered)] =
+            let
+              checkedOptions :: [Maybe (Int, BriDocNumbered)] =
                 zip [1 ..] options <&> (\(i, (b, x)) -> [ (i, x) | b ])
             rec
               $ fromMaybe (-- trace ("choosing last") $
@@ -250,7 +258,9 @@ 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 }
@@ -259,7 +269,8 @@ 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 ->
@@ -273,10 +284,7 @@ transformAlts =
         ind <- _acp_indent <$> mGet
         l' <- rec l
         lr' <- lr `forM` \x -> do
-            mModify $ \acp -> acp
+          mModify $ \acp -> acp { _acp_line = ind, _acp_indent = ind }
-              { _acp_line   = ind
-              , _acp_indent = ind
-              }
           rec x
         return $ reWrap $ BDFLines (l' : lr')
       BDFEnsureIndent indent bd -> do
@@ -297,14 +305,21 @@ 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
@@ -320,7 +335,8 @@ 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"
@@ -328,8 +344,13 @@ 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)
+    = line
-        && indent + indentPrep + par <= confUnpack (_lconfig_cols lconf)
+      + 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)
 
@@ -348,10 +369,11 @@ getSpacing !bridoc = rec bridoc
       -- BDWrapAnnKey _annKey bd -> rec bd
       BDFEmpty ->
         return $ LineModeValid $ VerticalSpacing 0 VerticalSpacingParNone False
-      BDFLit t ->
+      BDFLit t -> return $ LineModeValid $ VerticalSpacing
-        return $ LineModeValid $ VerticalSpacing (Text.length t) VerticalSpacingParNone False
+        (Text.length t)
-      BDFSeq list ->
+        VerticalSpacingParNone
-        sumVs <$> rec `mapM` list
+        False
+      BDFSeq list -> sumVs <$> rec `mapM` list
       BDFCols _sig list -> sumVs <$> rec `mapM` list
       BDFSeparator ->
         return $ LineModeValid $ VerticalSpacing 1 VerticalSpacingParNone False
@@ -360,9 +382,12 @@ 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
@@ -370,11 +395,8 @@ getSpacing !bridoc = rec bridoc
                 BrIndentSpecial j -> i + j
             VerticalSpacingParSome i -> VerticalSpacingParSome $ case indent of
               BrIndentNone -> i
-                BrIndentRegular   -> i + ( confUnpack
+              BrIndentRegular ->
-                                         $ _lconfig_indentAmount
+                i + (confUnpack $ _lconfig_indentAmount $ _conf_layout $ config)
-                                         $ _conf_layout
-                                         $ config
-                                         )
               BrIndentSpecial j -> i + j
           }
       BDFBaseYPushCur bd -> do
@@ -385,11 +407,13 @@ 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
@@ -403,12 +427,19 @@ getSpacing !bridoc = rec bridoc
             | VerticalSpacing lsp mPsp _ <- mVs
             , indSp <- mIndSp
             , lineMax <- getMaxVS $ mIndSp
-            , let pspResult = case mPsp of
+            , let
-                    VerticalSpacingParSome psp   -> VerticalSpacingParSome $ max psp lineMax
+              pspResult = case mPsp of
+                VerticalSpacingParSome psp ->
+                  VerticalSpacingParSome $ max psp lineMax
                 VerticalSpacingParNone -> VerticalSpacingParSome $ lineMax
-                    VerticalSpacingParAlways psp -> VerticalSpacingParAlways $ max psp lineMax
+                VerticalSpacingParAlways psp ->
-            , let parFlagResult =  mPsp == VerticalSpacingParNone
+                  VerticalSpacingParAlways $ max psp lineMax
-                                && _vs_paragraph indSp ==  VerticalSpacingParNone
+            , let
+              parFlagResult =
+                mPsp
+                  == VerticalSpacingParNone
+                  && _vs_paragraph indSp
+                  == VerticalSpacingParNone
                   && _vs_parFlag indSp
             ]
       BDFPar{} -> error "BDPar with indent in getSpacing"
@@ -435,35 +466,33 @@ getSpacing !bridoc = rec bridoc
       BDFAnnotationKW _annKey _kw bd -> rec bd
       BDFAnnotationRest _annKey bd -> rec bd
       BDFMoveToKWDP _annKey _kw _b bd -> rec bd
-      BDFLines [] -> return
+      BDFLines [] ->
-        $ LineModeValid
+        return $ LineModeValid $ VerticalSpacing 0 VerticalSpacingParNone False
-        $ 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
+            BrIndentRegular ->
-                                 $ _lconfig_indentAmount
+              confUnpack $ _lconfig_indentAmount $ _conf_layout $ config
-                                 $ _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
+        return $ mVs <|> LineModeValid
-          $   mVs
-          <|> LineModeValid
           (VerticalSpacing
             0
-                  (if b then VerticalSpacingParSome 0
+            (if b
+              then VerticalSpacingParSome 0
               else VerticalSpacingParAlways colMax
             )
             False
@@ -473,16 +502,29 @@ 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 _) ->
+    (liftM2
-        VerticalSpacing (max x1 y1) (case (x2, y2) of
+      (\(VerticalSpacing x1 x2 _) (VerticalSpacing y1 y2 _) -> VerticalSpacing
+        (max x1 y1)
+        (case (x2, y2) of
           (x, VerticalSpacingParNone) -> x
           (VerticalSpacingParNone, x) -> x
           (VerticalSpacingParAlways i, VerticalSpacingParAlways j) ->
@@ -492,9 +534,14 @@ 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
@@ -509,7 +556,8 @@ 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
@@ -548,12 +596,13 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc
   rec (brDcId, brdc) = memoWithKey brDcId $ do
     config <- mAsk
     let colMax = config & _conf_layout & _lconfig_cols & confUnpack
-      let hasOkColCount (VerticalSpacing lsp psp _) =
+    let
-            lsp <= colMax && case psp of
+      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)
            )
@@ -562,11 +611,9 @@ 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 =
+    let
-            config
+      allowHangingQuasiQuotes =
-              & _conf_layout
+        config & _conf_layout & _lconfig_allowHangingQuasiQuotes & confUnpack
-              & _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
@@ -586,7 +633,8 @@ 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
@@ -618,24 +666,23 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc
           . preFilterLimit
     result <- case brdc of
       -- BDWrapAnnKey _annKey bd -> rec bd
-        BDFEmpty ->
+      BDFEmpty -> return $ [VerticalSpacing 0 VerticalSpacingParNone False]
-          return $ [VerticalSpacing 0 VerticalSpacingParNone False]
       BDFLit t ->
         return $ [VerticalSpacing (Text.length t) VerticalSpacingParNone False]
-        BDFSeq list ->
+      BDFSeq list -> fmap sumVs . mapM filterAndLimit <$> rec `mapM` list
-          fmap sumVs . mapM filterAndLimit <$> rec `mapM` list
+      BDFCols _sig list -> fmap sumVs . mapM filterAndLimit <$> rec `mapM` list
-        BDFCols _sig list ->
+      BDFSeparator -> return $ [VerticalSpacing 1 VerticalSpacingParNone False]
-          fmap sumVs . mapM filterAndLimit <$> rec `mapM` list
-        BDFSeparator ->
-          return $ [VerticalSpacing 1 VerticalSpacingParNone False]
       BDFAddBaseY indent bd -> do
         mVs <- rec bd
         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
@@ -643,11 +690,8 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc
                 BrIndentSpecial j -> i + j
             VerticalSpacingParSome i -> VerticalSpacingParSome $ case indent of
               BrIndentNone -> i
-                  BrIndentRegular   -> i + ( confUnpack
+              BrIndentRegular ->
-                                           $ _lconfig_indentAmount
+                i + (confUnpack $ _lconfig_indentAmount $ _conf_layout $ config)
-                                           $ _conf_layout
-                                           $ config
-                                           )
               BrIndentSpecial j -> i + j
           }
       BDFBaseYPushCur bd -> do
@@ -658,11 +702,13 @@ 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
@@ -674,13 +720,8 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc
       BDFPar BrIndentNone sameLine indented -> do
         mVss <- filterAndLimit <$> rec sameLine
         indSps <- filterAndLimit <$> rec indented
-          let mVsIndSp = take limit
+        let mVsIndSp = take limit $ [ (x, y) | x <- mVss, y <- indSps ]
-                       $ [ (x,y)
+        return $ mVsIndSp <&> \(VerticalSpacing lsp mPsp _, indSp) ->
-                         | x<-mVss
-                         , y<-indSps
-                         ]
-          return $ mVsIndSp <&>
-            \(VerticalSpacing lsp mPsp _, indSp) ->
           VerticalSpacing
             lsp
             (case mPsp of
@@ -688,9 +729,12 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc
                 VerticalSpacingParSome $ max psp $ getMaxVS indSp -- TODO
               VerticalSpacingParNone -> spMakePar indSp
               VerticalSpacingParAlways psp ->
-                    VerticalSpacingParAlways $ max psp $ getMaxVS indSp)
+                VerticalSpacingParAlways $ max psp $ getMaxVS indSp
-                (  mPsp == VerticalSpacingParNone
+            )
-                && _vs_paragraph indSp == VerticalSpacingParNone
+            (mPsp
+            == VerticalSpacingParNone
+            && _vs_paragraph indSp
+            == VerticalSpacingParNone
             && _vs_parFlag indSp
             )
 
@@ -709,20 +753,15 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc
       BDFForwardLineMode bd -> rec bd
       BDFExternal _ _ _ txt | [t] <- Text.lines txt ->
         return $ [VerticalSpacing (Text.length t) VerticalSpacingParNone False]
-        BDFExternal{} ->
+      BDFExternal{} -> return $ [] -- yes, we just assume that we cannot properly layout
-          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
+            [t1] ->
-                (Text.length t1)
+              VerticalSpacing (Text.length t1) VerticalSpacingParNone False
-                VerticalSpacingParNone
+            (t1 : _) ->
-                False
+              VerticalSpacing (Text.length t1) (VerticalSpacingParAlways 0) True
-              (t1 : _) -> VerticalSpacing
-                (Text.length t1)
-                (VerticalSpacingParAlways 0)
-                True
         | allowHangingQuasiQuotes
         ]
       BDFAnnotationPrior _annKey bd -> rec bd
@@ -737,14 +776,13 @@ 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
+        let
-                      $ sequence
+          worbled = fmap reverse $ sequence $ reverse $ lSpss
-                      $ reverse
+          sumF lSps@(lSp1 : _) =
-                      $ lSpss
+            VerticalSpacing (_vs_sameLine lSp1) (spMakePar $ maxVs lSps) False
-              sumF lSps@(lSp1:_) = VerticalSpacing (_vs_sameLine lSp1)
+          sumF [] =
-                                                   (spMakePar $ maxVs lSps)
+            error
-                                                   False
+              $ "should not happen. if my logic does not fail"
-              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
@@ -760,12 +798,11 @@ 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
+            BrIndentRegular ->
-                                   $ _lconfig_indentAmount
+              confUnpack $ _lconfig_indentAmount $ _conf_layout $ config
-                                   $ _conf_layout
-                                   $ config
             BrIndentSpecial i -> i
         return $ mVs <&> \(VerticalSpacing lsp psp parFlag) ->
           VerticalSpacing (lsp + addInd) psp parFlag
@@ -776,9 +813,11 @@ 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
@@ -827,16 +866,25 @@ 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 x1 x2 _) (VerticalSpacing y1 y2 _) -> VerticalSpacing
-          VerticalSpacing
       (max x1 y1)
       (case (x2, y2) of
         (x, VerticalSpacingParNone) -> x
@@ -848,8 +896,10 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc
         (VerticalSpacingParSome i, VerticalSpacingParAlways j) ->
           VerticalSpacingParAlways $ max i j
         (VerticalSpacingParSome x, VerticalSpacingParSome y) ->
-                VerticalSpacingParSome $ max x y)
+          VerticalSpacingParSome $ max x y
-            False)
+      )
+      False
+    )
     (VerticalSpacing 0 VerticalSpacingParNone False)
   sumVs :: [VerticalSpacing] -> VerticalSpacing
   sumVs sps = foldl' go initial sps
@@ -865,7 +915,9 @@ 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
@@ -888,7 +940,8 @@ 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
@@ -898,7 +951,8 @@ 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

@@ -16,19 +16,35 @@ transformSimplifyColumns = Uniplate.rewrite $ \case
   --   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 ->
+    | all
-    Just $ BDCols sig1 (List.init cols1 ++ [BDSeq (List.last cols1:rest)])
+      (\case
-  BDLines lines | any (\case BDLines{} -> True
+        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 ->
+        _ -> False
-    Just $ BDLines $ filter isNotEmpty $ lines >>= \case
+      )
+      lines
+    -> Just $ BDLines $ filter isNotEmpty $ lines >>= \case
       BDLines l -> l
       x -> [x]
   -- prior floating in
@@ -42,15 +58,30 @@ transformSimplifyColumns = Uniplate.rewrite $ \case
   BDAnnotationRest annKey1 (BDSeq 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.
@@ -60,48 +91,46 @@ transformSimplifyColumns = Uniplate.rewrite $ \case
   BDCols sig1 cols1@(_ : _)
     | BDLines lines@(_ : _ : _) <- List.last cols1
     , BDCols sig2 cols2 <- List.last lines
-    , sig1==sig2 ->
+    , sig1 == sig2
-        Just $ BDLines
+    -> 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 ->
+    , sig1 == sig2
-        Just $ BDLines
+    -> 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 ->
+    | sig1 == sig2 -> Just $ BDPar ind (BDLines [col1, col2]) (BDLines rest)
-    Just $ BDPar ind (BDLines [col1, col2]) (BDLines rest)
   BDPar ind (BDLines lines1) col2@(BDCols sig2 _)
-    | BDCols sig1 _ <- List.last lines1
+    | BDCols sig1 _ <- List.last lines1, sig1 == sig2 -> Just
-    , sig1==sig2 ->
+    $ BDAddBaseY ind (BDLines $ lines1 ++ [col2])
-    Just $ BDAddBaseY ind (BDLines $ lines1 ++ [col2])
   BDPar ind (BDLines lines1) (BDLines (col2@(BDCols sig2 _) : rest))
-    | BDCols sig1 _ <- List.last lines1
+    | BDCols sig1 _ <- List.last lines1, sig1 == sig2 -> Just
-    , sig1==sig2 ->
+    $ BDPar ind (BDLines $ lines1 ++ [col2]) (BDLines rest)
-    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
+  BDCols sig1 cols
-                   , sig1==sig2 ->
+    | BDPar _ind line (BDCols sig2 cols2) <- List.last cols, sig1 == sig2
-    Just $ BDLines
+    -> Just
-      [ BDCols sig1 (List.init cols ++ [line])
+      $ BDLines [BDCols sig1 (List.init cols ++ [line]), BDCols sig2 cols2]
-      , BDCols sig2 cols2
+  BDCols sig1 cols
-      ]
+    | BDPar ind line (BDLines lines) <- List.last cols
-  BDCols sig1 cols | BDPar ind line (BDLines lines) <- List.last cols
     , BDCols sig2 cols2 <- List.last lines
-                   , sig1==sig2 ->
+    , sig1 == sig2
-    Just $ BDLines
+    -> Just $ BDLines
-      [ BDCols sig1 $ List.init cols ++ [BDPar ind line (BDLines $ List.init lines)]
+      [ 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

@@ -16,7 +16,8 @@ import Language.Haskell.Brittany.Internal.Utils
 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"
 
 
@@ -48,11 +49,20 @@ 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) ->
@@ -63,11 +73,20 @@ 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) ->
@@ -76,14 +95,12 @@ transformSimplifyFloating = stepBO .> stepFull
   descendBYPush = transformDownMay $ \case
     BDBaseYPushCur (BDCols sig cols@(_ : _)) ->
       Just $ BDCols sig (BDBaseYPushCur (List.head cols) : List.tail cols)
-      BDBaseYPushCur (BDDebug s x) ->
+    BDBaseYPushCur (BDDebug s x) -> Just $ BDDebug s (BDBaseYPushCur 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) ->
+    BDBaseYPop (BDDebug s x) -> Just $ BDDebug s (BDBaseYPop x)
-        Just $ BDDebug s (BDBaseYPop x)
     _ -> Nothing
   descendILPush = transformDownMay $ \case
     BDIndentLevelPushCur (BDCols sig cols@(_ : _)) ->
@@ -94,12 +111,10 @@ transformSimplifyFloating = stepBO .> stepFull
   descendILPop = transformDownMay $ \case
     BDIndentLevelPop (BDCols sig cols@(_ : _)) ->
       Just $ BDCols sig (List.init cols ++ [BDIndentLevelPop (List.last cols)])
-      BDIndentLevelPop (BDDebug s x) ->
+    BDIndentLevelPop (BDDebug s x) -> Just $ BDDebug s (BDIndentLevelPop x)
-        Just $ BDDebug s (BDIndentLevelPop x)
     _ -> Nothing
   descendAddB = transformDownMay $ \case
-      BDAddBaseY BrIndentNone x ->
+    BDAddBaseY BrIndentNone x -> Just x
-        Just x
     -- AddIndent floats into Lines.
     BDAddBaseY indent (BDLines lines) ->
       Just $ BDLines $ BDAddBaseY indent <$> lines
@@ -117,14 +132,11 @@ 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{} ->
+    BDAddBaseY _ lit@BDLit{} -> Just $ lit
-        Just $ lit
     BDAddBaseY ind (BDBaseYPushCur x) ->
       Just $ BDBaseYPushCur (BDAddBaseY ind x)
-      BDAddBaseY ind (BDBaseYPop x) ->
+    BDAddBaseY ind (BDBaseYPop x) -> Just $ BDBaseYPop (BDAddBaseY ind x)
-        Just $ BDBaseYPop (BDAddBaseY ind x)
+    BDAddBaseY ind (BDDebug s x) -> Just $ BDDebug s (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) ->
@@ -148,8 +160,7 @@ transformSimplifyFloating = stepBO .> stepFull
       x -> x
   stepFull = -- traceFunctionWith "stepFull" (show . briDocToDocWithAnns) (show . briDocToDocWithAnns) $
              Uniplate.rewrite $ \case
-      BDAddBaseY BrIndentNone x ->
+    BDAddBaseY BrIndentNone x -> Just $ x
-        Just $ x
     -- AddIndent floats into Lines.
     BDAddBaseY indent (BDLines lines) ->
       Just $ BDLines $ BDAddBaseY indent <$> lines
@@ -161,12 +172,10 @@ transformSimplifyFloating = stepBO .> stepFull
     -- merge AddIndent and Par
     BDAddBaseY ind1 (BDPar ind2 line indented) ->
       Just $ BDPar (mergeIndents ind1 ind2) line indented
-      BDAddBaseY _ lit@BDLit{} ->
+    BDAddBaseY _ lit@BDLit{} -> Just $ lit
-        Just $ lit
     BDAddBaseY ind (BDBaseYPushCur x) ->
       Just $ BDBaseYPushCur (BDAddBaseY ind x)
-      BDAddBaseY ind (BDBaseYPop x) ->
+    BDAddBaseY ind (BDBaseYPop x) -> Just $ BDBaseYPop (BDAddBaseY ind x)
-        Just $ BDBaseYPop (BDAddBaseY ind x)
     -- prior floating in
     BDAnnotationPrior annKey1 (BDPar ind line indented) ->
       Just $ BDPar ind (BDAnnotationPrior annKey1 line) indented
@@ -187,9 +196,18 @@ 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

@@ -27,13 +27,15 @@ transformSimplifyIndent = Uniplate.rewrite $ \case
   --     [ BDAddBaseY ind x
   --     , BDEnsureIndent ind indented
   --     ]
-  BDLines lines | any ( \case
+  BDLines lines
+    | any
+      (\case
         BDLines{} -> True
         BDEmpty{} -> True
         _ -> False
       )
-                      lines ->
+      lines
-    Just $ BDLines $ filter isNotEmpty $ lines >>= \case
+    -> Just $ BDLines $ filter isNotEmpty $ lines >>= \case
       BDLines l -> l
       x -> [x]
   BDLines [l] -> Just l

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

@@ -21,12 +21,15 @@ 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/Utils.hs

@@ -66,9 +66,11 @@ 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 =
@@ -93,11 +95,15 @@ 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
@@ -129,7 +135,8 @@ 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
@@ -193,12 +200,11 @@ traceIfDumpConf s accessor val = do
   whenM (mAsk <&> _conf_debug .> accessor .> confUnpack) $ do
     trace ("---- " ++ s ++ " ----\n" ++ show val) $ return ()
 
-tellDebugMess :: MonadMultiWriter
+tellDebugMess :: MonadMultiWriter (Seq String) m => String -> m ()
-  (Seq String) m => String -> m ()
 tellDebugMess s = mTell $ Seq.singleton s
 
-tellDebugMessShow :: forall a m . (MonadMultiWriter
+tellDebugMessShow
-  (Seq String) m, Show a) => a -> m ()
+  :: forall a m . (MonadMultiWriter (Seq String) m, Show a) => a -> m ()
 tellDebugMessShow = tellDebugMess . show
 
 -- i should really put that into multistate..
@@ -221,20 +227,19 @@ 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
+  where (bs, cs) = breakEither fn aR
-  (bs, cs) = breakEither fn aR
 
 spanMaybe :: (a -> Maybe b) -> [a] -> ([b], [a])
 spanMaybe f (x1 : xR) | Just y <- f x1 = (y : ys, xs)
- where
+  where (ys, xs) = spanMaybe f xR
-  (ys, xs) = spanMaybe f xR
 spanMaybe _ xs = ([], xs)
 
 data FirstLastView a

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

@@ -146,7 +146,8 @@ 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 ?
@@ -206,9 +207,10 @@ mainCmdParser helpDesc = do
         $ ppHelpShallow helpDesc
       System.Exit.exitSuccess
 
-    let inputPaths =
+    let
-          if null inputParams then [Nothing] else map Just inputParams
+      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
 
@@ -230,7 +232,8 @@ mainCmdParser helpDesc = do
       $ trace (showConfigYaml config)
       $ return ()
 
-    results <- zipWithM (coreIO putStrErrLn config suppressOutput checkMode)
+    results <- zipWithM
+      (coreIO putStrErrLn config suppressOutput checkMode)
       inputPaths
       outputPaths
 
@@ -275,15 +278,18 @@ 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."
@@ -299,14 +305,17 @@ 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)
@@ -343,7 +352,8 @@ coreIO putErrorLnIO config suppressOutput checkMode inputPathM outputPathM =
         when (config & _conf_debug & _dconf_dump_ast_full & confUnpack) $ do
           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
@@ -353,7 +363,8 @@ 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
@@ -361,14 +372,17 @@ 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
@@ -378,14 +392,16 @@ 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
@@ -455,7 +471,8 @@ 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