-- This file is part of Hoppy.
--
-- Copyright 2015-2024 Bryan Gardiner <bog@khumba.net>
--
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU Affero General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU Affero General Public License for more details.
--
-- You should have received a copy of the GNU Affero General Public License
-- along with this program.  If not, see <http://www.gnu.org/licenses/>.

{-# LANGUAGE CPP #-}

-- | Hooks for controlling various parts of generators.
module Foreign.Hoppy.Generator.Hook (
  Hooks (..),
  defaultHooks,
  -- * Enum evaluation
  EnumEvaluator,
  EnumEvaluatorArgs (..),
  EnumEvaluatorEntry (..),
  EnumEvaluatorResult (..),
  evaluateEnumsWithCompiler,
  evaluateEnumsWithDefaultCompiler,
  makeCppSourceToEvaluateEnums,
  interpretOutputToEvaluateEnums,
  -- * Internal
  NumericTypeInfo (..),
  pickNumericType,
  internalEvaluateEnumsForInterface,
  ) where

import Control.Arrow ((&&&))
import Control.Monad (forM, forM_, unless, when)
import Control.Monad.Except (ExceptT (ExceptT), MonadError, runExceptT, throwError)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.State (MonadState, execStateT, modify')
import Control.Monad.Writer (execWriter, tell)
import Data.ByteString.Lazy (ByteString, hPut)
import Data.ByteString.Builder (stringUtf8, toLazyByteString)
#if !MIN_VERSION_base(4,12,0)
import Data.List (splitAt)
#endif
import qualified Data.Map as M
import Data.Maybe (isJust, mapMaybe, maybeToList)
import qualified Data.Set as S
import Foreign.Hoppy.Generator.Common (doubleQuote, for, fromMaybeM, pluralize)
import Foreign.Hoppy.Generator.Common.Consume (MonadConsume, evalConsume, next)
import Foreign.Hoppy.Generator.Compiler (
  Compiler,
  SomeCompiler (SomeCompiler),
  compileProgram,
  prependIncludePath,
  )
import Foreign.Hoppy.Generator.Language.Cpp (renderIdentifier)
import Foreign.Hoppy.Generator.Spec.Base
import Foreign.Hoppy.Generator.Spec.Computed (
  EvaluatedEnumData (..),
  NumericTypeInfo,
  findNumericTypeInfo,
  numBytes,
  pickNumericType,
  )
import Foreign.Hoppy.Generator.Util (withTempFile)
import Foreign.Hoppy.Generator.Version (CppVersion (Cpp2011), activeCppVersion)
import System.Exit (ExitCode (ExitFailure, ExitSuccess), exitFailure)
import System.IO (hClose, hPutStrLn, stderr)
import System.Process (readProcessWithExitCode)

-- | These hooks can be used to customize the behaviour of a Hoppy generator.
data Hooks = Hooks
  { Hooks -> EnumEvaluator
hookEvaluateEnums :: EnumEvaluator
    -- ^ This hook is invoked once for an interface when the generator needs
    -- information about some enums beyond what's been baked into the interface
    -- (for example, to compute the enum's numeric type or entry values, see
    -- 'EvaluatedEnumData').  This will be called at most once per interface per
    -- invocation of the generator.
  }

-- | The default set of hooks associated with an interface.  This sets
-- 'hookEvaluateEnums' to 'evaluateEnumsWithDefaultCompiler'.
defaultHooks :: Hooks
defaultHooks :: Hooks
defaultHooks =
  Hooks
  { hookEvaluateEnums :: EnumEvaluator
hookEvaluateEnums = EnumEvaluator
evaluateEnumsWithDefaultCompiler
  }

-- | A function that answers with representation information about an enum (e.g.
-- entries' numeric values) for a given request.  On success, it returns the
-- requested data.  On failure, it prints a message to standard error and
-- returns @Nothing@.
type EnumEvaluator = EnumEvaluatorArgs -> IO (Maybe EnumEvaluatorResult)

-- | Inputs to the process of automatically evaluting enums.
data EnumEvaluatorArgs = EnumEvaluatorArgs
  { EnumEvaluatorArgs -> Interface
enumEvaluatorArgsInterface :: Interface
    -- ^ The interface that enum values are being calculated for.
  , EnumEvaluatorArgs -> EnumEntryWords
enumEvaluatorArgsPrependedIncludeDirs :: [FilePath]
    -- ^ Additional paths to prepend to the C++ include path during compilation.
  , EnumEvaluatorArgs -> Reqs
enumEvaluatorArgsReqs :: Reqs
    -- ^ Requirements (includes, etc.) needed to reference the enum identifiers
    -- being evaluated.
  , EnumEvaluatorArgs -> [Identifier]
enumEvaluatorArgsSizeofIdentifiers :: [Identifier]
    -- ^ The list of identifiers that we need to compute sizeof() for.
  , EnumEvaluatorArgs -> [EnumEvaluatorEntry]
enumEvaluatorArgsEntries :: [EnumEvaluatorEntry]
    -- ^ The list of entries to calculate values for.
  , EnumEvaluatorArgs -> Bool
enumEvaluatorArgsKeepOutputsOnFailure :: Bool
    -- ^ Whether to leave temporary build inputs and outputs on disk in case the
    -- calculation fails.  If failure does occur and this is true, then the
    -- calculation should print to standard error the location of these files
    -- (this is taken care of by the @calculateEnumValues*@ functions here.)
  }

-- | An entry in an enumeration.  This also tracks whether the entry came from a
-- scoped enum, for assertion reasons.
data EnumEvaluatorEntry = EnumEvaluatorEntry
  { EnumEvaluatorEntry -> Scoped
enumEvaluatorEntryScoped :: Scoped
    -- ^ Whether the entry comes from a scoped enum.
  , EnumEvaluatorEntry -> Identifier
enumEvaluatorEntryIdentifier :: Identifier
    -- ^ The identifier referring to the entry.
  }
  deriving (EnumEvaluatorEntry -> EnumEvaluatorEntry -> Bool
(EnumEvaluatorEntry -> EnumEvaluatorEntry -> Bool)
-> (EnumEvaluatorEntry -> EnumEvaluatorEntry -> Bool)
-> Eq EnumEvaluatorEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EnumEvaluatorEntry -> EnumEvaluatorEntry -> Bool
== :: EnumEvaluatorEntry -> EnumEvaluatorEntry -> Bool
$c/= :: EnumEvaluatorEntry -> EnumEvaluatorEntry -> Bool
/= :: EnumEvaluatorEntry -> EnumEvaluatorEntry -> Bool
Eq)

instance Ord EnumEvaluatorEntry where
  compare :: EnumEvaluatorEntry -> EnumEvaluatorEntry -> Ordering
compare (EnumEvaluatorEntry Scoped
_ Identifier
i1) (EnumEvaluatorEntry Scoped
_ Identifier
i2) =
    OrdIdentifier -> OrdIdentifier -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Identifier -> OrdIdentifier
OrdIdentifier Identifier
i1) (Identifier -> OrdIdentifier
OrdIdentifier Identifier
i2)

-- | Raw outputs parsed from the output of an enum evaluator.
data EnumEvaluatorResult = EnumEvaluatorResult
  { EnumEvaluatorResult -> [Int]
enumEvaluatorResultSizes :: ![Int]
    -- ^ The sizeof() for each identifier in 'enumEvaluatorArgsSizeofIdentifiers'.
    -- The lengths of these two lists must match.
  , EnumEvaluatorResult -> [Integer]
enumEvaluatorResultValues :: ![Integer]
    -- ^ The numeric value for each identifier in 'enumEvaluatorArgsEntries'.
    -- The lengths of these two lists must match.
  } deriving (Int -> EnumEvaluatorResult -> ShowS
[EnumEvaluatorResult] -> ShowS
EnumEvaluatorResult -> String
(Int -> EnumEvaluatorResult -> ShowS)
-> (EnumEvaluatorResult -> String)
-> ([EnumEvaluatorResult] -> ShowS)
-> Show EnumEvaluatorResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EnumEvaluatorResult -> ShowS
showsPrec :: Int -> EnumEvaluatorResult -> ShowS
$cshow :: EnumEvaluatorResult -> String
show :: EnumEvaluatorResult -> String
$cshowList :: [EnumEvaluatorResult] -> ShowS
showList :: [EnumEvaluatorResult] -> ShowS
Show)

-- | An 'EnumEvaluatorResult' without any data in it.
emptyEnumEvaluatorResult :: EnumEvaluatorResult
emptyEnumEvaluatorResult :: EnumEvaluatorResult
emptyEnumEvaluatorResult = EnumEvaluatorResult
  { enumEvaluatorResultSizes :: [Int]
enumEvaluatorResultSizes = []
  , enumEvaluatorResultValues :: [Integer]
enumEvaluatorResultValues = []
  }

-- | Calculates enum values using an interface's compiler.
evaluateEnumsWithDefaultCompiler :: EnumEvaluator
evaluateEnumsWithDefaultCompiler :: EnumEvaluator
evaluateEnumsWithDefaultCompiler EnumEvaluatorArgs
args = do
  let iface :: Interface
iface = EnumEvaluatorArgs -> Interface
enumEvaluatorArgsInterface EnumEvaluatorArgs
args
  case Interface -> Maybe SomeCompiler
interfaceCompiler Interface
iface of
    Just (SomeCompiler a
compiler) -> a -> EnumEvaluator
forall a. Compiler a => a -> EnumEvaluator
evaluateEnumsWithCompiler a
compiler EnumEvaluatorArgs
args
    Maybe SomeCompiler
Nothing -> do
      Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
        String
"evaluateEnumsWithDefaultCompiler: Don't have a compiler to evaluate enums with in " String -> ShowS
forall a. [a] -> [a] -> [a]
++
        Interface -> String
forall a. Show a => a -> String
show Interface
iface String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"."
      Maybe EnumEvaluatorResult -> IO (Maybe EnumEvaluatorResult)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe EnumEvaluatorResult
forall a. Maybe a
Nothing

-- | Evaluate enums using a specified compiler.
evaluateEnumsWithCompiler :: Compiler a => a -> EnumEvaluator
evaluateEnumsWithCompiler :: forall a. Compiler a => a -> EnumEvaluator
evaluateEnumsWithCompiler a
compiler EnumEvaluatorArgs
args =
  let compiler' :: a
compiler' = case EnumEvaluatorArgs -> EnumEntryWords
enumEvaluatorArgsPrependedIncludeDirs EnumEvaluatorArgs
args of
        [] -> a
compiler
        EnumEntryWords
dirs -> EnumEntryWords -> a -> a
forall a. Compiler a => EnumEntryWords -> a -> a
prependIncludePath EnumEntryWords
dirs a
compiler
  in
  String
-> Bool
-> (String -> Handle -> IO (Bool, Maybe EnumEvaluatorResult))
-> IO (Maybe EnumEvaluatorResult)
forall a.
String -> Bool -> (String -> Handle -> IO (Bool, a)) -> IO a
withTempFile String
"hoppy-enum.cpp" Bool
removeBuildFailures ((String -> Handle -> IO (Bool, Maybe EnumEvaluatorResult))
 -> IO (Maybe EnumEvaluatorResult))
-> (String -> Handle -> IO (Bool, Maybe EnumEvaluatorResult))
-> IO (Maybe EnumEvaluatorResult)
forall a b. (a -> b) -> a -> b
$ \String
cppPath Handle
cppHandle ->
  String
-> Bool
-> (String
    -> Handle -> IO (Bool, (Bool, Maybe EnumEvaluatorResult)))
-> IO (Bool, Maybe EnumEvaluatorResult)
forall a.
String -> Bool -> (String -> Handle -> IO (Bool, a)) -> IO a
withTempFile String
"hoppy-enum" Bool
removeBuildFailures ((String -> Handle -> IO (Bool, (Bool, Maybe EnumEvaluatorResult)))
 -> IO (Bool, Maybe EnumEvaluatorResult))
-> (String
    -> Handle -> IO (Bool, (Bool, Maybe EnumEvaluatorResult)))
-> IO (Bool, Maybe EnumEvaluatorResult)
forall a b. (a -> b) -> a -> b
$ \String
binPath Handle
binHandle -> do
  Handle -> ByteString -> IO ()
hPut Handle
cppHandle ByteString
program
  Handle -> IO ()
hClose Handle
cppHandle
  Handle -> IO ()
hClose Handle
binHandle
  Bool
success <- a -> String -> String -> IO Bool
forall a. Compiler a => a -> String -> String -> IO Bool
compileProgram a
compiler' String
cppPath String
binPath
  Maybe EnumEvaluatorResult
result <- case Bool
success of
    Bool
False -> do
      Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
        String
"evaluateEnumsWithCompiler: Failed to build program " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
cppPath String -> ShowS
forall a. [a] -> [a] -> [a]
++
        String
" to evaluate enums with " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
compiler' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"." String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
removeBuildFailuresNote
      Maybe EnumEvaluatorResult -> IO (Maybe EnumEvaluatorResult)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe EnumEvaluatorResult
forall a. Maybe a
Nothing
    Bool
True -> String -> IO (Maybe EnumEvaluatorResult)
runAndGetOutput String
binPath
  let remove :: Bool
remove = Maybe EnumEvaluatorResult -> Bool
forall a. Maybe a -> Bool
isJust Maybe EnumEvaluatorResult
result Bool -> Bool -> Bool
|| Bool
removeBuildFailures
  (Bool, (Bool, Maybe EnumEvaluatorResult))
-> IO (Bool, (Bool, Maybe EnumEvaluatorResult))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
remove, (Bool
remove, Maybe EnumEvaluatorResult
result))

  where removeBuildFailures :: Bool
removeBuildFailures = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ EnumEvaluatorArgs -> Bool
enumEvaluatorArgsKeepOutputsOnFailure EnumEvaluatorArgs
args

        removeBuildFailuresNote :: String
removeBuildFailuresNote =
          if Bool
removeBuildFailures
          then String
"  Pass --keep-temp-outputs-on-failure to keep build outputs around for debugging."
          else String
"  --keep-temp-outputs-on-failure was given, leaving files on disk."

        program :: ByteString
program = EnumEvaluatorArgs -> ByteString
makeCppSourceToEvaluateEnums EnumEvaluatorArgs
args

        runAndGetOutput :: FilePath -> IO (Maybe EnumEvaluatorResult)
        runAndGetOutput :: String -> IO (Maybe EnumEvaluatorResult)
runAndGetOutput String
binPath = do
          Either String EnumEvaluatorResult
result <- ExceptT String IO EnumEvaluatorResult
-> IO (Either String EnumEvaluatorResult)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT String IO EnumEvaluatorResult
 -> IO (Either String EnumEvaluatorResult))
-> ExceptT String IO EnumEvaluatorResult
-> IO (Either String EnumEvaluatorResult)
forall a b. (a -> b) -> a -> b
$ do
            (ExitCode
exitCode, String
out, String
err) <- IO (ExitCode, String, String)
-> ExceptT String IO (ExitCode, String, String)
forall a. IO a -> ExceptT String IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (ExitCode, String, String)
 -> ExceptT String IO (ExitCode, String, String))
-> IO (ExitCode, String, String)
-> ExceptT String IO (ExitCode, String, String)
forall a b. (a -> b) -> a -> b
$ String -> EnumEntryWords -> String -> IO (ExitCode, String, String)
readProcessWithExitCode String
binPath [] String
""
            case ExitCode
exitCode of
              ExitFailure Int
code ->
                String -> ExceptT String IO EnumEvaluatorResult
forall a. String -> ExceptT String IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ExceptT String IO EnumEvaluatorResult)
-> String -> ExceptT String IO EnumEvaluatorResult
forall a b. (a -> b) -> a -> b
$
                String
"evaluateEnumsWithCompiler: Failed to run binary " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
binPath String -> ShowS
forall a. [a] -> [a] -> [a]
++
                String
", code = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
code String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", stdout = <<<" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
out String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">>>, stderr = <<<" String -> ShowS
forall a. [a] -> [a] -> [a]
++
                String
err String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">>>." String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
removeBuildFailuresNote
              ExitCode
ExitSuccess ->
                IO (Either String EnumEvaluatorResult)
-> ExceptT String IO EnumEvaluatorResult
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either String EnumEvaluatorResult)
 -> ExceptT String IO EnumEvaluatorResult)
-> IO (Either String EnumEvaluatorResult)
-> ExceptT String IO EnumEvaluatorResult
forall a b. (a -> b) -> a -> b
$ Either String EnumEvaluatorResult
-> IO (Either String EnumEvaluatorResult)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String EnumEvaluatorResult
 -> IO (Either String EnumEvaluatorResult))
-> Either String EnumEvaluatorResult
-> IO (Either String EnumEvaluatorResult)
forall a b. (a -> b) -> a -> b
$ EnumEvaluatorArgs -> String -> Either String EnumEvaluatorResult
interpretOutputToEvaluateEnums EnumEvaluatorArgs
args String
out

          case Either String EnumEvaluatorResult
result of
            Right EnumEvaluatorResult
value -> Maybe EnumEvaluatorResult -> IO (Maybe EnumEvaluatorResult)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe EnumEvaluatorResult -> IO (Maybe EnumEvaluatorResult))
-> Maybe EnumEvaluatorResult -> IO (Maybe EnumEvaluatorResult)
forall a b. (a -> b) -> a -> b
$ EnumEvaluatorResult -> Maybe EnumEvaluatorResult
forall a. a -> Maybe a
Just EnumEvaluatorResult
value
            Left String
err -> do
              Handle -> String -> IO ()
hPutStrLn Handle
stderr String
err
              Maybe EnumEvaluatorResult -> IO (Maybe EnumEvaluatorResult)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe EnumEvaluatorResult
forall a. Maybe a
Nothing

-- | Constructs the C++ source program to evaluate enums.
makeCppSourceToEvaluateEnums :: EnumEvaluatorArgs -> ByteString
makeCppSourceToEvaluateEnums :: EnumEvaluatorArgs -> ByteString
makeCppSourceToEvaluateEnums EnumEvaluatorArgs
args =
  Builder -> ByteString
toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ String -> Builder
stringUtf8 (String -> Builder) -> String -> Builder
forall a b. (a -> b) -> a -> b
$ EnumEntryWords -> String
unlines (EnumEntryWords -> String) -> EnumEntryWords -> String
forall a b. (a -> b) -> a -> b
$
  [ String
"#include <iostream>"
  ] EnumEntryWords -> EnumEntryWords -> EnumEntryWords
forall a. [a] -> [a] -> [a]
++
  (if (EnumEvaluatorEntry -> Bool) -> [EnumEvaluatorEntry] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any EnumEvaluatorEntry -> Bool
isEntryScoped ([EnumEvaluatorEntry] -> Bool) -> [EnumEvaluatorEntry] -> Bool
forall a b. (a -> b) -> a -> b
$ EnumEvaluatorArgs -> [EnumEvaluatorEntry]
enumEvaluatorArgsEntries EnumEvaluatorArgs
args
    then [ String
"#include <type_traits>" ]  -- We've asserted that we have C++11 in this case.
    else []) EnumEntryWords -> EnumEntryWords -> EnumEntryWords
forall a. [a] -> [a] -> [a]
++
  [ String
""
  ] EnumEntryWords -> EnumEntryWords -> EnumEntryWords
forall a. [a] -> [a] -> [a]
++ [(Include -> String) -> [Include] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Include -> String
includeToString ([Include] -> String) -> [Include] -> String
forall a b. (a -> b) -> a -> b
$
        Set Include -> [Include]
forall a. Set a -> [a]
S.elems (Set Include -> [Include]) -> Set Include -> [Include]
forall a b. (a -> b) -> a -> b
$ Reqs -> Set Include
reqsIncludes (Reqs -> Set Include) -> Reqs -> Set Include
forall a b. (a -> b) -> a -> b
$ EnumEvaluatorArgs -> Reqs
enumEvaluatorArgsReqs EnumEvaluatorArgs
args] EnumEntryWords -> EnumEntryWords -> EnumEntryWords
forall a. [a] -> [a] -> [a]
++
  [ String
""
  , String
"int main() {"
  , String
"  std::cout << \"#sizes\\n\";"
  ] EnumEntryWords -> EnumEntryWords -> EnumEntryWords
forall a. [a] -> [a] -> [a]
++ [Identifier] -> (Identifier -> String) -> EnumEntryWords
forall a b. [a] -> (a -> b) -> [b]
for (EnumEvaluatorArgs -> [Identifier]
enumEvaluatorArgsSizeofIdentifiers EnumEvaluatorArgs
args)
       (\Identifier
identifier ->
         let rendered :: String
rendered = Identifier -> String
renderIdentifier Identifier
identifier
         in String
"  std::cout << sizeof(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
rendered String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") << ' ' << " String -> ShowS
forall a. [a] -> [a] -> [a]
++
            ShowS
doubleQuote String
rendered String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" << '\\n';") EnumEntryWords -> EnumEntryWords -> EnumEntryWords
forall a. [a] -> [a] -> [a]
++
  [ String
"  std::cout << \"#values\\n\";"
  ] EnumEntryWords -> EnumEntryWords -> EnumEntryWords
forall a. [a] -> [a] -> [a]
++ [EnumEvaluatorEntry]
-> (EnumEvaluatorEntry -> String) -> EnumEntryWords
forall a b. [a] -> (a -> b) -> [b]
for (EnumEvaluatorArgs -> [EnumEvaluatorEntry]
enumEvaluatorArgsEntries EnumEvaluatorArgs
args)
       (\(EnumEvaluatorEntry Scoped
scoped Identifier
identifier) ->
         let rendered :: String
rendered = Identifier -> String
renderIdentifier Identifier
identifier
             numericExpr :: String
numericExpr = case Scoped
scoped of
               Scoped
Unscoped -> String
rendered
               Scoped
Scoped ->
                 String
"static_cast<std::underlying_type<decltype(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
rendered String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")>::type>(" String -> ShowS
forall a. [a] -> [a] -> [a]
++
                 String
rendered String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
         in String
"  std::cout << (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
numericExpr String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") << ' ' << " String -> ShowS
forall a. [a] -> [a] -> [a]
++
            ShowS
doubleQuote String
rendered String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" << '\\n';") EnumEntryWords -> EnumEntryWords -> EnumEntryWords
forall a. [a] -> [a] -> [a]
++
  [ String
""
  , String
"  return 0;"
  , String
"}"
  ]

-- | Interprets the output of a program generated by
-- 'makeCppSourceToEvaluateEnums', returning parsed values if successful, and an
-- error string otherwise.
interpretOutputToEvaluateEnums ::
  EnumEvaluatorArgs
  -> String
  -> Either String EnumEvaluatorResult
interpretOutputToEvaluateEnums :: EnumEvaluatorArgs -> String -> Either String EnumEvaluatorResult
interpretOutputToEvaluateEnums EnumEvaluatorArgs
args String
out =
  EnumEntryWords
-> Consume String (Either String EnumEvaluatorResult)
-> Either String EnumEvaluatorResult
forall s a. [s] -> Consume s a -> a
evalConsume (String -> EnumEntryWords
lines String
out) (Consume String (Either String EnumEvaluatorResult)
 -> Either String EnumEvaluatorResult)
-> Consume String (Either String EnumEvaluatorResult)
-> Either String EnumEvaluatorResult
forall a b. (a -> b) -> a -> b
$ ExceptT String (ConsumeT String Identity) EnumEvaluatorResult
-> Consume String (Either String EnumEvaluatorResult)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT String (ConsumeT String Identity) EnumEvaluatorResult
 -> Consume String (Either String EnumEvaluatorResult))
-> ExceptT String (ConsumeT String Identity) EnumEvaluatorResult
-> Consume String (Either String EnumEvaluatorResult)
forall a b. (a -> b) -> a -> b
$ (StateT
   EnumEvaluatorResult (ExceptT String (ConsumeT String Identity)) ()
 -> EnumEvaluatorResult
 -> ExceptT String (ConsumeT String Identity) EnumEvaluatorResult)
-> EnumEvaluatorResult
-> StateT
     EnumEvaluatorResult (ExceptT String (ConsumeT String Identity)) ()
-> ExceptT String (ConsumeT String Identity) EnumEvaluatorResult
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT
  EnumEvaluatorResult (ExceptT String (ConsumeT String Identity)) ()
-> EnumEvaluatorResult
-> ExceptT String (ConsumeT String Identity) EnumEvaluatorResult
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT EnumEvaluatorResult
emptyEnumEvaluatorResult (StateT
   EnumEvaluatorResult (ExceptT String (ConsumeT String Identity)) ()
 -> ExceptT String (ConsumeT String Identity) EnumEvaluatorResult)
-> StateT
     EnumEvaluatorResult (ExceptT String (ConsumeT String Identity)) ()
-> ExceptT String (ConsumeT String Identity) EnumEvaluatorResult
forall a b. (a -> b) -> a -> b
$ do
  String
-> StateT
     EnumEvaluatorResult (ExceptT String (ConsumeT String Identity)) ()
forall (m :: * -> *).
(MonadConsume String m, MonadError String m) =>
String -> m ()
expectLine String
"#sizes"
  [Identifier]
-> StateT
     EnumEvaluatorResult (ExceptT String (ConsumeT String Identity)) ()
forall (m :: * -> *).
(MonadConsume String m, MonadError String m,
 MonadState EnumEvaluatorResult m) =>
[Identifier] -> m ()
readSizes ([Identifier]
 -> StateT
      EnumEvaluatorResult (ExceptT String (ConsumeT String Identity)) ())
-> [Identifier]
-> StateT
     EnumEvaluatorResult (ExceptT String (ConsumeT String Identity)) ()
forall a b. (a -> b) -> a -> b
$ EnumEvaluatorArgs -> [Identifier]
enumEvaluatorArgsSizeofIdentifiers EnumEvaluatorArgs
args
  String
-> StateT
     EnumEvaluatorResult (ExceptT String (ConsumeT String Identity)) ()
forall (m :: * -> *).
(MonadConsume String m, MonadError String m) =>
String -> m ()
expectLine String
"#values"
  [Identifier]
-> StateT
     EnumEvaluatorResult (ExceptT String (ConsumeT String Identity)) ()
forall (m :: * -> *).
(MonadConsume String m, MonadError String m,
 MonadState EnumEvaluatorResult m) =>
[Identifier] -> m ()
readValues ([Identifier]
 -> StateT
      EnumEvaluatorResult (ExceptT String (ConsumeT String Identity)) ())
-> [Identifier]
-> StateT
     EnumEvaluatorResult (ExceptT String (ConsumeT String Identity)) ()
forall a b. (a -> b) -> a -> b
$ (EnumEvaluatorEntry -> Identifier)
-> [EnumEvaluatorEntry] -> [Identifier]
forall a b. (a -> b) -> [a] -> [b]
map (\(EnumEvaluatorEntry Scoped
_ Identifier
i) -> Identifier
i) ([EnumEvaluatorEntry] -> [Identifier])
-> [EnumEvaluatorEntry] -> [Identifier]
forall a b. (a -> b) -> a -> b
$ EnumEvaluatorArgs -> [EnumEvaluatorEntry]
enumEvaluatorArgsEntries EnumEvaluatorArgs
args
  StateT
  EnumEvaluatorResult (ExceptT String (ConsumeT String Identity)) ()
forall (m :: * -> *).
(MonadConsume String m, MonadError String m) =>
m ()
expectEof
  (EnumEvaluatorResult -> EnumEvaluatorResult)
-> StateT
     EnumEvaluatorResult (ExceptT String (ConsumeT String Identity)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((EnumEvaluatorResult -> EnumEvaluatorResult)
 -> StateT
      EnumEvaluatorResult (ExceptT String (ConsumeT String Identity)) ())
-> (EnumEvaluatorResult -> EnumEvaluatorResult)
-> StateT
     EnumEvaluatorResult (ExceptT String (ConsumeT String Identity)) ()
forall a b. (a -> b) -> a -> b
$ \EnumEvaluatorResult
             { enumEvaluatorResultSizes :: EnumEvaluatorResult -> [Int]
enumEvaluatorResultSizes = [Int]
sizes
             , enumEvaluatorResultValues :: EnumEvaluatorResult -> [Integer]
enumEvaluatorResultValues = [Integer]
values
             } ->
    EnumEvaluatorResult
    { enumEvaluatorResultSizes :: [Int]
enumEvaluatorResultSizes = [Int] -> [Int]
forall a. [a] -> [a]
reverse [Int]
sizes
    , enumEvaluatorResultValues :: [Integer]
enumEvaluatorResultValues = [Integer] -> [Integer]
forall a. [a] -> [a]
reverse [Integer]
values
    }
  where expectEof :: (MonadConsume String m, MonadError String m) => m ()
        expectEof :: forall (m :: * -> *).
(MonadConsume String m, MonadError String m) =>
m ()
expectEof = m (Maybe String)
forall s (m :: * -> *). MonadConsume s m => m (Maybe s)
next m (Maybe String) -> (Maybe String -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Maybe String
Nothing -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Just String
line -> String -> m ()
forall a. String -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Expected EOF, got " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
line String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"."

        expectLine :: (MonadConsume String m, MonadError String m) => String -> m ()
        expectLine :: forall (m :: * -> *).
(MonadConsume String m, MonadError String m) =>
String -> m ()
expectLine String
expected = do
          Maybe String
line <- m (Maybe String)
forall s (m :: * -> *). MonadConsume s m => m (Maybe s)
next
          Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe String
line Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
/= String -> Maybe String
forall a. a -> Maybe a
Just String
expected) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
            String -> m ()
forall a. String -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Expected " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
expected String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", got " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe String -> String
forall a. Show a => a -> String
show Maybe String
line String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"."

        expectIdentifier :: (MonadError String m, Read a) => Identifier -> String -> m a
        expectIdentifier :: forall (m :: * -> *) a.
(MonadError String m, Read a) =>
Identifier -> String -> m a
expectIdentifier Identifier
identifier String
line = case ReadS a
forall a. Read a => ReadS a
reads String
line of
          [(a
value, Char
' ':String
identStr)] -> do
            let expectedStr :: String
expectedStr = Identifier -> String
renderIdentifier Identifier
identifier
            Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String
identStr String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
expectedStr) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
              String -> m ()
forall a. String -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Expected identifier " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
expectedStr String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", but saw identifier " String -> ShowS
forall a. [a] -> [a] -> [a]
++
              ShowS
forall a. Show a => a -> String
show String
identStr String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"."
            a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
value
          [(a, String)]
_ ->
            String -> m a
forall a. String -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ String
"Expected a line for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Identifier -> String
forall a. Show a => a -> String
show Identifier
identifier String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", but got line " String -> ShowS
forall a. [a] -> [a] -> [a]
++
            ShowS
forall a. Show a => a -> String
show String
line String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"."

        readSizes :: (MonadConsume String m, MonadError String m, MonadState EnumEvaluatorResult m)
                  => [Identifier]
                  -> m ()
        readSizes :: forall (m :: * -> *).
(MonadConsume String m, MonadError String m,
 MonadState EnumEvaluatorResult m) =>
[Identifier] -> m ()
readSizes [Identifier]
expectedIdentifiers = case [Identifier]
expectedIdentifiers of
          [] -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Identifier
expectedIdentifier:[Identifier]
restIdentifiers -> m (Maybe String)
forall s (m :: * -> *). MonadConsume s m => m (Maybe s)
next m (Maybe String) -> (Maybe String -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Just String
line -> do
              Int
size <- Identifier -> String -> m Int
forall (m :: * -> *) a.
(MonadError String m, Read a) =>
Identifier -> String -> m a
expectIdentifier Identifier
expectedIdentifier String
line
              (EnumEvaluatorResult -> EnumEvaluatorResult) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((EnumEvaluatorResult -> EnumEvaluatorResult) -> m ())
-> (EnumEvaluatorResult -> EnumEvaluatorResult) -> m ()
forall a b. (a -> b) -> a -> b
$ \r :: EnumEvaluatorResult
r@EnumEvaluatorResult { enumEvaluatorResultSizes :: EnumEvaluatorResult -> [Int]
enumEvaluatorResultSizes = [Int]
sizes } ->
                EnumEvaluatorResult
r { enumEvaluatorResultSizes = size:sizes }
              [Identifier] -> m ()
forall (m :: * -> *).
(MonadConsume String m, MonadError String m,
 MonadState EnumEvaluatorResult m) =>
[Identifier] -> m ()
readSizes [Identifier]
restIdentifiers
            Maybe String
Nothing -> String -> m ()
forall a. String -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"Unexpected end of input while reading enum sizes."

        readValues :: (MonadConsume String m, MonadError String m, MonadState EnumEvaluatorResult m)
                   => [Identifier]
                   -> m ()
        readValues :: forall (m :: * -> *).
(MonadConsume String m, MonadError String m,
 MonadState EnumEvaluatorResult m) =>
[Identifier] -> m ()
readValues [Identifier]
expectedIdentifiers = case [Identifier]
expectedIdentifiers of
          [] -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Identifier
expectedIdentifier:[Identifier]
restIdentifiers -> m (Maybe String)
forall s (m :: * -> *). MonadConsume s m => m (Maybe s)
next m (Maybe String) -> (Maybe String -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Just String
line -> do
              Integer
value <- Identifier -> String -> m Integer
forall (m :: * -> *) a.
(MonadError String m, Read a) =>
Identifier -> String -> m a
expectIdentifier Identifier
expectedIdentifier String
line
              (EnumEvaluatorResult -> EnumEvaluatorResult) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((EnumEvaluatorResult -> EnumEvaluatorResult) -> m ())
-> (EnumEvaluatorResult -> EnumEvaluatorResult) -> m ()
forall a b. (a -> b) -> a -> b
$ \r :: EnumEvaluatorResult
r@EnumEvaluatorResult { enumEvaluatorResultValues :: EnumEvaluatorResult -> [Integer]
enumEvaluatorResultValues = [Integer]
values } ->
                EnumEvaluatorResult
r { enumEvaluatorResultValues = value:values }
              [Identifier] -> m ()
forall (m :: * -> *).
(MonadConsume String m, MonadError String m,
 MonadState EnumEvaluatorResult m) =>
[Identifier] -> m ()
readValues [Identifier]
restIdentifiers
            Maybe String
Nothing -> String -> m ()
forall a. String -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"Unexpected end of input while reading enum sizes."

-- | Collects all of the enum values that need calculating in an interface, runs
-- the hook to evaluate them, and stores the result in the interface.  This
-- won't recalculate enum data if it's already been calculated.
internalEvaluateEnumsForInterface ::
     Interface
  -> Maybe FilePath
     -- ^ A optional directory to add to the compiler's header search path.
     -- This is meant to be the directory holding C++ files included in the C++
     -- package.
  -> Bool
  -> IO (M.Map ExtName EvaluatedEnumData)
internalEvaluateEnumsForInterface :: Interface
-> Maybe String -> Bool -> IO (Map ExtName EvaluatedEnumData)
internalEvaluateEnumsForInterface Interface
iface Maybe String
maybeCppDir Bool
keepBuildFailures = do
  let validateEnumTypes :: Bool
validateEnumTypes = Interface -> Bool
interfaceValidateEnumTypes Interface
iface

      -- Collect all exports in the interface.
      allExports :: M.Map ExtName Export
      allExports :: Map ExtName Export
allExports = [Map ExtName Export] -> Map ExtName Export
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
M.unions ([Map ExtName Export] -> Map ExtName Export)
-> [Map ExtName Export] -> Map ExtName Export
forall a b. (a -> b) -> a -> b
$ (Module -> Map ExtName Export) -> [Module] -> [Map ExtName Export]
forall a b. (a -> b) -> [a] -> [b]
map Module -> Map ExtName Export
moduleExports ([Module] -> [Map ExtName Export])
-> [Module] -> [Map ExtName Export]
forall a b. (a -> b) -> a -> b
$ Map String Module -> [Module]
forall k a. Map k a -> [a]
M.elems (Map String Module -> [Module]) -> Map String Module -> [Module]
forall a b. (a -> b) -> a -> b
$ Interface -> Map String Module
interfaceModules Interface
iface

      -- Collect pertinent information about all enum exports that we need to
      -- evaluate.
      --
      -- ExtName: The name of the enum.
      -- Maybe Type: The enum's numeric type, if explicitly set.
      -- Maybe Identifier: The enum's identifier, if we need to evaluate it.
      -- Reqs: Requirements to reference the enum.
      -- EnumValueMap: Entries, so that we can evaluate the auto ones.
      enumExports :: [(ExtName, Maybe Type, Scoped, Maybe Identifier, Reqs, EnumValueMap)]
      enumExports :: [(ExtName, Maybe Type, Scoped, Maybe Identifier, Reqs,
  EnumValueMap)]
enumExports = ((Export
  -> Maybe
       (ExtName, Maybe Type, Scoped, Maybe Identifier, Reqs,
        EnumValueMap))
 -> [Export]
 -> [(ExtName, Maybe Type, Scoped, Maybe Identifier, Reqs,
      EnumValueMap)])
-> [Export]
-> (Export
    -> Maybe
         (ExtName, Maybe Type, Scoped, Maybe Identifier, Reqs,
          EnumValueMap))
-> [(ExtName, Maybe Type, Scoped, Maybe Identifier, Reqs,
     EnumValueMap)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Export
 -> Maybe
      (ExtName, Maybe Type, Scoped, Maybe Identifier, Reqs,
       EnumValueMap))
-> [Export]
-> [(ExtName, Maybe Type, Scoped, Maybe Identifier, Reqs,
     EnumValueMap)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Map ExtName Export -> [Export]
forall k a. Map k a -> [a]
M.elems Map ExtName Export
allExports) ((Export
  -> Maybe
       (ExtName, Maybe Type, Scoped, Maybe Identifier, Reqs,
        EnumValueMap))
 -> [(ExtName, Maybe Type, Scoped, Maybe Identifier, Reqs,
      EnumValueMap)])
-> (Export
    -> Maybe
         (ExtName, Maybe Type, Scoped, Maybe Identifier, Reqs,
          EnumValueMap))
-> [(ExtName, Maybe Type, Scoped, Maybe Identifier, Reqs,
     EnumValueMap)]
forall a b. (a -> b) -> a -> b
$ \Export
export ->
        ((EnumInfo
  -> (ExtName, Maybe Type, Scoped, Maybe Identifier, Reqs,
      EnumValueMap))
 -> Maybe EnumInfo
 -> Maybe
      (ExtName, Maybe Type, Scoped, Maybe Identifier, Reqs,
       EnumValueMap))
-> Maybe EnumInfo
-> (EnumInfo
    -> (ExtName, Maybe Type, Scoped, Maybe Identifier, Reqs,
        EnumValueMap))
-> Maybe
     (ExtName, Maybe Type, Scoped, Maybe Identifier, Reqs, EnumValueMap)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (EnumInfo
 -> (ExtName, Maybe Type, Scoped, Maybe Identifier, Reqs,
     EnumValueMap))
-> Maybe EnumInfo
-> Maybe
     (ExtName, Maybe Type, Scoped, Maybe Identifier, Reqs, EnumValueMap)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Export -> Maybe EnumInfo
forall a. Exportable a => a -> Maybe EnumInfo
getExportEnumInfo Export
export) ((EnumInfo
  -> (ExtName, Maybe Type, Scoped, Maybe Identifier, Reqs,
      EnumValueMap))
 -> Maybe
      (ExtName, Maybe Type, Scoped, Maybe Identifier, Reqs,
       EnumValueMap))
-> (EnumInfo
    -> (ExtName, Maybe Type, Scoped, Maybe Identifier, Reqs,
        EnumValueMap))
-> Maybe
     (ExtName, Maybe Type, Scoped, Maybe Identifier, Reqs, EnumValueMap)
forall a b. (a -> b) -> a -> b
$ \(EnumInfo
info :: EnumInfo) ->
          (EnumInfo -> ExtName
enumInfoExtName EnumInfo
info,
           EnumInfo -> Maybe Type
enumInfoNumericType EnumInfo
info,
           EnumInfo -> Scoped
enumInfoScoped EnumInfo
info,
           case (EnumInfo -> Maybe Type
enumInfoNumericType EnumInfo
info, Bool
validateEnumTypes) of
             (Just Type
_, Bool
False) -> Maybe Identifier
forall a. Maybe a
Nothing  -- Don't need to evaluate sizeof().
             (Maybe Type, Bool)
_ -> Identifier -> Maybe Identifier
forall a. a -> Maybe a
Just (Identifier -> Maybe Identifier) -> Identifier -> Maybe Identifier
forall a b. (a -> b) -> a -> b
$ EnumInfo -> Identifier
enumInfoIdentifier EnumInfo
info,  -- Need to evaluate sizeof().
           EnumInfo -> Reqs
enumInfoReqs EnumInfo
info,
           EnumInfo -> EnumValueMap
enumInfoValues EnumInfo
info)

      -- Determine a list of all values to evaluate, and the Reqs required to do
      -- so.
      sumReqs :: Reqs
      sizeofIdentifiersToEvaluate :: [OrdIdentifier]
      entriesToEvaluate :: [EnumEvaluatorEntry]
      (Reqs
sumReqs, [OrdIdentifier]
sizeofIdentifiersToEvaluate, [EnumEvaluatorEntry]
entriesToEvaluate) =
        -- Deduplicate entries by passing them through a set.
        (\(Reqs
a, [OrdIdentifier]
b, [EnumEvaluatorEntry]
c) -> (Reqs
a, [OrdIdentifier]
b, Set EnumEvaluatorEntry -> [EnumEvaluatorEntry]
forall a. Set a -> [a]
S.toList (Set EnumEvaluatorEntry -> [EnumEvaluatorEntry])
-> Set EnumEvaluatorEntry -> [EnumEvaluatorEntry]
forall a b. (a -> b) -> a -> b
$ [EnumEvaluatorEntry] -> Set EnumEvaluatorEntry
forall a. Ord a => [a] -> Set a
S.fromList [EnumEvaluatorEntry]
c)) ((Reqs, [OrdIdentifier], [EnumEvaluatorEntry])
 -> (Reqs, [OrdIdentifier], [EnumEvaluatorEntry]))
-> (Reqs, [OrdIdentifier], [EnumEvaluatorEntry])
-> (Reqs, [OrdIdentifier], [EnumEvaluatorEntry])
forall a b. (a -> b) -> a -> b
$
        Writer (Reqs, [OrdIdentifier], [EnumEvaluatorEntry]) ()
-> (Reqs, [OrdIdentifier], [EnumEvaluatorEntry])
forall w a. Writer w a -> w
execWriter (Writer (Reqs, [OrdIdentifier], [EnumEvaluatorEntry]) ()
 -> (Reqs, [OrdIdentifier], [EnumEvaluatorEntry]))
-> Writer (Reqs, [OrdIdentifier], [EnumEvaluatorEntry]) ()
-> (Reqs, [OrdIdentifier], [EnumEvaluatorEntry])
forall a b. (a -> b) -> a -> b
$ [(ExtName, Maybe Type, Scoped, Maybe Identifier, Reqs,
  EnumValueMap)]
-> ((ExtName, Maybe Type, Scoped, Maybe Identifier, Reqs,
     EnumValueMap)
    -> Writer (Reqs, [OrdIdentifier], [EnumEvaluatorEntry]) ())
-> Writer (Reqs, [OrdIdentifier], [EnumEvaluatorEntry]) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(ExtName, Maybe Type, Scoped, Maybe Identifier, Reqs,
  EnumValueMap)]
enumExports (((ExtName, Maybe Type, Scoped, Maybe Identifier, Reqs,
   EnumValueMap)
  -> Writer (Reqs, [OrdIdentifier], [EnumEvaluatorEntry]) ())
 -> Writer (Reqs, [OrdIdentifier], [EnumEvaluatorEntry]) ())
-> ((ExtName, Maybe Type, Scoped, Maybe Identifier, Reqs,
     EnumValueMap)
    -> Writer (Reqs, [OrdIdentifier], [EnumEvaluatorEntry]) ())
-> Writer (Reqs, [OrdIdentifier], [EnumEvaluatorEntry]) ()
forall a b. (a -> b) -> a -> b
$ \(ExtName
_, Maybe Type
_, Scoped
scoped, Maybe Identifier
maybeIdent, Reqs
reqs, EnumValueMap
entries) -> do
          (Reqs, [OrdIdentifier], [EnumEvaluatorEntry])
-> Writer (Reqs, [OrdIdentifier], [EnumEvaluatorEntry]) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Reqs
reqs,
                [OrdIdentifier]
-> (Identifier -> [OrdIdentifier])
-> Maybe Identifier
-> [OrdIdentifier]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Identifier
i -> [Identifier -> OrdIdentifier
OrdIdentifier Identifier
i]) Maybe Identifier
maybeIdent,
                [])
          [(EnumEntryWords, EnumValue)]
-> ((EnumEntryWords, EnumValue)
    -> Writer (Reqs, [OrdIdentifier], [EnumEvaluatorEntry]) ())
-> Writer (Reqs, [OrdIdentifier], [EnumEvaluatorEntry]) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map EnumEntryWords EnumValue -> [(EnumEntryWords, EnumValue)]
forall k a. Map k a -> [(k, a)]
M.toList (Map EnumEntryWords EnumValue -> [(EnumEntryWords, EnumValue)])
-> Map EnumEntryWords EnumValue -> [(EnumEntryWords, EnumValue)]
forall a b. (a -> b) -> a -> b
$ EnumValueMap -> Map EnumEntryWords EnumValue
enumValueMapValues EnumValueMap
entries) (((EnumEntryWords, EnumValue)
  -> Writer (Reqs, [OrdIdentifier], [EnumEvaluatorEntry]) ())
 -> Writer (Reqs, [OrdIdentifier], [EnumEvaluatorEntry]) ())
-> ((EnumEntryWords, EnumValue)
    -> Writer (Reqs, [OrdIdentifier], [EnumEvaluatorEntry]) ())
-> Writer (Reqs, [OrdIdentifier], [EnumEvaluatorEntry]) ()
forall a b. (a -> b) -> a -> b
$ \(EnumEntryWords
_, EnumValue
value) -> case EnumValue
value of
            EnumValueManual Integer
_ -> () -> Writer (Reqs, [OrdIdentifier], [EnumEvaluatorEntry]) ()
forall a.
a
-> WriterT (Reqs, [OrdIdentifier], [EnumEvaluatorEntry]) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            EnumValueAuto Identifier
identifier -> (Reqs, [OrdIdentifier], [EnumEvaluatorEntry])
-> Writer (Reqs, [OrdIdentifier], [EnumEvaluatorEntry]) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Reqs
forall a. Monoid a => a
mempty, [], [Scoped -> Identifier -> EnumEvaluatorEntry
EnumEvaluatorEntry Scoped
scoped Identifier
identifier])

  -- We currently only support evaluation of scoped enum entries in C++11
  -- and later, because we use std::underlying_type to perform the
  -- conversion of those entries to integral types, rather than doing
  -- e.g. two compilations, first determining their size.
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CppVersion
activeCppVersion CppVersion -> CppVersion -> Bool
forall a. Ord a => a -> a -> Bool
< CppVersion
Cpp2011) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    let [ExtName]
scopedEnumsWithAutoEntries :: [ExtName] = (((ExtName, Maybe Type, Scoped, Maybe Identifier, Reqs,
   EnumValueMap)
  -> Maybe ExtName)
 -> [(ExtName, Maybe Type, Scoped, Maybe Identifier, Reqs,
      EnumValueMap)]
 -> [ExtName])
-> [(ExtName, Maybe Type, Scoped, Maybe Identifier, Reqs,
     EnumValueMap)]
-> ((ExtName, Maybe Type, Scoped, Maybe Identifier, Reqs,
     EnumValueMap)
    -> Maybe ExtName)
-> [ExtName]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((ExtName, Maybe Type, Scoped, Maybe Identifier, Reqs,
  EnumValueMap)
 -> Maybe ExtName)
-> [(ExtName, Maybe Type, Scoped, Maybe Identifier, Reqs,
     EnumValueMap)]
-> [ExtName]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe [(ExtName, Maybe Type, Scoped, Maybe Identifier, Reqs,
  EnumValueMap)]
enumExports (((ExtName, Maybe Type, Scoped, Maybe Identifier, Reqs,
   EnumValueMap)
  -> Maybe ExtName)
 -> [ExtName])
-> ((ExtName, Maybe Type, Scoped, Maybe Identifier, Reqs,
     EnumValueMap)
    -> Maybe ExtName)
-> [ExtName]
forall a b. (a -> b) -> a -> b
$
          \(ExtName
extName, Maybe Type
_, Scoped
_, Maybe Identifier
_, Reqs
_, EnumValueMap
entries) ->
            if (EnumValue -> Bool) -> [EnumValue] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any EnumValue -> Bool
isAuto ([EnumValue] -> Bool) -> [EnumValue] -> Bool
forall a b. (a -> b) -> a -> b
$ Map EnumEntryWords EnumValue -> [EnumValue]
forall k a. Map k a -> [a]
M.elems (Map EnumEntryWords EnumValue -> [EnumValue])
-> Map EnumEntryWords EnumValue -> [EnumValue]
forall a b. (a -> b) -> a -> b
$ EnumValueMap -> Map EnumEntryWords EnumValue
enumValueMapValues EnumValueMap
entries
            then ExtName -> Maybe ExtName
forall a. a -> Maybe a
Just ExtName
extName
            else Maybe ExtName
forall a. Maybe a
Nothing
        ([ExtName]
namesToShow, [ExtName]
namesToSkip) = Int -> [ExtName] -> ([ExtName], [ExtName])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
10 [ExtName]
scopedEnumsWithAutoEntries
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([ExtName] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ExtName]
scopedEnumsWithAutoEntries) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
        String
"internalEvaluateEnumsForInterface': Automatic evaluation of enum values " String -> ShowS
forall a. [a] -> [a] -> [a]
++
        String
"requires at least " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CppVersion -> String
forall a. Show a => a -> String
show CppVersion
Cpp2011 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", but we are compiling for " String -> ShowS
forall a. [a] -> [a] -> [a]
++
        CppVersion -> String
forall a. Show a => a -> String
show CppVersion
activeCppVersion String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", aborting.  Enums requesting evaluation are " String -> ShowS
forall a. [a] -> [a] -> [a]
++
        [ExtName] -> String
forall a. Show a => a -> String
show [ExtName]
namesToShow String -> ShowS
forall a. [a] -> [a] -> [a]
++
        (if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [ExtName] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ExtName]
namesToSkip then String
" (and more)" else String
"") String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"."
      IO ()
forall a. IO a
exitFailure

  -- Evaluate the identifiers we are curious about, using the hook provided by
  -- the interface.
  EnumEvaluatorResult
evaluatorResult :: EnumEvaluatorResult <-
    case ([OrdIdentifier]
sizeofIdentifiersToEvaluate, [EnumEvaluatorEntry]
entriesToEvaluate) of
      ([], []) -> EnumEvaluatorResult -> IO EnumEvaluatorResult
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return EnumEvaluatorResult
emptyEnumEvaluatorResult
      ([OrdIdentifier], [EnumEvaluatorEntry])
_ -> do
        let hooks :: Hooks
hooks = Interface -> Hooks
interfaceHooks Interface
iface
            args :: EnumEvaluatorArgs
args = EnumEvaluatorArgs
                   { enumEvaluatorArgsInterface :: Interface
enumEvaluatorArgsInterface = Interface
iface
                   , enumEvaluatorArgsPrependedIncludeDirs :: EnumEntryWords
enumEvaluatorArgsPrependedIncludeDirs = Maybe String -> EnumEntryWords
forall a. Maybe a -> [a]
maybeToList Maybe String
maybeCppDir
                   , enumEvaluatorArgsReqs :: Reqs
enumEvaluatorArgsReqs = Reqs
sumReqs
                   , enumEvaluatorArgsSizeofIdentifiers :: [Identifier]
enumEvaluatorArgsSizeofIdentifiers =
                       (OrdIdentifier -> Identifier) -> [OrdIdentifier] -> [Identifier]
forall a b. (a -> b) -> [a] -> [b]
map OrdIdentifier -> Identifier
ordIdentifier [OrdIdentifier]
sizeofIdentifiersToEvaluate
                   , enumEvaluatorArgsEntries :: [EnumEvaluatorEntry]
enumEvaluatorArgsEntries = [EnumEvaluatorEntry]
entriesToEvaluate
                   , enumEvaluatorArgsKeepOutputsOnFailure :: Bool
enumEvaluatorArgsKeepOutputsOnFailure = Bool
keepBuildFailures
                   }
        Hooks -> EnumEvaluator
hookEvaluateEnums Hooks
hooks EnumEvaluatorArgs
args IO (Maybe EnumEvaluatorResult)
-> (Maybe EnumEvaluatorResult -> IO EnumEvaluatorResult)
-> IO EnumEvaluatorResult
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
          IO EnumEvaluatorResult
-> Maybe EnumEvaluatorResult -> IO EnumEvaluatorResult
forall (m :: * -> *) a. Monad m => m a -> Maybe a -> m a
fromMaybeM
          (do Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
                String
"internalEvaluateEnumsForInterface': Failed to build and run program.  Aborting."
              IO EnumEvaluatorResult
forall a. IO a
exitFailure)

  let entryIdentifiersToEvaluate :: [OrdIdentifier]
      entryIdentifiersToEvaluate :: [OrdIdentifier]
entryIdentifiersToEvaluate =
        (EnumEvaluatorEntry -> OrdIdentifier)
-> [EnumEvaluatorEntry] -> [OrdIdentifier]
forall a b. (a -> b) -> [a] -> [b]
map (Identifier -> OrdIdentifier
OrdIdentifier (Identifier -> OrdIdentifier)
-> (EnumEvaluatorEntry -> Identifier)
-> EnumEvaluatorEntry
-> OrdIdentifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumEvaluatorEntry -> Identifier
enumEvaluatorEntryIdentifier) [EnumEvaluatorEntry]
entriesToEvaluate

      evaluatedIdentifierSizes :: M.Map OrdIdentifier Int
      evaluatedIdentifierSizes :: Map OrdIdentifier Int
evaluatedIdentifierSizes =
        [(OrdIdentifier, Int)] -> Map OrdIdentifier Int
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(OrdIdentifier, Int)] -> Map OrdIdentifier Int)
-> [(OrdIdentifier, Int)] -> Map OrdIdentifier Int
forall a b. (a -> b) -> a -> b
$ [OrdIdentifier] -> [Int] -> [(OrdIdentifier, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [OrdIdentifier]
sizeofIdentifiersToEvaluate ([Int] -> [(OrdIdentifier, Int)])
-> [Int] -> [(OrdIdentifier, Int)]
forall a b. (a -> b) -> a -> b
$ EnumEvaluatorResult -> [Int]
enumEvaluatorResultSizes EnumEvaluatorResult
evaluatorResult

      evaluatedIdentifierValues :: M.Map OrdIdentifier Integer
      evaluatedIdentifierValues :: Map OrdIdentifier Integer
evaluatedIdentifierValues =
        [(OrdIdentifier, Integer)] -> Map OrdIdentifier Integer
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(OrdIdentifier, Integer)] -> Map OrdIdentifier Integer)
-> [(OrdIdentifier, Integer)] -> Map OrdIdentifier Integer
forall a b. (a -> b) -> a -> b
$ [OrdIdentifier] -> [Integer] -> [(OrdIdentifier, Integer)]
forall a b. [a] -> [b] -> [(a, b)]
zip [OrdIdentifier]
entryIdentifiersToEvaluate ([Integer] -> [(OrdIdentifier, Integer)])
-> [Integer] -> [(OrdIdentifier, Integer)]
forall a b. (a -> b) -> a -> b
$ EnumEvaluatorResult -> [Integer]
enumEvaluatorResultValues EnumEvaluatorResult
evaluatorResult

      getIdentifierSize :: Identifier -> IO Int
      getIdentifierSize :: Identifier -> IO Int
getIdentifierSize Identifier
identifier =
        IO Int -> Maybe Int -> IO Int
forall (m :: * -> *) a. Monad m => m a -> Maybe a -> m a
fromMaybeM
          (do Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
                String
"internalEvaluateEnumsForInterface': Internal error, " String -> ShowS
forall a. [a] -> [a] -> [a]
++
                String
"failed to find evaluated size for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Identifier -> String
forall a. Show a => a -> String
show Identifier
identifier String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"."
              IO Int
forall a. IO a
exitFailure) (Maybe Int -> IO Int) -> Maybe Int -> IO Int
forall a b. (a -> b) -> a -> b
$
          OrdIdentifier -> Map OrdIdentifier Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Identifier -> OrdIdentifier
OrdIdentifier Identifier
identifier) Map OrdIdentifier Int
evaluatedIdentifierSizes

      getIdentifierValue :: Identifier -> IO Integer
      getIdentifierValue :: Identifier -> IO Integer
getIdentifierValue Identifier
identifier =
        IO Integer -> Maybe Integer -> IO Integer
forall (m :: * -> *) a. Monad m => m a -> Maybe a -> m a
fromMaybeM
          (do Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
                String
"internalEvaluateEnumsForInterface': Internal error, " String -> ShowS
forall a. [a] -> [a] -> [a]
++
                String
"failed to find evaluated value for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Identifier -> String
forall a. Show a => a -> String
show Identifier
identifier String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"."
              IO Integer
forall a. IO a
exitFailure) (Maybe Integer -> IO Integer) -> Maybe Integer -> IO Integer
forall a b. (a -> b) -> a -> b
$
          OrdIdentifier -> Map OrdIdentifier Integer -> Maybe Integer
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Identifier -> OrdIdentifier
OrdIdentifier Identifier
identifier) Map OrdIdentifier Integer
evaluatedIdentifierValues

      getNumericTypeInfo :: ExtName -> Type -> IO NumericTypeInfo
      getNumericTypeInfo :: ExtName -> Type -> IO NumericTypeInfo
getNumericTypeInfo ExtName
extName Type
t =
        IO NumericTypeInfo -> Maybe NumericTypeInfo -> IO NumericTypeInfo
forall (m :: * -> *) a. Monad m => m a -> Maybe a -> m a
fromMaybeM
          (do Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
                String
"internalEvaluateEnumsForInterface': Explicit type " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Type -> String
forall a. Show a => a -> String
show Type
t String -> ShowS
forall a. [a] -> [a] -> [a]
++
                String
" for enum " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ExtName -> String
forall a. Show a => a -> String
show ExtName
extName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is not a usable numeric type."
              IO NumericTypeInfo
forall a. IO a
exitFailure) (Maybe NumericTypeInfo -> IO NumericTypeInfo)
-> Maybe NumericTypeInfo -> IO NumericTypeInfo
forall a b. (a -> b) -> a -> b
$
        Type -> Maybe NumericTypeInfo
findNumericTypeInfo Type
t

  -- Build a map containing the evaluated type and numeric values for all of
  -- the enums in the interface.
  Map ExtName EvaluatedEnumData
evaluatedDataMap :: M.Map ExtName EvaluatedEnumData <-
    ([(ExtName, EvaluatedEnumData)] -> Map ExtName EvaluatedEnumData)
-> IO [(ExtName, EvaluatedEnumData)]
-> IO (Map ExtName EvaluatedEnumData)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(ExtName, EvaluatedEnumData)] -> Map ExtName EvaluatedEnumData
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList (IO [(ExtName, EvaluatedEnumData)]
 -> IO (Map ExtName EvaluatedEnumData))
-> IO [(ExtName, EvaluatedEnumData)]
-> IO (Map ExtName EvaluatedEnumData)
forall a b. (a -> b) -> a -> b
$ [(ExtName, Maybe Type, Scoped, Maybe Identifier, Reqs,
  EnumValueMap)]
-> ((ExtName, Maybe Type, Scoped, Maybe Identifier, Reqs,
     EnumValueMap)
    -> IO (ExtName, EvaluatedEnumData))
-> IO [(ExtName, EvaluatedEnumData)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(ExtName, Maybe Type, Scoped, Maybe Identifier, Reqs,
  EnumValueMap)]
enumExports (((ExtName, Maybe Type, Scoped, Maybe Identifier, Reqs,
   EnumValueMap)
  -> IO (ExtName, EvaluatedEnumData))
 -> IO [(ExtName, EvaluatedEnumData)])
-> ((ExtName, Maybe Type, Scoped, Maybe Identifier, Reqs,
     EnumValueMap)
    -> IO (ExtName, EvaluatedEnumData))
-> IO [(ExtName, EvaluatedEnumData)]
forall a b. (a -> b) -> a -> b
$
    \(ExtName
extName, Maybe Type
maybeNumericType, Scoped
_, Maybe Identifier
maybeIdent, Reqs
_, EnumValueMap
values) -> do
      -- Build a map containing all of the numeric values in the enum.
      Map EnumEntryWords Integer
numMap :: M.Map [String] Integer <-
        ([(EnumEntryWords, Integer)] -> Map EnumEntryWords Integer)
-> IO [(EnumEntryWords, Integer)]
-> IO (Map EnumEntryWords Integer)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(EnumEntryWords, Integer)] -> Map EnumEntryWords Integer
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList (IO [(EnumEntryWords, Integer)] -> IO (Map EnumEntryWords Integer))
-> IO [(EnumEntryWords, Integer)]
-> IO (Map EnumEntryWords Integer)
forall a b. (a -> b) -> a -> b
$ [(EnumEntryWords, EnumValue)]
-> ((EnumEntryWords, EnumValue) -> IO (EnumEntryWords, Integer))
-> IO [(EnumEntryWords, Integer)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Map EnumEntryWords EnumValue -> [(EnumEntryWords, EnumValue)]
forall k a. Map k a -> [(k, a)]
M.toList (Map EnumEntryWords EnumValue -> [(EnumEntryWords, EnumValue)])
-> Map EnumEntryWords EnumValue -> [(EnumEntryWords, EnumValue)]
forall a b. (a -> b) -> a -> b
$ EnumValueMap -> Map EnumEntryWords EnumValue
enumValueMapValues EnumValueMap
values) (((EnumEntryWords, EnumValue) -> IO (EnumEntryWords, Integer))
 -> IO [(EnumEntryWords, Integer)])
-> ((EnumEntryWords, EnumValue) -> IO (EnumEntryWords, Integer))
-> IO [(EnumEntryWords, Integer)]
forall a b. (a -> b) -> a -> b
$ \(EnumEntryWords
label, EnumValue
value) -> do
          Integer
num <- case EnumValue
value of
            EnumValueManual Integer
n -> Integer -> IO Integer
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
n
            EnumValueAuto Identifier
entryIdent -> Identifier -> IO Integer
getIdentifierValue Identifier
entryIdent
          (EnumEntryWords, Integer) -> IO (EnumEntryWords, Integer)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (EnumEntryWords
label, Integer
num)

      -- Determine the bounds for those values, and use those to select a
      -- numeric type that we should use outside of C++ to represent the enum's
      -- values.  C++ doesn't give us a way to ask for the numeric type it uses
      -- directly, so we manually pick a numeric type of the right size that can
      -- handle everything.
      Int
bytes <- case (Maybe Type
maybeNumericType, Maybe Identifier
maybeIdent) of
        (Just Type
numericType, Just Identifier
identifier) -> do
          Int
providedBytes <- NumericTypeInfo -> Int
numBytes (NumericTypeInfo -> Int) -> IO NumericTypeInfo -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExtName -> Type -> IO NumericTypeInfo
getNumericTypeInfo ExtName
extName Type
numericType
          Int
evaluatedBytes <- Identifier -> IO Int
getIdentifierSize Identifier
identifier

          -- Verify that the explicit numeric type set on the enum is correct to
          -- use.
          Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
providedBytes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
evaluatedBytes) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
              String
"internalEvaluateEnumsForInterface': The explicit type " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Type -> String
forall a. Show a => a -> String
show Type
numericType String -> ShowS
forall a. [a] -> [a] -> [a]
++
              String
" for enum " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ExtName -> String
forall a. Show a => a -> String
show ExtName
extName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" takes " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String -> ShowS
pluralize Int
providedBytes String
"byte" String
"bytes" String -> ShowS
forall a. [a] -> [a] -> [a]
++
              String
", but sizeof(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Identifier -> String
renderIdentifier Identifier
identifier String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") evaluates to " String -> ShowS
forall a. [a] -> [a] -> [a]
++
              Int -> String -> ShowS
pluralize Int
evaluatedBytes String
"byte" String
"bytes" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"."
            IO ()
forall a. IO a
exitFailure

          Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
providedBytes

        (Just Type
numericType, Maybe Identifier
Nothing) -> NumericTypeInfo -> Int
numBytes (NumericTypeInfo -> Int) -> IO NumericTypeInfo -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExtName -> Type -> IO NumericTypeInfo
getNumericTypeInfo ExtName
extName Type
numericType

        (Maybe Type
Nothing, Just Identifier
identifier) -> Identifier -> IO Int
getIdentifierSize Identifier
identifier

        (Maybe Type
Nothing, Maybe Identifier
Nothing) ->
          String -> IO Int
forall a. HasCallStack => String -> a
error (String -> IO Int) -> String -> IO Int
forall a b. (a -> b) -> a -> b
$ String
"internalEvaluateEnumsForInterface': Internal error, don't have a size for " String -> ShowS
forall a. [a] -> [a] -> [a]
++
          String
"enum " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ExtName -> String
forall a. Show a => a -> String
show ExtName
extName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", shouldn't happen."

      let (Integer
low, Integer
high) = [Integer] -> Integer
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ([Integer] -> Integer)
-> ([Integer] -> Integer) -> [Integer] -> (Integer, Integer)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& [Integer] -> Integer
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Integer] -> (Integer, Integer))
-> [Integer] -> (Integer, Integer)
forall a b. (a -> b) -> a -> b
$ Map EnumEntryWords Integer -> [Integer]
forall k a. Map k a -> [a]
M.elems Map EnumEntryWords Integer
numMap
      NumericTypeInfo
numericType <-
        IO NumericTypeInfo -> Maybe NumericTypeInfo -> IO NumericTypeInfo
forall (m :: * -> *) a. Monad m => m a -> Maybe a -> m a
fromMaybeM
          (do Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
                String
"internalEvaluateEnumsForInterface': Couldn't find a numeric type " String -> ShowS
forall a. [a] -> [a] -> [a]
++
                String
"to use to represent the C++ enumeration " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ExtName -> String
forall a. Show a => a -> String
show ExtName
extName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"."
              IO NumericTypeInfo
forall a. IO a
exitFailure) (Maybe NumericTypeInfo -> IO NumericTypeInfo)
-> Maybe NumericTypeInfo -> IO NumericTypeInfo
forall a b. (a -> b) -> a -> b
$
        Int -> Integer -> Integer -> Maybe NumericTypeInfo
pickNumericType Int
bytes Integer
low Integer
high

      let result :: EvaluatedEnumData
result = EvaluatedEnumData
            { evaluatedEnumNumericType :: NumericTypeInfo
evaluatedEnumNumericType = NumericTypeInfo
numericType
            , evaluatedEnumValueMap :: Map EnumEntryWords Integer
evaluatedEnumValueMap = Map EnumEntryWords Integer
numMap
            }
      (ExtName, EvaluatedEnumData) -> IO (ExtName, EvaluatedEnumData)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ExtName
extName, EvaluatedEnumData
result)

  Map ExtName EvaluatedEnumData -> IO (Map ExtName EvaluatedEnumData)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Map ExtName EvaluatedEnumData
evaluatedDataMap

newtype OrdIdentifier = OrdIdentifier { OrdIdentifier -> Identifier
ordIdentifier :: Identifier }
  deriving (OrdIdentifier -> OrdIdentifier -> Bool
(OrdIdentifier -> OrdIdentifier -> Bool)
-> (OrdIdentifier -> OrdIdentifier -> Bool) -> Eq OrdIdentifier
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OrdIdentifier -> OrdIdentifier -> Bool
== :: OrdIdentifier -> OrdIdentifier -> Bool
$c/= :: OrdIdentifier -> OrdIdentifier -> Bool
/= :: OrdIdentifier -> OrdIdentifier -> Bool
Eq, Int -> OrdIdentifier -> ShowS
[OrdIdentifier] -> ShowS
OrdIdentifier -> String
(Int -> OrdIdentifier -> ShowS)
-> (OrdIdentifier -> String)
-> ([OrdIdentifier] -> ShowS)
-> Show OrdIdentifier
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OrdIdentifier -> ShowS
showsPrec :: Int -> OrdIdentifier -> ShowS
$cshow :: OrdIdentifier -> String
show :: OrdIdentifier -> String
$cshowList :: [OrdIdentifier] -> ShowS
showList :: [OrdIdentifier] -> ShowS
Show)

instance Ord OrdIdentifier where
  compare :: OrdIdentifier -> OrdIdentifier -> Ordering
compare (OrdIdentifier Identifier
i1) (OrdIdentifier Identifier
i2) =
    String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Identifier -> String
renderIdentifier Identifier
i1) (Identifier -> String
renderIdentifier Identifier
i2)

isAuto :: EnumValue -> Bool
isAuto :: EnumValue -> Bool
isAuto (EnumValueAuto Identifier
_) = Bool
True
isAuto (EnumValueManual Integer
_) = Bool
False

isEntryScoped :: EnumEvaluatorEntry -> Bool
isEntryScoped :: EnumEvaluatorEntry -> Bool
isEntryScoped (EnumEvaluatorEntry Scoped
scoped Identifier
_) = Scoped -> Bool
isScoped Scoped
scoped