From 89a9f47b72a7d41cce19a49e8503440101cfb8ac Mon Sep 17 00:00:00 2001 From: Taylor Fausak Date: Sun, 21 Nov 2021 23:40:15 +0000 Subject: [PATCH] Ignore warnings when parsing modules --- data/10-tests.blt | 70 ++++++++----------- data/15-regressions.blt | 3 +- data/30-tests-context-free.blt | 66 ++++++++--------- .../Haskell/Brittany/Internal/ParseModule.hs | 16 ++--- 4 files changed, 62 insertions(+), 93 deletions(-) diff --git a/data/10-tests.blt b/data/10-tests.blt index 311c911..debf9aa 100644 --- a/data/10-tests.blt +++ b/data/10-tests.blt @@ -35,7 +35,7 @@ func :: (((((((((()))))))))) -- current output is.. funny. wonder if that can/needs to be improved.. #test give me more! -#pending +#pending nested tuples over line length func :: ((((((((((((((((((((((((((((((((((((((((((())))))))))))))))))))))))))))))))))))))))))) #test unit @@ -196,7 +196,7 @@ func ] ############################################################################### #test type operator stuff -#pending +#pending HsOpTy test050 :: a :+: b test051 :: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd :+: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd @@ -258,20 +258,18 @@ funcA :: a -> b -- comment A funcB :: a -> b -- comment B #test comments all -#pending -- a func -- b :: -- c - a -- d + a -- d -> -- e - ( -- f - c -- g - , -- h - d -- i - ) -- j + ( -- f + c -- g + , -- h + d -- i + ) -- j -- k - ############################################################################### ############################################################################### ############################################################################### @@ -303,10 +301,9 @@ func = f func :: Int #test inline pragma 4 -#pending this does not work with the compiler version we currently use yet (i think). should work with ghc-8.0.2. func = f where - {-# INLINE [~] f #-} + {-# INLINE [~1] f #-} f = id @@ -363,7 +360,6 @@ data MyRecord = MyConstructor } #test record with DataTypeContexts -#pending data type contexts are deprecated in ghc 9.0 {-# LANGUAGE DatatypeContexts #-} data ( LooooooooooooooooooooongConstraint a @@ -647,21 +643,15 @@ x *** y = x func _ = x #test simple long pattern -#pending -func reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable - = x +func reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable = + x #test simple multiline pattern -#pending -func reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable - reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable +func reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable = x #test another multiline pattern -#pending -func reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable - a - b +func reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable a b = x #test simple constructor @@ -671,7 +661,6 @@ func (A a) = a func (x : xr) = x #test some other constructor symbol -#pending func (x :+: xr) = x #test normal infix constructor @@ -738,21 +727,21 @@ describe "infix op" $ do func = x + x #test long -#pending -func = mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj - + mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj +func = + mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj + + mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj #test long keep linemode 1 -#pending -func = mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj - + mweroiuxlskdfjlksj - + mweroiuxlskdfjlksj +func = + mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj + + mweroiuxlskdfjlksj + + mweroiuxlskdfjlksj #test long keep linemode 2 -#pending -func = mweroiuxlskdfjlksj - + mweroiuxlskdfjlksj - + mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj +func = + mweroiuxlskdfjlksj + + mweroiuxlskdfjlksj + + mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj #test literals func = 1 @@ -816,9 +805,10 @@ myTupleSection = ) #test 2 -#pending -func = (lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd - , lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd) +func = + ( lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd + , lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd + ) #test comment-after-then foo = if True @@ -1400,12 +1390,10 @@ type Foo a -- fancy type comment Int #test synonym-type-operators -#pending - type (a :+: b) = (a, b) #test synonym-multi-parens -#pending +#pending loses extra parens type ((a :+: b) c) = (a, c) diff --git a/data/15-regressions.blt b/data/15-regressions.blt index df2dada..9a6b623 100644 --- a/data/15-regressions.blt +++ b/data/15-regressions.blt @@ -134,11 +134,10 @@ func = if x else Nothing #test qualified infix pattern -#pending "TODO" wrapPatPrepend pat prepElem = do patDocs <- layoutPat pat case Seq.viewl patDocs of - Seq.EmptyL -> return $ Seq.empty + Seq.EmptyL -> return $ Seq.empty x1 Seq.:< xR -> do x1' <- docSeq [prepElem, return x1] return $ x1' Seq.<| xR diff --git a/data/30-tests-context-free.blt b/data/30-tests-context-free.blt index 003a23d..d73e6d4 100644 --- a/data/30-tests-context-free.blt +++ b/data/30-tests-context-free.blt @@ -35,7 +35,7 @@ func :: (((((((((()))))))))) -- current output is.. funny. wonder if that can/needs to be improved.. #test give me more! -#pending +#pending nested tuples over line length func :: ((((((((((((((((((((((((((((((((((((((((((())))))))))))))))))))))))))))))))))))))))))) #test unit @@ -196,7 +196,7 @@ func ] ############################################################################### #test type operator stuff -#pending +#pending HsOpTy test050 :: a :+: b test051 :: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd @@ -249,18 +249,16 @@ funcA :: a -> b -- comment A funcB :: a -> b -- comment B #test comments all -#pending -- a func -- b :: -- c - a -- d + a -- d -> -- e - ( -- f - c -- g - , -- h - d -- i - ) -- j --- k + ( -- f + c -- g + , -- h + d -- i + ) -- j-- k ############################################################################### @@ -305,10 +303,9 @@ func = f f = id #test inline pragma 4 -#pending this does not work with the compiler version we currently use yet (i think). should work with ghc-8.0.2. func = f where - {-# INLINE [~] f #-} + {-# INLINE [~1] f #-} f = id @@ -390,21 +387,15 @@ x *** y = x func _ = x #test simple long pattern -#pending -func reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable - = x +func reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable = + x #test simple multiline pattern -#pending -func reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable - reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable +func reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable = x #test another multiline pattern -#pending -func reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable - a - b +func reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable a b = x #test simple constructor @@ -414,7 +405,6 @@ func (A a) = a func (x : xr) = x #test some other constructor symbol -#pending func (x :+: xr) = x @@ -479,21 +469,21 @@ describe "infix op" $ do func = x + x #test long -#pending -func = mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj - + mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj +func = + mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj + + mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj #test long keep linemode 1 -#pending -func = mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj - + mweroiuxlskdfjlksj - + mweroiuxlskdfjlksj +func = + mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj + + mweroiuxlskdfjlksj + + mweroiuxlskdfjlksj #test long keep linemode 2 -#pending -func = mweroiuxlskdfjlksj - + mweroiuxlskdfjlksj - + mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj +func = + mweroiuxlskdfjlksj + + mweroiuxlskdfjlksj + + mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj #test literals func = 1 @@ -551,9 +541,10 @@ func = (`abc` 1) func = (abc, def) #test 2 -#pending -func = (lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd - , lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd) +func = + ( lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd + , lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd + ) #test let in on single line foo = @@ -1082,7 +1073,6 @@ func = if x else Nothing #test qualified infix pattern -#pending "TODO" wrapPatPrepend pat prepElem = do patDocs <- layoutPat pat case Seq.viewl patDocs of diff --git a/source/library/Language/Haskell/Brittany/Internal/ParseModule.hs b/source/library/Language/Haskell/Brittany/Internal/ParseModule.hs index fa84f02..2cc259f 100644 --- a/source/library/Language/Haskell/Brittany/Internal/ParseModule.hs +++ b/source/library/Language/Haskell/Brittany/Internal/ParseModule.hs @@ -11,7 +11,6 @@ import qualified GHC.ByteOrder import qualified GHC.Data.Bag import qualified GHC.Data.EnumSet import qualified GHC.Data.StringBuffer -import qualified GHC.Driver.CmdLine import qualified GHC.Driver.Session import qualified GHC.Parser.Header import qualified GHC.Platform @@ -48,18 +47,17 @@ parseModule arguments1 filePath checkDynFlags string = Except.runExceptT $ do { GHC.Driver.Session.safeHaskell = GHC.Driver.Session.Sf_Unsafe } GHC.Driver.Session.Opt_KeepRawTokenStream - (dynFlags2, leftovers1, warnings1) <- + (dynFlags2, leftovers1, _) <- GHC.Driver.Session.parseDynamicFlagsCmdLine dynFlags1 $ fmap GHC.Types.SrcLoc.noLoc arguments1 handleLeftovers leftovers1 - handleWarnings warnings1 let stringBuffer = GHC.Data.StringBuffer.stringToStringBuffer string arguments2 = GHC.Parser.Header.getOptions dynFlags2 stringBuffer filePath - (dynFlags3, leftovers2, warnings2) <- - GHC.Driver.Session.parseDynamicFilePragma dynFlags2 arguments2 + (dynFlags3, leftovers2, _) <- GHC.Driver.Session.parseDynamicFilePragma + dynFlags2 + arguments2 handleLeftovers leftovers2 - handleWarnings warnings2 dynFlagsResult <- Except.ExceptT $ checkDynFlags dynFlags3 let parseResult = @@ -74,12 +72,6 @@ handleLeftovers leftovers = Monad.unless (null leftovers) . Except.throwE $ "leftovers: " <> show (fmap GHC.Types.SrcLoc.unLoc leftovers) -handleWarnings - :: Monad m => [GHC.Driver.CmdLine.Warn] -> Except.ExceptT String m () -handleWarnings warnings = - Monad.unless (null warnings) . Except.throwE $ "warnings: " <> show - (fmap (GHC.Types.SrcLoc.unLoc . GHC.Driver.CmdLine.warnMsg) warnings) - handleErrorMessages :: Monad m => GHC.Utils.Error.ErrorMessages -> Except.ExceptT String m a handleErrorMessages =