{-# LANGUAGE CPP #-}
{-# LANGUAGE Safe #-}

-- |
-- Copyright: 2026 Greg Pfeil
-- License: AGPL-3.0-only WITH Universal-FOSS-exception-1.0 OR LicenseRef-commercial
--
-- Option handling for "GhcCompat".
module GhcCompat.Opts
  ( Opts (Opts),
    ReportLevel (Error, Warn),
    correctOptionOrder,
    minVersion,
    parse,
    reportIncompatibleExtensions,
  )
where

import "base" Control.Applicative (pure)
import "base" Control.Category ((.))
import "base" Control.Monad ((<=<))
import "base" Data.Bifunctor (second)
import "base" Data.Either (Either (Left))
import "base" Data.Eq ((==))
import "base" Data.Foldable (foldrM)
import "base" Data.Function (flip, ($))
import "base" Data.Functor (fmap, (<$>))
import "base" Data.List (break, drop, lookup, reverse, uncons)
import "base" Data.Maybe (Maybe (Nothing), maybe)
import "base" Data.Monoid ((<>))
import "base" Data.String (String)
import "base" Data.Tuple (fst, uncurry)
import "base" Data.Version (Version, parseVersion)
import "base" Text.ParserCombinators.ReadP (readP_to_S)

-- | `-fplugin-opt`s are provided to the plugin in reverse order before GHC 8.6.
--   This ensures the plugin always receives then in the order they were
--   provided on the command line.
correctOptionOrder :: [String] -> [String]
#if MIN_VERSION_GLASGOW_HASKELL(8, 6, 1, 0)
correctOptionOrder :: [String] -> [String]
correctOptionOrder [String]
x = [String]
x
#else
correctOptionOrder = reverse
#endif

-- | This mirrors the levels provided by GHC’s warning flags. Correspondingly,
--   we use the lowercase forms for the plugin opts instead of the capitalized
--   ones.
data ReportLevel = Warn | Error

defaultOpts :: Version -> Opts
defaultOpts :: Version -> Opts
defaultOpts Version
minVersion =
  Opts {Version
minVersion :: Version
minVersion :: Version
minVersion, reportIncompatibleExtensions :: Maybe ReportLevel
reportIncompatibleExtensions = ReportLevel -> Maybe ReportLevel
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ReportLevel
Warn}

readVersion :: String -> Maybe Version
readVersion :: String -> Maybe Version
readVersion = (((Version, String), [(Version, String)]) -> Version)
-> Maybe ((Version, String), [(Version, String)]) -> Maybe Version
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Version, String) -> Version
forall a b. (a, b) -> a
fst ((Version, String) -> Version)
-> (((Version, String), [(Version, String)]) -> (Version, String))
-> ((Version, String), [(Version, String)])
-> Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((Version, String), [(Version, String)]) -> (Version, String)
forall a b. (a, b) -> a
fst) (Maybe ((Version, String), [(Version, String)]) -> Maybe Version)
-> (String -> Maybe ((Version, String), [(Version, String)]))
-> String
-> Maybe Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [(Version, String)]
-> Maybe ((Version, String), [(Version, String)])
forall a. [a] -> Maybe (a, [a])
uncons ([(Version, String)]
 -> Maybe ((Version, String), [(Version, String)]))
-> (String -> [(Version, String)])
-> String
-> Maybe ((Version, String), [(Version, String)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [(Version, String)] -> [(Version, String)]
forall a. [a] -> [a]
reverse ([(Version, String)] -> [(Version, String)])
-> (String -> [(Version, String)]) -> String -> [(Version, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ReadP Version -> String -> [(Version, String)]
forall a. ReadP a -> ReadS a
readP_to_S ReadP Version
parseVersion

-- | Options support by the plugin. These can be specified with the
--   [@-fplugin-opt@](https://downloads.haskell.org/ghc/latest/docs/users_guide/extending_ghc.html#ghc-flag-fplugin-opt-module-args)
--   GHC option.
--
-- >>> defaultOpts <$> readVersion "7.10.1"
-- Just (Opts {minVersion = Version {versionBranch = [7,10,1], versionTags = []}, reportIncompatibleExtensions = Just Warn})
data Opts = Opts
  { -- | Period-separated natural numbers (e.g., “7.10.1”).
    Opts -> Version
minVersion :: Version,
    -- | This can be “no”, “warn” (the default), or “error”.
    Opts -> Maybe ReportLevel
reportIncompatibleExtensions :: Maybe ReportLevel
  }

parseVersion' :: String -> Either String Version
parseVersion' :: String -> Either String Version
parseVersion' String
versionStr =
  Either String Version
-> (Version -> Either String Version)
-> Maybe Version
-> Either String Version
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
    (String -> Either String Version
forall a b. a -> Either a b
Left (String -> Either String Version)
-> String -> Either String Version
forall a b. (a -> b) -> a -> b
$ String
"Couldn’t parse ‘minVersion’ value ‘" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
versionStr String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"’.")
    Version -> Either String Version
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (Maybe Version -> Either String Version)
-> Maybe Version -> Either String Version
forall a b. (a -> b) -> a -> b
$ String -> Maybe Version
readVersion String
versionStr

parseOpt :: Opts -> String -> String -> Either String Opts
parseOpt :: Opts -> String -> String -> Either String Opts
parseOpt Opts
opts String
name String
value = case (String
name, String
value) of
  (String
"minVersion", String
version) ->
    (\Version
v -> Opts
opts {minVersion = v}) (Version -> Opts) -> Either String Version -> Either String Opts
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Either String Version
parseVersion' String
version
  (String
"reportIncompatibleExtensions", String
level) ->
    (\Maybe ReportLevel
v -> Opts
opts {reportIncompatibleExtensions = v}) (Maybe ReportLevel -> Opts)
-> Either String (Maybe ReportLevel) -> Either String Opts
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case String
level of
      String
"no" -> Maybe ReportLevel -> Either String (Maybe ReportLevel)
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ReportLevel
forall a. Maybe a
Nothing
      String
"warn" -> Maybe ReportLevel -> Either String (Maybe ReportLevel)
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ReportLevel -> Either String (Maybe ReportLevel))
-> Maybe ReportLevel -> Either String (Maybe ReportLevel)
forall a b. (a -> b) -> a -> b
$ ReportLevel -> Maybe ReportLevel
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ReportLevel
Warn
      String
"error" -> Maybe ReportLevel -> Either String (Maybe ReportLevel)
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ReportLevel -> Either String (Maybe ReportLevel))
-> Maybe ReportLevel -> Either String (Maybe ReportLevel)
forall a b. (a -> b) -> a -> b
$ ReportLevel -> Maybe ReportLevel
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ReportLevel
Error
      String
_ ->
        String -> Either String (Maybe ReportLevel)
forall a b. a -> Either a b
Left (String -> Either String (Maybe ReportLevel))
-> String -> Either String (Maybe ReportLevel)
forall a b. (a -> b) -> a -> b
$
          String
"Unknown reporting level ‘"
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
level
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"’ (options are ‘no’, ‘warn’, and ‘error’)."
  (String
k, String
v) ->
    String -> Either String Opts
forall a b. a -> Either a b
Left (String -> Either String Opts) -> String -> Either String Opts
forall a b. (a -> b) -> a -> b
$
      String
"Received unknown plugin-opt ‘" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
k String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"’ with value ‘" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
v String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"’."

parse :: [String] -> Either String Opts
parse :: [String] -> Either String Opts
parse [String]
optStrs =
  let kv :: [(String, String)]
kv = (String -> String) -> (String, String) -> (String, String)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1) ((String, String) -> (String, String))
-> (String -> (String, String)) -> String -> (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'=') (String -> (String, String)) -> [String] -> [(String, String)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
optStrs
   in Either String Opts
-> (String -> Either String Opts)
-> Maybe String
-> Either String Opts
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        (String -> Either String Opts
forall a b. a -> Either a b
Left String
"Missing required ‘minVersion’ plugin-opt.")
        ( ( \Version
version ->
              ((String, String) -> Opts -> Either String Opts)
-> Opts -> [(String, String)] -> Either String Opts
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> b -> m b) -> b -> t a -> m b
foldrM ((Opts -> (String, String) -> Either String Opts)
-> (String, String) -> Opts -> Either String Opts
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Opts -> (String, String) -> Either String Opts)
 -> (String, String) -> Opts -> Either String Opts)
-> (Opts -> (String, String) -> Either String Opts)
-> (String, String)
-> Opts
-> Either String Opts
forall a b. (a -> b) -> a -> b
$ (String -> String -> Either String Opts)
-> (String, String) -> Either String Opts
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((String -> String -> Either String Opts)
 -> (String, String) -> Either String Opts)
-> (Opts -> String -> String -> Either String Opts)
-> Opts
-> (String, String)
-> Either String Opts
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Opts -> String -> String -> Either String Opts
parseOpt) (Version -> Opts
defaultOpts Version
version) ([(String, String)] -> Either String Opts)
-> [(String, String)] -> Either String Opts
forall a b. (a -> b) -> a -> b
$
                [(String, String)] -> [(String, String)]
forall a. [a] -> [a]
reverse [(String, String)]
kv
          )
            (Version -> Either String Opts)
-> (String -> Either String Version)
-> String
-> Either String Opts
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< String -> Either String Version
parseVersion'
        )
        (Maybe String -> Either String Opts)
-> Maybe String -> Either String Opts
forall a b. (a -> b) -> a -> b
$ String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"minVersion" [(String, String)]
kv