diff --git a/src/Language/Haskell/Brittany/BriLayouter.hs b/src/Language/Haskell/Brittany/BriLayouter.hs index 88013c4..af7e57d 100644 --- a/src/Language/Haskell/Brittany/BriLayouter.hs +++ b/src/Language/Haskell/Brittany/BriLayouter.hs @@ -617,8 +617,10 @@ getSpacing !bridoc = rec bridoc getSpacings :: forall m . (MonadMultiReader Config m, MonadMultiWriter (Seq String) m) => Int -> BriDocNumbered -> Memo.MemoT Int [VerticalSpacing] m [VerticalSpacing] -getSpacings limit bridoc = rec bridoc +getSpacings limit bridoc = preFilterLimit <$> rec bridoc where + preFilterLimit :: [VerticalSpacing] -> [VerticalSpacing] + preFilterLimit = take (3*limit) memoWithKey :: Memo.MonadMemo k v m1 => k -> m1 v -> m1 v memoWithKey k v = Memo.memo (const v) k rec :: BriDocNumbered -> Memo.MemoT Int [VerticalSpacing] m [VerticalSpacing] @@ -631,16 +633,14 @@ getSpacings limit bridoc = rec bridoc VerticalSpacingParSome i -> i <= colMax VerticalSpacingParNonBottom -> True let filterAndLimit :: [VerticalSpacing] -> [VerticalSpacing] - filterAndLimit = forceList - . take limit + filterAndLimit = take limit . filter hasOkColCount - . take (100*limit) -- we need to limit here in case + . preFilterLimit -- we need to limit here in case -- that the input list is -- _large_ with a similarly _large_ -- prefix not passing hasOkColCount -- predicate. - -- TODO: 100 is arbitrary. - forceList l = foldl (flip seq) l l + -- TODO: 3 is arbitrary. result <- case brdc of -- BDWrapAnnKey _annKey bd -> rec bd BDFEmpty -> @@ -648,9 +648,9 @@ getSpacings limit bridoc = rec bridoc BDFLit t -> return $ [VerticalSpacing (Text.length t) VerticalSpacingParNone False] BDFSeq list -> - filterAndLimit . fmap sumVs . sequence <$> rec `mapM` list + fmap sumVs . sequence . fmap filterAndLimit <$> rec `mapM` list BDFCols _sig list -> - filterAndLimit . fmap sumVs . sequence <$> rec `mapM` list + fmap sumVs . sequence . fmap filterAndLimit <$> rec `mapM` list BDFSeparator -> return $ [VerticalSpacing 1 VerticalSpacingParNone False] BDFAddBaseY indent bd -> do @@ -689,14 +689,12 @@ getSpacings limit bridoc = rec bridoc BDFIndentLevelPushCur bd -> rec bd BDFIndentLevelPop bd -> rec bd BDFPar BrIndentNone sameLine indented -> do - mVss <- rec sameLine - indSps <- rec indented + mVss <- filterAndLimit <$> rec sameLine + indSps <- filterAndLimit <$> rec indented let mVsIndSp = take limit $ [ (x,y) | x<-mVss , y<-indSps - , hasOkColCount x - , hasOkColCount y ] return $ mVsIndSp <&> \(VerticalSpacing lsp mPsp _, indSp) -> @@ -716,11 +714,11 @@ getSpacings limit bridoc = rec bridoc BDFAlt [] -> error "empty BDAlt" -- BDAlt (alt:_) -> rec alt BDFAlt alts -> do - r <- filterAndLimit . join <$> (rec `mapM` alts) - return r + r <- rec `mapM` alts + return $ filterAndLimit =<< r BDFForceMultiline bd -> rec bd BDFForceSingleline bd -> do - mVs <- rec bd + mVs <- filterAndLimit <$> rec bd return $ filter ((==VerticalSpacingParNone) . _vs_paragraph) mVs BDFForwardLineMode bd -> rec bd BDFExternal{} -> @@ -735,7 +733,7 @@ getSpacings limit bridoc = rec bridoc -- paragraph". That most importantly means that Lines should never -- be inserted anywhere but at the start of the line. A -- counterexample would be anything like Seq[Lit "foo", Lines]. - lSpss <- rec `mapM` ls + lSpss <- fmap filterAndLimit <$> rec `mapM` ls let worbled = fmap reverse $ sequence $ reverse @@ -744,7 +742,7 @@ getSpacings limit bridoc = rec bridoc VerticalSpacing (_vs_sameLine lSp1) (spMakePar $ maxVs lSps) False - return $ filterAndLimit $ summed + return $ summed -- lSpss@(mVs:_) <- rec `mapM` ls -- return $ case Control.Lens.transposeOf traverse lSpss of -- TODO: we currently only -- -- consider the first alternative for the @@ -776,12 +774,12 @@ getSpacings limit bridoc = rec bridoc mVs <- rec bd return $ mVs <&> \vs -> vs { _vs_parFlag = True } BDFForceParSpacing bd -> do - mVs <- rec bd + mVs <- preFilterLimit <$> rec bd return $ [ vs | vs <- mVs, _vs_parFlag vs || _vs_paragraph vs == VerticalSpacingParNone ] BDFProhibitMTEL bd -> rec bd BDFDebug s bd -> do r <- rec bd - tellDebugMess $ "getSpacings: BDFDebug " ++ show s ++ " (node-id=" ++ show brDcId ++ "): vs=" ++ show r + tellDebugMess $ "getSpacings: BDFDebug " ++ show s ++ " (node-id=" ++ show brDcId ++ "): vs=" ++ show (take 9 r) return r #if INSERTTRACESGETSPACING case brdc of @@ -790,7 +788,7 @@ getSpacings limit bridoc = rec bridoc _ -> mTell $ Seq.fromList ["getSpacing: visiting: " ++ show {-(toConstr $ brdc)-} (briDocToDoc $ unwrapBriDocNumbered (0, brdc)) , " -> " - ++ show result + ++ show (take 9 result) ] #endif return result