diff --git a/src/Language/Haskell/Brittany/Internal/BackendUtils.hs b/src/Language/Haskell/Brittany/Internal/BackendUtils.hs index 1253f1a..201c7c5 100644 --- a/src/Language/Haskell/Brittany/Internal/BackendUtils.hs +++ b/src/Language/Haskell/Brittany/Internal/BackendUtils.hs @@ -1,11 +1,6 @@ -#define INSERTTRACES 0 - {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE TypeApplications #-} -#if !INSERTTRACES -{-# OPTIONS_GHC -Wno-redundant-constraints #-} -#endif module Language.Haskell.Brittany.Internal.BackendUtils ( layoutWriteAppend @@ -58,13 +53,7 @@ traceLocal :: (MonadMultiState LayoutState m, MonadMultiWriter (Seq String) m, Show a) => a -> m () -#if INSERTTRACES -traceLocal x = do - mGet >>= tellDebugMessShow @LayoutState - tellDebugMessShow x -#else traceLocal _ = return () -#endif layoutWriteAppend @@ -79,21 +68,12 @@ layoutWriteAppend t = do state <- mGet case _lstate_curYOrAddNewline state of Right i -> do -#if INSERTTRACES - tellDebugMessShow (" inserted newlines: ", i) -#endif replicateM_ i $ mTell $ Text.Builder.fromString $ "\n" Left{} -> do -#if INSERTTRACES - tellDebugMessShow (" inserted no newlines") -#endif return () let spaces = case _lstate_addSepSpace state of Just i -> i Nothing -> 0 -#if INSERTTRACES - tellDebugMessShow (" inserted spaces: ", spaces) -#endif mTell $ Text.Builder.fromText $ Text.pack (replicate spaces ' ') mTell $ Text.Builder.fromText $ t mModify $ \s -> s @@ -159,7 +139,7 @@ layoutWriteNewlineBlock = do -- mSet $ state -- { _lstate_addSepSpace = Just -- $ if isJust $ _lstate_addNewline state --- then i +-- then i -- else _lstate_indLevelLinger state + i - _lstate_curY state -- } @@ -303,9 +283,6 @@ layoutRemoveIndentLevelLinger :: ( MonadMultiState LayoutState m , MonadMultiWriter (Seq String) m ) => m () layoutRemoveIndentLevelLinger = do -#if INSERTTRACES - tellDebugMessShow ("layoutRemoveIndentLevelLinger") -#endif mModify $ \s -> s { _lstate_indLevelLinger = lstate_indLevel s } @@ -318,9 +295,6 @@ layoutWithAddBaseCol => m () -> m () layoutWithAddBaseCol m = do -#if INSERTTRACES - tellDebugMessShow ("layoutWithAddBaseCol") -#endif amount <- mAsk <&> _conf_layout .> _lconfig_indentAmount .> confUnpack state <- mGet layoutBaseYPushInternal $ lstate_baseY state + amount @@ -336,9 +310,6 @@ layoutWithAddBaseColBlock => m () -> m () layoutWithAddBaseColBlock m = do -#if INSERTTRACES - tellDebugMessShow ("layoutWithAddBaseColBlock") -#endif amount <- mAsk <&> _conf_layout .> _lconfig_indentAmount .> confUnpack state <- mGet layoutBaseYPushInternal $ lstate_baseY state + amount @@ -390,9 +361,6 @@ layoutWithAddBaseColN -> m () -> m () layoutWithAddBaseColN amount m = do -#if INSERTTRACES - tellDebugMessShow ("layoutWithAddBaseColN", amount) -#endif state <- mGet layoutBaseYPushInternal $ lstate_baseY state + amount m @@ -444,9 +412,6 @@ layoutAddSepSpace :: (MonadMultiState LayoutState m , MonadMultiWriter (Seq String) m) => m () layoutAddSepSpace = do -#if INSERTTRACES - tellDebugMessShow ("layoutAddSepSpace") -#endif state <- mGet mSet $ state { _lstate_addSepSpace = Just $ fromMaybe 1 $ _lstate_addSepSpace state } @@ -523,9 +488,6 @@ layoutWritePriorComments ast = do Map.adjust (\ann -> ann { ExactPrint.annPriorComments = [] }) key anns } return mAnn -#if INSERTTRACES - tellDebugMessShow ("layoutWritePriorComments", ExactPrint.mkAnnKey ast, mAnn) -#endif case mAnn of Nothing -> return () Just priors -> do @@ -559,9 +521,6 @@ layoutWritePostComments ast = do anns } return mAnn -#if INSERTTRACES - tellDebugMessShow ("layoutWritePostComments", ExactPrint.mkAnnKey ast, mAnn) -#endif case mAnn of Nothing -> return () Just posts -> do @@ -584,9 +543,6 @@ layoutIndentRestorePostComment = do state <- mGet let mCommentCol = _lstate_commentCol state let eCurYAddNL = _lstate_curYOrAddNewline state -#if INSERTTRACES - tellDebugMessShow ("layoutIndentRestorePostComment", mCommentCol) -#endif mModify $ \s -> s { _lstate_commentCol = Nothing , _lstate_commentNewlines = 0 } @@ -604,7 +560,7 @@ layoutIndentRestorePostComment = do -- layoutWritePriorCommentsRestore x = do -- layoutWritePriorComments x -- layoutIndentRestorePostComment --- +-- -- layoutWritePostCommentsRestore :: (Data.Data.Data ast, -- MonadMultiWriter Text.Builder.Builder m, -- MonadMultiState LayoutState m diff --git a/src/Language/Haskell/Brittany/Internal/Transformations/Alt.hs b/src/Language/Haskell/Brittany/Internal/Transformations/Alt.hs index 6a15eac..d186564 100644 --- a/src/Language/Haskell/Brittany/Internal/Transformations/Alt.hs +++ b/src/Language/Haskell/Brittany/Internal/Transformations/Alt.hs @@ -1,7 +1,3 @@ -#define INSERTTRACESALT 0 -#define INSERTTRACESALTVISIT 0 -#define INSERTTRACESGETSPACING 0 - {-# LANGUAGE TypeOperators #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE DataKinds #-} @@ -117,14 +113,6 @@ transformAlts = rec :: BriDocNumbered -> Memo.MemoT Int [VerticalSpacing] (MultiRWSS.MultiRWS r w (AltCurPos ': s)) BriDocNumbered rec bdX@(brDcId, brDc) = do -#if INSERTTRACESALTVISIT - do - acp :: AltCurPos <- mGet - tellDebugMess $ "transformAlts: visiting: " ++ case brDc of - BDFAnnotationPrior annKey _ -> show (toConstr brDc, annKey, acp) - BDFAnnotationRest annKey _ -> show (toConstr brDc, annKey, acp) - _ -> show (toConstr brDc, acp) -#endif let reWrap = (,) brDcId -- debugAcp :: AltCurPos <- mGet case brDc of @@ -206,20 +194,10 @@ transformAlts = -- TODO: use COMPLETE pragma instead? lineCheck _ = error "ghc exhaustive check is insufficient" lconf <- _conf_layout <$> mAsk -#if INSERTTRACESALT - tellDebugMess $ "considering options with " ++ show (length alts, acp) -#endif 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)) -#if INSERTTRACESALT - zip spacings options `forM_` \(vs, (_, bd)) -> - tellDebugMess $ " " ++ "spacing=" ++ show vs - ++ ",hasSpace1=" ++ show (hasSpace1 lconf acp vs) - ++ ",lineCheck=" ++ show (lineCheck vs) - ++ " " ++ show (toConstr bd) -#endif id -- - $ (fmap $ \x -> traceShow (briDocToDoc x) x) $ rec $ fromMaybe (-- trace ("choosing last") $ @@ -240,9 +218,6 @@ transformAlts = AltLineModeStateForceML{} -> p /= VerticalSpacingParNone AltLineModeStateContradiction -> False lconf <- _conf_layout <$> mAsk -#if INSERTTRACESALT - tellDebugMess $ "considering options with " ++ show (length alts, acp) -#endif 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)) @@ -250,14 +225,6 @@ transformAlts = && any lineCheck vs, bd)) let checkedOptions :: [Maybe (Int, BriDocNumbered)] = zip [1..] options <&> (\(i, (b,x)) -> [ (i, x) | b ]) -#if INSERTTRACESALT - zip spacings options `forM_` \(vs, (_, bd)) -> - tellDebugMess $ " " ++ "spacing=" ++ show vs - ++ ",hasSpace2=" ++ show (hasSpace2 lconf acp <$> vs) - ++ ",lineCheck=" ++ show (lineCheck <$> vs) - ++ " " ++ show (toConstr bd) - tellDebugMess $ " " ++ show (Data.Maybe.mapMaybe (fmap fst) checkedOptions) -#endif id -- - $ (fmap $ \x -> traceShow (briDocToDoc x) x) $ rec $ fromMaybe (-- trace ("choosing last") $ @@ -510,9 +477,6 @@ getSpacing !bridoc = rec bridoc r <- rec bd tellDebugMess $ "getSpacing: BDFDebug " ++ show s ++ " (node-id=" ++ show brDcId ++ "): mVs=" ++ show r return r -#if INSERTTRACESGETSPACING - tellDebugMess $ "getSpacing: visiting: " ++ show (toConstr $ brDc) ++ " -> " ++ show result -#endif return result maxVs :: [LineModeValidity VerticalSpacing] -> LineModeValidity VerticalSpacing maxVs = foldl' @@ -867,16 +831,6 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc r <- rec bd tellDebugMess $ "getSpacings: BDFDebug " ++ show s ++ " (node-id=" ++ show brDcId ++ "): vs=" ++ show (take 9 r) return r -#if INSERTTRACESGETSPACING - case brdc of - BDFAnnotationPrior{} -> return () - BDFAnnotationRest{} -> return () - _ -> mTell $ Seq.fromList ["getSpacings: visiting: " - ++ show (toConstr $ brdc) -- (briDocToDoc $ unwrapBriDocNumbered (0, brdc)) - , " -> " - ++ show (take 9 result) - ] -#endif return result maxVs :: [VerticalSpacing] -> VerticalSpacing maxVs = foldl'