hoppy-generator 0.7.1 → 0.8.0

raw patch · 33 files changed

+575/−213 lines, 33 filessetup-changedPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Setup.hs +1/−1
• hoppy-generator.cabal +4/−3
• src/Foreign/Hoppy/Generator/Common.hs +1/−1
• src/Foreign/Hoppy/Generator/Common/Consume.hs +1/−1
• src/Foreign/Hoppy/Generator/Compiler.hs +37/−4
• src/Foreign/Hoppy/Generator/Hook.hs +35/−58
• src/Foreign/Hoppy/Generator/Hook.hs-boot +1/−1
• src/Foreign/Hoppy/Generator/Language/Cpp.hs +17/−5
• src/Foreign/Hoppy/Generator/Language/Cpp.hs-boot +1/−1
• src/Foreign/Hoppy/Generator/Language/Cpp/Internal.hs +5/−5
• src/Foreign/Hoppy/Generator/Language/Haskell.hs +25/−8
• src/Foreign/Hoppy/Generator/Language/Haskell.hs-boot +1/−1
• src/Foreign/Hoppy/Generator/Language/Haskell/Internal.hs +5/−5
• src/Foreign/Hoppy/Generator/Main.hs +237/−54
• src/Foreign/Hoppy/Generator/Override.hs +1/−1
• src/Foreign/Hoppy/Generator/Spec.hs +7/−5
• src/Foreign/Hoppy/Generator/Spec/Base.hs +15/−35
• src/Foreign/Hoppy/Generator/Spec/Base.hs-boot +1/−1
• src/Foreign/Hoppy/Generator/Spec/Callback.hs +1/−1
• src/Foreign/Hoppy/Generator/Spec/Callback.hs-boot +1/−1
• src/Foreign/Hoppy/Generator/Spec/Class.hs +1/−1
• src/Foreign/Hoppy/Generator/Spec/Class.hs-boot +1/−1
• src/Foreign/Hoppy/Generator/Spec/ClassFeature.hs +1/−1
• src/Foreign/Hoppy/Generator/Spec/Computed.hs +131/−0
• src/Foreign/Hoppy/Generator/Spec/Conversion.hs +1/−1
• src/Foreign/Hoppy/Generator/Spec/Enum.hs +36/−10
• src/Foreign/Hoppy/Generator/Spec/Enum.hs-boot +1/−1
• src/Foreign/Hoppy/Generator/Spec/Function.hs +1/−1
• src/Foreign/Hoppy/Generator/Spec/Function.hs-boot +1/−1
• src/Foreign/Hoppy/Generator/Spec/Variable.hs +1/−1
• src/Foreign/Hoppy/Generator/Types.hs +1/−1
• src/Foreign/Hoppy/Generator/Util.hs +1/−1
• src/Foreign/Hoppy/Generator/Version.hs +1/−1

@@ -1,6 +1,6 @@ -- This file is part of Hoppy. ----- Copyright 2015-2020 Bryan Gardiner <bog@khumba.net>+-- 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

@@ -1,15 +1,15 @@ name: hoppy-generator-version: 0.7.1+version: 0.8.0 synopsis: C++ FFI generator - Code generator homepage: http://khumba.net/projects/hoppy license: AGPL-3 license-file: LICENSE author: Bryan Gardiner <bog@khumba.net> maintainer: Bryan Gardiner <bog@khumba.net>-copyright: Copyright 2015-2020 Bryan Gardiner+copyright: Copyright 2015-2021 Bryan Gardiner category: Foreign build-type: Simple-cabal-version: >=1.10+cabal-version: 1.24 description:     Hoppy generates Haskell bindings to C++ libraries.     .@@ -27,6 +27,7 @@     , Foreign.Hoppy.Generator.Spec.Callback     , Foreign.Hoppy.Generator.Spec.ClassFeature     , Foreign.Hoppy.Generator.Spec.Class+    , Foreign.Hoppy.Generator.Spec.Computed     , Foreign.Hoppy.Generator.Spec.Enum     , Foreign.Hoppy.Generator.Spec.Function     , Foreign.Hoppy.Generator.Spec.Variable

@@ -1,6 +1,6 @@ -- This file is part of Hoppy. ----- Copyright 2015-2020 Bryan Gardiner <bog@khumba.net>+-- 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

@@ -1,6 +1,6 @@ -- This file is part of Hoppy. ----- Copyright 2015-2020 Bryan Gardiner <bog@khumba.net>+-- 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

@@ -1,6 +1,6 @@ -- This file is part of Hoppy. ----- Copyright 2015-2020 Bryan Gardiner <bog@khumba.net>+-- 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@@ -51,6 +51,10 @@   -- error, and false is returned.   compileProgram :: a -> FilePath -> FilePath -> IO Bool +  -- | Modifies the compiler to prepend the given paths to the header search+  -- path.+  prependIncludePath :: [FilePath] -> a -> a+ -- | An existential data type for 'Compiler's. data SomeCompiler = forall a. Compiler a => SomeCompiler a @@ -60,6 +64,8 @@ instance Compiler SomeCompiler where   compileProgram (SomeCompiler c) = compileProgram c +  prependIncludePath paths (SomeCompiler c) = SomeCompiler $ prependIncludePath paths c+ -- | A compiler that can compile a source file into a binary with a single -- program invocation. --@@ -87,6 +93,12 @@                (scArguments compiler)                (M.fromList [("in", inPath), ("out", outPath)]) +  prependIncludePath paths compiler =+    compiler { scArguments =+                 concatMap (\path -> ["-I", path]) paths +++                 scArguments compiler+             }+ -- | Adds arguments to the start of a compiler's argument list. prependArguments :: [String] -> SimpleCompiler -> SimpleCompiler prependArguments args compiler =@@ -119,20 +131,41 @@   { ccLabel :: String     -- ^ A label to display when the compiler is 'show'n.  The string is     -- @\"\<CustomCompiler \" ++ label ++ \">\"@.-  , ccCompile :: FilePath -> FilePath -> IO Bool++  , ccCompile :: CustomCompiler -> FilePath -> FilePath -> IO Bool     -- ^ Given a source file path and an output path, compiles the source file,     -- producing a binary at the output path.  Returns true on success.  Logs to     -- standard error and returns false on failure.+    --+    -- This should inspect the compiler argument to make use of its+    -- 'ccHeaderSearchPath'.+    --+    -- The first argument is the 'CustomCompiler' object that this function was+    -- pulled out of.  This is passed in explicitly by 'compileProgram' because+    -- due to the presence of 'prependIncludePath' it's not always possible to+    -- have access to the final compiler object ahead of time.++  , ccHeaderSearchPath :: [FilePath]+    -- ^ Paths to be searched for C++ header files, in addition to the+    -- compiler's default search directories.   }  instance Show CustomCompiler where   show c = "<CustomCompiler " ++ ccLabel c ++ ">"  instance Compiler CustomCompiler where-  compileProgram = ccCompile+  compileProgram c = ccCompile c c +  prependIncludePath paths c =+    c { ccHeaderSearchPath = paths ++ ccHeaderSearchPath c }+ -- | The default compiler, used by an 'Foreign.Hoppy.Generator.Spec.Interface'--- that doesn't specify its own.  This is:+-- that doesn't specify its own.  This will be 'gppCompiler', however if the+-- environment variables @CXX@ or @CXXFLAGS@ are set and nonempty, they will be+-- used.  @CXX@ will override the path to the compiler used, and @CXXFLAGS@ will+-- be split on spaces and appended to the compiler's argument list.+--+-- Specifically, this is defined as: -- -- @'unsafePerformIO' $ 'overrideCompilerFromEnvironment' 'gppCompiler'@ defaultCompiler :: SimpleCompiler

@@ -1,6 +1,6 @@ -- This file is part of Hoppy. ----- Copyright 2015-2020 Bryan Gardiner <bog@khumba.net>+-- 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@@ -31,6 +31,8 @@   makeCppSourceToEvaluateEnums,   interpretOutputToEvaluateEnums,   -- * Internal+  NumericTypeInfo (..),+  pickNumericType,   internalEvaluateEnumsForInterface,   ) where @@ -46,18 +48,27 @@ import Data.List (splitAt) #endif import qualified Data.Map as M-import Data.Maybe (isJust, listToMaybe, mapMaybe)+import Data.Maybe (isJust, mapMaybe, maybeToList) import qualified Data.Set as S-import Foreign.C (CInt, CLong, CLLong, CUInt, CULong, CULLong) 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)+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.Types (intT, llongT, longT, uintT, ullongT, ulongT)+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 Foreign.Storable (Storable, sizeOf) import System.Exit (ExitCode (ExitFailure, ExitSuccess), exitFailure) import System.IO (hClose, hPutStrLn, stderr) import System.Process (readProcessWithExitCode)@@ -90,6 +101,8 @@ data EnumEvaluatorArgs = EnumEvaluatorArgs   { enumEvaluatorArgsInterface :: Interface     -- ^ The interface that enum values are being calculated for.+  , enumEvaluatorArgsPrependedIncludeDirs :: [FilePath]+    -- ^ Additional paths to prepend to the C++ include path during compilation.   , enumEvaluatorArgsReqs :: Reqs     -- ^ Requirements (includes, etc.) needed to reference the enum identifiers     -- being evaluated.@@ -150,17 +163,21 @@ -- | Evaluate enums using a specified compiler. evaluateEnumsWithCompiler :: Compiler a => a -> EnumEvaluator evaluateEnumsWithCompiler compiler args =+  let compiler' = case enumEvaluatorArgsPrependedIncludeDirs args of+        [] -> compiler+        dirs -> prependIncludePath dirs compiler+  in   withTempFile "hoppy-enum.cpp" removeBuildFailures $ \cppPath cppHandle ->   withTempFile "hoppy-enum" removeBuildFailures $ \binPath binHandle -> do   hPut cppHandle program   hClose cppHandle   hClose binHandle-  success <- compileProgram compiler cppPath binPath+  success <- compileProgram compiler' cppPath binPath   result <- case success of     False -> do       hPutStrLn stderr $         "evaluateEnumsWithCompiler: Failed to build program " ++ show cppPath ++-        " to evaluate enums with " ++ show compiler ++ "." ++ removeBuildFailuresNote+        " to evaluate enums with " ++ show compiler' ++ "." ++ removeBuildFailuresNote       return Nothing     True -> runAndGetOutput binPath   let remove = isJust result || removeBuildFailures@@ -304,14 +321,12 @@ -- | 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 -> Bool -> IO Interface-internalEvaluateEnumsForInterface iface keepBuildFailures =-  case interfaceEvaluatedEnumData iface of-    Just _ -> return iface-    Nothing -> internalEvaluateEnumsForInterface' iface keepBuildFailures--internalEvaluateEnumsForInterface' :: Interface -> Bool -> IO Interface-internalEvaluateEnumsForInterface' iface keepBuildFailures = do+internalEvaluateEnumsForInterface ::+     Interface+  -> Maybe FilePath+  -> Bool+  -> IO (M.Map ExtName EvaluatedEnumData)+internalEvaluateEnumsForInterface iface maybeCppDir keepBuildFailures = do   let validateEnumTypes = interfaceValidateEnumTypes iface        -- Collect all exports in the interface.@@ -367,7 +382,7 @@         (namesToShow, namesToSkip) = splitAt 10 scopedEnumsWithAutoEntries     unless (null scopedEnumsWithAutoEntries) $ do       hPutStrLn stderr $-        "internalEvaluateEnumsForInterface': Automatic evaluation of enum values is not " +++        "internalEvaluateEnumsForInterface': Automatic evaluation of enum values " ++         "requires at least " ++ show Cpp2011 ++ ", but we are compiling for " ++         show activeCppVersion ++ ", aborting.  Enums requesting evaluation are " ++         show namesToShow ++@@ -383,6 +398,7 @@         let hooks = interfaceHooks iface             args = EnumEvaluatorArgs                    { enumEvaluatorArgsInterface = iface+                   , enumEvaluatorArgsPrependedIncludeDirs = maybeToList maybeCppDir                    , enumEvaluatorArgsReqs = sumReqs                    , enumEvaluatorArgsSizeofIdentifiers =                        map ordIdentifier sizeofIdentifiersToEvaluate@@ -487,12 +503,12 @@         pickNumericType bytes low high        let result = EvaluatedEnumData-            { evaluatedEnumType = numericType+            { evaluatedEnumNumericType = numericType             , evaluatedEnumValueMap = numMap             }       return (extName, result) -  return iface { interfaceEvaluatedEnumData = Just evaluatedDataMap }+  return evaluatedDataMap  newtype OrdIdentifier = OrdIdentifier { ordIdentifier :: Identifier }   deriving (Eq, Show)@@ -500,45 +516,6 @@ instance Ord OrdIdentifier where   compare (OrdIdentifier i1) (OrdIdentifier i2) =     compare (renderIdentifier i1) (renderIdentifier i2)---- | Bound information about numeric types.-data NumericTypeInfo = NumericTypeInfo-  { numType :: Type-  , numBytes :: Int-  , numMinBound :: Integer-  , numMaxBound :: Integer-  }---- | Numeric types usable to hold enum values.  These are ordered by decreasing--- precedence (increasing word size).-numericTypeInfo :: [NumericTypeInfo]-numericTypeInfo =-  [ mk intT (undefined :: CInt)-  , mk uintT (undefined :: CUInt)-  , mk longT (undefined :: CLong)-  , mk ulongT (undefined :: CULong)-  , mk llongT (undefined :: CLLong)-  , mk ullongT (undefined :: CULLong)-  ]-  where mk :: forall a. (Bounded a, Integral a, Storable a) => Type -> a -> NumericTypeInfo-        mk t _ = NumericTypeInfo-                 { numType = t-                 , numBytes = sizeOf (undefined :: a)-                 , numMinBound = toInteger (minBound :: a)-                 , numMaxBound = toInteger (maxBound :: a)-                 }--findNumericTypeInfo :: Type -> Maybe NumericTypeInfo-findNumericTypeInfo t = listToMaybe $ filter (\i -> numType i == t) numericTypeInfo---- | Selects the preferred numeric type for holding numeric values in the given--- range.-pickNumericType :: Int -> Integer -> Integer -> Maybe Type-pickNumericType bytes low high =-  fmap numType $ listToMaybe $ flip filter numericTypeInfo $ \info ->-  numBytes info == bytes &&-  numMinBound info <= low &&-  numMaxBound info >= high  isAuto :: EnumValue -> Bool isAuto (EnumValueAuto _) = True

@@ -1,6 +1,6 @@ -- This file is part of Hoppy. ----- Copyright 2015-2020 Bryan Gardiner <bog@khumba.net>+-- 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

@@ -1,6 +1,6 @@ -- This file is part of Hoppy. ----- Copyright 2015-2020 Bryan Gardiner <bog@khumba.net>+-- 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@@ -24,7 +24,7 @@   Env,   execGenerator,   addIncludes, addInclude, addReqsM,-  askInterface, askModule, abort,+  askInterface, askComputedInterfaceData, askModule, abort,   -- * Names   makeCppName,   externalNameToCpp,@@ -70,6 +70,7 @@ import qualified Data.Set as S import Foreign.Hoppy.Generator.Common import Foreign.Hoppy.Generator.Spec.Base+import Foreign.Hoppy.Generator.Spec.Computed (ComputedInterfaceData) import {-# SOURCE #-} Foreign.Hoppy.Generator.Spec.Class (classIdentifier, classReqs) import Foreign.Hoppy.Generator.Types @@ -81,14 +82,21 @@ -- | Context information for generating C++ code. data Env = Env   { envInterface :: Interface+  , envComputedInterfaceData :: ComputedInterfaceData   , envModule :: Module   }  -- | Runs a generator action and returns its output, or an error message if -- unsuccessful.-execGenerator :: Interface -> Module -> Maybe String -> Generator a -> Either ErrorMsg String-execGenerator iface m maybeHeaderGuardName action = do-  chunk <- execChunkWriterT $ runReaderT action $ Env iface m+execGenerator ::+     Interface+  -> ComputedInterfaceData+  -> Module+  -> Maybe String+  -> Generator a+  -> Either ErrorMsg String+execGenerator iface computed m maybeHeaderGuardName action = do+  chunk <- execChunkWriterT $ runReaderT action $ Env iface computed m   let contents = chunkContents chunk       includes = chunkIncludes chunk   return $ chunkContents $ execChunkWriter $ do@@ -125,6 +133,10 @@ -- | Returns the currently generating interface. askInterface :: MonadReader Env m => m Interface askInterface = fmap envInterface ask++-- | Returns the computed data for the currently generating interface.+askComputedInterfaceData :: Generator ComputedInterfaceData+askComputedInterfaceData = fmap envComputedInterfaceData ask  -- | Returns the currently generating module. askModule :: MonadReader Env m => m Module

@@ -1,6 +1,6 @@ -- This file is part of Hoppy. ----- Copyright 2015-2020 Bryan Gardiner <bog@khumba.net>+-- 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

@@ -1,6 +1,6 @@ -- This file is part of Hoppy. ----- Copyright 2015-2020 Bryan Gardiner <bog@khumba.net>+-- 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@@ -51,15 +51,15 @@   }  -- | Runs the C++ code generator against an interface.-generate :: Interface -> Either ErrorMsg Generation-generate iface =+generate :: Interface -> ComputedInterfaceData -> Either ErrorMsg Generation+generate iface computed =   fmap (Generation . M.fromList) $   execWriterT $   forM_ (M.elems $ interfaceModules iface) $ \m -> do     let headerGuard = concat ["HOPPY_MODULE_", interfaceName iface, "_", moduleName m]-    header <- lift $ execGenerator iface m (Just headerGuard) sayModuleHeader+    header <- lift $ execGenerator iface computed m (Just headerGuard) sayModuleHeader     tell [(moduleHppPath m, header)]-    source <- lift $ execGenerator iface m Nothing sayModuleSource+    source <- lift $ execGenerator iface computed m Nothing sayModuleSource     tell [(moduleCppPath m, source)]  sayModuleHeader :: Generator ()

@@ -1,6 +1,6 @@ -- This file is part of Hoppy. ----- Copyright 2015-2020 Bryan Gardiner <bog@khumba.net>+-- 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@@ -33,6 +33,7 @@   renderPartial,   Env (..),   askInterface,+  askComputedInterfaceData,   askModule,   askModuleName,   getModuleForExtName,@@ -90,6 +91,7 @@ import Data.Tuple (swap) import Foreign.Hoppy.Generator.Common import Foreign.Hoppy.Generator.Spec.Base+import Foreign.Hoppy.Generator.Spec.Computed (ComputedInterfaceData) import {-# SOURCE #-} Foreign.Hoppy.Generator.Spec.Class (   Class,   ClassHaskellConversion,@@ -242,6 +244,7 @@ -- | Context information for generating Haskell code. data Env = Env   { envInterface :: Interface+  , envComputedInterfaceData :: ComputedInterfaceData   , envModule :: Module   , envModuleName :: String   }@@ -250,6 +253,10 @@ askInterface :: Generator Interface askInterface = asks envInterface +-- | Returns the computed data for the currently generating interface.+askComputedInterfaceData :: Generator ComputedInterfaceData+askComputedInterfaceData = asks envComputedInterfaceData+ -- | Returns the currently generating module. askModule :: Generator Module askModule = asks envModule@@ -317,21 +324,31 @@ -- | Runs a generator action for the given interface and module name string. -- Returns an error message if an error occurred, otherwise the action's output -- together with its value.-runGenerator :: Interface -> Module -> Generator a -> Either ErrorMsg (Partial, a)-runGenerator iface m generator =+runGenerator ::+     Interface+  -> ComputedInterfaceData+  -> Module+  -> Generator a+  -> Either ErrorMsg (Partial, a)+runGenerator iface computed m generator =   let modName = getModuleName iface m   in fmap (first (Partial modName) . swap) $      runExcept $      flip catchError (\msg -> throwError $ msg ++ ".") $-     runWriterT $ runReaderT generator $ Env iface m modName+     runWriterT $ runReaderT generator $ Env iface computed m modName  -- | Runs a generator action and returns the its value.-evalGenerator :: Interface -> Module -> Generator a -> Either ErrorMsg a-evalGenerator iface m = fmap snd . runGenerator iface m+evalGenerator :: Interface -> ComputedInterfaceData -> Module -> Generator a -> Either ErrorMsg a+evalGenerator iface computed m = fmap snd . runGenerator iface computed m  -- | Runs a generator action and returns its output.-execGenerator :: Interface -> Module -> Generator a -> Either ErrorMsg Partial-execGenerator iface m = fmap fst . runGenerator iface m+execGenerator ::+     Interface+  -> ComputedInterfaceData+  -> Module+  -> Generator a+  -> Either ErrorMsg Partial+execGenerator iface computed m = fmap fst . runGenerator iface computed m  -- | Converts a 'Partial' into a complete Haskell module. renderPartial :: Partial -> String

@@ -1,6 +1,6 @@ -- This file is part of Hoppy. ----- Copyright 2015-2020 Bryan Gardiner <bog@khumba.net>+-- 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

@@ -1,6 +1,6 @@ -- This file is part of Hoppy. ----- Copyright 2015-2020 Bryan Gardiner <bog@khumba.net>+-- 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@@ -58,11 +58,11 @@   }  -- | Runs the C++ code generator against an interface.-generate :: Interface -> Either ErrorMsg Generation-generate iface = do+generate :: Interface -> ComputedInterfaceData -> Either ErrorMsg Generation+generate iface computed = do   -- Build the partial generation of each module.   modPartials <- forM (M.elems $ interfaceModules iface) $ \m ->-    (,) m <$> execGenerator iface m (generateSource m)+    (,) m <$> execGenerator iface computed m (generateSource m)    -- Compute the strongly connected components.  If there is a nontrivial SCC,   -- then there is a module import cycle that we'll have to break with hs-boot@@ -85,7 +85,7 @@       let cycleModNames = S.fromList $ map (partialModuleHsName . snd) mps       forM_ mps $ \(m, p) -> do         -- Create a boot partial.-        pBoot <- lift $ execGenerator iface m (generateBootSource m)+        pBoot <- lift $ execGenerator iface computed m (generateBootSource m)          -- Change the source and boot partials so that all imports of modules in         -- this cycle are {-# SOURCE #-} imports.

@@ -1,6 +1,6 @@ -- This file is part of Hoppy. ----- Copyright 2015-2020 Bryan Gardiner <bog@khumba.net>+-- 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@@ -33,8 +33,10 @@ -- @ module Foreign.Hoppy.Generator.Main (   Action (..),+  EnumEvalCacheMode (..),   defaultMain,   defaultMain',+  ensureInterfaces,   run,   ) where @@ -55,7 +57,7 @@ import qualified Foreign.Hoppy.Generator.Language.Cpp.Internal as Cpp import qualified Foreign.Hoppy.Generator.Language.Haskell.Internal as Haskell import Foreign.Hoppy.Generator.Spec-import System.Directory (createDirectoryIfMissing, doesDirectoryExist)+import System.Directory (createDirectoryIfMissing, doesDirectoryExist, doesFileExist, removeFile) import System.Environment (getArgs) import System.Exit (exitFailure, exitSuccess) import System.FilePath ((</>), takeDirectory)@@ -75,6 +77,10 @@     -- ^ Generates C++ wrappers for an interface in the given location.   | GenHaskell FilePath     -- ^ Generates Haskell bindings for an interface in the given location.+  | CleanCpp FilePath+    -- ^ Removes the generated files in C++ bindings.+  | CleanHs FilePath+    -- ^ Removes the generated files in Haskell bindings.   | KeepTempOutputsOnFailure     -- ^ Instructs the generator to keep on disk any temporary programs or files     -- created, in case of failure.@@ -83,14 +89,45 @@     -- interface.   | DumpEnums     -- ^ Dumps to stdout information about all enums in the current interface.+  | EnumEvalCachePath (Maybe FilePath)+    -- ^ Specifies the path to a enum evaluation cache file to use.+  | EnumEvalCacheMode EnumEvalCacheMode+    -- ^ Specifies the behaviour with respect to how the enum evaluation cache+    -- cache file is used.  data AppState = AppState   { appInterfaces :: Map String Interface   , appCurrentInterfaceName :: String   , appCaches :: Caches   , appKeepTempOutputsOnFailure :: Bool+  , appEnumEvalCachePath :: Maybe FilePath+  , appEnumEvalCacheMode :: EnumEvalCacheMode   } +-- | Controls the behaviour of a generatior with respect to the enum cache file,+-- when a file path provided (@--enum-eval-cache-path@).+--+-- If enum evaluation is required, based on the presence of the cache file and+-- which of these modes is selected, then the compiler will be called and the+-- results will be written to the cache file+--+-- If an enum cache file path is not provided, then this mode is ignored, and+-- enum evaluation is attempted if a generator requires it.+--+-- Change detection is not currently supported.  There is no ability to detect+-- whether the cache file is up to date and contains all of the enum entries for+-- the current state of the enums defined in an interface.  The cache file is+-- meant to be refreshed with 'RefreshEnumCache' when building the C++ binding+-- package, and installed with them so that the Haskell binding package can use+-- 'EnumCacheMustExist'.+data EnumEvalCacheMode =+    RefreshEnumCache+    -- ^ The default.  Ignore the presence of an existing cache file, and+    -- evaluate enums freshly, updating the cache file with new contents.+  | EnumCacheMustExist+    -- ^ Require the cache file to exist.  If it does not, enum evaluation will+    -- not be attempted; the generator will exit unsuccessfully instead.+ appCurrentInterface :: AppState -> Interface appCurrentInterface state =   let name = appCurrentInterfaceName state@@ -107,49 +144,118 @@   , appCurrentInterfaceName = interfaceName $ head ifaces   , appCaches = M.empty   , appKeepTempOutputsOnFailure = False+  , appEnumEvalCachePath = Nothing+  , appEnumEvalCacheMode = RefreshEnumCache   }  type Caches = Map String InterfaceCache  data InterfaceCache = InterfaceCache-  { generatedCpp :: Maybe Cpp.Generation-  , generatedHaskell :: Maybe Haskell.Generation+  { cacheGeneratedCpp :: Maybe Cpp.Generation+  , cacheGeneratedHaskell :: Maybe Haskell.Generation+  , cacheComputedData :: Maybe ComputedInterfaceData   }  emptyCache :: InterfaceCache-emptyCache = InterfaceCache Nothing Nothing+emptyCache = InterfaceCache Nothing Nothing Nothing  getGeneratedCpp ::-  AppState+     Maybe FilePath+  -> AppState   -> Interface   -> InterfaceCache-  -> IO (Interface, InterfaceCache, Either String Cpp.Generation)-getGeneratedCpp state iface cache = case generatedCpp cache of-  Just gen -> return (iface, cache, Right gen)-  _ -> do-    iface' <- evaluateEnums state iface-    case Cpp.generate iface' of-      l@(Left _) -> return (iface', cache, l)-      r@(Right gen) -> return (iface', cache { generatedCpp = Just gen }, r)+  -> IO (InterfaceCache, Either String Cpp.Generation)+getGeneratedCpp maybeCppDir state iface cache = case cacheGeneratedCpp cache of+  Just gen -> return (cache, Right gen)+  Nothing -> do+    cache' <- generateComputedData maybeCppDir state iface cache+    computedData <- flip fromMaybeM (cacheComputedData cache') $ do+      hPutStrLn stderr $+        "getGeneratedCpp: Expected computed data to already exist for " ++ show iface ++ "."+      exitFailure+    case Cpp.generate iface computedData of+      l@(Left _) -> return (cache', l)+      r@(Right gen) -> return (cache' { cacheGeneratedCpp = Just gen }, r)  getGeneratedHaskell ::   AppState   -> Interface   -> InterfaceCache-  -> IO (Interface, InterfaceCache, Either String Haskell.Generation)-getGeneratedHaskell state iface cache = case generatedHaskell cache of-  Just gen -> return (iface, cache, Right gen)-  _ -> do-    iface' <- evaluateEnums state iface-    case Haskell.generate iface' of-      l@(Left _) -> return (iface', cache, l)-      r@(Right gen) -> return (iface', cache { generatedHaskell = Just gen }, r)+  -> IO (InterfaceCache, Either String Haskell.Generation)+getGeneratedHaskell state iface cache = case cacheGeneratedHaskell cache of+  Just gen -> return (cache, Right gen)+  Nothing -> do+    cache' <- generateComputedData Nothing state iface cache+    computedData <- flip fromMaybeM (cacheComputedData cache') $ do+      hPutStrLn stderr $+        "getGeneratedHaskell: Expected computed data to already exist for " ++ show iface ++ "."+      exitFailure+    case Haskell.generate iface computedData of+      l@(Left _) -> return (cache', l)+      r@(Right gen) -> return (cache' { cacheGeneratedHaskell = Just gen }, r) -evaluateEnums :: AppState -> Interface -> IO Interface-evaluateEnums state iface =-  internalEvaluateEnumsForInterface iface $-  appKeepTempOutputsOnFailure state+-- | Ensures that the cached computed data for an interface been calculated,+-- doing so if it hasn't.+--+-- This ensures that the 'ComputedInterfaceData' for an 'Interface' has been+-- calculated.  This is only computed once for an interface, and is stored in+-- the interface's 'InterfaceCache'.  This function returns the resulting cache+-- with the computed data populated.+generateComputedData ::+     Maybe FilePath+  -> AppState+  -> Interface+  -> InterfaceCache+  -> IO InterfaceCache+generateComputedData maybeCppDir state iface cache = case cacheComputedData cache of+  Just _ -> return cache+  Nothing -> do+    evaluatedEnumMap <- generateEnumData state iface maybeCppDir+    return cache+      { cacheComputedData = Just ComputedInterfaceData+        { computedInterfaceName = interfaceName iface+        , evaluatedEnumMap = evaluatedEnumMap+        }+      } +-- | Generates evaluated enum data for storing in the interface cache.+--+-- If there is a cache path provided, and the file exists, then it is loaded and+-- used.  Otherwise, if there is a cache path provided and the file doesn't+-- exist, but a cache path is set to be required ('appEnumEvalCacheRequire'),+-- then generation aborts.  Otherwise, the enum evaluation hook is called to+-- evaluate the enums (see "Foreign.Hoppy.Generator.Hook"), and if a cache path+-- is provided, then the result is serialized and written to the path.+generateEnumData :: AppState -> Interface -> Maybe FilePath -> IO (Map ExtName EvaluatedEnumData)+generateEnumData state iface maybeCppDir =+  case appEnumEvalCachePath state of+    Nothing -> doEnumEval+    Just path -> do+      cached <- doesFileExist path+      case (appEnumEvalCacheMode state, cached) of+        (RefreshEnumCache, _) -> evalAndWriteFile path+        (EnumCacheMustExist, True) -> useFile path+        (EnumCacheMustExist, False) -> do+          hPutStrLn stderr $+            "generateEnumData: Error, enum evaluation cache expected for " +++            show iface ++ ", but none found at path '" ++ path ++ "'."+          exitFailure++  where useFile path = deserializeEnumData <$> readFile path+        evalAndWriteFile path = do+          result <- doEnumEval+          writeFileIfDifferent path $ serializeEnumData result+          return result+        doEnumEval = do+          internalEvaluateEnumsForInterface iface maybeCppDir+            (appKeepTempOutputsOnFailure state)++serializeEnumData :: Map ExtName EvaluatedEnumData -> String+serializeEnumData = show . M.mapKeys fromExtName++deserializeEnumData :: String -> Map ExtName EvaluatedEnumData+deserializeEnumData = M.mapKeys toExtName . read+ -- | This provides a simple @main@ function for a generator.  Define your @main@ -- as: --@@ -165,16 +271,22 @@ -- | This is a version of 'defaultMain' that accepts multiple interfaces. defaultMain' :: [Either String Interface] -> IO () defaultMain' interfaceResults = do-  interfaces <- forM interfaceResults $ \case-    Left errorMsg -> do-      hPutStrLn stderr $ "Error initializing interface: " ++ errorMsg-      exitFailure-    Right iface -> return iface-+  interfaces <- ensureInterfaces interfaceResults   args <- getArgs   _ <- run interfaces args   return () +-- | Ensures that all of the entries in a list of results coming from+-- 'interface' are successful, and returns the list of 'Interface' values.  If+-- any results are unsuccessful, then an error message is printed, and the+-- program exits with an error ('exitFailure').+ensureInterfaces :: [Either String Interface] -> IO [Interface]+ensureInterfaces interfaceResults = forM interfaceResults $ \case+  Left errorMsg -> do+    hPutStrLn stderr $ "Error initializing interface: " ++ errorMsg+    exitFailure+  Right iface -> return iface+ -- | @run interfaces args@ runs the driver with the command-line arguments from -- @args@ against the listed interfaces, and returns the list of actions -- performed.@@ -182,6 +294,9 @@ -- The recognized arguments are listed below.  The exact forms shown are -- required; the @--long-arg=value@ style is not supported. --+-- Arguments are processed in the order given, this means that settings must+-- come before action arguments.+-- -- - __@--help@:__ Displays a menu listing the valid commands. -- -- - __@--list-interfaces@:__ Lists the interfaces compiled into the generator.@@ -193,6 +308,18 @@ -- -- - __@--gen-hs \<outdir\>@:__ Generates Haskell bindings under the given --   top-level source directory.+--+-- - __@--enum-eval-cache-path \<cachefile\>@:__ Specifies a cache file to use+--   for the results of enum evaluation.  If the cache file already exists, then+--   it may be loaded to save calling the compiler, depending on the cache mode+--   (@--enum-eval-cache-mode@).  Because enum evaluation results are required+--   when generating both the C++ and Haskell interfaces and these are normally+--   separate packages, this allows the C++ package's evaluation work to be+--   shared with the Haskell package.+--+-- - __@--enum-eval-cache-mode \<refresh|must-exist\>@:__+--   Controls the specific behaviour of the generator with respect to the enum+--   evaluation cache file.  See 'EnumEvalCacheMode'. run :: [Interface] -> [String] -> IO [Action] run interfaces args = do   stateVar <- newMVar $ initialAppState interfaces@@ -210,24 +337,36 @@   mapM_ putStrLn     [ "Hoppy binding generator"     , ""+    , "Arguments: [ option... ] [ action... ]"+    , "  Arguments are processed in the order seen, so put options before the"+    , "  arguments they apply to.  Normally, pass --gen-* last."+    , ""     , "Interfaces: " ++ intercalate ", " interfaceNames     , ""-    , "Supported options:"+    , "Supported actions:"     , "  --help                      Displays this menu."-    , "  --interface <iface>         Sets the interface used for subsequent options."     , "  --list-interfaces           Lists the interfaces compiled into this binary."     , "  --list-cpp-files            Lists generated file paths in C++ bindings."     , "  --list-hs-files             Lists generated file paths in Haskell bindings."     , "  --gen-cpp <outdir>          Generate C++ bindings in a directory."     , "  --gen-hs <outdir>           Generate Haskell bindings under the given"     , "                              top-level source directory."-    , "  --keep-temp-outputs-on-failure"-    , "                              Keeps on disk any temporary programs that fail"-    , "                              to build.  Pass this before --gen-* commands."+    , "  --clean-cpp <outdir>        Removes generated file paths in C++ bindings."+    , "  --clean-hs <outdir>         Removes generated file paths in Haskell bindings."     , "  --dump-ext-names            Lists the current interface's external names."     , "  --dump-enums                Lists the current interface's enum data."     , ""-    , "Arguments are processed in the order seen."+    , "Supported options:"+    , "  --interface <iface>         Sets the interface used for subsequent options."+    , "  --keep-temp-outputs-on-failure"+    , "                              Keeps on disk any temporary programs that fail"+    , "                              to build.  Pass this before --gen-* commands."+    , "  --enum-eval-cache-path <path>"+    , "  --enum-eval-cache-mode <refresh|must-exist>"+    , "          Controls the behaviour of the enum evaluation result caching."+    , "          Caching is disabled if no path is given.  With 'refresh', enums"+    , "          are always evaluated freshly and the cache file is updated."+    , "          With 'must-exist', the cache file must already exist."     ]  processArgs :: MVar AppState -> [String] -> IO [Action]@@ -251,7 +390,7 @@       (ListInterfaces:) <$> processArgs stateVar rest      "--list-cpp-files":rest -> do-      genResult <- withCurrentCache stateVar getGeneratedCpp+      genResult <- withCurrentCache stateVar $ getGeneratedCpp Nothing       case genResult of         Left errorMsg -> do           hPutStrLn stderr $ "--list-cpp-files: Failed to generate: " ++ errorMsg@@ -277,7 +416,7 @@           "--gen-cpp: Please create this directory so that I can generate files in it: " ++           baseDir         exitFailure-      genResult <- withCurrentCache stateVar getGeneratedCpp+      genResult <- withCurrentCache stateVar $ getGeneratedCpp $ Just baseDir       case genResult of         Left errorMsg -> do           hPutStrLn stderr $ "--gen-cpp: Failed to generate: " ++ errorMsg@@ -300,25 +439,55 @@           hPutStrLn stderr $ "--gen-hs: Failed to generate: " ++ errorMsg           exitFailure         Right gen -> do-          forM_ (M.toList $ Haskell.generatedFiles gen) $-            uncurry $ writeGeneratedFile baseDir+          forM_ (M.toList $ Haskell.generatedFiles gen) $ \(subpath, contents) ->+            writeGeneratedFile baseDir subpath contents           (GenHaskell baseDir:) <$> processArgs stateVar rest +    "--clean-cpp":baseDir:rest -> do+      baseDirExists <- doesDirectoryExist baseDir+      when baseDirExists $ do+        genResult <- withCurrentCache stateVar $ getGeneratedCpp $ Just baseDir+        case genResult of+          Left errorMsg -> do+            hPutStrLn stderr $ "--clean-cpp: Failed to evaluate interface: " ++ errorMsg+            exitFailure+          Right gen -> do+            -- TODO Remove empty directories.+            forM_ (M.keys $ Cpp.generatedFiles gen) $ \path ->+              removeFile $ baseDir </> path+      (CleanCpp baseDir:) <$> processArgs stateVar rest++    "--clean-hs":baseDir:rest -> do+      baseDirExists <- doesDirectoryExist baseDir+      when baseDirExists $ do+        genResult <- withCurrentCache stateVar $ getGeneratedHaskell+        case genResult of+          Left errorMsg -> do+            hPutStrLn stderr $ "--clean-hs: Failed to evaluate interface: " ++ errorMsg+            exitFailure+          Right gen -> do+            -- TODO Remove empty directories.+            forM_ (M.keys $ Haskell.generatedFiles gen) $ \path ->+              removeFile $ baseDir </> path+      (CleanHs baseDir:) <$> processArgs stateVar rest+     "--dump-ext-names":rest -> do       withCurrentCache stateVar $ \_ iface cache -> do         forM_ (interfaceModules iface) $ \m ->           forM_ (moduleExports m) $ \export ->           forM_ (getAllExtNames export) $ \extName ->           putStrLn $ "extname module=" ++ moduleName m ++ " name=" ++ fromExtName extName-        return (iface, cache, ())+        return (cache, ())       (DumpExtNames:) <$> processArgs stateVar rest      "--dump-enums":rest -> do       withCurrentCache stateVar $ \state iface cache -> do-        iface' <- evaluateEnums state iface-        allEvaluatedData <- flip fromMaybeM (interfaceEvaluatedEnumData iface') $ do+        -- TODO 'Nothing' is less than ideal here.+        cache' <- generateComputedData Nothing state iface cache+        computed <- flip fromMaybeM (cacheComputedData cache') $ do           hPutStrLn stderr $ "--dump-enums expected to have evaluated enum data, but doesn't."           exitFailure+        let allEvaluatedData = evaluatedEnumMap computed         forM_ (M.toList allEvaluatedData) $ \(extName, evaluatedData) -> do           m <- flip fromMaybeM (M.lookup extName $ interfaceNamesToModules iface) $ do             hPutStrLn stderr $@@ -326,20 +495,36 @@             exitFailure           let typeStr =                 Cpp.chunkContents $ Cpp.execChunkWriter $-                Cpp.sayType Nothing $ evaluatedEnumType evaluatedData+                Cpp.sayType Nothing $ numType $ evaluatedEnumNumericType evaluatedData           putStrLn $ "enum name=" ++ fromExtName extName ++ " module=" ++ moduleName m ++             " type=" ++ typeStr           forM_ (M.toList $ evaluatedEnumValueMap evaluatedData) $ \(words', number) ->             putStrLn $ "entry value=" ++ show number ++ " name=" ++ show words'-        return (iface', cache, ())+        return (cache', ())       (DumpEnums:) <$> processArgs stateVar rest      "--keep-temp-outputs-on-failure":rest -> do-      modifyMVar_ stateVar $ \state -> return $ state { appKeepTempOutputsOnFailure = True }+      modifyMVar_ stateVar $ \state -> return state { appKeepTempOutputsOnFailure = True }       (KeepTempOutputsOnFailure:) <$> processArgs stateVar rest +    "--enum-eval-cache-path":path:rest -> do+      let path' = if path == "" then Nothing else Just path+      modifyMVar_ stateVar $ \state -> return state { appEnumEvalCachePath = path' }+      (EnumEvalCachePath path':) <$> processArgs stateVar rest++    "--enum-eval-cache-mode":arg:rest -> do+      mode <- case arg of+        "must-exist" -> return EnumCacheMustExist+        "refresh" -> return RefreshEnumCache+        _ -> do+          hPutStrLn stderr $+            "--enum-eval-cache-mode received unexpected argument, got: '" ++ arg ++ "'"+          exitFailure+      modifyMVar_ stateVar $ \state -> return state { appEnumEvalCacheMode = mode }+      (EnumEvalCacheMode mode:) <$> processArgs stateVar rest+     arg:_ -> do-      hPutStrLn stderr $ "Invalid option or missing argument for '" ++ arg ++ "'."+      hPutStrLn stderr $ "Invalid option, or missing argument for '" ++ arg ++ "'."       exitFailure  writeGeneratedFile :: FilePath -> FilePath -> String -> IO ()@@ -350,16 +535,14 @@  withCurrentCache ::   MVar AppState-  -> (AppState -> Interface -> InterfaceCache -> IO (Interface, InterfaceCache, a))+  -> (AppState -> Interface -> InterfaceCache -> IO (InterfaceCache, a))   -> IO a withCurrentCache stateVar fn = modifyMVar stateVar $ \state -> do   let iface = appCurrentInterface state       name = interfaceName iface   let cache = fromMaybe emptyCache $ M.lookup name $ appCaches state-  (iface', cache', result) <- fn state iface cache-  return ( state { appInterfaces = M.insert name iface' $ appInterfaces state-                 , appCaches = M.insert name cache' $ appCaches state-                 }+  (cache', result) <- fn state iface cache+  return ( state { appCaches = M.insert name cache' $ appCaches state }          , result          ) 

@@ -1,6 +1,6 @@ -- This file is part of Hoppy. ----- Copyright 2015-2020 Bryan Gardiner <bog@khumba.net>+-- 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

@@ -1,6 +1,6 @@ -- This file is part of Hoppy. ----- Copyright 2015-2020 Bryan Gardiner <bog@khumba.net>+-- 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@@ -23,19 +23,21 @@ -- \" ++ show cls@. module Foreign.Hoppy.Generator.Spec (   module Foreign.Hoppy.Generator.Spec.Base,-  module Foreign.Hoppy.Generator.Spec.Conversion,-  module Foreign.Hoppy.Generator.Spec.Variable,-  module Foreign.Hoppy.Generator.Spec.Enum,-  module Foreign.Hoppy.Generator.Spec.Function,   module Foreign.Hoppy.Generator.Spec.Callback,   module Foreign.Hoppy.Generator.Spec.Class,   module Foreign.Hoppy.Generator.Spec.ClassFeature,+  module Foreign.Hoppy.Generator.Spec.Computed,+  module Foreign.Hoppy.Generator.Spec.Conversion,+  module Foreign.Hoppy.Generator.Spec.Enum,+  module Foreign.Hoppy.Generator.Spec.Function,+  module Foreign.Hoppy.Generator.Spec.Variable,   ) where  import Foreign.Hoppy.Generator.Spec.Base import Foreign.Hoppy.Generator.Spec.Callback import Foreign.Hoppy.Generator.Spec.Class import Foreign.Hoppy.Generator.Spec.ClassFeature+import Foreign.Hoppy.Generator.Spec.Computed import Foreign.Hoppy.Generator.Spec.Conversion import Foreign.Hoppy.Generator.Spec.Enum import Foreign.Hoppy.Generator.Spec.Function

@@ -1,6 +1,6 @@ -- This file is part of Hoppy. ----- Copyright 2015-2020 Bryan Gardiner <bog@khumba.net>+-- 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@@ -167,12 +167,8 @@   hsWholeModuleImport, hsQualifiedImport, hsImport1, hsImport1', hsImports, hsImports',   hsImportSetMakeSource,   -- * Internal to Hoppy-  EvaluatedEnumData (..),-  EvaluatedEnumValueMap,   interfaceAllExceptionClasses,   interfaceSharedPtr,-  interfaceEvaluatedEnumData,-  interfaceGetEvaluatedEnumData,   -- ** Haskell imports   makeHsImportSet,   getHsImportSet,@@ -265,13 +261,19 @@     -- it.  This defaults to using @std::shared_ptr@ from @\<memory\>@, but can     -- be changed if necessary via 'interfaceSetSharedPtr'.   , interfaceCompiler :: Maybe SomeCompiler-    -- ^ The compiler to use when building code for the interface.  This can be-    -- overridden or disabled.  This defaults to 'defaultCompiler'.+    -- ^ The C++ compiler for the generator itself to use when building+    -- temporary code for the interface.  This can be overridden or disabled.+    -- This defaults to 'defaultCompiler'.+    --+    -- __This is separate__ from the @./configure && make@ compilation process+    -- used by @Foreign.Hoppy.Runtime.Setup.cppMain@ to build generated C+++    -- bindings (see hoppy-runtime).  This compiler is used to evaluate enums'+    -- numeric values when the generator is called, and is not used otherwise.+    -- See 'Foreign.Hoppy.Generator.Spec.Enum.makeAutoEnum' and+    -- "Foreign.Hoppy.Generator.Hooks".   , interfaceHooks :: Hooks     -- ^ Hooks allowing the interface to execute code at various points during     -- the code generator's execution.  This defaults to 'defaultHooks'.-  , interfaceEvaluatedEnumData :: Maybe (M.Map ExtName EvaluatedEnumData)-    -- ^ Evaluated numeric types and values for all enums in the interface.   , interfaceValidateEnumTypes :: Bool     -- ^ Whether to validate manually-provided enum numeric types     -- ('Foreign.Hoppy.Generator.Spec.Enum.enumNumericType') using a compiled@@ -365,7 +367,6 @@     , interfaceSharedPtr = (reqInclude $ includeStd "memory", "std::shared_ptr")     , interfaceCompiler = Just $ SomeCompiler defaultCompiler     , interfaceHooks = defaultHooks-    , interfaceEvaluatedEnumData = Nothing     , interfaceValidateEnumTypes = True     } @@ -494,18 +495,6 @@ interfaceModifyHooks f iface =   iface { interfaceHooks = f $ interfaceHooks iface } --- | Returns the map containing the calculated values for all entries in the--- enum with the given 'ExtName'.  This requires hooks to have been run.-interfaceGetEvaluatedEnumData :: HasCallStack => Interface -> ExtName -> EvaluatedEnumData-interfaceGetEvaluatedEnumData iface extName =-  case interfaceEvaluatedEnumData iface of-    Nothing -> error $ "interfaceGetEvaluatedEnumData: Data have not been " ++-               "evaluated for " ++ show iface ++ "."-    Just enumMap -> case M.lookup extName enumMap of-      Nothing -> error $ "interfaceGetEvaluatedEnumData: No data found for " ++-                 show extName ++ " in " ++ show iface ++ "."-      Just info -> info- -- | An @#include@ directive in a C++ file. newtype Include = Include   { includeToString :: String@@ -514,10 +503,14 @@   } deriving (Eq, Ord, Show)  -- | Creates an @#include \<...\>@ directive.+--+-- This can be added to most types of C++ entities with 'addReqIncludes'. includeStd :: String -> Include includeStd path = Include $ "#include <" ++ path ++ ">\n"  -- | Creates an @#include "..."@ directive.+--+-- This can be added to most types of C++ entities with 'addReqIncludes'. includeLocal :: String -> Include includeLocal path = Include $ "#include \"" ++ path ++ "\"\n" @@ -1520,19 +1513,6 @@   , conversionSpecHaskellToCppFn = toCppFn   , conversionSpecHaskellFromCppFn = fromCppFn   }---- | Information about the enum that has been completed beyond what the--- interface definition provides, possibly by building actual C++ code.-data EvaluatedEnumData = EvaluatedEnumData-  { evaluatedEnumType :: Type-    -- ^ The numeric type that C++ uses to hold the enum's values, or an-    -- equivalently-sized type.-  , evaluatedEnumValueMap :: EvaluatedEnumValueMap-    -- ^ Calculated values for all of the enum's entries.-  }---- | Contains the numeric values for each of the entries in a C++ enum.-type EvaluatedEnumValueMap = M.Map [String] Integer  -- | Each exception class has a unique exception ID. newtype ExceptionId = ExceptionId

@@ -1,6 +1,6 @@ -- This file is part of Hoppy. ----- Copyright 2015-2020 Bryan Gardiner <bog@khumba.net>+-- 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

@@ -1,6 +1,6 @@ -- This file is part of Hoppy. ----- Copyright 2015-2020 Bryan Gardiner <bog@khumba.net>+-- 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

@@ -1,6 +1,6 @@ -- This file is part of Hoppy. ----- Copyright 2015-2020 Bryan Gardiner <bog@khumba.net>+-- 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

@@ -1,6 +1,6 @@ -- This file is part of Hoppy. ----- Copyright 2015-2020 Bryan Gardiner <bog@khumba.net>+-- 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

@@ -1,6 +1,6 @@ -- This file is part of Hoppy. ----- Copyright 2015-2020 Bryan Gardiner <bog@khumba.net>+-- 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

@@ -1,6 +1,6 @@ -- This file is part of Hoppy. ----- Copyright 2015-2020 Bryan Gardiner <bog@khumba.net>+-- 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

@@ -0,0 +1,131 @@+-- 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/>.++-- | Module for computed data for an interface.+module Foreign.Hoppy.Generator.Spec.Computed (+  ComputedInterfaceData (..),+  EvaluatedEnumData (..),+  EvaluatedEnumValueMap,+  getEvaluatedEnumData,+  -- * Numeric types+  NumericTypeInfo,+  numType, numBytes, numMinBound, numMaxBound,+  findNumericTypeInfo,+  pickNumericType,+  ) where++import qualified Data.Map as M+import Data.Map (Map)+import Data.Maybe (listToMaybe)+import Foreign.C (CInt, CLong, CLLong, CUInt, CULong, CULLong)+import Foreign.Hoppy.Generator.Spec.Base (ExtName, Type)+import Foreign.Hoppy.Generator.Types (intT, llongT, longT, uintT, ullongT, ulongT)+import Foreign.Storable (Storable, sizeOf)+import GHC.Stack (HasCallStack)++-- | Holds "computed data" for an interface.  This is data that is calculated by+-- Hoppy, beyond what is directly specified in the interface.+data ComputedInterfaceData = ComputedInterfaceData+  { computedInterfaceName :: String+    -- ^ The name of the interface.+  , evaluatedEnumMap :: Map ExtName EvaluatedEnumData+    -- ^ Evaluated numeric types and values for all enums in the interface.+  }++-- | Information about the enum that has been completed beyond what the+-- interface definition provides, possibly by building actual C++ code.+data EvaluatedEnumData = EvaluatedEnumData+  { evaluatedEnumNumericType :: NumericTypeInfo+    -- ^ The numeric type that C++ uses to hold the enum's values, or an+    -- equivalently-sized type.+  , evaluatedEnumValueMap :: EvaluatedEnumValueMap+    -- ^ Calculated values for all of the enum's entries.+  } deriving (Read, Show)++-- | Contains the numeric values for each of the entries in a C++ enum.+type EvaluatedEnumValueMap = Map [String] Integer++-- | Returns the map containing the calculated values for all entries in the+-- enum with the given 'ExtName'.  This requires hooks to have been run.+getEvaluatedEnumData ::+     HasCallStack+  => ComputedInterfaceData+  -> ExtName+  -> EvaluatedEnumData+getEvaluatedEnumData computed extName = case M.lookup extName (evaluatedEnumMap computed) of+  Nothing -> error $ "interfaceGetEvaluatedEnumData: No data found for " +++             show extName ++ " in interface '" ++ computedInterfaceName computed ++ "'."+  Just info -> info++-- | Bound information about numeric types.+data NumericTypeInfo = NumericTypeInfo+  { numType :: Type+    -- ^ The numeric data type described by the record.+  , numBytes :: Int+    -- ^ The number of bytes in a value of the type.+  , numMinBound :: Integer+    -- ^ The lowest (most negative) value representable by the type.+  , numMaxBound :: Integer+    -- ^ The highest (most positive) value representable by the type.+  }++instance Show NumericTypeInfo where+  show info = show (numBytes info, numMinBound info, numMaxBound info)++instance Read NumericTypeInfo where+  readsPrec p s =+    case readsPrec p s of+      [((bytes, minBound, maxBound), rest)] ->+        case pickNumericType bytes minBound maxBound of+          Just info -> [(info, rest)]+          Nothing -> []+      [] -> []+      other ->+        error $ "Read NumericTypeInfo: Unexpected readsPrec result: " ++ show other++-- | Numeric types usable to hold enum values.  These are ordered by decreasing+-- precedence (increasing word size).+numericTypeInfo :: [NumericTypeInfo]+numericTypeInfo =+  [ mk intT (undefined :: CInt)+  , mk uintT (undefined :: CUInt)+  , mk longT (undefined :: CLong)+  , mk ulongT (undefined :: CULong)+  , mk llongT (undefined :: CLLong)+  , mk ullongT (undefined :: CULLong)+  ]+  where mk :: forall a. (Bounded a, Integral a, Storable a) => Type -> a -> NumericTypeInfo+        mk t _ = NumericTypeInfo+                 { numType = t+                 , numBytes = sizeOf (undefined :: a)+                 , numMinBound = toInteger (minBound :: a)+                 , numMaxBound = toInteger (maxBound :: a)+                 }++-- | Searches the list of known numeric types usable for enum values, and+-- returns the record for the given type.+findNumericTypeInfo :: Type -> Maybe NumericTypeInfo+findNumericTypeInfo t = listToMaybe $ filter (\i -> numType i == t) numericTypeInfo++-- | Selects the preferred numeric type for holding numeric values in the given+-- range.+pickNumericType :: Int -> Integer -> Integer -> Maybe NumericTypeInfo+pickNumericType bytes low high =+  listToMaybe $ flip filter numericTypeInfo $ \info ->+  numBytes info == bytes &&+  numMinBound info <= low &&+  numMaxBound info >= high

@@ -1,6 +1,6 @@ -- This file is part of Hoppy. ----- Copyright 2015-2020 Bryan Gardiner <bog@khumba.net>+-- 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

@@ -1,6 +1,6 @@ -- This file is part of Hoppy. ----- Copyright 2015-2020 Bryan Gardiner <bog@khumba.net>+-- 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@@ -64,6 +64,13 @@ import qualified Data.Map as M import Foreign.Hoppy.Generator.Common (butLast, capitalize, for) import Foreign.Hoppy.Generator.Spec.Base+import Foreign.Hoppy.Generator.Spec.Computed (+  EvaluatedEnumData,+  evaluatedEnumNumericType,+  evaluatedEnumValueMap,+  getEvaluatedEnumData,+  numType,+  ) import qualified Foreign.Hoppy.Generator.Language.Cpp as LC import qualified Foreign.Hoppy.Generator.Language.Haskell as LH import Foreign.Hoppy.Generator.Override (addOverrideMap, overriddenMapLookup, plainMap)@@ -218,7 +225,23 @@ -- | Creates a binding for a C++ enum. -- -- An enum created using this function will determine its entries' numeric--- values automatically when the generator is run, by compiling a C++ program.+-- values automatically when the generator is run, by compiling a temporary,+-- autogenerated C++ helper program.+--+-- This helper program needs to be able to access the C++ declaration of the+-- enum.  In addition to any 'includeStd' or 'includeLocal' requirements added+-- to the enum for the generated C++ bindings to use, the /interface's compiler/+-- ('interfaceCompiler') will need to be able to use these includes to access+-- the enum from C++ file built in a temporary directory.  To add @-I@ arguments+-- or otherwise change the compiler, you can reconfigure the interface:+--+-- @+-- myInterface =+--   'interfaceSetCompiler' (prependArguments [\"-I\" ++ pathToIncludes] defaultCompiler) $+--   'interface' ...+-- @+--+-- See "Foreign.Hoppy.Generator.Compiler". makeAutoEnum ::   IsAutoEnumValue v   => Identifier  -- ^ 'enumIdentifier'@@ -264,7 +287,7 @@ -- The @('EnumEntryWords', String)@ instance is the canonical one, with -- 'toAutoEnumValue' defined as @id@.  The string on the right is the C++ name -- of the entry, and the list of strings on the left are the words from which to--- generate foreign binding's entries.+-- generate foreign bindings' entry names. -- -- The @String@ instance takes the C++ name of the entry, and splits it into -- words via 'splitIntoWords'.@@ -350,7 +373,8 @@           makeConversionSpecHaskell             (HsTyCon . UnQual . HsIdent <$> toHsEnumTypeName e)             (Just $ do evaluatedData <- hsGetEvaluatedEnumData $ enumExtName e-                       LH.cppTypeToHsTypeAndUse LH.HsCSide $ evaluatedEnumType evaluatedData)+                       LH.cppTypeToHsTypeAndUse LH.HsCSide $+                         numType $ evaluatedEnumNumericType evaluatedData)             (CustomConversion $ do                LH.addImports $ mconcat [hsImport1 "Prelude" "(.)",                                         hsImportForPrelude,@@ -377,7 +401,8 @@     LH.SayExportDecls -> do       hsTypeName <- toHsEnumTypeName enum       evaluatedData <- hsGetEvaluatedEnumData $ enumExtName enum-      numericType <- LH.cppTypeToHsTypeAndUse LH.HsCSide $ evaluatedEnumType evaluatedData+      numericType <- LH.cppTypeToHsTypeAndUse LH.HsCSide $+        numType $ evaluatedEnumNumericType evaluatedData       let evaluatedValueMap = evaluatedEnumValueMap evaluatedData       evaluatedValues <- forM (enumValueMapNames $ enumValues enum) $ \name ->         case M.lookup name evaluatedValueMap of@@ -475,7 +500,8 @@     LH.SayExportBoot -> do       hsTypeName <- toHsEnumTypeName enum       evaluatedData <- hsGetEvaluatedEnumData $ enumExtName enum-      numericType <- LH.cppTypeToHsTypeAndUse LH.HsCSide $ evaluatedEnumType evaluatedData+      numericType <- LH.cppTypeToHsTypeAndUse LH.HsCSide $+        numType $ evaluatedEnumNumericType evaluatedData       LH.addImports $ mconcat [hsImportForPrelude, hsImportForRuntime]       LH.addExport hsTypeName       LH.ln@@ -491,15 +517,15 @@ -- | Reads evaluated data for the named enum from the C++ generator environment. cppGetEvaluatedEnumData :: HasCallStack => ExtName -> LC.Generator EvaluatedEnumData cppGetEvaluatedEnumData extName = do-  iface <- LC.askInterface-  return $ interfaceGetEvaluatedEnumData iface extName+  computed <- LC.askComputedInterfaceData+  return $ getEvaluatedEnumData computed extName  -- | Reads evaluated data for the named enum from the Haskell generator -- environment. hsGetEvaluatedEnumData :: HasCallStack => ExtName -> LH.Generator EvaluatedEnumData hsGetEvaluatedEnumData extName = do-  iface <- LH.askInterface-  return $ interfaceGetEvaluatedEnumData iface extName+  computed <- LH.askComputedInterfaceData+  return $ getEvaluatedEnumData computed extName  -- | Returns the Haskell name for an enum. --

@@ -1,6 +1,6 @@ -- This file is part of Hoppy. ----- Copyright 2015-2020 Bryan Gardiner <bog@khumba.net>+-- 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

@@ -1,6 +1,6 @@ -- This file is part of Hoppy. ----- Copyright 2015-2020 Bryan Gardiner <bog@khumba.net>+-- 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

@@ -1,6 +1,6 @@ -- This file is part of Hoppy. ----- Copyright 2015-2020 Bryan Gardiner <bog@khumba.net>+-- 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

@@ -1,6 +1,6 @@ -- This file is part of Hoppy. ----- Copyright 2015-2020 Bryan Gardiner <bog@khumba.net>+-- 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

@@ -1,6 +1,6 @@ -- This file is part of Hoppy. ----- Copyright 2015-2020 Bryan Gardiner <bog@khumba.net>+-- 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

@@ -1,6 +1,6 @@ -- This file is part of Hoppy. ----- Copyright 2015-2020 Bryan Gardiner <bog@khumba.net>+-- 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

@@ -1,6 +1,6 @@ -- This file is part of Hoppy. ----- Copyright 2015-2020 Bryan Gardiner <bog@khumba.net>+-- 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