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

Hack away Backend

mxxun/ghc-9.2
mrkun 2022-01-30 16:02:59 +03:00
parent 494a0ba09a
commit 2535f82d82
2 changed files with 80 additions and 76 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

154
source/library/Language/Haskell/Brittany/Internal/Backend.hs
View File

@ -66,7 +66,7 @@ data ColBuildState = ColBuildState
type LayoutConstraints m type LayoutConstraints m
= ( MonadMultiReader Config m = ( MonadMultiReader Config m
, MonadMultiReader ExactPrint.Types.Anns m -- , MonadMultiReader ExactPrint.Types.Anns m
, MonadMultiWriter Text.Builder.Builder m , MonadMultiWriter Text.Builder.Builder m
, MonadMultiWriter (Seq String) m , MonadMultiWriter (Seq String) m
, MonadMultiState LayoutState m , MonadMultiState LayoutState m
@ -138,12 +138,12 @@ layoutBriDocM = \case
let let
tlines = Text.lines $ t <> Text.pack "\n" tlines = Text.lines $ t <> Text.pack "\n"
tlineCount = length tlines tlineCount = length tlines
anns :: ExactPrint.Anns <- mAsk -- anns <- mAsk
when shouldAddComment $ do when shouldAddComment $ do
layoutWriteAppend layoutWriteAppend
$ Text.pack $ Text.pack
$ "{-" $ "{-"
++ show (annKey, Map.lookup annKey anns) ++ show (annKey, Map.lookup annKey {-anns-} undefined :: Maybe String)
++ "-}" ++ "-}"
zip [1 ..] tlines `forM_` \(i, l) -> do zip [1 ..] tlines `forM_` \(i, l) -> do
layoutWriteAppend $ l layoutWriteAppend $ l
@ -152,7 +152,7 @@ layoutBriDocM = \case
state <- mGet state <- mGet
let filterF k _ = not $ k `Set.member` subKeys let filterF k _ = not $ k `Set.member` subKeys
mSet $ state mSet $ state
{ _lstate_comments = Map.filterWithKey filterF $ _lstate_comments state { _lstate_comments = undefined -- Map.filterWithKey filterF $ _lstate_comments state
} }
BDPlain t -> do BDPlain t -> do
layoutWriteAppend t layoutWriteAppend t
@ -162,12 +162,12 @@ layoutBriDocM = \case
let let
moveToExactLocationAction = case _lstate_curYOrAddNewline state of moveToExactLocationAction = case _lstate_curYOrAddNewline state of
Left{} -> pure () Left{} -> pure ()
Right{} -> moveToExactAnn annKey Right{} -> undefined -- moveToExactAnn annKey
mAnn <- do mAnn <- do
let mAnn = ExactPrint.annPriorComments <$> Map.lookup annKey m let mAnn = {-ExactPrint.annPriorComments-} undefined <$> Map.lookup annKey m
mSet $ state mSet $ state
{ _lstate_comments = Map.adjust { _lstate_comments = Map.adjust
(\ann -> ann { ExactPrint.annPriorComments = [] }) (\ann -> ann {- ExactPrint.annPriorComments = [] -})
annKey annKey
m m
} }
@ -177,20 +177,20 @@ layoutBriDocM = \case
Just [] -> moveToExactLocationAction Just [] -> moveToExactLocationAction
Just priors -> do Just priors -> do
-- layoutResetSepSpace -- layoutResetSepSpace
priors -- priors
`forM_` \(ExactPrint.Types.Comment comment _ _, ExactPrint.Types.DP (y, x)) -> -- `forM_` \(ExactPrint.Types.Comment comment _ _, ExactPrint.Types.DP (y, x)) ->
when (comment /= "(" && comment /= ")") $ do -- when (comment /= "(" && comment /= ")") $ do
let commentLines = Text.lines $ Text.pack $ comment -- let commentLines = Text.lines $ Text.pack $ comment
case comment of -- case comment of
('#' : _) -> -- ('#' : _) ->
layoutMoveToCommentPos y (-999) (length commentLines) -- layoutMoveToCommentPos y (-999) (length commentLines)
-- ^ evil hack for CPP -- -- ^ evil hack for CPP
_ -> layoutMoveToCommentPos y x (length commentLines) -- _ -> layoutMoveToCommentPos y x (length commentLines)
-- fixedX <- fixMoveToLineByIsNewline x -- -- fixedX <- fixMoveToLineByIsNewline x
-- replicateM_ fixedX layoutWriteNewline -- -- replicateM_ fixedX layoutWriteNewline
-- layoutMoveToIndentCol y -- -- layoutMoveToIndentCol y
layoutWriteAppendMultiline commentLines -- layoutWriteAppendMultiline commentLines
-- mModify $ \s -> s { _lstate_curYOrAddNewline = Right 0 } -- -- mModify $ \s -> s { _lstate_curYOrAddNewline = Right 0 }
moveToExactLocationAction moveToExactLocationAction
layoutBriDocM bd layoutBriDocM bd
BDAnnotationKW annKey keyword bd -> do BDAnnotationKW annKey keyword bd -> do
@ -198,22 +198,22 @@ layoutBriDocM = \case
mComments <- do mComments <- do
state <- mGet state <- mGet
let m = _lstate_comments state let m = _lstate_comments state
let mAnn = ExactPrint.annsDP <$> Map.lookup annKey m let mAnn = {-ExactPrint.annsDP-} undefined <$> Map.lookup annKey m
let let
mToSpan = case mAnn of mToSpan = case mAnn of
Just anns | Maybe.isNothing keyword -> Just anns Just anns | Maybe.isNothing keyword -> Just anns
Just ((ExactPrint.Types.G kw1, _) : annR) | keyword == Just kw1 -> -- Just ((ExactPrint.Types.G kw1, _) : annR) | keyword == Just kw1 ->
Just annR -- Just annR
_ -> Nothing _ -> Nothing
case mToSpan of case mToSpan of
Just anns -> do Just anns -> do
let let
(comments, rest) = flip spanMaybe anns $ \case (comments, rest) = flip spanMaybe anns $ \case
(ExactPrint.Types.AnnComment x, dp) -> Just (x, dp) -- (ExactPrint.Types.AnnComment x, dp) -> Just (x, dp)
_ -> Nothing _ -> Nothing
mSet $ state mSet $ state
{ _lstate_comments = Map.adjust { _lstate_comments = Map.adjust
(\ann -> ann { ExactPrint.annsDP = rest }) (\ann -> ann {- ExactPrint.annsDP = rest -})
annKey annKey
m m
} }
@ -221,21 +221,22 @@ layoutBriDocM = \case
_ -> return Nothing _ -> return Nothing
case mComments of case mComments of
Nothing -> pure () Nothing -> pure ()
Just comments -> do Just comments -> undefined
comments -- do
`forM_` \(ExactPrint.Types.Comment comment _ _, ExactPrint.Types.DP (y, x)) -> -- comments
when (comment /= "(" && comment /= ")") $ do -- `forM_` \(ExactPrint.Types.Comment comment _ _, ExactPrint.Types.DP (y, x)) ->
let commentLines = Text.lines $ Text.pack $ comment -- when (comment /= "(" && comment /= ")") $ do
-- evil hack for CPP: -- let commentLines = Text.lines $ Text.pack $ comment
case comment of -- -- evil hack for CPP:
('#' : _) -> -- case comment of
layoutMoveToCommentPos y (-999) (length commentLines) -- ('#' : _) ->
_ -> layoutMoveToCommentPos y x (length commentLines) -- layoutMoveToCommentPos y (-999) (length commentLines)
-- fixedX <- fixMoveToLineByIsNewline x -- _ -> layoutMoveToCommentPos y x (length commentLines)
-- replicateM_ fixedX layoutWriteNewline -- -- fixedX <- fixMoveToLineByIsNewline x
-- layoutMoveToIndentCol y -- -- replicateM_ fixedX layoutWriteNewline
layoutWriteAppendMultiline commentLines -- -- layoutMoveToIndentCol y
-- mModify $ \s -> s { _lstate_curYOrAddNewline = Right 0 } -- layoutWriteAppendMultiline commentLines
-- -- mModify $ \s -> s { _lstate_curYOrAddNewline = Right 0 }
BDAnnotationRest annKey bd -> do BDAnnotationRest annKey bd -> do
layoutBriDocM bd layoutBriDocM bd
annMay <- do annMay <- do
@ -247,7 +248,7 @@ layoutBriDocM = \case
semiCount = length semiCount = length
[ () [ ()
| Just ann <- [annMay] | Just ann <- [annMay]
, (ExactPrint.Types.AnnSemiSep, _) <- ExactPrint.Types.annsDP ann -- , (ExactPrint.Types.AnnSemiSep, _) <- ExactPrint.Types.annsDP ann
] ]
shouldAddSemicolonNewlines <- shouldAddSemicolonNewlines <-
mAsk mAsk
@ -257,12 +258,12 @@ layoutBriDocM = \case
mModify $ \state -> state mModify $ \state -> state
{ _lstate_comments = Map.adjust { _lstate_comments = Map.adjust
(\ann -> ann (\ann -> ann
{ ExactPrint.annFollowingComments = [] -- { ExactPrint.annFollowingComments = []
, ExactPrint.annPriorComments = [] -- , ExactPrint.annPriorComments = []
, ExactPrint.annsDP = flip filter (ExactPrint.annsDP ann) $ \case -- , ExactPrint.annsDP = flip filter (ExactPrint.annsDP ann) $ \case
(ExactPrint.Types.AnnComment{}, _) -> False -- (ExactPrint.Types.AnnComment{}, _) -> False
_ -> True -- _ -> True
} -- }
) )
annKey annKey
(_lstate_comments state) (_lstate_comments state)
@ -271,41 +272,44 @@ layoutBriDocM = \case
Nothing -> do Nothing -> do
when shouldAddSemicolonNewlines $ do when shouldAddSemicolonNewlines $ do
[1 .. semiCount] `forM_` const layoutWriteNewline [1 .. semiCount] `forM_` const layoutWriteNewline
Just comments -> do Just comments -> undefined
comments -- do
`forM_` \(ExactPrint.Types.Comment comment _ _, ExactPrint.Types.DP (y, x)) -> -- comments
when (comment /= "(" && comment /= ")") $ do -- `forM_` \(ExactPrint.Types.Comment comment _ _, ExactPrint.Types.DP (y, x)) ->
let commentLines = Text.lines $ Text.pack comment -- when (comment /= "(" && comment /= ")") $ do
case comment of -- let commentLines = Text.lines $ Text.pack comment
('#' : _) -> layoutMoveToCommentPos y (-999) 1 -- case comment of
-- ^ evil hack for CPP -- ('#' : _) -> layoutMoveToCommentPos y (-999) 1
")" -> pure () -- -- ^ evil hack for CPP
-- ^ fixes the formatting of parens -- ")" -> pure ()
-- on the lhs of type alias defs -- -- ^ fixes the formatting of parens
_ -> layoutMoveToCommentPos y x (length commentLines) -- -- on the lhs of type alias defs
-- fixedX <- fixMoveToLineByIsNewline x -- _ -> layoutMoveToCommentPos y x (length commentLines)
-- replicateM_ fixedX layoutWriteNewline -- -- fixedX <- fixMoveToLineByIsNewline x
-- layoutMoveToIndentCol y -- -- replicateM_ fixedX layoutWriteNewline
layoutWriteAppendMultiline commentLines -- -- layoutMoveToIndentCol y
-- mModify $ \s -> s { _lstate_curYOrAddNewline = Right 0 } -- layoutWriteAppendMultiline commentLines
-- -- mModify $ \s -> s { _lstate_curYOrAddNewline = Right 0 }
BDMoveToKWDP annKey keyword shouldRestoreIndent bd -> do BDMoveToKWDP annKey keyword shouldRestoreIndent bd -> do
mDP <- do mDP <- do
state <- mGet state <- mGet
let m = _lstate_comments state let m = _lstate_comments state
let mAnn = ExactPrint.annsDP <$> Map.lookup annKey m -- let mAnn = ExactPrint.annsDP <$> Map.lookup annKey m
let let
relevant = relevant = undefined
[ dp -- [ dp
| Just ann <- [mAnn] -- | Just ann <- [mAnn]
, (ExactPrint.Types.G kw1, dp) <- ann -- -- , (ExactPrint.Types.G kw1, dp) <- ann
, keyword == kw1
] -- , keyword == kw1
-- ]
-- mTell $ Seq.fromList [show keyword, "KWDP: " ++ show annKey ++ " " ++ show mAnn, show relevant] -- mTell $ Seq.fromList [show keyword, "KWDP: " ++ show annKey ++ " " ++ show mAnn, show relevant]
case relevant of case relevant of
[] -> pure Nothing [] -> pure Nothing
(ExactPrint.Types.DP (y, x) : _) -> do _ -> pure undefined
mSet state { _lstate_commentNewlines = 0 } -- (ExactPrint.Types.DP (y, x) : _) -> do
pure $ Just (y - _lstate_commentNewlines state, x) -- mSet state { _lstate_commentNewlines = 0 }
-- pure $ Just (y - _lstate_commentNewlines state, x)
case mDP of case mDP of
Nothing -> pure () Nothing -> pure ()
Just (y, x) -> Just (y, x) ->

2
source/library/Language/Haskell/Brittany/Internal/Types.hs
View File

@ -27,7 +27,7 @@ import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint.Types
-- import Language.Haskell.GHC.ExactPrint.Types (Anns) -- import Language.Haskell.GHC.ExactPrint.Types (Anns)
import qualified Safe import qualified Safe
type Anns = () type Anns = Map AnnKey ()
type AnnKey = () type AnnKey = ()
data PerItemConfig = PerItemConfig data PerItemConfig = PerItemConfig