From 75cf5b83a3c24309ef4fe4171d8de8b3aeb381ab Mon Sep 17 00:00:00 2001 From: Taylor Fausak Date: Sat, 6 Nov 2021 20:40:31 +0000 Subject: [PATCH] Remove unused tests --- src-idemtests/.gitignore | 4 - src-idemtests/README | 17 - src-idemtests/brittany.yaml | 29 -- src-idemtests/cases/LayoutBasics.hs | 733 ---------------------------- src-idemtests/run.sh | 36 -- 5 files changed, 819 deletions(-) delete mode 100644 src-idemtests/.gitignore delete mode 100644 src-idemtests/README delete mode 100644 src-idemtests/brittany.yaml delete mode 100644 src-idemtests/cases/LayoutBasics.hs delete mode 100755 src-idemtests/run.sh diff --git a/src-idemtests/.gitignore b/src-idemtests/.gitignore deleted file mode 100644 index 4830bd8..0000000 --- a/src-idemtests/.gitignore +++ /dev/null @@ -1,4 +0,0 @@ -iterOne/ -iterTwo/ -brittany -report.txt diff --git a/src-idemtests/README b/src-idemtests/README deleted file mode 100644 index 3560f17..0000000 --- a/src-idemtests/README +++ /dev/null @@ -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. diff --git a/src-idemtests/brittany.yaml b/src-idemtests/brittany.yaml deleted file mode 100644 index 6e5dcfb..0000000 --- a/src-idemtests/brittany.yaml +++ /dev/null @@ -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 - diff --git a/src-idemtests/cases/LayoutBasics.hs b/src-idemtests/cases/LayoutBasics.hs deleted file mode 100644 index d1331a5..0000000 --- a/src-idemtests/cases/LayoutBasics.hs +++ /dev/null @@ -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 diff --git a/src-idemtests/run.sh b/src-idemtests/run.sh deleted file mode 100755 index 298ecef..0000000 --- a/src-idemtests/run.sh +++ /dev/null @@ -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