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".pull/35/head
Lennart Spitzner
parent
19a05d01c4
commit
a7e4bdc168
|
|
@ -690,10 +690,8 @@ showPackageDetailedInfo pkginfo =
|
|||
, entry "Documentation" haddockHtml showIfInstalled text
|
||||
, entry "Cached" haveTarball alwaysShow dispYesNo
|
||||
, if not (hasLib pkginfo)
|
||||
then
|
||||
empty
|
||||
else
|
||||
text "Modules:"
|
||||
then empty
|
||||
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)
|
||||
|
||||
|
||||
###############################################################################
|
||||
###############################################################################
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
-- that the input list is
|
||||
-- _large_ with a similarly _large_
|
||||
-- prefix not passing hasOkColCount
|
||||
-- predicate.
|
||||
-- TODO: 3 is arbitrary.
|
||||
-- throw out any spacings (i.e. children) that
|
||||
-- already use more columns than available in
|
||||
-- total.
|
||||
. List.nub
|
||||
-- In the end we want to know if there is at least
|
||||
-- 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 ->
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
Loading…
Reference in New Issue