{-# LANGUAGE DeriveGeneric #-}
module Distribution.Parsec.Warning (
PWarning (..),
PWarnType (..),
showPWarning,
) where
import Distribution.Compat.Prelude
import Distribution.Parsec.Position
import Prelude ()
import System.FilePath (normalise)
data PWarnType
= PWTOther
| PWTUTF
| PWTBoolCase
| PWTVersionTag
| PWTNewSyntax
| PWTOldSyntax
| PWTDeprecatedField
| PWTInvalidSubsection
| PWTUnknownField
| PWTUnknownSection
| PWTTrailingFields
| PWTExtraMainIs
|
|
| PWTLexNBSP
| PWTLexBOM
| PWTLexTab
| PWTQuirkyCabalFile
| PWTDoubleDash
| PWTMultipleSingularField
| PWTBuildTypeDefault
| PWTVersionOperator
| PWTVersionWildcard
| PWTSpecVersion
| PWTEmptyFilePath
| PWTExperimental
deriving (PWarnType -> PWarnType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PWarnType -> PWarnType -> Bool
$c/= :: PWarnType -> PWarnType -> Bool
== :: PWarnType -> PWarnType -> Bool
$c== :: PWarnType -> PWarnType -> Bool
Eq, Eq PWarnType
PWarnType -> PWarnType -> Bool
PWarnType -> PWarnType -> Ordering
PWarnType -> PWarnType -> PWarnType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PWarnType -> PWarnType -> PWarnType
$cmin :: PWarnType -> PWarnType -> PWarnType
max :: PWarnType -> PWarnType -> PWarnType
$cmax :: PWarnType -> PWarnType -> PWarnType
>= :: PWarnType -> PWarnType -> Bool
$c>= :: PWarnType -> PWarnType -> Bool
> :: PWarnType -> PWarnType -> Bool
$c> :: PWarnType -> PWarnType -> Bool
<= :: PWarnType -> PWarnType -> Bool
$c<= :: PWarnType -> PWarnType -> Bool
< :: PWarnType -> PWarnType -> Bool
$c< :: PWarnType -> PWarnType -> Bool
compare :: PWarnType -> PWarnType -> Ordering
$ccompare :: PWarnType -> PWarnType -> Ordering
Ord, Int -> PWarnType -> ShowS
[PWarnType] -> ShowS
PWarnType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PWarnType] -> ShowS
$cshowList :: [PWarnType] -> ShowS
show :: PWarnType -> String
$cshow :: PWarnType -> String
showsPrec :: Int -> PWarnType -> ShowS
$cshowsPrec :: Int -> PWarnType -> ShowS
Show, Int -> PWarnType
PWarnType -> Int
PWarnType -> [PWarnType]
PWarnType -> PWarnType
PWarnType -> PWarnType -> [PWarnType]
PWarnType -> PWarnType -> PWarnType -> [PWarnType]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: PWarnType -> PWarnType -> PWarnType -> [PWarnType]
$cenumFromThenTo :: PWarnType -> PWarnType -> PWarnType -> [PWarnType]
enumFromTo :: PWarnType -> PWarnType -> [PWarnType]
$cenumFromTo :: PWarnType -> PWarnType -> [PWarnType]
enumFromThen :: PWarnType -> PWarnType -> [PWarnType]
$cenumFromThen :: PWarnType -> PWarnType -> [PWarnType]
enumFrom :: PWarnType -> [PWarnType]
$cenumFrom :: PWarnType -> [PWarnType]
fromEnum :: PWarnType -> Int
$cfromEnum :: PWarnType -> Int
toEnum :: Int -> PWarnType
$ctoEnum :: Int -> PWarnType
pred :: PWarnType -> PWarnType
$cpred :: PWarnType -> PWarnType
succ :: PWarnType -> PWarnType
$csucc :: PWarnType -> PWarnType
Enum, PWarnType
forall a. a -> a -> Bounded a
maxBound :: PWarnType
$cmaxBound :: PWarnType
minBound :: PWarnType
$cminBound :: PWarnType
Bounded, forall x. Rep PWarnType x -> PWarnType
forall x. PWarnType -> Rep PWarnType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PWarnType x -> PWarnType
$cfrom :: forall x. PWarnType -> Rep PWarnType x
Generic)
instance Binary PWarnType
instance NFData PWarnType where rnf :: PWarnType -> ()
rnf = forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf
data PWarning = PWarning !PWarnType !Position String
deriving (Int -> PWarning -> ShowS
[PWarning] -> ShowS
PWarning -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PWarning] -> ShowS
$cshowList :: [PWarning] -> ShowS
show :: PWarning -> String
$cshow :: PWarning -> String
showsPrec :: Int -> PWarning -> ShowS
$cshowsPrec :: Int -> PWarning -> ShowS
Show, forall x. Rep PWarning x -> PWarning
forall x. PWarning -> Rep PWarning x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PWarning x -> PWarning
$cfrom :: forall x. PWarning -> Rep PWarning x
Generic)
instance Binary PWarning
instance NFData PWarning where rnf :: PWarning -> ()
rnf = forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf
showPWarning :: FilePath -> PWarning -> String
showPWarning :: String -> PWarning -> String
showPWarning String
fpath (PWarning PWarnType
_ Position
pos String
msg) =
ShowS
normalise String
fpath forall a. [a] -> [a] -> [a]
++ String
":" forall a. [a] -> [a] -> [a]
++ Position -> String
showPos Position
pos forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ String
msg