Ignore warnings when parsing modules

pull/357/head
Taylor Fausak 2021-11-21 23:40:15 +00:00 committed by GitHub
parent ab59e9acc3
commit 89a9f47b72
4 changed files with 62 additions and 93 deletions

View File

@ -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)

View File

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

View File

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

View File

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