Remove unused tests

src-idemtests/.gitignore

@@ -1,4 +0,0 @@
-iterOne/
-iterTwo/
-brittany
-report.txt

src-idemtests/README

@@ -1,17 +0,0 @@
-idempotency testing on real-life examples, i.e. checks that brittany(x) is
-equal to brittany(brittany(x)) for some x's. The idea is that these testcases
-are not yet transformed, i.e. that x is not brittany(x). This can capture
-certain bugs that are not detected by checking that brittany behaves as
-identity on "well-formed" input.
-
-to run:
-
-- put a "brittany" executable into this directory.
-- cd into this directory.
-- ./run.sh
-
-report.txt will contain the results.
-
-note that only the configuration in brittany.yaml is tested, which contains
-the default settings. ideally this would be managed in some other, more
-transparent fashion.

src-idemtests/brittany.yaml

@@ -1,29 +0,0 @@
-conf_errorHandling:
-  econf_Werror: false
-  econf_produceOutputOnErrors: false
-  econf_CPPMode: CPPModeNowarn
-conf_layout:
-  lconfig_indentPolicy: IndentPolicyFree
-  lconfig_cols: 80
-  lconfig_indentAmount: 2
-  lconfig_importColumn: 60
-  lconfig_altChooser:
-    tag: AltChooserBoundedSearch
-    contents: 3
-  lconfig_indentWhereSpecial: true
-  lconfig_indentListSpecial: true
-conf_forward:
-  options_ghc: []
-conf_debug:
-  dconf_dump_annotations: false
-  dconf_dump_bridoc_simpl_par: false
-  dconf_dump_bridoc_simpl_indent: false
-  dconf_dump_bridoc_simpl_floating: false
-  dconf_dump_ast_full: false
-  dconf_dump_bridoc_simpl_columns: false
-  dconf_dump_ast_unknown: false
-  dconf_dump_bridoc_simpl_alt: false
-  dconf_dump_bridoc_final: false
-  dconf_dump_bridoc_raw: false
-  dconf_dump_config: false
-

src-idemtests/cases/LayoutBasics.hs

@@ -1,733 +0,0 @@
-module Language.Haskell.Brittany.Internal.LayoutBasics
-  ( processDefault
-  , layoutByExact
-  -- , layoutByExactR
-  , descToBlockStart
-  , descToBlockMinMax
-  , descToMinMax
-  , rdrNameToText
-  , lrdrNameToText
-  , lrdrNameToTextAnn
-  , askIndent
-  , calcLayoutMin
-  , calcLayoutMax
-  , getCurRemaining
-  , layoutWriteAppend
-  , layoutWriteAppendMultiline
-  , layoutWriteNewline
-  , layoutWriteNewlinePlain
-  , layoutWriteEnsureNewline
-  , layoutWriteEnsureBlock
-  , layoutWriteEnsureBlockPlusN
-  , layoutWithAddIndent
-  , layoutWithAddIndentBlock
-  , layoutWithAddIndentN
-  , layoutWithAddIndentNBlock
-  , layoutWithNonParamIndent
-  , layoutWriteEnsureAbsoluteN
-  , layoutAddSepSpace
-  , moveToExactAnn
-  , moveToExactAnn'
-  , setOpIndent
-  , stringLayouter
-  , layoutWritePriorComments
-  , layoutWritePostComments
-  , layoutIndentRestorePostComment
-  , layoutWritePriorCommentsRestore
-  , layoutWritePostCommentsRestore
-  , extractCommentsPrior
-  , extractCommentsPost
-  , applyLayouter
-  , applyLayouterRestore
-  , filterAnns
-  , layouterFToLayouterM
-  , ppmMoveToExactLoc
-  , customLayouterF
-  , docEmpty
-  , docLit
-  , docAlt
-  , docSeq
-  , docPar
-  -- , docCols
-  , docPostComment
-  , docWrapNode
-  , briDocByExact
-  , fromMaybeIdentity
-  , foldedAnnKeys
-  )
-where
-
-
-
--- more imports here..
-
-import qualified Language.Haskell.GHC.ExactPrint as ExactPrint
-import qualified Language.Haskell.GHC.ExactPrint.Annotate as ExactPrint.Annotate
-import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint.Types
-import qualified Language.Haskell.GHC.ExactPrint.Utils as ExactPrint.Utils
-
-import Language.Haskell.GHC.ExactPrint.Types ( AnnKey, Annotation )
-
-import qualified Data.Text.Lazy.Builder as Text.Builder
-
-import Language.Haskell.Brittany.Internal.Config.Types
-import Language.Haskell.Brittany.Internal.Types
-import Language.Haskell.Brittany.Internal.Utils
-
-import           RdrName ( RdrName(..) )
-import           GHC ( runGhc, GenLocated(L), moduleNameString )
-import qualified Outputable    as GHC
-import qualified DynFlags      as GHC
-import qualified FastString    as GHC
-import qualified SrcLoc        as GHC
-import           SrcLoc ( SrcSpan )
-import           OccName ( occNameString )
-import           Name ( getOccString )
-import           Module ( moduleName )
-import           ApiAnnotation ( AnnKeywordId(..) )
-
-import           Data.Data
-import           Data.Generics.Schemes
-import           Data.Generics.Aliases
-
-import           DataTreePrint
-
-import qualified Text.PrettyPrint as PP
-
-import           Data.Function ( fix )
-
-
-
-processDefault :: (ExactPrint.Annotate.Annotate ast, MonadMultiWriter
-                                                 Text.Builder.Builder m,
-                                               MonadMultiReader ExactPrint.Types.Anns m)
-               => GenLocated SrcSpan ast
-               -> m ()
-processDefault x = do
-  anns <- mAsk
-  let str = ExactPrint.exactPrint x anns
-  -- this hack is here so our print-empty-module trick does not add
-  -- a newline at the start if there actually is no module header / imports
-  -- / anything.
-  -- TODO: instead the appropriate annotation could be removed when "cleaning"
-  --       the module (header). This would remove the need for this hack!
-    --test
-  case str of
-    "\n" -> return ()
-    _    -> mTell $ Text.Builder.fromString $ str
-
-
-layoutByExact :: ( MonadMultiReader Config m
-                 , MonadMultiReader (ExactPrint.Types.Anns) m
-                 , ExactPrint.Annotate.Annotate ast
-                  )
-               => GenLocated SrcSpan ast -> m Layouter
-layoutByExact x = do
-  anns <- mAsk
-  trace (showTreeWithCustom (customLayouterF anns) x) $ layoutByExactR x
-  -- trace (ExactPrint.Utils.showAnnData anns 2 x) $ layoutByExactR x
-
-layoutByExactR :: (MonadMultiReader Config m
-                  , MonadMultiReader (ExactPrint.Types.Anns) m
-                  , ExactPrint.Annotate.Annotate ast)
-               => GenLocated SrcSpan ast -> m Layouter
-layoutByExactR x = do
-  indent <- askIndent
-  anns <- mAsk
-  let t = Text.pack $ ExactPrint.exactPrint x anns
-  let tlines = Text.lines $ t <> Text.pack "\n"
-      tlineCount = length tlines
-  let len = indent + maximum (Text.length <$> tlines)
-  return $ Layouter
-    { _layouter_desc = LayoutDesc Nothing $ Just $ BlockDesc AllSameIndent len len Nothing
-    , _layouter_func = \_ -> do
-        -- layoutWriteEnsureBlock
-        layoutWriteAppend $ Text.pack $ "{-" ++ show (ExactPrint.Types.mkAnnKey x, Map.lookup (ExactPrint.Types.mkAnnKey x) anns) ++ "-}"
-        zip [1..] tlines `forM_` \(i, l) -> do
-          layoutWriteAppend $ l
-          unless (i==tlineCount) layoutWriteNewline
-        do
-          let subKeys = foldedAnnKeys x
-          state <- mGet
-          let filterF k _ = not $ k `Set.member` subKeys
-          mSet $ state
-            { _lstate_commentsPrior = Map.filterWithKey filterF
-                                    $ _lstate_commentsPrior state
-            , _lstate_commentsPost  = Map.filterWithKey filterF
-                                    $ _lstate_commentsPost  state
-            }
-    , _layouter_ast = x
-    }
-
-briDocByExact :: (ExactPrint.Annotate.Annotate ast,
-                     MonadMultiReader Config m,
-                     MonadMultiReader ExactPrint.Types.Anns m
-                     ) => GenLocated SrcSpan ast -> m BriDoc
-briDocByExact ast = do
-  anns <- mAsk
-  traceIfDumpConf "ast" _dconf_dump_ast_unknown
-    (printTreeWithCustom 100 (customLayouterF anns) ast)
-  return $ docExt ast anns
-
-descToBlockStart :: LayoutDesc -> Maybe BlockStart
-descToBlockStart (LayoutDesc _ (Just (BlockDesc bs _ _ _))) = Just bs
-descToBlockStart (LayoutDesc (Just line) _)                 = Just $ RestOfLine line
-descToBlockStart _                                          = Nothing
-
-descToBlockMinMax :: LayoutDesc -> Maybe (Int, Int)
-descToBlockMinMax (LayoutDesc _ (Just (BlockDesc _ bmin bmax _))) = Just (bmin, bmax)
-descToBlockMinMax _                                               = Nothing
-
-descToMinMax :: Int -> LayoutDesc -> Maybe (Int, Int)
-descToMinMax p (LayoutDesc _ (Just (BlockDesc start bmin bmax _))) =
-  Just (max rolMin bmin, max rolMin bmax)
-    where
-      rolMin = case start of
-        RestOfLine rol -> p + _lColumns_min rol
-        AllSameIndent -> 0
-
-descToMinMax p (LayoutDesc (Just (LayoutColumns _ _ lmin)) _)    =
-  Just (len, len)
-    where
-      len = p + lmin
-descToMinMax _ _                                                 =
-  Nothing
-
-rdrNameToText :: RdrName -> Text
--- rdrNameToText = Text.pack . show . flip runSDoc unsafeGlobalDynFlags . ppr
-rdrNameToText ( Unqual occname     ) = Text.pack $ occNameString occname
-rdrNameToText ( Qual mname occname ) = Text.pack $ moduleNameString mname
-                                                ++ "."
-                                                ++ occNameString occname
-rdrNameToText ( Orig modul occname ) = Text.pack $ moduleNameString (moduleName modul)
-                                                ++ occNameString occname
-rdrNameToText ( Exact name )         = Text.pack $ getOccString name
-
-lrdrNameToText :: GenLocated l RdrName -> Text
-lrdrNameToText (L _ n) = rdrNameToText n
-
-lrdrNameToTextAnn :: ( MonadMultiReader Config m
-                     , MonadMultiReader (Map AnnKey Annotation) m
-                     )
-                  => GenLocated SrcSpan RdrName
-                  -> m Text
-lrdrNameToTextAnn ast@(L _ n) = do
-  anns <- mAsk
-  let t = rdrNameToText n
-  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
-  --       output. in such cases, resorting to byExact is probably the safe
-  --       choice.
-  return $ case Map.lookup (ExactPrint.Types.mkAnnKey ast) anns of
-    Nothing -> traceShow "Nothing" t
-    Just (ExactPrint.Types.Ann _ _ _ aks _ _) -> if
-        | any (hasUni AnnBackquote) aks -> Text.pack "`" <> t <> Text.pack "`"
-        | any (hasUni AnnOpenP)     aks -> Text.pack "(" <> t <> Text.pack ")"
-        | otherwise -> t
-
-
-askIndent :: (MonadMultiReader Config m) => m Int
-askIndent = runIdentity . _lconfig_indentAmount . _conf_layout <$> mAsk
-
--- minimum block width, judged from block info or line, whichever is
--- available.
--- example: calcLayoutMin doBlock ~~~ atomically $ do
---                                      foo
---                                    ##              indent
---                                    #############   linepre
---                                    ############### result (in this case)
-calcLayoutMin :: Int -- basic indentation amount
-              -> Int -- currently used width in current line (after indent)
-                     -- used to accurately calc placing of the current-line
-                     -- stuff ("do" in the above example) and its width.
-              -> LayoutDesc
-              -> Int
-calcLayoutMin indent linePre (LayoutDesc line block) = case (line, block) of
-  (_, Just (BlockDesc AllSameIndent m _ _))    -> indent + m
-  (_, Just (BlockDesc (RestOfLine inl) m _ _)) -> max (linePre + _lColumns_min inl) (indent + m)
-  (Just s, _)                                  -> indent + _lColumns_min s
-  _ -> error "bad LayoutDesc mnasdoiucxvlkjasd"
-
--- see
-calcLayoutMax :: Int -- basic indentation amount
-              -> Int -- currently used width in current line (after indent)
-                     -- used to accurately calc placing of the current-line
-                     -- stuff ("do" in the above example) and its width.
-              -> LayoutDesc
-              -> Int
-calcLayoutMax indent linePre (LayoutDesc line block) = case (line, block) of
-  (Just s, _)                                  -> linePre + _lColumns_min s
-  (_, Just (BlockDesc AllSameIndent _ m _))    -> indent + m
-  (_, Just (BlockDesc (RestOfLine inl) _ m _)) -> max (linePre + _lColumns_min inl) (indent + m)
-  _ -> error "bad LayoutDesc msdnfgouvadnfoiu"
-
-getCurRemaining :: ( MonadMultiReader Config m
-                  , MonadMultiState LayoutState m
-                  )
-                => m Int
-getCurRemaining = do
-  cols <- mAsk <&> _conf_layout .> _lconfig_cols .> runIdentity
-  clc <- _lstate_curLineCols <$> mGet
-  return $ cols - clc
-
-layoutWriteAppend :: (MonadMultiWriter
-                                                 Text.Builder.Builder m,
-                                               MonadMultiState LayoutState m)
-                  => Text
-                  -> m ()
-layoutWriteAppend t = do
-  state <- mGet
-  if _lstate_addSepSpace state
-    then do
-      mSet $ state { _lstate_curLineCols = _lstate_curLineCols state + Text.length t + 1
-                   , _lstate_addSepSpace = False
-                   }
-      mTell $ Text.Builder.fromText $ Text.pack " " <> t
-    else do
-      mSet $ state { _lstate_curLineCols = _lstate_curLineCols state + Text.length t }
-      mTell $ Text.Builder.fromText t
-
-layoutWriteAppendMultiline :: (MonadMultiWriter
-                                                 Text.Builder.Builder m,
-                                               MonadMultiState LayoutState m)
-                  => Text
-                  -> m ()
-layoutWriteAppendMultiline t = case Text.lines t of
-  [] -> return ()
-  (l:lr) -> do
-    layoutWriteAppend l
-    lr `forM_` \x -> do
-      layoutWriteNewlinePlain
-      layoutWriteAppend x
-
--- adds a newline and adds spaces to reach the current indentation level.
--- TODO: rename newline -> newlineBlock and newlinePlain -> newline
-layoutWriteNewline :: (MonadMultiWriter
-                                                 Text.Builder.Builder m,
-                                               MonadMultiState LayoutState m)
-                  => m ()
-layoutWriteNewline = do
-  state <- mGet
-  mSet $ state { _lstate_curLineCols = _lstate_indent state
-                          , _lstate_commentCol = Nothing
-                          , _lstate_addSepSpace = False
-                          }
-  mTell $ Text.Builder.fromString $ "\n" ++ replicate (_lstate_indent state) ' '
-
--- | does _not_ add spaces to again reach the current indentation levels.
-layoutWriteNewlinePlain :: (MonadMultiWriter
-                                                 Text.Builder.Builder m,
-                                               MonadMultiState LayoutState m)
-                  => m ()
-layoutWriteNewlinePlain = do
-  state <- mGet
-  mSet $ state { _lstate_curLineCols = 0
-                          , _lstate_commentCol = Nothing
-                          , _lstate_addSepSpace = False
-                          }
-  mTell $ Text.Builder.fromString $ "\n"
-
-layoutWriteEnsureNewline :: (MonadMultiWriter
-                                                 Text.Builder.Builder m,
-                                               MonadMultiState LayoutState m)
-                  => m ()
-layoutWriteEnsureNewline = do
-  state <- mGet
-  when (_lstate_curLineCols state /= _lstate_indent state)
-    $ layoutWriteNewline
-
-layoutWriteEnsureBlock :: (MonadMultiWriter
-                                                 Text.Builder.Builder m,
-                                               MonadMultiState LayoutState m)
-                  => m ()
-layoutWriteEnsureBlock = do
-  state <- mGet
-  let diff = _lstate_curLineCols state - _lstate_indent state
-  if diff>0
-    then layoutWriteNewline
-    else if diff<0
-      then do
-        layoutWriteAppend $ Text.pack $ replicate (negate diff) ' '
-        mSet $ state { _lstate_curLineCols = _lstate_indent state
-                     , _lstate_addSepSpace = False
-                     }
-      else return ()
-
-layoutWriteEnsureAbsoluteN :: (MonadMultiWriter
-                                                 Text.Builder.Builder m,
-                                               MonadMultiState LayoutState m)
-                  => Int -> m ()
-layoutWriteEnsureAbsoluteN n = do
-  state <- mGet
-  let diff = n - _lstate_curLineCols state
-  if diff>0
-    then do
-      layoutWriteAppend $ Text.pack $ replicate diff ' '
-      mSet $ state { _lstate_curLineCols = n
-                   , _lstate_addSepSpace = False
-                   }
-    else return ()
-
-layoutWriteEnsureBlockPlusN :: (MonadMultiWriter
-                                                           Text.Builder.Builder m,
-                                                         MonadMultiState LayoutState m)
-                            => Int -> m ()
-layoutWriteEnsureBlockPlusN n = do
-  state <- mGet
-  let diff = _lstate_curLineCols state - _lstate_indent state - n
-  if diff>0
-    then layoutWriteNewline
-    else if diff<0
-      then do
-        layoutWriteAppend $ Text.pack $ replicate (negate diff) ' '
-        mSet $ state { _lstate_addSepSpace = False }
-      else return ()
-
-layoutWithAddIndent :: (MonadMultiWriter
-                                                 Text.Builder.Builder m,
-                                               MonadMultiState LayoutState m
-                                               ,MonadMultiReader Config m)
-                  => m ()
-                  -> m ()
-layoutWithAddIndent m = do
-  amount <- mAsk <&> _conf_layout .> _lconfig_indentAmount .> runIdentity
-  state <- mGet
-  mSet state { _lstate_indent = _lstate_indent state + amount }
-  m
-  do
-    s <- mGet
-    mSet $ s { _lstate_indent = _lstate_indent state }
-
-layoutWithAddIndentBlock :: (MonadMultiWriter
-                                                 Text.Builder.Builder m,
-                                               MonadMultiState LayoutState m
-                                               ,MonadMultiReader Config m)
-                  => m ()
-                  -> m ()
-layoutWithAddIndentBlock m = do
-  amount <- mAsk <&> _conf_layout .> _lconfig_indentAmount .> runIdentity
-  state <- mGet
-  mSet state { _lstate_indent = _lstate_indent state + amount }
-  layoutWriteEnsureBlock
-  m
-  do
-    s <- mGet
-    mSet $ s { _lstate_indent = _lstate_indent state }
-
-layoutWithAddIndentNBlock :: (MonadMultiWriter
-                                                 Text.Builder.Builder m,
-                                               MonadMultiState LayoutState m)
-                  => Int
-                  -> m ()
-                  -> m ()
-layoutWithAddIndentNBlock amount m = do
-  state <- mGet
-  mSet state { _lstate_indent = _lstate_indent state + amount }
-  layoutWriteEnsureBlock
-  m
-  do
-    s <- mGet
-    mSet $ s { _lstate_indent = _lstate_indent state }
-
-layoutWithAddIndentN :: (MonadMultiWriter
-                                                 Text.Builder.Builder m,
-                                               MonadMultiState LayoutState m)
-                  => Int
-                  -> m ()
-                  -> m ()
-layoutWithAddIndentN amount m = do
-  state <- mGet
-  mSet state { _lstate_indent = _lstate_indent state + amount }
-  m
-  do
-    s <- mGet
-    mSet $ s { _lstate_indent = _lstate_indent state }
-
-layoutAddSepSpace :: MonadMultiState LayoutState m => m ()
-layoutAddSepSpace = do
-  state <- mGet
-  mSet $ state { _lstate_addSepSpace = True }
-
-moveToExactAnn :: (Data.Data.Data x,
-                    MonadMultiWriter Text.Builder.Builder m,
-                    MonadMultiState LayoutState m,
-                    MonadMultiReader (Map AnnKey Annotation) m) => GenLocated SrcSpan x -> m ()
-moveToExactAnn ast = do
-  anns <- mAsk
-  case Map.lookup (ExactPrint.Types.mkAnnKey ast) anns of
-    Nothing -> return ()
-    Just ann -> do
-      let ExactPrint.Types.DP (x, _y) = ExactPrint.Types.annEntryDelta ann
-      replicateM_ x $ layoutWriteNewline
-
--- TODO: when refactoring is complete, the other version of this method
--- can probably be removed.
-moveToExactAnn' :: (MonadMultiWriter Text.Builder.Builder m,
-                    MonadMultiState LayoutState m,
-                    MonadMultiReader (Map AnnKey Annotation) m) => AnnKey -> m ()
-moveToExactAnn' annKey = do
-  anns <- mAsk
-  case Map.lookup annKey anns of
-    Nothing -> return ()
-    Just ann -> do
-      -- curY <- mGet <&> _lstate_curLineCols
-      let ExactPrint.Types.DP (x, _y) = ExactPrint.Types.annEntryDelta ann
-      replicateM_ x $ layoutWriteNewline
-      -- when (x/=0) $ do
-      --   replicateM_ x $ layoutWriteNewlinePlain
-      --   mModify $ \s -> s { _lstate_curLineCols = curY }
-      --   mTell $ Text.Builder.fromString $ replicate curY ' '
-
-ppmMoveToExactLoc :: MonadMultiWriter Text.Builder.Builder m
-                  => ExactPrint.Types.DeltaPos
-                  -> m ()
-ppmMoveToExactLoc (ExactPrint.Types.DP (x,y)) = do
-  replicateM_ x $ mTell $ Text.Builder.fromString "\n"
-  replicateM_ y $ mTell $ Text.Builder.fromString " "
-
-layoutWithNonParamIndent :: (MonadMultiWriter
-                                                 Text.Builder.Builder m,
-                                               MonadMultiState LayoutState m)
-    => LayoutFuncParams -> m () -> m ()
-layoutWithNonParamIndent params m = do
-  case _params_opIndent params of
-    Nothing -> m
-    Just x -> layoutWithAddIndentN x m
-
-setOpIndent :: Int -> LayoutDesc -> LayoutFuncParams -> LayoutFuncParams
-setOpIndent i desc p = p
-  { _params_opIndent = Just $ case _bdesc_opIndentFloatUp =<< _ldesc_block desc of
-      Nothing -> i
-      Just j -> max i j
-  }
-
-stringLayouter :: Data.Data.Data ast
-               => GenLocated SrcSpan ast -> Text -> Layouter
-stringLayouter ast t = Layouter
-  { _layouter_desc = LayoutDesc
-    { _ldesc_line = Just $ LayoutColumns
-      { _lColumns_key = ColumnKeyUnique
-      , _lColumns_lengths = [Text.length t]
-      , _lColumns_min = Text.length t
-      }
-    , _ldesc_block = Nothing
-    }
-  , _layouter_func = \_ -> do
-      layoutWritePriorCommentsRestore ast
-      layoutWriteAppend t
-      layoutWritePostComments ast
-  , _layouter_ast = ast
-  }
-
-layoutWritePriorComments :: (Data.Data.Data ast,
-                                               MonadMultiWriter Text.Builder.Builder m,
-                                               MonadMultiState LayoutState m)
-                         => GenLocated SrcSpan ast -> m ()
-layoutWritePriorComments ast = do
-  mAnn <- do
-    state <- mGet
-    let key = ExactPrint.Types.mkAnnKey ast
-    let m   = _lstate_commentsPrior state
-    let mAnn = Map.lookup key m
-    mSet $ state { _lstate_commentsPrior = Map.delete key m }
-    return mAnn
-  case mAnn of
-    Nothing -> return ()
-    Just priors -> do
-      when (not $ null priors) $ do
-        state <- mGet
-        mSet $ state { _lstate_commentCol = Just $ _lstate_curLineCols state }
-      priors `forM_` \( ExactPrint.Types.Comment comment _ _
-                      , ExactPrint.Types.DP (x, y)
-                      ) -> do
-        replicateM_ x layoutWriteNewlinePlain
-        layoutWriteAppend $ Text.pack $ replicate y ' '
-        layoutWriteAppendMultiline $ Text.pack $ comment
-
--- this currently only extracs from the `annsDP` field of Annotations.
--- per documentation, this seems sufficient, as the
--- "..`annFollowingComments` are only added by AST transformations ..".
-layoutWritePostComments :: (Data.Data.Data ast,
-                                               MonadMultiWriter Text.Builder.Builder m,
-                                               MonadMultiState LayoutState m)
-                         => GenLocated SrcSpan ast -> m ()
-layoutWritePostComments ast = do
-  mAnn <- do
-    state <- mGet
-    let key = ExactPrint.Types.mkAnnKey ast
-    let m   = _lstate_commentsPost state
-    let mAnn = Map.lookup key m
-    mSet $ state { _lstate_commentsPost = Map.delete key m }
-    return mAnn
-  case mAnn of
-    Nothing -> return ()
-    Just posts -> do
-      when (not $ null posts) $ do
-        state <- mGet
-        mSet $ state { _lstate_commentCol = Just $ _lstate_curLineCols state }
-      posts `forM_` \( ExactPrint.Types.Comment comment _ _
-                      , ExactPrint.Types.DP (x, y)
-                      ) -> do
-        replicateM_ x layoutWriteNewlinePlain
-        layoutWriteAppend $ Text.pack $ replicate y ' '
-        layoutWriteAppendMultiline $ Text.pack $ comment
-
-layoutIndentRestorePostComment :: ( Monad m
-           , MonadMultiState LayoutState m
-           , MonadMultiWriter Text.Builder.Builder m
-           )
-                               => m ()
-layoutIndentRestorePostComment = do
-  mCommentCol <- _lstate_commentCol <$> mGet
-  case mCommentCol of
-    Nothing -> return ()
-    Just commentCol -> do
-      layoutWriteNewlinePlain
-      layoutWriteAppend $ Text.pack $ replicate commentCol ' '
-
-layoutWritePriorCommentsRestore :: (Data.Data.Data ast,
-                                               MonadMultiWriter Text.Builder.Builder m,
-                                               MonadMultiState LayoutState m)
-                                => GenLocated SrcSpan ast -> m ()
-layoutWritePriorCommentsRestore x = do
-  layoutWritePriorComments x
-  layoutIndentRestorePostComment
-
-layoutWritePostCommentsRestore :: (Data.Data.Data ast,
-                                               MonadMultiWriter Text.Builder.Builder m,
-                                               MonadMultiState LayoutState m)
-                                => GenLocated SrcSpan ast -> m ()
-layoutWritePostCommentsRestore x = do
-  layoutWritePostComments x
-  layoutIndentRestorePostComment
-
-extractCommentsPrior :: ExactPrint.Types.Anns -> PriorMap
-extractCommentsPrior anns = flip Map.mapMaybe anns $ \ann ->
-  [r | let r = ExactPrint.Types.annPriorComments ann, not (null r)]
-extractCommentsPost  :: ExactPrint.Types.Anns -> PostMap
-extractCommentsPost  anns = flip Map.mapMaybe anns $ \ann ->
-  [r
-  | let
-    r = ExactPrint.Types.annsDP ann
-      >>= \case
-                 (ExactPrint.Types.AnnComment comment, dp) -> [(comment, dp)]
-                 _ -> []
-  , not (null r)
-  ]
-
-
-applyLayouter :: Layouter -> LayoutFuncParams -> LayoutM ()
-applyLayouter l@(Layouter _ _ ast) params = do
-  -- (always) write the prior comments at this point.
-  layoutWritePriorCommentsRestore ast
-  -- run the real stuff.
-  _layouter_func l params
-  -- if the _layouter_func has not done so already at some point
-  -- (there are nodes for which this makes sense),
-  -- write the post comments.
-  -- effect is `return ()` if there are no postComments.
-  layoutWritePostComments ast
-
-applyLayouterRestore :: Layouter -> LayoutFuncParams -> LayoutM ()
-applyLayouterRestore l@(Layouter _ _ ast) params = do
-  -- (always) write the prior comments at this point.
-  layoutWritePriorCommentsRestore ast
-  -- run the real stuff.
-  _layouter_func l params
-  -- if the _layouter_func has not done so already at some point
-  -- (there are nodes for which this makes sense),
-  -- write the post comments.
-  -- effect is `return ()` if there are no postComments.
-  layoutWritePostCommentsRestore ast
-
-foldedAnnKeys :: Data.Data.Data ast
-              => ast
-              -> Set ExactPrint.Types.AnnKey
-foldedAnnKeys ast = everything
-  Set.union
-  (\x -> maybe
-         Set.empty
-         Set.singleton
-         [ gmapQi 1 (\t -> ExactPrint.Types.mkAnnKey $ L l t) x
-         | typeRepTyCon (typeOf (L () ())) == (typeRepTyCon (typeOf x))
-         , l <- gmapQi 0 cast x
-         ]
-  )
-  ast
-
-filterAnns :: Data.Data.Data ast
-           => ast
-           -> ExactPrint.Types.Anns
-           -> ExactPrint.Types.Anns
-filterAnns ast anns =
-  Map.filterWithKey (\k _ -> k `Set.member` foldedAnnKeys ast) anns
-
-layouterFToLayouterM :: MultiReader '[Config, ExactPrint.Types.Anns] a -> LayoutM a
-layouterFToLayouterM m = do
-  settings <- mAsk
-  anns <- mAsk
-  return $ runIdentity
-         $ runMultiReaderTNil
-         $ Control.Monad.Trans.MultiReader.Lazy.withMultiReader anns
-         $ Control.Monad.Trans.MultiReader.Lazy.withMultiReader settings
-         $ m
-
--- new BriDoc stuff
-
-docEmpty :: BriDoc
-docEmpty = BDEmpty
-
-docLit :: Text -> BriDoc
-docLit t = BDLit t
-
-docExt :: ExactPrint.Annotate.Annotate ast
-       => GenLocated SrcSpan ast -> ExactPrint.Types.Anns -> BriDoc
-docExt x anns = BDExternal
-                  (ExactPrint.Types.mkAnnKey x)
-                  (foldedAnnKeys x)
-                  (Text.pack $ ExactPrint.exactPrint x anns)
-
-docAlt :: [BriDoc] -> BriDoc
-docAlt = BDAlt
-
-
-docSeq :: [BriDoc] -> BriDoc
-docSeq = BDSeq
-
-
-docPostComment :: Data.Data.Data ast
-               => GenLocated SrcSpan ast
-               -> BriDoc
-               -> BriDoc
-docPostComment ast bd = BDAnnotationPost (ExactPrint.Types.mkAnnKey ast) bd
-
-docWrapNode :: Data.Data.Data ast
-            => GenLocated SrcSpan ast
-            -> BriDoc
-            -> BriDoc
-docWrapNode ast bd = BDAnnotationPrior (ExactPrint.Types.mkAnnKey ast)
-                   $ BDAnnotationPost (ExactPrint.Types.mkAnnKey ast)
-                   $ bd
-
-docPar :: BriDoc
-       -> BriDoc
-       -> BriDoc
-docPar line indented = BDPar BrIndentNone line indented
-
--- docPar :: BriDoc
---        -> BrIndent
---        -> [BriDoc]
---        -> BriDoc
--- docPar = BDPar
-
--- docCols :: ColSig
---         -> [BriDoc]
---         -> BriDoc
--- docCols = BDCols
-
-
-fromMaybeIdentity :: Identity a -> Maybe a -> Identity a
-fromMaybeIdentity x y = Data.Coerce.coerce
-                      $ fromMaybe (Data.Coerce.coerce x) y

src-idemtests/run.sh

@@ -1,36 +0,0 @@
-#!/bin/bash
-
-# set -x
-set -e
-
-rm report.txt &> /dev/null || true
-
-mkdir iterOne &> /dev/null || true
-mkdir iterTwo &> /dev/null || true
-
-for FILE in ./cases/*
-do
-  NAME=$(basename "$FILE")
-  ITERNAMEONE="./iterOne/$NAME"
-  ITERNAMETWO="./iterTwo/$NAME"
-  if ! ./brittany -i "$FILE" -o "$ITERNAMEONE"
-  then
-    echo "FAILED step 1 for $FILE" | tee -a report.txt
-    continue
-  fi
-  if ! ./brittany -i "$ITERNAMEONE" -o "$ITERNAMETWO"
-  then
-    echo "FAILED step 2 for $FILE" | tee -a report.txt
-    continue
-  fi
-  if ! diff "$ITERNAMEONE" "$ITERNAMETWO" > diff.temp
-  then
-    echo "FAILED diff for $FILE with diff:" | tee -a report.txt
-    cat diff.temp | tee -a report.txt
-    echo "# meld $(realpath $ITERNAMEONE) $(realpath $ITERNAMETWO)" | tee -a report.txt
-    continue
-  fi
-  echo "success for $FILE" | tee -a report.txt
-done
-
-rm diff.temp &> /dev/null || true