Ignore warnings when parsing modules

2021-11-21 23:40:15 +00:00 · 2021-11-21 23:40:15 +00:00 · 89a9f47b72
parent ab59e9acc3
commit 89a9f47b72
4 changed files with 62 additions and 93 deletions
--- 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)

--- 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
--- 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
--- 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 =