{-|
  Copyright   :  (C) 2026, QBayLogic B.V.
  License     :  BSD2 (see the file LICENSE)
  Maintainer  :  QBayLogic B.V. <devops@qbaylogic.com>

  Named warnings and the options controlling them.

  Every warning Clash can emit has a name and can be controlled individually
  with GHC-style flags:

    [@-W\<name\>@] enable the warning
    [@-Wno-\<name\>@] disable the warning
    [@-Werror=\<name\>@] enable the warning and promote it to an error
    [@-Wwarn=\<name\>@, @-Wno-error=\<name\>@] demote the warning back to a
    warning, also exempting it from a global @-Werror@

  Note that Clash parses its flags in a separate pass from GHC's, so ordering
  between GHC's global @-Werror@ and @-Wwarn=\<name\>@ is not positional: an
  explicit @-Wwarn=\<name\>@ always wins over a global @-Werror@. Ordering
  among the Clash warning flags themselves is positional (last one wins).
-}

{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE LambdaCase #-}

module Clash.Warning
  ( ClashWarning(..)
  , warningName
  , parseWarningName
    -- * Warning options
  , WarningOpts(..)
  , defWarningOpts
  , wopt
  , woptFatal
    -- * Flag-parsing state transitions
  , enableWarning
  , disableWarning
  , promoteWarning
  , demoteWarning
  ) where

import Control.DeepSeq (NFData)
import Data.Hashable (Hashable)
import Data.Map.Strict (Map)
import Data.Set (Set)
import GHC.Generics (Generic)

import qualified Data.Map.Strict as Map
import qualified Data.Set as Set

-- | Warnings Clash can emit. See the module documentation of "Clash.Warning"
-- for the command line flags controlling each of these.
data ClashWarning
  = WarnDubiousPrimitive
  -- ^ A primitive marked with @WarnAlways@ was instantiated, e.g. a primitive
  -- that only approximates its Haskell model.
  --
  -- Flag: @-Wclash-dubious-primitive@
  | WarnNonSynthesizable
  -- ^ A primitive marked with @WarnNonSynthesizable@ was instantiated outside
  -- of a test bench context.
  --
  -- Flag: @-Wclash-non-synthesizable@
  | WarnPrimitiveDefinition
  -- ^ A primitive's Haskell definition looks problematic: it isn't marked
  -- OPAQUE, its result is always an error, or its blackbox uses arguments the
  -- Haskell definition doesn't use.
  --
  -- Flag: @-Wclash-primitive-definition@
  | WarnCastSpecialization
  -- ^ A function is specialized on a non work-free cast, possibly duplicating
  -- work.
  --
  -- Flag: @-Wclash-cast-specialization@
  | WarnIntegerNarrowing
  -- ^ A @toInteger@ conversion narrows its argument to the width of 'Int',
  -- possibly dropping most significant bits.
  --
  -- Flag: @-Wclash-integer-narrowing@
  | WarnUnmatchableConstant
  -- ^ A case subject evaluated to a constant that matches none of the
  -- alternatives, usually a missing reduction rule in the primitive evaluator.
  -- Only reported when invariants are being checked (@-fclash-debug@).
  --
  -- Flag: @-Wclash-unmatchable-constant@
  deriving (Int -> ClashWarning -> ShowS
[ClashWarning] -> ShowS
ClashWarning -> String
(Int -> ClashWarning -> ShowS)
-> (ClashWarning -> String)
-> ([ClashWarning] -> ShowS)
-> Show ClashWarning
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ClashWarning -> ShowS
showsPrec :: Int -> ClashWarning -> ShowS
$cshow :: ClashWarning -> String
show :: ClashWarning -> String
$cshowList :: [ClashWarning] -> ShowS
showList :: [ClashWarning] -> ShowS
Show, ClashWarning -> ClashWarning -> Bool
(ClashWarning -> ClashWarning -> Bool)
-> (ClashWarning -> ClashWarning -> Bool) -> Eq ClashWarning
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ClashWarning -> ClashWarning -> Bool
== :: ClashWarning -> ClashWarning -> Bool
$c/= :: ClashWarning -> ClashWarning -> Bool
/= :: ClashWarning -> ClashWarning -> Bool
Eq, Eq ClashWarning
Eq ClashWarning =>
(ClashWarning -> ClashWarning -> Ordering)
-> (ClashWarning -> ClashWarning -> Bool)
-> (ClashWarning -> ClashWarning -> Bool)
-> (ClashWarning -> ClashWarning -> Bool)
-> (ClashWarning -> ClashWarning -> Bool)
-> (ClashWarning -> ClashWarning -> ClashWarning)
-> (ClashWarning -> ClashWarning -> ClashWarning)
-> Ord ClashWarning
ClashWarning -> ClashWarning -> Bool
ClashWarning -> ClashWarning -> Ordering
ClashWarning -> ClashWarning -> ClashWarning
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 :: ClashWarning -> ClashWarning -> Ordering
compare :: ClashWarning -> ClashWarning -> Ordering
$c< :: ClashWarning -> ClashWarning -> Bool
< :: ClashWarning -> ClashWarning -> Bool
$c<= :: ClashWarning -> ClashWarning -> Bool
<= :: ClashWarning -> ClashWarning -> Bool
$c> :: ClashWarning -> ClashWarning -> Bool
> :: ClashWarning -> ClashWarning -> Bool
$c>= :: ClashWarning -> ClashWarning -> Bool
>= :: ClashWarning -> ClashWarning -> Bool
$cmax :: ClashWarning -> ClashWarning -> ClashWarning
max :: ClashWarning -> ClashWarning -> ClashWarning
$cmin :: ClashWarning -> ClashWarning -> ClashWarning
min :: ClashWarning -> ClashWarning -> ClashWarning
Ord, Int -> ClashWarning
ClashWarning -> Int
ClashWarning -> [ClashWarning]
ClashWarning -> ClashWarning
ClashWarning -> ClashWarning -> [ClashWarning]
ClashWarning -> ClashWarning -> ClashWarning -> [ClashWarning]
(ClashWarning -> ClashWarning)
-> (ClashWarning -> ClashWarning)
-> (Int -> ClashWarning)
-> (ClashWarning -> Int)
-> (ClashWarning -> [ClashWarning])
-> (ClashWarning -> ClashWarning -> [ClashWarning])
-> (ClashWarning -> ClashWarning -> [ClashWarning])
-> (ClashWarning -> ClashWarning -> ClashWarning -> [ClashWarning])
-> Enum ClashWarning
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 :: ClashWarning -> ClashWarning
succ :: ClashWarning -> ClashWarning
$cpred :: ClashWarning -> ClashWarning
pred :: ClashWarning -> ClashWarning
$ctoEnum :: Int -> ClashWarning
toEnum :: Int -> ClashWarning
$cfromEnum :: ClashWarning -> Int
fromEnum :: ClashWarning -> Int
$cenumFrom :: ClashWarning -> [ClashWarning]
enumFrom :: ClashWarning -> [ClashWarning]
$cenumFromThen :: ClashWarning -> ClashWarning -> [ClashWarning]
enumFromThen :: ClashWarning -> ClashWarning -> [ClashWarning]
$cenumFromTo :: ClashWarning -> ClashWarning -> [ClashWarning]
enumFromTo :: ClashWarning -> ClashWarning -> [ClashWarning]
$cenumFromThenTo :: ClashWarning -> ClashWarning -> ClashWarning -> [ClashWarning]
enumFromThenTo :: ClashWarning -> ClashWarning -> ClashWarning -> [ClashWarning]
Enum, ClashWarning
ClashWarning -> ClashWarning -> Bounded ClashWarning
forall a. a -> a -> Bounded a
$cminBound :: ClashWarning
minBound :: ClashWarning
$cmaxBound :: ClashWarning
maxBound :: ClashWarning
Bounded, (forall x. ClashWarning -> Rep ClashWarning x)
-> (forall x. Rep ClashWarning x -> ClashWarning)
-> Generic ClashWarning
forall x. Rep ClashWarning x -> ClashWarning
forall x. ClashWarning -> Rep ClashWarning x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ClashWarning -> Rep ClashWarning x
from :: forall x. ClashWarning -> Rep ClashWarning x
$cto :: forall x. Rep ClashWarning x -> ClashWarning
to :: forall x. Rep ClashWarning x -> ClashWarning
Generic, ClashWarning -> ()
(ClashWarning -> ()) -> NFData ClashWarning
forall a. (a -> ()) -> NFData a
$crnf :: ClashWarning -> ()
rnf :: ClashWarning -> ()
NFData, Eq ClashWarning
Eq ClashWarning =>
(Int -> ClashWarning -> Int)
-> (ClashWarning -> Int) -> Hashable ClashWarning
Int -> ClashWarning -> Int
ClashWarning -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> ClashWarning -> Int
hashWithSalt :: Int -> ClashWarning -> Int
$chash :: ClashWarning -> Int
hash :: ClashWarning -> Int
Hashable)

-- | The name of a warning as used in command line flags, e.g.
-- @clash-dubious-primitive@ for 'WarnDubiousPrimitive'.
warningName :: ClashWarning -> String
warningName :: ClashWarning -> String
warningName = \case
  ClashWarning
WarnDubiousPrimitive -> String
"clash-dubious-primitive"
  ClashWarning
WarnNonSynthesizable -> String
"clash-non-synthesizable"
  ClashWarning
WarnPrimitiveDefinition -> String
"clash-primitive-definition"
  ClashWarning
WarnCastSpecialization -> String
"clash-cast-specialization"
  ClashWarning
WarnIntegerNarrowing -> String
"clash-integer-narrowing"
  ClashWarning
WarnUnmatchableConstant -> String
"clash-unmatchable-constant"

-- | Inverse of 'warningName'
parseWarningName :: String -> Maybe ClashWarning
parseWarningName :: String -> Maybe ClashWarning
parseWarningName = (String -> Map String ClashWarning -> Maybe ClashWarning)
-> Map String ClashWarning -> String -> Maybe ClashWarning
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> Map String ClashWarning -> Maybe ClashWarning
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Map String ClashWarning
warningsByName
 where
  warningsByName :: Map String ClashWarning
  warningsByName :: Map String ClashWarning
warningsByName =
    [(String, ClashWarning)] -> Map String ClashWarning
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(ClashWarning -> String
warningName ClashWarning
w, ClashWarning
w) | ClashWarning
w <- [ClashWarning
forall a. Bounded a => a
minBound .. ClashWarning
forall a. Bounded a => a
maxBound]]

-- | Which warnings are enabled, and which of them are fatal. Construct with
-- 'defWarningOpts' and the state transitions below; query with 'wopt' and
-- 'woptFatal'.
data WarningOpts = WarningOpts
  { WarningOpts -> Set ClashWarning
warn_enabled :: Set ClashWarning
  -- ^ Warnings that are enabled. All warnings are enabled by default.
  , WarningOpts -> Set ClashWarning
warn_fatal :: Set ClashWarning
  -- ^ Warnings explicitly promoted to errors with @-Werror=\<name\>@
  , WarningOpts -> Set ClashWarning
warn_nonFatal :: Set ClashWarning
  -- ^ Warnings explicitly demoted with @-Wwarn=\<name\>@; these are also
  -- exempt from a global @-Werror@
  }
  deriving (Int -> WarningOpts -> ShowS
[WarningOpts] -> ShowS
WarningOpts -> String
(Int -> WarningOpts -> ShowS)
-> (WarningOpts -> String)
-> ([WarningOpts] -> ShowS)
-> Show WarningOpts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WarningOpts -> ShowS
showsPrec :: Int -> WarningOpts -> ShowS
$cshow :: WarningOpts -> String
show :: WarningOpts -> String
$cshowList :: [WarningOpts] -> ShowS
showList :: [WarningOpts] -> ShowS
Show, WarningOpts -> WarningOpts -> Bool
(WarningOpts -> WarningOpts -> Bool)
-> (WarningOpts -> WarningOpts -> Bool) -> Eq WarningOpts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WarningOpts -> WarningOpts -> Bool
== :: WarningOpts -> WarningOpts -> Bool
$c/= :: WarningOpts -> WarningOpts -> Bool
/= :: WarningOpts -> WarningOpts -> Bool
Eq, (forall x. WarningOpts -> Rep WarningOpts x)
-> (forall x. Rep WarningOpts x -> WarningOpts)
-> Generic WarningOpts
forall x. Rep WarningOpts x -> WarningOpts
forall x. WarningOpts -> Rep WarningOpts x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. WarningOpts -> Rep WarningOpts x
from :: forall x. WarningOpts -> Rep WarningOpts x
$cto :: forall x. Rep WarningOpts x -> WarningOpts
to :: forall x. Rep WarningOpts x -> WarningOpts
Generic, WarningOpts -> ()
(WarningOpts -> ()) -> NFData WarningOpts
forall a. (a -> ()) -> NFData a
$crnf :: WarningOpts -> ()
rnf :: WarningOpts -> ()
NFData, Eq WarningOpts
Eq WarningOpts =>
(Int -> WarningOpts -> Int)
-> (WarningOpts -> Int) -> Hashable WarningOpts
Int -> WarningOpts -> Int
WarningOpts -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> WarningOpts -> Int
hashWithSalt :: Int -> WarningOpts -> Int
$chash :: WarningOpts -> Int
hash :: WarningOpts -> Int
Hashable)

-- | All warnings enabled, none fatal
defWarningOpts :: WarningOpts
defWarningOpts :: WarningOpts
defWarningOpts = WarningOpts
  { warn_enabled :: Set ClashWarning
warn_enabled = [ClashWarning] -> Set ClashWarning
forall a. Ord a => [a] -> Set a
Set.fromList [ClashWarning
forall a. Bounded a => a
minBound .. ClashWarning
forall a. Bounded a => a
maxBound]
  , warn_fatal :: Set ClashWarning
warn_fatal = Set ClashWarning
forall a. Set a
Set.empty
  , warn_nonFatal :: Set ClashWarning
warn_nonFatal = Set ClashWarning
forall a. Set a
Set.empty
  }

-- | Is the given warning enabled?
wopt :: ClashWarning -> WarningOpts -> Bool
wopt :: ClashWarning -> WarningOpts -> Bool
wopt ClashWarning
w WarningOpts
opts = ClashWarning
w ClashWarning -> Set ClashWarning -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` WarningOpts -> Set ClashWarning
warn_enabled WarningOpts
opts

-- | Should the given warning be promoted to an error? The first argument
-- indicates whether /all/ warnings should be treated as errors (@-Werror@).
woptFatal :: Bool -> ClashWarning -> WarningOpts -> Bool
woptFatal :: Bool -> ClashWarning -> WarningOpts -> Bool
woptFatal Bool
werror ClashWarning
w WarningOpts
opts =
  (Bool
werror Bool -> Bool -> Bool
|| ClashWarning
w ClashWarning -> Set ClashWarning -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` WarningOpts -> Set ClashWarning
warn_fatal WarningOpts
opts)
    Bool -> Bool -> Bool
&& ClashWarning
w ClashWarning -> Set ClashWarning -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.notMember` WarningOpts -> Set ClashWarning
warn_nonFatal WarningOpts
opts

-- | @-W\<name\>@
enableWarning :: ClashWarning -> WarningOpts -> WarningOpts
enableWarning :: ClashWarning -> WarningOpts -> WarningOpts
enableWarning ClashWarning
w WarningOpts
opts =
  WarningOpts
opts { warn_enabled = Set.insert w (warn_enabled opts) }

-- | @-Wno-\<name\>@
disableWarning :: ClashWarning -> WarningOpts -> WarningOpts
disableWarning :: ClashWarning -> WarningOpts -> WarningOpts
disableWarning ClashWarning
w WarningOpts
opts = WarningOpts
opts
  { warn_enabled = Set.delete w (warn_enabled opts)
  , warn_fatal = Set.delete w (warn_fatal opts)
  }

-- | @-Werror=\<name\>@. Implies @-W\<name\>@, like in GHC.
promoteWarning :: ClashWarning -> WarningOpts -> WarningOpts
promoteWarning :: ClashWarning -> WarningOpts -> WarningOpts
promoteWarning ClashWarning
w WarningOpts
opts = WarningOpts
opts
  { warn_enabled = Set.insert w (warn_enabled opts)
  , warn_fatal = Set.insert w (warn_fatal opts)
  , warn_nonFatal = Set.delete w (warn_nonFatal opts)
  }

-- | @-Wwarn=\<name\>@ / @-Wno-error=\<name\>@
demoteWarning :: ClashWarning -> WarningOpts -> WarningOpts
demoteWarning :: ClashWarning -> WarningOpts -> WarningOpts
demoteWarning ClashWarning
w WarningOpts
opts = WarningOpts
opts
  { warn_fatal = Set.delete w (warn_fatal opts)
  , warn_nonFatal = Set.insert w (warn_nonFatal opts)
  }