{-# LANGUAGE DeriveGeneric #-}

module Distribution.Parsec.Warning
  ( PWarning (..)
  , PWarnType (..)
  , showPWarning
  ) where

import Distribution.Compat.Prelude
import Distribution.Parsec.Position
import System.FilePath (normalise)
import Prelude ()

-- | Type of parser warning. We do classify warnings.
--
-- Different application may decide not to show some, or have fatal behaviour on others
data PWarnType
  = -- | Unclassified warning
    PWTOther
  | -- | Invalid UTF encoding
    PWTUTF
  | -- | @true@ or @false@, not @True@ or @False@
    PWTBoolCase
  | -- | there are version with tags
    PWTVersionTag
  | -- | New syntax used, but no @cabal-version: >= 1.2@ specified
    PWTNewSyntax
  | -- | Old syntax used, and @cabal-version >= 1.2@ specified
    PWTOldSyntax
  | PWTDeprecatedField
  | PWTInvalidSubsection
  | PWTUnknownField
  | PWTUnknownSection
  | PWTTrailingFields
  | -- | extra main-is field
    PWTExtraMainIs
  | -- | extra test-module field
    PWTExtraTestModule
  | -- | extra benchmark-module field
    PWTExtraBenchmarkModule
  | PWTLexNBSP
  | PWTLexBOM
  | PWTLexTab
  | -- | legacy cabal file that we know how to patch
    PWTQuirkyCabalFile
  | -- | Double dash token, most likely it's a mistake - it's not a comment
    PWTDoubleDash
  | -- | e.g. name or version should be specified only once.
    PWTMultipleSingularField
  | -- | Workaround for derive-package having build-type: Default. See <https://github.com/haskell/cabal/issues/5020>.
    PWTBuildTypeDefault
  | -- | Version operators used (without cabal-version: 1.8)
    PWTVersionOperator
  | -- | Version wildcard used (without cabal-version: 1.6)
    PWTVersionWildcard
  | -- | Warnings about cabal-version format.
    PWTSpecVersion
  | -- | Empty filepath, i.e. literally ""
    PWTEmptyFilePath
  | -- | sections contents (sections and fields) are indented inconsistently
    PWTInconsistentIndentation
  | -- | Experimental feature
    PWTExperimental
  deriving (PWarnType -> PWarnType -> Bool
(PWarnType -> PWarnType -> Bool)
-> (PWarnType -> PWarnType -> Bool) -> Eq PWarnType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PWarnType -> PWarnType -> Bool
== :: PWarnType -> PWarnType -> Bool
$c/= :: PWarnType -> PWarnType -> Bool
/= :: PWarnType -> PWarnType -> Bool
Eq, Eq PWarnType
Eq PWarnType =>
(PWarnType -> PWarnType -> Ordering)
-> (PWarnType -> PWarnType -> Bool)
-> (PWarnType -> PWarnType -> Bool)
-> (PWarnType -> PWarnType -> Bool)
-> (PWarnType -> PWarnType -> Bool)
-> (PWarnType -> PWarnType -> PWarnType)
-> (PWarnType -> PWarnType -> PWarnType)
-> Ord 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
$ccompare :: PWarnType -> PWarnType -> Ordering
compare :: PWarnType -> PWarnType -> Ordering
$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
>= :: PWarnType -> PWarnType -> Bool
$cmax :: PWarnType -> PWarnType -> PWarnType
max :: PWarnType -> PWarnType -> PWarnType
$cmin :: PWarnType -> PWarnType -> PWarnType
min :: PWarnType -> PWarnType -> PWarnType
Ord, Int -> PWarnType -> ShowS
[PWarnType] -> ShowS
PWarnType -> String
(Int -> PWarnType -> ShowS)
-> (PWarnType -> String)
-> ([PWarnType] -> ShowS)
-> Show PWarnType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PWarnType -> ShowS
showsPrec :: Int -> PWarnType -> ShowS
$cshow :: PWarnType -> String
show :: PWarnType -> String
$cshowList :: [PWarnType] -> ShowS
showList :: [PWarnType] -> ShowS
Show, Int -> PWarnType
PWarnType -> Int
PWarnType -> [PWarnType]
PWarnType -> PWarnType
PWarnType -> PWarnType -> [PWarnType]
PWarnType -> PWarnType -> PWarnType -> [PWarnType]
(PWarnType -> PWarnType)
-> (PWarnType -> PWarnType)
-> (Int -> PWarnType)
-> (PWarnType -> Int)
-> (PWarnType -> [PWarnType])
-> (PWarnType -> PWarnType -> [PWarnType])
-> (PWarnType -> PWarnType -> [PWarnType])
-> (PWarnType -> PWarnType -> PWarnType -> [PWarnType])
-> Enum 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
$csucc :: PWarnType -> PWarnType
succ :: PWarnType -> PWarnType
$cpred :: PWarnType -> PWarnType
pred :: PWarnType -> PWarnType
$ctoEnum :: Int -> PWarnType
toEnum :: Int -> PWarnType
$cfromEnum :: PWarnType -> Int
fromEnum :: PWarnType -> Int
$cenumFrom :: PWarnType -> [PWarnType]
enumFrom :: PWarnType -> [PWarnType]
$cenumFromThen :: PWarnType -> PWarnType -> [PWarnType]
enumFromThen :: PWarnType -> PWarnType -> [PWarnType]
$cenumFromTo :: PWarnType -> PWarnType -> [PWarnType]
enumFromTo :: PWarnType -> PWarnType -> [PWarnType]
$cenumFromThenTo :: PWarnType -> PWarnType -> PWarnType -> [PWarnType]
enumFromThenTo :: PWarnType -> PWarnType -> PWarnType -> [PWarnType]
Enum, PWarnType
PWarnType -> PWarnType -> Bounded PWarnType
forall a. a -> a -> Bounded a
$cminBound :: PWarnType
minBound :: PWarnType
$cmaxBound :: PWarnType
maxBound :: PWarnType
Bounded, (forall x. PWarnType -> Rep PWarnType x)
-> (forall x. Rep PWarnType x -> PWarnType) -> Generic PWarnType
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
$cfrom :: forall x. PWarnType -> Rep PWarnType x
from :: forall x. PWarnType -> Rep PWarnType x
$cto :: forall x. Rep PWarnType x -> PWarnType
to :: forall x. Rep PWarnType x -> PWarnType
Generic)

instance Binary PWarnType
instance NFData PWarnType where rnf :: PWarnType -> ()
rnf = PWarnType -> ()
forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf

-- | Parser warning.
data PWarning = PWarning !PWarnType !Position String
  deriving (PWarning -> PWarning -> Bool
(PWarning -> PWarning -> Bool)
-> (PWarning -> PWarning -> Bool) -> Eq PWarning
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PWarning -> PWarning -> Bool
== :: PWarning -> PWarning -> Bool
$c/= :: PWarning -> PWarning -> Bool
/= :: PWarning -> PWarning -> Bool
Eq, Eq PWarning
Eq PWarning =>
(PWarning -> PWarning -> Ordering)
-> (PWarning -> PWarning -> Bool)
-> (PWarning -> PWarning -> Bool)
-> (PWarning -> PWarning -> Bool)
-> (PWarning -> PWarning -> Bool)
-> (PWarning -> PWarning -> PWarning)
-> (PWarning -> PWarning -> PWarning)
-> Ord PWarning
PWarning -> PWarning -> Bool
PWarning -> PWarning -> Ordering
PWarning -> PWarning -> PWarning
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
$ccompare :: PWarning -> PWarning -> Ordering
compare :: PWarning -> PWarning -> Ordering
$c< :: PWarning -> PWarning -> Bool
< :: PWarning -> PWarning -> Bool
$c<= :: PWarning -> PWarning -> Bool
<= :: PWarning -> PWarning -> Bool
$c> :: PWarning -> PWarning -> Bool
> :: PWarning -> PWarning -> Bool
$c>= :: PWarning -> PWarning -> Bool
>= :: PWarning -> PWarning -> Bool
$cmax :: PWarning -> PWarning -> PWarning
max :: PWarning -> PWarning -> PWarning
$cmin :: PWarning -> PWarning -> PWarning
min :: PWarning -> PWarning -> PWarning
Ord, Int -> PWarning -> ShowS
[PWarning] -> ShowS
PWarning -> String
(Int -> PWarning -> ShowS)
-> (PWarning -> String) -> ([PWarning] -> ShowS) -> Show PWarning
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PWarning -> ShowS
showsPrec :: Int -> PWarning -> ShowS
$cshow :: PWarning -> String
show :: PWarning -> String
$cshowList :: [PWarning] -> ShowS
showList :: [PWarning] -> ShowS
Show, (forall x. PWarning -> Rep PWarning x)
-> (forall x. Rep PWarning x -> PWarning) -> Generic PWarning
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
$cfrom :: forall x. PWarning -> Rep PWarning x
from :: forall x. PWarning -> Rep PWarning x
$cto :: forall x. Rep PWarning x -> PWarning
to :: forall x. Rep PWarning x -> PWarning
Generic)

instance Binary PWarning
instance NFData PWarning where rnf :: PWarning -> ()
rnf = PWarning -> ()
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 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Position -> String
showPos Position
pos String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg