hexagoxel
/
brittany
1
0
Fork 0
Code Issues 117 Pull Requests 5 Packages Projects Releases 5 Wiki Activity

Improve column aligning; Add config for aligning

pull/3/head
Lennart Spitzner 2016-09-02 00:08:10 +02:00
parent 395fe02644
commit 371fad303d
5 changed files with 100 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
src-unittests/TestUtils.hs
View File

@ -48,6 +48,7 @@ defaultTestConfig = Config
, _lconfig_indentListSpecial = coerce True
, _lconfig_importColumn = coerce (60 :: Int)
, _lconfig_altChooser = coerce $ AltChooserBoundedSearch 3
, _lconfig_columnAlignMode = coerce ColumnAlignModeUnanimously
}
, _conf_errorHandling = _conf_errorHandling staticDefaultConfig
, _conf_forward = ForwardOptions

83
src/Language/Haskell/Brittany/BriLayouter.hs
View File

@ -1517,17 +1517,35 @@ layoutBriDocM = \case
-- (colInfos, finalState) = StateS.runState (mergeBriDocs l) (ColBuildState IntMapS.empty 0)
alignColsLines :: [BriDoc]
-> m ()
alignColsLines l = do -- colInfos `forM_` \colInfo -> do
alignColsLines bridocs = do -- colInfos `forM_` \colInfo -> do
curX <- do
state <- mGet
return $ either id (const 0) (_lstate_curYOrAddNewline state)
+ fromMaybe 0 (_lstate_addSepSpace state)
colMax <- mAsk <&> _conf_layout .> _lconfig_cols .> confUnpack
sequence_ $ List.intersperse layoutWriteEnsureNewlineBlock $ colInfos <&> processInfo colMax (_cbs_map finalState)
sequence_ $ List.intersperse layoutWriteEnsureNewlineBlock
$ colInfos <&> processInfo (processedMap curX colMax)
where
(colInfos, finalState) = StateS.runState (mergeBriDocs l) (ColBuildState IntMapS.empty 0)
(colInfos, finalState) = StateS.runState (mergeBriDocs bridocs)
(ColBuildState IntMapS.empty 0)
processedMap :: Int -> Int -> ColMap2
processedMap curX colMax =
_cbs_map finalState <&> \colss ->
let maxCols = Foldable.foldl1 (zipWith max) colss
(_, posXs) = mapAccumL (\acc x -> (acc+x,acc)) curX maxCols
counter count l =
if List.last posXs + List.last l <=colMax
then count + 1
else count
ratio = fromIntegral (foldl counter (0::Int) colss)
/ fromIntegral (length colss)
in (ratio, maxCols, colss)
briDocToColInfo :: BriDoc -> StateS.State ColBuildState ColInfo
briDocToColInfo = \case
BDCols sig list -> withAlloc $ \ind -> do
subInfos <- mapM briDocToColInfo list
let lengths = briDocLineLength <$> list
return $ (lengths, ColInfo ind sig (zip lengths subInfos))
return $ (Seq.singleton lengths, ColInfo ind sig (zip lengths subInfos))
bd -> return $ ColInfoNo bd
mergeBriDocs :: [BriDoc] -> StateS.State ColBuildState [ColInfo]
@ -1558,14 +1576,14 @@ layoutBriDocM = \case
let (Just spaces) = IntMapS.lookup infoInd m
StateS.put s
{ _cbs_map = IntMapS.insert infoInd
(zipWith max spaces curLengths)
(spaces Seq.|> curLengths)
m
}
return $ ColInfo infoInd colSig (zip curLengths infos)
| otherwise -> briDocToColInfo bd
bd -> return $ ColInfoNo bd
withAlloc :: (ColIndex -> StateS.State ColBuildState (ColSpace, ColInfo))
withAlloc :: (ColIndex -> StateS.State ColBuildState (ColSpaces, ColInfo))
-> StateS.State ColBuildState ColInfo
withAlloc f = do
cbs <- StateS.get
@ -1576,18 +1594,20 @@ layoutBriDocM = \case
$ c { _cbs_map = IntMapS.insert ind space $ _cbs_map c }
return info
processInfo :: Int -> ColMap -> ColInfo -> m ()
processInfo colMax m = \case
processInfo :: ColMap2 -> ColInfo -> m ()
processInfo m = \case
ColInfoStart -> error "should not happen (TM)"
ColInfoNo doc -> layoutBriDocM doc
ColInfo ind _ list -> do
colMax <- mAsk <&> _conf_layout .> _lconfig_cols .> confUnpack
alignMode <- mAsk <&> _conf_layout .> _lconfig_columnAlignMode .> confUnpack
curX <- do
state <- mGet
return $ either id (const 0) (_lstate_curYOrAddNewline state)
+ fromMaybe 0 (_lstate_addSepSpace state)
-- tellDebugMess $ show curX
let Just cols = IntMapS.lookup ind m
let (maxX, posXs) = (mapAccumL (\acc x -> (acc+x,acc)) curX cols)
let Just (ratio, maxCols, _colss) = IntMapS.lookup ind m
let (maxX, posXs) = mapAccumL (\acc x -> (acc+x,acc)) curX maxCols
-- handle the cases that the vertical alignment leads to more than max
-- cols:
-- this is not a full fix, and we must correct individually in addition.
@ -1596,37 +1616,46 @@ layoutBriDocM = \case
-- sizes in such a way that it works _if_ we have sizes (*factor)
-- in each column. but in that line, in the last column, we will be
-- forced to occupy the full vertical space, not reduced by any factor.
let fixedPosXs = if maxX>colMax
then let
let fixedPosXs = case alignMode of
ColumnAlignModeAnimouslyScale i | maxX>colMax -> fixed <&> (+curX)
where
factor :: Float =
-- 0.0001 as an offering to the floating point gods.
min 1.0001 ( fromIntegral (10 + colMax - curX) -- TODO: remove arbitrary 10..
min 1.0001 ( fromIntegral (i + colMax - curX)
/ fromIntegral (maxX - curX)
)
offsets = (subtract curX) <$> posXs
fixed = offsets <&> fromIntegral .> (*factor) .> truncate
in fixed <&> (+curX)
else posXs
-- fixing overflows, act II.
if List.last fixedPosXs + fst (List.last list) > colMax
then -- we are doomed. there is no space in the world for us.
-- or our children.
list `forM_` (snd .> processInfoIgnore)
-- we COULD do some fancy put-as-much-to-the-right-as-possible
-- here. could. dunno if that would look good even, though.
else zip fixedPosXs list `forM_` \(destX, x) -> do
_ -> posXs
let alignAct = zip fixedPosXs list `forM_` \(destX, x) -> do
layoutWriteEnsureAbsoluteN destX
processInfo colMax m (snd x)
processInfo m (snd x)
noAlignAct = list `forM_` (snd .> processInfoIgnore)
animousAct =
-- per-item check if there is overflowing.
if List.last fixedPosXs + fst (List.last list) > colMax
then noAlignAct
else alignAct
case alignMode of
ColumnAlignModeDisabled -> noAlignAct
ColumnAlignModeUnanimously | maxX<=colMax -> alignAct
ColumnAlignModeUnanimously -> noAlignAct
ColumnAlignModeMajority limit | ratio>=limit -> animousAct
ColumnAlignModeMajority{} -> noAlignAct
ColumnAlignModeAnimouslyScale{} -> animousAct
ColumnAlignModeAnimously -> animousAct
ColumnAlignModeAlways -> alignAct
processInfoIgnore :: ColInfo -> m ()
processInfoIgnore = \case
ColInfoStart -> error "should not happen (TM)"
ColInfoNo doc -> layoutBriDocM doc
ColInfo _ _ list -> list `forM_` (snd .> processInfoIgnore)
type ColIndex = Int
type ColSpace = [Int]
type ColMap = IntMapS.IntMap {- ColIndex -} ColSpace
type ColSpaces = Seq [Int]
type ColMap1 = IntMapS.IntMap {- ColIndex -} ColSpaces
type ColMap2 = IntMapS.IntMap {- ColIndex -} (Float, ColSpace, ColSpaces)
data ColInfo
= ColInfoStart -- start value to begin the mapAccumL.
@ -1634,6 +1663,6 @@ data ColInfo
| ColInfo ColIndex ColSig [(Int, ColInfo)]
data ColBuildState = ColBuildState
{ _cbs_map :: ColMap
{ _cbs_map :: ColMap1
, _cbs_index :: ColIndex
}

1
src/Language/Haskell/Brittany/Config.hs
View File

@ -119,6 +119,7 @@ configParser = do
, _lconfig_indentListSpecial = mempty -- falseToNothing _
, _lconfig_importColumn = optionConcat importCol
, _lconfig_altChooser = mempty
, _lconfig_columnAlignMode = mempty
}
, _conf_errorHandling = ErrorHandlingConfig
{ _econf_produceOutputOnErrors = wrapLast $ falseToNothing outputOnErrors

32
src/Language/Haskell/Brittany/Config/Types.hs
View File

@ -53,6 +53,7 @@ data LayoutConfigF f = LayoutConfig
-- multi-line list literals.
, _lconfig_importColumn :: f (Last Int)
, _lconfig_altChooser :: f (Last AltChooser)
, _lconfig_columnAlignMode :: f (Last ColumnAlignMode)
}
deriving (Generic)
@ -132,6 +133,8 @@ instance FromJSON IndentPolicy
instance ToJSON IndentPolicy
instance FromJSON AltChooser
instance ToJSON AltChooser
instance FromJSON ColumnAlignMode
instance ToJSON ColumnAlignMode
instance FromJSON CPPMode
instance ToJSON CPPMode
@ -192,6 +195,29 @@ data AltChooser = AltChooserSimpleQuick -- always choose last alternative.
-- options having sufficient space.
deriving (Show, Generic, Data)
data ColumnAlignMode
= ColumnAlignModeDisabled
-- ^ Make no column alignments whatsoever
| ColumnAlignModeUnanimously
-- ^ Make column alignments only if it does not cause overflow for any of
-- the affected lines.
| ColumnAlignModeMajority Float
-- ^ If at least (ratio::Float) of the aligned elements have sufficient
-- space for the alignment, act like ColumnAlignModeAnimously; otherwise
-- act like ColumnAlignModeDisabled.
| ColumnAlignModeAnimouslyScale Int
-- ^ Scale back columns to some degree if their sum leads to overflow.
-- This is done in a linear fashion.
-- The Int specifies additional columns to be added to column maximum for
-- scaling calculation purposes.
| ColumnAlignModeAnimously
-- ^ Decide on a case-by-case basis if alignment would cause overflow.
-- If it does, cancel all alignments for this (nested) column description.
-- ColumnAlignModeAnimouslySome -- potentially to implement
| ColumnAlignModeAlways
-- ^ Always respect column alignments, even if it makes stuff overflow.
deriving (Show, Generic, Data)
data CPPMode = CPPModeAbort -- abort program on seeing -XCPP
| CPPModeWarn -- warn about CPP and non-roundtripping in its
-- presence.
@ -222,6 +248,7 @@ staticDefaultConfig = Config
, _lconfig_indentListSpecial = coerce True
, _lconfig_importColumn = coerce (60 :: Int)
, _lconfig_altChooser = coerce (AltChooserBoundedSearch 3)
, _lconfig_columnAlignMode = coerce (ColumnAlignModeMajority 0.7)
}
, _conf_errorHandling = ErrorHandlingConfig
{ _econf_produceOutputOnErrors = coerce False
@ -255,8 +282,8 @@ instance CZip DebugConfigF where
(f x11 y11)
instance CZip LayoutConfigF where
cZip f (LayoutConfig x1 x2 x3 x4 x5 x6 x7)
(LayoutConfig y1 y2 y3 y4 y5 y6 y7) = LayoutConfig
cZip f (LayoutConfig x1 x2 x3 x4 x5 x6 x7 x8)
(LayoutConfig y1 y2 y3 y4 y5 y6 y7 y8) = LayoutConfig
(f x1 y1)
(f x2 y2)
(f x3 y3)
@ -264,6 +291,7 @@ instance CZip LayoutConfigF where
(f x5 y5)
(f x6 y6)
(f x7 y7)
(f x8 y8)
instance CZip ErrorHandlingConfigF where
cZip f (ErrorHandlingConfig x1 x2 x3)