Fix #16; Improve layouting in two cases; Add comments

- the #16 fix is a one-liner:
  Throw `nub` at spacings before pruning.
- Expr/OpApp layouting: Force single-line for children in
  the params-in-multiple-lines-right-of-the-function case.
- Expr/HsIf layouting: Insert a SetBaseY to prevent
  "then"/"else" being placed left of "if".

src-literatetests/tests.blt

@@ -690,10 +690,8 @@ showPackageDetailedInfo pkginfo =
           , entry "Documentation" haddockHtml  showIfInstalled text
           , entry "Cached"        haveTarball  alwaysShow      dispYesNo
           , if not (hasLib pkginfo)
-          then
+            then empty
-            empty
+            else text "Modules:"
-          else
-            text "Modules:"
               $+$ nest 4 (vcat (map disp . sort . modules $ pkginfo))
           ]
 
@@ -710,6 +708,10 @@ foo = Reflex.runSpiderHost $ ReflexHost.hostApp $ do
   liftIO . forkIO . forever $ getLine >>= inputFire
   ReflexHost.performEvent_ $ fmap (liftIO . putStrLn) inputEvent
 
+#test issue 16
+foldrDesc f z = unSwitchQueue $ \q ->
+  switch (Min.foldrDesc (f unTaggedF) z q) (Min.foldrAsc (f unTaggedF) z q)
+
 
 ###############################################################################
 ###############################################################################

src/Language/Haskell/Brittany/Layouters/Expr.hs

@@ -109,24 +109,36 @@ layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of
     headDoc <- docSharedWrapper layoutExpr headE
     paramDocs <- docSharedWrapper layoutExpr `mapM` paramEs
     docAlt
-      [ docCols ColApp
+      [ -- foo x y
+        docCols ColApp
       $ appSep (docForceSingleline headDoc)
       : spacifyDocs (docForceSingleline <$> paramDocs)
-      , docSeq
+      , -- foo x
+        --     y
+        docSeq
         [ appSep (docForceSingleline headDoc)
         , docSetBaseY
         $ docAddBaseY BrIndentRegular
         $ docLines
-        $ paramDocs
+        $ (docForceSingleline <$> paramDocs)
         ]
-      , docSetParSpacing
+      , -- foo
+        --   x
+        --   y
+        docSetParSpacing
       $ docAddBaseY BrIndentRegular
       $ docPar
         (docForceSingleline headDoc)
         ( docNonBottomSpacing
         $ docLines paramDocs
         )
-      , docAddBaseY BrIndentRegular
+      , -- ( multi
+        --   line
+        --   function
+        -- )
+        --   x
+        --   y
+        docAddBaseY BrIndentRegular
       $ docPar
         headDoc
         ( docNonBottomSpacing
@@ -317,7 +329,8 @@ layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of
     elseExprDoc <- docSharedWrapper layoutExpr elseExpr
     hasComments <- hasAnyCommentsBelow lexpr
     docAltFilter
-      [ (,) (not hasComments)
+      [ -- if _ then _ else _
+        (,) (not hasComments)
       $ docSeq
         [ appSep $ docLit $ Text.pack "if"
         , appSep $ docForceSingleline ifExprDoc
@@ -326,7 +339,20 @@ layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of
         , appSep $ docLit $ Text.pack "else"
         , docForceSingleline elseExprDoc
         ]
-      , (,) True
+      , -- either
+        --   if expr
+        --   then foo
+        --     bar
+        --   else foo
+        --     bar
+        -- or
+        --   if expr
+        --   then
+        --     stuff
+        --   else
+        --     stuff
+        -- note that this has par-spacing
+        (,) True
       $ docSetParSpacing
       $ docAddBaseY BrIndentRegular
       $ docPar
@@ -350,7 +376,24 @@ layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of
               $ docPar (docLit $ Text.pack "else") elseExprDoc
               ]
             ])
-      , (,) True
+      , -- either
+        --   if multi
+        --      line
+        --      condition
+        --   then foo
+        --     bar
+        --   else foo
+        --     bar
+        -- or
+        --   if multi
+        --      line
+        --      condition
+        --   then
+        --     stuff
+        --   else
+        --     stuff
+        -- note that this does _not_ have par-spacing
+        (,) True
       $ docAddBaseY BrIndentRegular
       $ docPar
           ( docAddBaseY (BrIndentSpecial 3)
@@ -374,6 +417,7 @@ layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of
               ]
             ])
       , (,) True
+      $ docSetBaseY
       $ docLines
         [ docAddBaseY (BrIndentSpecial 3)
         $ docSeq

src/Language/Haskell/Brittany/Transformations/Alt.hs

@@ -552,6 +552,11 @@ getSpacings
   -> Memo.MemoT Int [VerticalSpacing] m [VerticalSpacing]
 getSpacings limit bridoc = preFilterLimit <$> rec bridoc
   where
+    -- when we do `take K . filter someCondition` on a list of spacings, we
+    -- need to first (also) limit the size of the input list, otherwise a
+    -- _large_ input with a similarly _large_ prefix not passing our filtering
+    -- process could lead to exponential runtime behaviour.
+    -- TODO: 3 is arbitrary.
     preFilterLimit :: [VerticalSpacing] -> [VerticalSpacing]
     preFilterLimit = take (3*limit)
     memoWithKey :: Memo.MonadMemo k v m1 => k -> m1 v -> m1 v
@@ -565,15 +570,41 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc
               VerticalSpacingParNone -> True
               VerticalSpacingParSome i -> i <= colMax
               VerticalSpacingParAlways{} -> True
-      let filterAndLimit :: [VerticalSpacing] -> [VerticalSpacing]
+      let -- the standard function used to enforce a constant upper bound
+          -- on the number of elements returned for each node. Should be
+          -- 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
+                           -- prune so we always consider a constant
+                           -- amount of spacings per node of the BriDoc.
                          . filter hasOkColCount
-                         . preFilterLimit   -- we need to limit here in case
+                           -- throw out any spacings (i.e. children) that
-                                            -- that the input list is
+                           -- already use more columns than available in
-                                            -- _large_ with a similarly _large_
+                           -- total.
-                                            -- prefix not passing hasOkColCount
+                         . List.nub
-                                            -- predicate.
+                           -- In the end we want to know if there is at least
-                                            -- TODO: 3 is arbitrary.
+                           -- one valid spacing for any alternative.
+                           -- If there are duplicates in the list, then these
+                           -- will either all be valid (so having more than the
+                           -- first is pointless) or all invalid (in which
+                           -- case having any of them is pointless).
+                           -- Nonetheless I think the order of spacings should
+                           -- be preserved as it provides a deterministic
+                           -- choice for which spacings to prune (which is
+                           -- an argument against simly using a Set).
+                           -- I have also considered `fmap head . group` which
+                           -- seems to work similarly well for common cases
+                           -- and which might behave even better when it comes
+                           -- to determinism of the algorithm. But determinism
+                           -- should not be overrated here either - in the end
+                           -- this is about deterministic behaviour of the
+                           -- pruning we do that potentially results in
+                           -- non-optimal layouts, and we'd rather take optimal
+                           -- layouts when we can than take non-optimal layouts
+                           -- just to be consistent with other cases where
+                           -- we'd choose non-optimal layouts.
+                         . preFilterLimit
       result <- case brdc of
         -- BDWrapAnnKey _annKey bd -> rec bd
         BDFEmpty ->

src/Language/Haskell/Brittany/Types.hs

@@ -412,7 +412,7 @@ data VerticalSpacing
     , _vs_paragraph :: !VerticalSpacingPar
     , _vs_parFlag   :: !Bool
     }
-  deriving Show
+  deriving (Eq, Show)
 
 newtype LineModeValidity a = LineModeValidity (Strict.Maybe a)
   deriving (Functor, Applicative, Monad, Show, Alternative)