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

Apply brittany to `layoutBriDocM`

pull/35/head
Lennart Spitzner 2017-05-17 21:38:50 +02:00
parent 6448ee780a
commit 56e53a9cbb
1 changed files with 257 additions and 228 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

139
src/Language/Haskell/Brittany/Backend.hs
View File

@ -171,8 +171,7 @@ layoutBriDocM = \case
indentF $ do
layoutWriteNewlineBlock
layoutBriDocM indented
BDLines lines ->
alignColsLines lines
BDLines lines -> alignColsLines lines
BDAlt [] -> error "empty BDAlt"
BDAlt (alt:_) -> layoutBriDocM alt
BDForceMultiline bd -> layoutBriDocM bd
@ -183,7 +182,11 @@ layoutBriDocM = \case
tlineCount = length tlines
anns :: ExactPrint.Anns <- mAsk
when shouldAddComment $ do
layoutWriteAppend $ Text.pack $ "{-" ++ show (annKey, Map.lookup annKey anns) ++ "-}"
layoutWriteAppend
$ Text.pack
$ "{-"
++ show (annKey, Map.lookup annKey anns)
++ "-}"
zip [1 ..] tlines `forM_` \(i, l) -> do
layoutWriteAppend $ l
unless (i == tlineCount) layoutWriteNewlineBlock
@ -191,8 +194,7 @@ layoutBriDocM = \case
state <- mGet
let filterF k _ = not $ k `Set.member` subKeys
mSet $ state
{ _lstate_comments = Map.filterWithKey filterF
$ _lstate_comments state
{ _lstate_comments = Map.filterWithKey filterF $ _lstate_comments state
}
BDAnnotationPrior annKey bd -> do
state <- mGet
@ -202,8 +204,10 @@ layoutBriDocM = \case
mAnn <- do
let mAnn = ExactPrint.annPriorComments <$> Map.lookup annKey m
mSet $ state
{ _lstate_comments =
Map.adjust (\ann -> ann { ExactPrint.annPriorComments = [] }) annKey m
{ _lstate_comments = Map.adjust
(\ann -> ann { ExactPrint.annPriorComments = [] })
annKey
m
}
return mAnn
case mAnn of
@ -211,9 +215,9 @@ layoutBriDocM = \case
Just [] -> when allowMTEL $ moveToExactAnn annKey
Just priors -> do
-- layoutResetSepSpace
priors `forM_` \( ExactPrint.Types.Comment comment _ _
, ExactPrint.Types.DP (y, x)
) -> do
priors
`forM_` \(ExactPrint.Types.Comment comment _ _, ExactPrint.Types.DP (y, x)) ->
do
-- evil hack for CPP:
case comment of
('#':_) -> layoutMoveToCommentPos y (-999)
@ -233,8 +237,8 @@ layoutBriDocM = \case
let mAnn = ExactPrint.annsDP <$> Map.lookup annKey m
let mToSpan = case mAnn of
Just anns | keyword == Nothing -> Just anns
Just ((ExactPrint.Types.G kw1, _):annR)
| keyword==Just kw1 -> Just annR
Just ((ExactPrint.Types.G kw1, _):annR) | keyword == Just kw1 -> Just
annR
_ -> Nothing
case mToSpan of
Just anns -> do
@ -242,16 +246,17 @@ layoutBriDocM = \case
(ExactPrint.Types.AnnComment x, dp) -> Just (x, dp)
_ -> Nothing
mSet $ state
{ _lstate_comments =
Map.adjust (\ann -> ann { ExactPrint.annsDP = rest })
{ _lstate_comments = Map.adjust
(\ann -> ann { ExactPrint.annsDP = rest })
annKey
m
}
return $ [ comments | not $ null comments ]
_ -> return Nothing
forM_ mAnn $ mapM_ $ \( ExactPrint.Types.Comment comment _ _
, ExactPrint.Types.DP (y, x)
) -> do
forM_ mAnn
$ mapM_
$ \(ExactPrint.Types.Comment comment _ _, ExactPrint.Types.DP (y, x)) ->
do
-- evil hack for CPP:
case comment of
('#':_) -> layoutMoveToCommentPos y (-999)
@ -268,8 +273,8 @@ layoutBriDocM = \case
let m = _lstate_comments state
let mAnn = extractAllComments <$> Map.lookup annKey m
mSet $ state
{ _lstate_comments =
Map.adjust (\ann -> ann { ExactPrint.annFollowingComments = []
{ _lstate_comments = Map.adjust
( \ann -> ann { ExactPrint.annFollowingComments = []
, ExactPrint.annPriorComments = []
, ExactPrint.annsDP = []
}
@ -278,9 +283,10 @@ layoutBriDocM = \case
m
}
return mAnn
forM_ mAnn $ mapM_ $ \( ExactPrint.Types.Comment comment _ _
, ExactPrint.Types.DP (y, x)
) -> do
forM_ mAnn
$ mapM_
$ \(ExactPrint.Types.Comment comment _ _, ExactPrint.Types.DP (y, x)) ->
do
-- evil hack for CPP:
case comment of
('#':_) -> layoutMoveToCommentPos y (-999)
@ -324,18 +330,22 @@ layoutBriDocM = \case
alignColsLines bridocs = do -- colInfos `forM_` \colInfo -> do
curX <- do
state <- mGet
return $ either id (const 0) (_lstate_curYOrAddNewline state)
+ fromMaybe 0 (_lstate_addSepSpace state)
return $ either id (const 0) (_lstate_curYOrAddNewline state) + fromMaybe
0
(_lstate_addSepSpace state)
colMax <- mAsk <&> _conf_layout .> _lconfig_cols .> confUnpack
alignMax <- mAsk <&> _conf_layout .> _lconfig_alignmentLimit .> confUnpack
alignBreak <- mAsk <&> _conf_layout .> _lconfig_alignmentBreakOnMultiline .> confUnpack
alignBreak <-
mAsk <&> _conf_layout .> _lconfig_alignmentBreakOnMultiline .> confUnpack
case () of
_ ->
sequence_ $ List.intersperse layoutWriteEnsureNewlineBlock
$ colInfos <&> processInfo processedMap
sequence_
$ List.intersperse layoutWriteEnsureNewlineBlock
$ colInfos
<&> processInfo processedMap
where
(colInfos, finalState) = StateS.runState (mergeBriDocs bridocs)
(ColBuildState IntMapS.empty 0)
(colInfos, finalState) =
StateS.runState (mergeBriDocs bridocs) (ColBuildState IntMapS.empty 0)
-- maxZipper :: [Int] -> [Int] -> [Int]
-- maxZipper [] ys = ys
-- maxZipper xs [] = xs
@ -344,12 +354,15 @@ layoutBriDocM = \case
colAggregation xs = maximum [ x | x <- xs, x < minimum xs + alignMax ]
processedMap :: ColMap2
processedMap = fix $ \result ->
_cbs_map finalState <&> \(lastFlag, colSpacingss) ->
let colss = colSpacingss <&> \spss -> case reverse spss of
processedMap =
fix $ \result -> _cbs_map finalState <&> \(lastFlag, colSpacingss) ->
let
colss = colSpacingss <&> \spss -> case reverse spss of
[] -> []
(xN:xR) -> reverse
$ (if lastFlag then fLast else fInit) xN : fmap fInit xR
(xN:xR) ->
reverse $ (if lastFlag then fLast else fInit) xN : fmap
fInit
xR
where
fLast (ColumnSpacingLeaf len ) = len
fLast (ColumnSpacingRef len _) = len
@ -360,36 +373,43 @@ layoutBriDocM = \case
maxCols = {-Foldable.foldl1 maxZipper-}
fmap colAggregation $ transpose $ Foldable.toList colss
(_, posXs) = mapAccumL (\acc x -> (acc + x, acc)) curX maxCols
counter count l =
if List.last posXs + List.last l <=colMax
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)
in
(ratio, maxCols, colss)
mergeBriDocs :: [BriDoc] -> StateS.State ColBuildState [ColInfo]
mergeBriDocs bds = mergeBriDocsW ColInfoStart bds
mergeBriDocsW :: ColInfo -> [BriDoc] -> StateS.State ColBuildState [ColInfo]
mergeBriDocsW
:: ColInfo -> [BriDoc] -> StateS.State ColBuildState [ColInfo]
mergeBriDocsW _ [] = return []
mergeBriDocsW lastInfo (bd:bdr) = do
info <- mergeInfoBriDoc True lastInfo bd
infor <- mergeBriDocsW (if alignBreak && briDocIsMultiLine bd then ColInfoStart else info) bdr
infor <- mergeBriDocsW
(if alignBreak && briDocIsMultiLine bd then ColInfoStart else info)
bdr
return $ info : infor
mergeInfoBriDoc :: Bool
mergeInfoBriDoc
:: Bool
-> ColInfo
-> BriDoc
-> StateS.StateT ColBuildState Identity ColInfo
mergeInfoBriDoc lastFlag ColInfoStart = briDocToColInfo lastFlag
mergeInfoBriDoc lastFlag ColInfoNo{} = briDocToColInfo lastFlag
mergeInfoBriDoc lastFlag (ColInfo infoInd infoSig subLengthsInfos) = \case
mergeInfoBriDoc lastFlag (ColInfo infoInd infoSig subLengthsInfos) =
\case
brdc@(BDCols colSig subDocs)
| infoSig == colSig
&& length subLengthsInfos == length subDocs -> do
let isLastList =
if lastFlag then (== length subDocs) <$> [1..] else repeat False
| infoSig == colSig && length subLengthsInfos == length subDocs
-> do
let
isLastList = if lastFlag
then (==length subDocs) <$> [1 ..]
else repeat False
infos <- zip3 isLastList (snd <$> subLengthsInfos) subDocs
`forM` \(lf, info, bd) -> mergeInfoBriDoc lf info bd
let curLengths = briDocLineLength <$> subDocs
@ -399,12 +419,14 @@ layoutBriDocM = \case
let m = _cbs_map s
let (Just (_, spaces)) = IntMapS.lookup infoInd m
StateS.put s
{ _cbs_map = IntMapS.insert infoInd
{ _cbs_map = IntMapS.insert
infoInd
(lastFlag, spaces Seq.|> trueSpacings)
m
}
return $ ColInfo infoInd colSig (zip curLengths infos)
| otherwise -> briDocToColInfo lastFlag brdc
| otherwise
-> briDocToColInfo lastFlag brdc
brdc -> return $ ColInfoNo brdc
briDocToColInfo :: Bool -> BriDoc -> StateS.State ColBuildState ColInfo
@ -423,8 +445,11 @@ layoutBriDocM = \case
(len, ColInfo i _ _) -> ColumnSpacingRef len i
(len, _ ) -> ColumnSpacingLeaf len
withAlloc :: Bool
-> (ColIndex -> StateS.State ColBuildState (ColumnBlocks ColumnSpacing, ColInfo))
withAlloc
:: Bool
-> ( ColIndex
-> StateS.State ColBuildState (ColumnBlocks ColumnSpacing, ColInfo)
)
-> StateS.State ColBuildState ColInfo
withAlloc lastFlag f = do
cbs <- StateS.get
@ -441,10 +466,12 @@ layoutBriDocM = \case
ColInfoNo doc -> layoutBriDocM doc
ColInfo ind _ list -> do
colMax <- mAsk <&> _conf_layout .> _lconfig_cols .> confUnpack
alignMode <- mAsk <&> _conf_layout .> _lconfig_columnAlignMode .> confUnpack
alignMode <-
mAsk <&> _conf_layout .> _lconfig_columnAlignMode .> confUnpack
curX <- do
state <- mGet
return $ either id (const 0) (_lstate_curYOrAddNewline state)
return
$ either id (const 0) (_lstate_curYOrAddNewline state)
+ fromMaybe 0 (_lstate_addSepSpace state)
-- tellDebugMess $ show curX
let Just (ratio, maxCols, _colss) = IntMapS.lookup ind m
@ -457,14 +484,15 @@ 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 = case alignMode of
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 (i + colMax - curX)
/ fromIntegral (maxX - curX)
)
min
1.0001
(fromIntegral (i + colMax - curX) / fromIntegral (maxX - curX))
offsets = (subtract curX) <$> posXs
fixed = offsets <&> fromIntegral .> (*factor) .> truncate
_ -> posXs
@ -486,6 +514,7 @@ layoutBriDocM = \case
ColumnAlignModeAnimouslyScale{} -> animousAct
ColumnAlignModeAnimously -> animousAct
ColumnAlignModeAlways -> alignAct
processInfoIgnore :: ColInfo -> m ()
processInfoIgnore = \case
ColInfoStart -> error "should not happen (TM)"