Ignore warnings when parsing modules
Taylor Fausak
GitHub
parent
ab59e9acc3
commit
89a9f47b72
source/library/Language/Haskell/Brittany/Internal
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 =
|
||||
|
|
|
|||
Loading…
Reference in New Issue