Ignore warnings when parsing modules

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
+     ( -- f
-  c -- g
+      c -- g
-  , -- h
+       , -- h
-  d -- i
+         d -- i
-  ) -- j
+          ) -- 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 =
-func reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable
+  x
-  = 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 =
-func = mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj
+  mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj
-     + mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj
+    + mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj
 
 #test long keep linemode 1
-#pending
+func =
-func = mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj
+  mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj
-     + mweroiuxlskdfjlksj
+    + mweroiuxlskdfjlksj
-     + mweroiuxlskdfjlksj
+    + mweroiuxlskdfjlksj
 
 #test long keep linemode 2
-#pending
+func =
-func = mweroiuxlskdfjlksj
+  mweroiuxlskdfjlksj
-     + mweroiuxlskdfjlksj
+    + mweroiuxlskdfjlksj
-     + mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj
+    + mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj
 
 #test literals
 func = 1
@@ -816,9 +805,10 @@ myTupleSection =
   )
 
 #test 2
-#pending
+func =
-func = (lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd
+  ( lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd
-  , 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)
 

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

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
+     ( -- f
-  c -- g
+      c -- g
-  , -- h
+       , -- h
-  d -- i
+         d -- i
-  ) -- j
+          ) -- j-- k
--- 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 =
-func reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable
+  x
-  = 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 =
-func = mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj
+  mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj
-  + mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj
+    + mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj
 
 #test long keep linemode 1
-#pending
+func =
-func = mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj
+  mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj
-  + mweroiuxlskdfjlksj
+    + mweroiuxlskdfjlksj
-  + mweroiuxlskdfjlksj
+    + mweroiuxlskdfjlksj
 
 #test long keep linemode 2
-#pending
+func =
-func = mweroiuxlskdfjlksj
+  mweroiuxlskdfjlksj
-  + mweroiuxlskdfjlksj
+    + mweroiuxlskdfjlksj
-  + mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj
+    + mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj
 
 #test literals
 func = 1
@@ -551,9 +541,10 @@ func = (`abc` 1)
 func = (abc, def)
 
 #test 2
-#pending
+func =
-func = (lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd
+  ( lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd
-  , 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

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) <-
+  (dynFlags3, leftovers2, _) <- GHC.Driver.Session.parseDynamicFilePragma
-    GHC.Driver.Session.parseDynamicFilePragma dynFlags2 arguments2
+    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 =