-- This file is part of Hoppy.
--
-- Copyright 2015-2021 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 :: EnumEvaluator -> Hooks
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 -> [FilePath]
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
/= :: EnumEvaluatorEntry -> EnumEvaluatorEntry -> Bool
$c/= :: EnumEvaluatorEntry -> EnumEvaluatorEntry -> Bool
== :: EnumEvaluatorEntry -> EnumEvaluatorEntry -> Bool
$c== :: 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 -> FilePath
(Int -> EnumEvaluatorResult -> ShowS)
-> (EnumEvaluatorResult -> FilePath)
-> ([EnumEvaluatorResult] -> ShowS)
-> Show EnumEvaluatorResult
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [EnumEvaluatorResult] -> ShowS
$cshowList :: [EnumEvaluatorResult] -> ShowS
show :: EnumEvaluatorResult -> FilePath
$cshow :: EnumEvaluatorResult -> FilePath
showsPrec :: Int -> EnumEvaluatorResult -> ShowS
$cshowsPrec :: Int -> EnumEvaluatorResult -> ShowS
Show)

-- | An 'EnumEvaluatorResult' without any data in it.
emptyEnumEvaluatorResult :: EnumEvaluatorResult
emptyEnumEvaluatorResult :: EnumEvaluatorResult
emptyEnumEvaluatorResult = EnumEvaluatorResult :: [Int] -> [Integer] -> EnumEvaluatorResult
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 -> FilePath -> IO ()
hPutStrLn Handle
stderr (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
        FilePath
"evaluateEnumsWithDefaultCompiler: Don't have a compiler to evaluate enums with in " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++
        Interface -> FilePath
forall a. Show a => a -> FilePath
show Interface
iface FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"."
      Maybe EnumEvaluatorResult -> IO (Maybe EnumEvaluatorResult)
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 :: a -> EnumEvaluator
evaluateEnumsWithCompiler a
compiler EnumEvaluatorArgs
args =
  let compiler' :: a
compiler' = case EnumEvaluatorArgs -> [FilePath]
enumEvaluatorArgsPrependedIncludeDirs EnumEvaluatorArgs
args of
        [] -> a
compiler
        [FilePath]
dirs -> [FilePath] -> a -> a
forall a. Compiler a => [FilePath] -> a -> a
prependIncludePath [FilePath]
dirs a
compiler
  in
  FilePath
-> Bool
-> (FilePath -> Handle -> IO (Bool, Maybe EnumEvaluatorResult))
-> IO (Maybe EnumEvaluatorResult)
forall a.
FilePath -> Bool -> (FilePath -> Handle -> IO (Bool, a)) -> IO a
withTempFile FilePath
"hoppy-enum.cpp" Bool
removeBuildFailures ((FilePath -> Handle -> IO (Bool, Maybe EnumEvaluatorResult))
 -> IO (Maybe EnumEvaluatorResult))
-> (FilePath -> Handle -> IO (Bool, Maybe EnumEvaluatorResult))
-> IO (Maybe EnumEvaluatorResult)
forall a b. (a -> b) -> a -> b
$ \FilePath
cppPath Handle
cppHandle ->
  FilePath
-> Bool
-> (FilePath
    -> Handle -> IO (Bool, (Bool, Maybe EnumEvaluatorResult)))
-> IO (Bool, Maybe EnumEvaluatorResult)
forall a.
FilePath -> Bool -> (FilePath -> Handle -> IO (Bool, a)) -> IO a
withTempFile FilePath
"hoppy-enum" Bool
removeBuildFailures ((FilePath
  -> Handle -> IO (Bool, (Bool, Maybe EnumEvaluatorResult)))
 -> IO (Bool, Maybe EnumEvaluatorResult))
-> (FilePath
    -> Handle -> IO (Bool, (Bool, Maybe EnumEvaluatorResult)))
-> IO (Bool, Maybe EnumEvaluatorResult)
forall a b. (a -> b) -> a -> b
$ \FilePath
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 -> FilePath -> FilePath -> IO Bool
forall a. Compiler a => a -> FilePath -> FilePath -> IO Bool
compileProgram a
compiler' FilePath
cppPath FilePath
binPath
  Maybe EnumEvaluatorResult
result <- case Bool
success of
    Bool
False -> do
      Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
        FilePath
"evaluateEnumsWithCompiler: Failed to build program " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> FilePath
show FilePath
cppPath FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++
        FilePath
" to evaluate enums with " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> FilePath
forall a. Show a => a -> FilePath
show a
compiler' FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"." FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
removeBuildFailuresNote
      Maybe EnumEvaluatorResult -> IO (Maybe EnumEvaluatorResult)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe EnumEvaluatorResult
forall a. Maybe a
Nothing
    Bool
True -> FilePath -> IO (Maybe EnumEvaluatorResult)
runAndGetOutput FilePath
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 (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 :: FilePath
removeBuildFailuresNote =
          if Bool
removeBuildFailures
          then FilePath
"  Pass --keep-temp-outputs-on-failure to keep build outputs around for debugging."
          else FilePath
"  --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 :: FilePath -> IO (Maybe EnumEvaluatorResult)
runAndGetOutput FilePath
binPath = do
          Either FilePath EnumEvaluatorResult
result <- ExceptT FilePath IO EnumEvaluatorResult
-> IO (Either FilePath EnumEvaluatorResult)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT FilePath IO EnumEvaluatorResult
 -> IO (Either FilePath EnumEvaluatorResult))
-> ExceptT FilePath IO EnumEvaluatorResult
-> IO (Either FilePath EnumEvaluatorResult)
forall a b. (a -> b) -> a -> b
$ do
            (ExitCode
exitCode, FilePath
out, FilePath
err) <- IO (ExitCode, FilePath, FilePath)
-> ExceptT FilePath IO (ExitCode, FilePath, FilePath)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (ExitCode, FilePath, FilePath)
 -> ExceptT FilePath IO (ExitCode, FilePath, FilePath))
-> IO (ExitCode, FilePath, FilePath)
-> ExceptT FilePath IO (ExitCode, FilePath, FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath
-> [FilePath] -> FilePath -> IO (ExitCode, FilePath, FilePath)
readProcessWithExitCode FilePath
binPath [] FilePath
""
            case ExitCode
exitCode of
              ExitFailure Int
code ->
                FilePath -> ExceptT FilePath IO EnumEvaluatorResult
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (FilePath -> ExceptT FilePath IO EnumEvaluatorResult)
-> FilePath -> ExceptT FilePath IO EnumEvaluatorResult
forall a b. (a -> b) -> a -> b
$
                FilePath
"evaluateEnumsWithCompiler: Failed to run binary " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> FilePath
show FilePath
binPath FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++
                FilePath
", code = " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
code FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
", stdout = <<<" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
out FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
">>>, stderr = <<<" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++
                FilePath
err FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
">>>." FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
removeBuildFailuresNote
              ExitCode
ExitSuccess ->
                IO (Either FilePath EnumEvaluatorResult)
-> ExceptT FilePath IO EnumEvaluatorResult
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either FilePath EnumEvaluatorResult)
 -> ExceptT FilePath IO EnumEvaluatorResult)
-> IO (Either FilePath EnumEvaluatorResult)
-> ExceptT FilePath IO EnumEvaluatorResult
forall a b. (a -> b) -> a -> b
$ Either FilePath EnumEvaluatorResult
-> IO (Either FilePath EnumEvaluatorResult)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FilePath EnumEvaluatorResult
 -> IO (Either FilePath EnumEvaluatorResult))
-> Either FilePath EnumEvaluatorResult
-> IO (Either FilePath EnumEvaluatorResult)
forall a b. (a -> b) -> a -> b
$ EnumEvaluatorArgs
-> FilePath -> Either FilePath EnumEvaluatorResult
interpretOutputToEvaluateEnums EnumEvaluatorArgs
args FilePath
out

          case Either FilePath EnumEvaluatorResult
result of
            Right EnumEvaluatorResult
value -> Maybe EnumEvaluatorResult -> IO (Maybe EnumEvaluatorResult)
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 FilePath
err -> do
              Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr FilePath
err
              Maybe EnumEvaluatorResult -> IO (Maybe EnumEvaluatorResult)
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
$ FilePath -> Builder
stringUtf8 (FilePath -> Builder) -> FilePath -> Builder
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unlines ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$
  [ FilePath
"#include <iostream>"
  ] [FilePath] -> [FilePath] -> [FilePath]
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 [ FilePath
"#include <type_traits>" ]  -- We've asserted that we have C++11 in this case.
    else []) [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
  [ FilePath
""
  ] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [(Include -> FilePath) -> [Include] -> FilePath
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Include -> FilePath
includeToString ([Include] -> FilePath) -> [Include] -> FilePath
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] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
  [ FilePath
""
  , FilePath
"int main() {"
  , FilePath
"  std::cout << \"#sizes\\n\";"
  ] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [Identifier] -> (Identifier -> FilePath) -> [FilePath]
forall a b. [a] -> (a -> b) -> [b]
for (EnumEvaluatorArgs -> [Identifier]
enumEvaluatorArgsSizeofIdentifiers EnumEvaluatorArgs
args)
       (\Identifier
identifier ->
         let rendered :: FilePath
rendered = Identifier -> FilePath
renderIdentifier Identifier
identifier
         in FilePath
"  std::cout << sizeof(" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
rendered FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
") << ' ' << " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++
            ShowS
doubleQuote FilePath
rendered FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" << '\\n';") [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
  [ FilePath
"  std::cout << \"#values\\n\";"
  ] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [EnumEvaluatorEntry]
-> (EnumEvaluatorEntry -> FilePath) -> [FilePath]
forall a b. [a] -> (a -> b) -> [b]
for (EnumEvaluatorArgs -> [EnumEvaluatorEntry]
enumEvaluatorArgsEntries EnumEvaluatorArgs
args)
       (\(EnumEvaluatorEntry Scoped
scoped Identifier
identifier) ->
         let rendered :: FilePath
rendered = Identifier -> FilePath
renderIdentifier Identifier
identifier
             numericExpr :: FilePath
numericExpr = case Scoped
scoped of
               Scoped
Unscoped -> FilePath
rendered
               Scoped
Scoped ->
                 FilePath
"static_cast<std::underlying_type<decltype(" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
rendered FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
")>::type>(" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++
                 FilePath
rendered FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
")"
         in FilePath
"  std::cout << (" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
numericExpr FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
") << ' ' << " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++
            ShowS
doubleQuote FilePath
rendered FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" << '\\n';") [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
  [ FilePath
""
  , FilePath
"  return 0;"
  , FilePath
"}"
  ]

-- | 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
-> FilePath -> Either FilePath EnumEvaluatorResult
interpretOutputToEvaluateEnums EnumEvaluatorArgs
args FilePath
out =
  [FilePath]
-> Consume FilePath (Either FilePath EnumEvaluatorResult)
-> Either FilePath EnumEvaluatorResult
forall s a. [s] -> Consume s a -> a
evalConsume (FilePath -> [FilePath]
lines FilePath
out) (Consume FilePath (Either FilePath EnumEvaluatorResult)
 -> Either FilePath EnumEvaluatorResult)
-> Consume FilePath (Either FilePath EnumEvaluatorResult)
-> Either FilePath EnumEvaluatorResult
forall a b. (a -> b) -> a -> b
$ ExceptT FilePath (ConsumeT FilePath Identity) EnumEvaluatorResult
-> Consume FilePath (Either FilePath EnumEvaluatorResult)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT FilePath (ConsumeT FilePath Identity) EnumEvaluatorResult
 -> Consume FilePath (Either FilePath EnumEvaluatorResult))
-> ExceptT
     FilePath (ConsumeT FilePath Identity) EnumEvaluatorResult
-> Consume FilePath (Either FilePath EnumEvaluatorResult)
forall a b. (a -> b) -> a -> b
$ (StateT
   EnumEvaluatorResult
   (ExceptT FilePath (ConsumeT FilePath Identity))
   ()
 -> EnumEvaluatorResult
 -> ExceptT
      FilePath (ConsumeT FilePath Identity) EnumEvaluatorResult)
-> EnumEvaluatorResult
-> StateT
     EnumEvaluatorResult
     (ExceptT FilePath (ConsumeT FilePath Identity))
     ()
-> ExceptT
     FilePath (ConsumeT FilePath Identity) EnumEvaluatorResult
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT
  EnumEvaluatorResult
  (ExceptT FilePath (ConsumeT FilePath Identity))
  ()
-> EnumEvaluatorResult
-> ExceptT
     FilePath (ConsumeT FilePath Identity) EnumEvaluatorResult
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT EnumEvaluatorResult
emptyEnumEvaluatorResult (StateT
   EnumEvaluatorResult
   (ExceptT FilePath (ConsumeT FilePath Identity))
   ()
 -> ExceptT
      FilePath (ConsumeT FilePath Identity) EnumEvaluatorResult)
-> StateT
     EnumEvaluatorResult
     (ExceptT FilePath (ConsumeT FilePath Identity))
     ()
-> ExceptT
     FilePath (ConsumeT FilePath Identity) EnumEvaluatorResult
forall a b. (a -> b) -> a -> b
$ do
  FilePath
-> StateT
     EnumEvaluatorResult
     (ExceptT FilePath (ConsumeT FilePath Identity))
     ()
forall (m :: * -> *).
(MonadConsume FilePath m, MonadError FilePath m) =>
FilePath -> m ()
expectLine FilePath
"#sizes"
  [Identifier]
-> StateT
     EnumEvaluatorResult
     (ExceptT FilePath (ConsumeT FilePath Identity))
     ()
forall (m :: * -> *).
(MonadConsume FilePath m, MonadError FilePath m,
 MonadState EnumEvaluatorResult m) =>
[Identifier] -> m ()
readSizes ([Identifier]
 -> StateT
      EnumEvaluatorResult
      (ExceptT FilePath (ConsumeT FilePath Identity))
      ())
-> [Identifier]
-> StateT
     EnumEvaluatorResult
     (ExceptT FilePath (ConsumeT FilePath Identity))
     ()
forall a b. (a -> b) -> a -> b
$ EnumEvaluatorArgs -> [Identifier]
enumEvaluatorArgsSizeofIdentifiers EnumEvaluatorArgs
args
  FilePath
-> StateT
     EnumEvaluatorResult
     (ExceptT FilePath (ConsumeT FilePath Identity))
     ()
forall (m :: * -> *).
(MonadConsume FilePath m, MonadError FilePath m) =>
FilePath -> m ()
expectLine FilePath
"#values"
  [Identifier]
-> StateT
     EnumEvaluatorResult
     (ExceptT FilePath (ConsumeT FilePath Identity))
     ()
forall (m :: * -> *).
(MonadConsume FilePath m, MonadError FilePath m,
 MonadState EnumEvaluatorResult m) =>
[Identifier] -> m ()
readValues ([Identifier]
 -> StateT
      EnumEvaluatorResult
      (ExceptT FilePath (ConsumeT FilePath Identity))
      ())
-> [Identifier]
-> StateT
     EnumEvaluatorResult
     (ExceptT FilePath (ConsumeT FilePath 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 FilePath (ConsumeT FilePath Identity))
  ()
forall (m :: * -> *).
(MonadConsume FilePath m, MonadError FilePath m) =>
m ()
expectEof
  (EnumEvaluatorResult -> EnumEvaluatorResult)
-> StateT
     EnumEvaluatorResult
     (ExceptT FilePath (ConsumeT FilePath Identity))
     ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((EnumEvaluatorResult -> EnumEvaluatorResult)
 -> StateT
      EnumEvaluatorResult
      (ExceptT FilePath (ConsumeT FilePath Identity))
      ())
-> (EnumEvaluatorResult -> EnumEvaluatorResult)
-> StateT
     EnumEvaluatorResult
     (ExceptT FilePath (ConsumeT FilePath Identity))
     ()
forall a b. (a -> b) -> a -> b
$ \EnumEvaluatorResult
             { enumEvaluatorResultSizes :: EnumEvaluatorResult -> [Int]
enumEvaluatorResultSizes = [Int]
sizes
             , enumEvaluatorResultValues :: EnumEvaluatorResult -> [Integer]
enumEvaluatorResultValues = [Integer]
values
             } ->
    EnumEvaluatorResult :: [Int] -> [Integer] -> EnumEvaluatorResult
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 :: m ()
expectEof = m (Maybe FilePath)
forall s (m :: * -> *). MonadConsume s m => m (Maybe s)
next m (Maybe FilePath) -> (Maybe FilePath -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Maybe FilePath
Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Just FilePath
line -> FilePath -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (FilePath -> m ()) -> FilePath -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Expected EOF, got " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> FilePath
show FilePath
line FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"."

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

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

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

        readValues :: (MonadConsume String m, MonadError String m, MonadState EnumEvaluatorResult m)
                   => [Identifier]
                   -> m ()
        readValues :: [Identifier] -> m ()
readValues [Identifier]
expectedIdentifiers = case [Identifier]
expectedIdentifiers of
          [] -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Identifier
expectedIdentifier:[Identifier]
restIdentifiers -> m (Maybe FilePath)
forall s (m :: * -> *). MonadConsume s m => m (Maybe s)
next m (Maybe FilePath) -> (Maybe FilePath -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Just FilePath
line -> do
              Integer
value <- Identifier -> FilePath -> m Integer
forall (m :: * -> *) a.
(MonadError FilePath m, Read a) =>
Identifier -> FilePath -> m a
expectIdentifier Identifier
expectedIdentifier FilePath
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 :: [Integer]
enumEvaluatorResultValues = Integer
valueInteger -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
:[Integer]
values }
              [Identifier] -> m ()
forall (m :: * -> *).
(MonadConsume FilePath m, MonadError FilePath m,
 MonadState EnumEvaluatorResult m) =>
[Identifier] -> m ()
readValues [Identifier]
restIdentifiers
            Maybe FilePath
Nothing -> FilePath -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError FilePath
"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
  -> Bool
  -> IO (M.Map ExtName EvaluatedEnumData)
internalEvaluateEnumsForInterface :: Interface
-> Maybe FilePath -> Bool -> IO (Map ExtName EvaluatedEnumData)
internalEvaluateEnumsForInterface Interface
iface Maybe FilePath
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 FilePath Module -> [Module]
forall k a. Map k a -> [a]
M.elems (Map FilePath Module -> [Module])
-> Map FilePath Module -> [Module]
forall a b. (a -> b) -> a -> b
$ Interface -> Map FilePath 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 (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,
                [])
          [([FilePath], EnumValue)]
-> (([FilePath], 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 [FilePath] EnumValue -> [([FilePath], EnumValue)]
forall k a. Map k a -> [(k, a)]
M.toList (Map [FilePath] EnumValue -> [([FilePath], EnumValue)])
-> Map [FilePath] EnumValue -> [([FilePath], EnumValue)]
forall a b. (a -> b) -> a -> b
$ EnumValueMap -> Map [FilePath] EnumValue
enumValueMapValues EnumValueMap
entries) ((([FilePath], EnumValue)
  -> Writer (Reqs, [OrdIdentifier], [EnumEvaluatorEntry]) ())
 -> Writer (Reqs, [OrdIdentifier], [EnumEvaluatorEntry]) ())
-> (([FilePath], EnumValue)
    -> Writer (Reqs, [OrdIdentifier], [EnumEvaluatorEntry]) ())
-> Writer (Reqs, [OrdIdentifier], [EnumEvaluatorEntry]) ()
forall a b. (a -> b) -> a -> b
$ \([FilePath]
_, EnumValue
value) -> case EnumValue
value of
            EnumValueManual Integer
_ -> () -> Writer (Reqs, [OrdIdentifier], [EnumEvaluatorEntry]) ()
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 [FilePath] EnumValue -> [EnumValue]
forall k a. Map k a -> [a]
M.elems (Map [FilePath] EnumValue -> [EnumValue])
-> Map [FilePath] EnumValue -> [EnumValue]
forall a b. (a -> b) -> a -> b
$ EnumValueMap -> Map [FilePath] 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 (t :: * -> *) a. Foldable t => t a -> Bool
null [ExtName]
scopedEnumsWithAutoEntries) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
        FilePath
"internalEvaluateEnumsForInterface': Automatic evaluation of enum values " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++
        FilePath
"requires at least " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ CppVersion -> FilePath
forall a. Show a => a -> FilePath
show CppVersion
Cpp2011 FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
", but we are compiling for " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++
        CppVersion -> FilePath
forall a. Show a => a -> FilePath
show CppVersion
activeCppVersion FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
", aborting.  Enums requesting evaluation are " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++
        [ExtName] -> FilePath
forall a. Show a => a -> FilePath
show [ExtName]
namesToShow FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++
        (if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [ExtName] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ExtName]
namesToSkip then FilePath
" (and more)" else FilePath
"") FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"."
      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 (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 :: Interface
-> [FilePath]
-> Reqs
-> [Identifier]
-> [EnumEvaluatorEntry]
-> Bool
-> EnumEvaluatorArgs
EnumEvaluatorArgs
                   { enumEvaluatorArgsInterface :: Interface
enumEvaluatorArgsInterface = Interface
iface
                   , enumEvaluatorArgsPrependedIncludeDirs :: [FilePath]
enumEvaluatorArgsPrependedIncludeDirs = Maybe FilePath -> [FilePath]
forall a. Maybe a -> [a]
maybeToList Maybe FilePath
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 (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 -> FilePath -> IO ()
hPutStrLn Handle
stderr (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
                FilePath
"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 -> FilePath -> IO ()
hPutStrLn Handle
stderr (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
                FilePath
"internalEvaluateEnumsForInterface': Internal error, " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++
                FilePath
"failed to find evaluated size for " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Identifier -> FilePath
forall a. Show a => a -> FilePath
show Identifier
identifier FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"."
              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 -> FilePath -> IO ()
hPutStrLn Handle
stderr (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
                FilePath
"internalEvaluateEnumsForInterface': Internal error, " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++
                FilePath
"failed to find evaluated value for " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Identifier -> FilePath
forall a. Show a => a -> FilePath
show Identifier
identifier FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"."
              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 -> FilePath -> IO ()
hPutStrLn Handle
stderr (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
                FilePath
"internalEvaluateEnumsForInterface': Explicit type " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Type -> FilePath
forall a. Show a => a -> FilePath
show Type
t FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++
                FilePath
" for enum " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ ExtName -> FilePath
forall a. Show a => a -> FilePath
show ExtName
extName FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" 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 (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 [FilePath] Integer
numMap :: M.Map [String] Integer <-
        ([([FilePath], Integer)] -> Map [FilePath] Integer)
-> IO [([FilePath], Integer)] -> IO (Map [FilePath] Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [([FilePath], Integer)] -> Map [FilePath] Integer
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList (IO [([FilePath], Integer)] -> IO (Map [FilePath] Integer))
-> IO [([FilePath], Integer)] -> IO (Map [FilePath] Integer)
forall a b. (a -> b) -> a -> b
$ [([FilePath], EnumValue)]
-> (([FilePath], EnumValue) -> IO ([FilePath], Integer))
-> IO [([FilePath], Integer)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Map [FilePath] EnumValue -> [([FilePath], EnumValue)]
forall k a. Map k a -> [(k, a)]
M.toList (Map [FilePath] EnumValue -> [([FilePath], EnumValue)])
-> Map [FilePath] EnumValue -> [([FilePath], EnumValue)]
forall a b. (a -> b) -> a -> b
$ EnumValueMap -> Map [FilePath] EnumValue
enumValueMapValues EnumValueMap
values) ((([FilePath], EnumValue) -> IO ([FilePath], Integer))
 -> IO [([FilePath], Integer)])
-> (([FilePath], EnumValue) -> IO ([FilePath], Integer))
-> IO [([FilePath], Integer)]
forall a b. (a -> b) -> a -> b
$ \([FilePath]
label, EnumValue
value) -> do
          Integer
num <- case EnumValue
value of
            EnumValueManual Integer
n -> Integer -> IO Integer
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
n
            EnumValueAuto Identifier
entryIdent -> Identifier -> IO Integer
getIdentifierValue Identifier
entryIdent
          ([FilePath], Integer) -> IO ([FilePath], Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath]
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 -> FilePath -> IO ()
hPutStrLn Handle
stderr (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
              FilePath
"internalEvaluateEnumsForInterface': The explicit type " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Type -> FilePath
forall a. Show a => a -> FilePath
show Type
numericType FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++
              FilePath
" for enum " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ ExtName -> FilePath
forall a. Show a => a -> FilePath
show ExtName
extName FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" takes " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> FilePath -> ShowS
pluralize Int
providedBytes FilePath
"byte" FilePath
"bytes" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++
              FilePath
", but sizeof(" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Identifier -> FilePath
renderIdentifier Identifier
identifier FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
") evaluates to " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++
              Int -> FilePath -> ShowS
pluralize Int
evaluatedBytes FilePath
"byte" FilePath
"bytes" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"."
            IO ()
forall a. IO a
exitFailure

          Int -> IO Int
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) ->
          FilePath -> IO Int
forall a. HasCallStack => FilePath -> a
error (FilePath -> IO Int) -> FilePath -> IO Int
forall a b. (a -> b) -> a -> b
$ FilePath
"internalEvaluateEnumsForInterface': Internal error, don't have a size for " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++
          FilePath
"enum " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ ExtName -> FilePath
forall a. Show a => a -> FilePath
show ExtName
extName FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
", shouldn't happen."

      let (Integer
low, Integer
high) = [Integer] -> Integer
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ([Integer] -> Integer)
-> ([Integer] -> Integer) -> [Integer] -> (Integer, Integer)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& [Integer] -> Integer
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 [FilePath] Integer -> [Integer]
forall k a. Map k a -> [a]
M.elems Map [FilePath] Integer
numMap
      NumericTypeInfo
numericType <-
        IO NumericTypeInfo -> Maybe NumericTypeInfo -> IO NumericTypeInfo
forall (m :: * -> *) a. Monad m => m a -> Maybe a -> m a
fromMaybeM
          (do Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
                FilePath
"internalEvaluateEnumsForInterface': Couldn't find a numeric type " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++
                FilePath
"to use to represent the C++ enumeration " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ ExtName -> FilePath
forall a. Show a => a -> FilePath
show ExtName
extName FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"."
              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 :: NumericTypeInfo -> Map [FilePath] Integer -> EvaluatedEnumData
EvaluatedEnumData
            { evaluatedEnumNumericType :: NumericTypeInfo
evaluatedEnumNumericType = NumericTypeInfo
numericType
            , evaluatedEnumValueMap :: Map [FilePath] Integer
evaluatedEnumValueMap = Map [FilePath] Integer
numMap
            }
      (ExtName, EvaluatedEnumData) -> IO (ExtName, EvaluatedEnumData)
forall (m :: * -> *) a. Monad m => a -> m a
return (ExtName
extName, EvaluatedEnumData
result)

  Map ExtName EvaluatedEnumData -> IO (Map ExtName EvaluatedEnumData)
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
/= :: OrdIdentifier -> OrdIdentifier -> Bool
$c/= :: OrdIdentifier -> OrdIdentifier -> Bool
== :: OrdIdentifier -> OrdIdentifier -> Bool
$c== :: OrdIdentifier -> OrdIdentifier -> Bool
Eq, Int -> OrdIdentifier -> ShowS
[OrdIdentifier] -> ShowS
OrdIdentifier -> FilePath
(Int -> OrdIdentifier -> ShowS)
-> (OrdIdentifier -> FilePath)
-> ([OrdIdentifier] -> ShowS)
-> Show OrdIdentifier
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [OrdIdentifier] -> ShowS
$cshowList :: [OrdIdentifier] -> ShowS
show :: OrdIdentifier -> FilePath
$cshow :: OrdIdentifier -> FilePath
showsPrec :: Int -> OrdIdentifier -> ShowS
$cshowsPrec :: Int -> OrdIdentifier -> ShowS
Show)

instance Ord OrdIdentifier where
  compare :: OrdIdentifier -> OrdIdentifier -> Ordering
compare (OrdIdentifier Identifier
i1) (OrdIdentifier Identifier
i2) =
    FilePath -> FilePath -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Identifier -> FilePath
renderIdentifier Identifier
i1) (Identifier -> FilePath
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