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

Fix error in Annotation filtering (fixes #70)

pull/75/head
Lennart Spitzner 2017-12-08 19:57:16 +01:00
parent 5bba918705
commit 39c48b33f1
3 changed files with 19 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
src-literatetests/15-regressions.blt
View File

@ -509,3 +509,7 @@ fmapuv f xs = G.generate (G.length xs) (f . (xs G.!))
#test parallellistcomp-workaround #test parallellistcomp-workaround
cs0 = 0 : [ c / Interval n | c <- cs | n <- [1..] ] cs0 = 0 : [ c / Interval n | c <- cs | n <- [1..] ]
#test issue 70
{-# LANGUAGE TemplateHaskell #-}
deriveFromJSON (unPrefix "assignPost") ''AssignmentPost

8
src/Language/Haskell/Brittany/Internal.hs
View File

@ -320,8 +320,8 @@ withTransformedAnns ast m = do
ppDecl :: LHsDecl RdrName -> PPMLocal () ppDecl :: LHsDecl RdrName -> PPMLocal ()
ppDecl d@(L loc decl) = case decl of ppDecl d@(L loc decl) = case decl of
SigD sig -> -- trace (_sigHead sig) $ SigD sig -> -- trace (_sigHead sig) $
withTransformedAnns d $ do withTransformedAnns d $ do
-- runLayouter $ Old.layoutSig (L loc sig) -- runLayouter $ Old.layoutSig (L loc sig)
briDoc <- briDocMToPPM $ layoutSig (L loc sig) briDoc <- briDocMToPPM $ layoutSig (L loc sig)
layoutBriDoc briDoc layoutBriDoc briDoc
@ -332,9 +332,9 @@ ppDecl d@(L loc decl) = case decl of
eitherNode <- layoutBind (L loc bind) eitherNode <- layoutBind (L loc bind)
case eitherNode of case eitherNode of
Left ns -> docLines $ return <$> ns Left ns -> docLines $ return <$> ns
Right n -> return n Right n -> return n
layoutBriDoc briDoc layoutBriDoc briDoc
_ -> briDocMToPPM (briDocByExactNoComment d) >>= layoutBriDoc _ -> briDocMToPPM (briDocByExactNoComment d) >>= layoutBriDoc
_sigHead :: Sig RdrName -> String _sigHead :: Sig RdrName -> String
_sigHead = \case _sigHead = \case

15
src/Language/Haskell/Brittany/Internal/ExactPrintUtils.hs
View File

@ -217,11 +217,18 @@ extractToplevelAnns
extractToplevelAnns lmod anns = output extractToplevelAnns lmod anns = output
where where
(L _ (HsModule _ _ _ ldecls _ _)) = lmod (L _ (HsModule _ _ _ ldecls _ _)) = lmod
declMap :: Map ExactPrint.AnnKey ExactPrint.AnnKey declMap1 :: Map ExactPrint.AnnKey ExactPrint.AnnKey
declMap = Map.unions $ ldecls <&> \ldecl -> declMap1 = Map.unions $ ldecls <&> \ldecl ->
Map.fromSet (const (ExactPrint.mkAnnKey ldecl)) (foldedAnnKeys ldecl) Map.fromSet (const (ExactPrint.mkAnnKey ldecl)) (foldedAnnKeys ldecl)
modKey = ExactPrint.mkAnnKey lmod declMap2 :: Map ExactPrint.AnnKey ExactPrint.AnnKey
output = groupMap (\k _ -> Map.findWithDefault modKey k declMap) anns declMap2 =
Map.fromList
$ [ (captured, declMap1 Map.! k)
| (k, ExactPrint.Ann _ _ _ _ _ (Just captured)) <- Map.toList anns
]
declMap = declMap1 `Map.union` declMap2
modKey = ExactPrint.mkAnnKey lmod
output = groupMap (\k _ -> Map.findWithDefault modKey k declMap) anns
groupMap :: (Ord k, Ord l) => (k -> a -> l) -> Map k a -> Map l (Map k a) groupMap :: (Ord k, Ord l) => (k -> a -> l) -> Map k a -> Map l (Map k a)
groupMap f = Map.foldlWithKey' (\m k a -> Map.alter (insert k a) (f k a) m) groupMap f = Map.foldlWithKey' (\m k a -> Map.alter (insert k a) (f k a) m)