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

{-# LANGUAGE CPP, GeneralizedNewtypeDeriving #-}

module Foreign.Hoppy.Generator.Spec.Base (
  ErrorMsg,
  -- * Interfaces
  Interface,
  InterfaceOptions (..),
  defaultInterfaceOptions,
  interface,
  interface',
  interfaceName,
  interfaceModules,
  interfaceNamesToModules,
  interfaceHaskellModuleBase,
  interfaceDefaultHaskellModuleBase,
  interfaceAddHaskellModuleBase,
  interfaceHaskellModuleImportNames,
  interfaceExceptionHandlers,
  interfaceCallbacksThrow,
  interfaceSetCallbacksThrow,
  interfaceExceptionClassId,
  interfaceExceptionSupportModule,
  interfaceSetExceptionSupportModule,
  interfaceSetSharedPtr,
  interfaceCompiler,
  interfaceSetCompiler,
  interfaceSetCompiler',
  interfaceSetNoCompiler,
  interfaceValidateEnumTypes,
  interfaceSetValidateEnumTypes,
  interfaceHooks,
  interfaceModifyHooks,
  -- * C++ includes
  Include,
  includeStd,
  includeLocal,
  includeToString,
  -- * Modules
  Module,
  moduleName,
  moduleHppPath,
  moduleCppPath,
  moduleExports,
  moduleReqs,
  moduleExceptionHandlers,
  moduleCallbacksThrow,
  moduleSetCallbacksThrow,
  moduleAddendum,
  moduleHaskellName,
  makeModule,
  moduleModify,
  moduleModify',
  moduleSetHppPath,
  moduleSetCppPath,
  moduleAddExports,
  moduleAddHaskellName,
  -- * Requirements
  Reqs,
  reqsIncludes,
  reqInclude,
  HasReqs (..),
  addReqs,
  addReqIncludes,
  -- * Names
  ExtName,
  toExtName,
  extNameOrIdentifier,
  extNameOrFnIdentifier,
  extNameOrString,
  isValidExtName,
  fromExtName,
  HasExtNames (..),
  getAllExtNames,
  FnName (..),
  IsFnName (..),
  Operator (..),
  OperatorType (..),
  operatorPreferredExtName,
  operatorPreferredExtName',
  operatorType,
  Identifier,
  makeIdentifier,
  identifierParts,
  IdPart,
  makeIdPart,
  idPartBase,
  idPartArgs,
  ident, ident', ident1, ident2, ident3, ident4, ident5,
  identT, identT', ident1T, ident2T, ident3T, ident4T, ident5T,
  -- * Exports
  Exportable (..),
  Export (..),
  -- * Basic types
  Type (..),
  normalizeType,
  stripConst,
  stripToGc,
  Scoped (..),
  isScoped,
  -- * Functions and parameters
  Constness (..), constNegate,
  Purity (..),
  Parameter, parameterType, onParameterType, parameterName,
  IsParameter (..), toParameters,
  np, (~:),
  -- * Conversions
  ConversionMethod (..),
  ConversionSpec (conversionSpecName, conversionSpecCpp, conversionSpecHaskell),
  makeConversionSpec,
  ConversionSpecCpp (
    ConversionSpecCpp,
    conversionSpecCppName,
    conversionSpecCppReqs,
    conversionSpecCppConversionType,
    conversionSpecCppConversionToCppExpr,
    conversionSpecCppConversionFromCppExpr
  ),
  makeConversionSpecCpp,
  ConversionSpecHaskell (
    ConversionSpecHaskell,
    conversionSpecHaskellHsType,
    conversionSpecHaskellHsArgType,
    conversionSpecHaskellCType,
    conversionSpecHaskellToCppFn,
    conversionSpecHaskellFromCppFn
  ),
  makeConversionSpecHaskell,
  -- * Exceptions
  ExceptionId (..),
  exceptionCatchAllId,
  ExceptionHandler (..),
  ExceptionHandlers (..),
  HandlesExceptions (..),
  handleExceptions,
  -- * Addenda
  Addendum (..),
  HasAddendum (..),
  addAddendumHaskell,
  -- * Enum support
  EnumInfo (..),
  EnumEntryWords,
  EnumValueMap (..),
  EnumValue (..),
  -- * Languages
  ForeignLanguage (..),
  WithForeignLanguageOverrides,
  MapWithForeignLanguageOverrides,
  -- * Haskell imports
  HsModuleName, HsImportSet, HsImportKey (..), HsImportSpecs (..), HsImportName, HsImportVal (..),
  hsWholeModuleImport, hsQualifiedImport, hsImport1, hsImport1', hsImports, hsImports',
  hsImportSetMakeSource,
  -- * Internal to Hoppy
  interfaceAllExceptionClasses,
  interfaceSharedPtr,
  -- ** Haskell imports
  makeHsImportSet,
  getHsImportSet,
  hsImportForBits,
  hsImportForException,
  hsImportForInt,
  hsImportForWord,
  hsImportForForeign,
  hsImportForForeignC,
  hsImportForMap,
  hsImportForPrelude,
  hsImportForRuntime,
  hsImportForSystemPosixTypes,
  hsImportForUnsafeIO,
  -- ** Error messages
  objToHeapTWrongDirectionErrorMsg,
  tToGcInvalidFormErrorMessage,
  toGcTWrongDirectionErrorMsg,
  ) where

#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>), (<*>))
#endif
import Control.Arrow ((&&&))
import Control.Monad (liftM2, unless)
#if MIN_VERSION_mtl(2,2,1)
import Control.Monad.Except (MonadError, throwError)
#else
import Control.Monad.Error (MonadError, throwError)
#endif
import Control.Monad.State (MonadState, StateT, execStateT, get, modify, put)
import Data.Char (isAlpha, isAlphaNum)
import Data.Function (on)
import Data.List (intercalate, intersperse)
import qualified Data.Map as M
import Data.Maybe (catMaybes, fromMaybe)
#if !MIN_VERSION_base(4,8,0)
import Data.Monoid (Monoid, mappend, mconcat, mempty)
#endif
import Data.Semigroup as Sem
import qualified Data.Set as S
import Data.Typeable (Typeable, cast)
import Foreign.Hoppy.Generator.Common
import Foreign.Hoppy.Generator.Compiler (Compiler, SomeCompiler (SomeCompiler), defaultCompiler)
import {-# SOURCE #-} Foreign.Hoppy.Generator.Hook (Hooks, defaultHooks)
import {-# SOURCE #-} qualified Foreign.Hoppy.Generator.Language.Cpp as LC
import {-# SOURCE #-} qualified Foreign.Hoppy.Generator.Language.Haskell as LH
import Foreign.Hoppy.Generator.Override (MapWithOverrides, WithOverrides)
import {-# SOURCE #-} Foreign.Hoppy.Generator.Spec.Class (Class, classExtName)
import GHC.Stack (HasCallStack)
import Language.Haskell.Syntax (HsName, HsQualType, HsType)

-- | Indicates strings that are error messages.
type ErrorMsg = String

-- | A complete specification of a C++ API.  Generators for different languages,
-- including the binding generator for C++, use these to produce their output.
--
-- 'Interface' does not have a 'HandlesExceptions' instance because
-- 'modifyExceptionHandlers' does not work for it (handled exceptions cannot be
-- modified after an 'Interface' is constructed).
data Interface = Interface
  { Interface -> HsImportName
interfaceName :: String
    -- ^ The textual name of the interface.
  , Interface -> Map HsImportName Module
interfaceModules :: M.Map String Module
    -- ^ All of the individual modules, by 'moduleName'.
  , Interface -> Map ExtName Module
interfaceNamesToModules :: M.Map ExtName Module
    -- ^ Maps each 'ExtName' exported by some module to the module that exports
    -- the name.
  , Interface -> Maybe [HsImportName]
interfaceHaskellModuleBase' :: Maybe [String]
    -- ^ See 'interfaceHaskellModuleBase'.
  , Interface -> Map Module HsImportName
interfaceHaskellModuleImportNames :: M.Map Module String
    -- ^ Short qualified module import names that generated modules use to refer
    -- to each other tersely.
  , Interface -> ExceptionHandlers
interfaceExceptionHandlers :: ExceptionHandlers
    -- ^ Exceptions that all functions in the interface may throw.
  , Interface -> Bool
interfaceCallbacksThrow :: Bool
    -- ^ Whether callbacks within the interface support throwing C++ exceptions
    -- from Haskell into C++ during their execution.  This may be overridden by
    -- 'moduleCallbacksThrow' and
    -- 'Foreign.Hoppy.Generator.Spec.Callback.callbackThrows'.
  , Interface -> Map ExtName ExceptionId
interfaceExceptionNamesToIds :: M.Map ExtName ExceptionId
    -- ^ Maps from external names of exception classes to their exception IDs.
  , Interface -> Maybe Module
interfaceExceptionSupportModule :: Maybe Module
    -- ^ When an interface uses C++ exceptions, then one module needs to
    -- manually be selected to contain some interface-specific runtime support.
    -- This is the selected module.
  , Interface -> (Reqs, HsImportName)
interfaceSharedPtr :: (Reqs, String)
    -- ^ The name of the @shared_ptr@ class to use, and the requirements to use
    -- it.  This defaults to using @std::shared_ptr@ from @\<memory\>@, but can
    -- be changed if necessary via 'interfaceSetSharedPtr'.
  , Interface -> Maybe SomeCompiler
interfaceCompiler :: Maybe SomeCompiler
    -- ^ 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".
  , Interface -> Hooks
interfaceHooks :: Hooks
    -- ^ Hooks allowing the interface to execute code at various points during
    -- the code generator's execution.  This defaults to 'defaultHooks'.
  , Interface -> Bool
interfaceValidateEnumTypes :: Bool
    -- ^ Whether to validate manually-provided enum numeric types
    -- ('Foreign.Hoppy.Generator.Spec.Enum.enumNumericType') using a compiled
    -- C++ @sizeof()@, as is done for enums that don't have an @enumNumericType@
    -- set.
    --
    -- This defaults to true, but can be set to false to discourage requiring a
    -- compiler.  See 'interfaceSetNoCompiler'.
  }

instance Show Interface where
  show :: Interface -> HsImportName
show Interface
iface = [HsImportName] -> HsImportName
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [HsImportName
"<Interface ", ShowS
forall a. Show a => a -> HsImportName
show (Interface -> HsImportName
interfaceName Interface
iface), HsImportName
">"]

instance HasExports Interface where
  lookupExport :: ExtName -> Interface -> Maybe Export
lookupExport ExtName
name Interface
iface =
    ExtName -> Module -> Maybe Export
forall a. HasExports a => ExtName -> a -> Maybe Export
lookupExport ExtName
name (Module -> Maybe Export) -> Maybe Module -> Maybe Export
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ExtName -> Map ExtName Module -> Maybe Module
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ExtName
name (Interface -> Map ExtName Module
interfaceNamesToModules Interface
iface)

-- | Optional parameters when constructing an 'Interface' with 'interface'.
newtype InterfaceOptions = InterfaceOptions
  { InterfaceOptions -> ExceptionHandlers
interfaceOptionsExceptionHandlers :: ExceptionHandlers
  }

-- | Options used by 'interface'.  This contains no exception handlers.
defaultInterfaceOptions :: InterfaceOptions
defaultInterfaceOptions :: InterfaceOptions
defaultInterfaceOptions = ExceptionHandlers -> InterfaceOptions
InterfaceOptions ExceptionHandlers
forall a. Monoid a => a
mempty

-- | Constructs an 'Interface' from the required parts.  Some validation is
-- performed; if the resulting interface would be invalid, an error message is
-- returned instead.
--
-- This function passes 'defaultInterfaceOptions' to 'interface''.
interface :: String  -- ^ 'interfaceName'
          -> [Module]  -- ^ 'interfaceModules'
          -> Either ErrorMsg Interface
interface :: HsImportName -> [Module] -> Either HsImportName Interface
interface HsImportName
ifName [Module]
modules = HsImportName
-> [Module] -> InterfaceOptions -> Either HsImportName Interface
interface' HsImportName
ifName [Module]
modules InterfaceOptions
defaultInterfaceOptions

-- | Same as 'interface', but accepts some optional arguments.
interface' :: String  -- ^ 'interfaceName'
           -> [Module]  -- ^ 'interfaceModules'
           -> InterfaceOptions
           -> Either ErrorMsg Interface
interface' :: HsImportName
-> [Module] -> InterfaceOptions -> Either HsImportName Interface
interface' HsImportName
ifName [Module]
modules InterfaceOptions
options = do
  -- TODO Check for duplicate module names.
  -- TODO Check for duplicate module file paths.

  -- Check for multiple modules exporting an ExtName.
  let extNamesToModules :: M.Map ExtName [Module]
      extNamesToModules :: Map ExtName [Module]
extNamesToModules =
        ([Module] -> [Module] -> [Module])
-> [Map ExtName [Module]] -> Map ExtName [Module]
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
M.unionsWith [Module] -> [Module] -> [Module]
forall a. [a] -> [a] -> [a]
(++) ([Map ExtName [Module]] -> Map ExtName [Module])
-> [Map ExtName [Module]] -> Map ExtName [Module]
forall a b. (a -> b) -> a -> b
$
        [Module]
-> (Module -> Map ExtName [Module]) -> [Map ExtName [Module]]
forall a b. [a] -> (a -> b) -> [b]
for [Module]
modules ((Module -> Map ExtName [Module]) -> [Map ExtName [Module]])
-> (Module -> Map ExtName [Module]) -> [Map ExtName [Module]]
forall a b. (a -> b) -> a -> b
$ \Module
m ->
        let extNames :: [ExtName]
extNames = (Export -> [ExtName]) -> [Export] -> [ExtName]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Export -> [ExtName]
forall a. HasExtNames a => a -> [ExtName]
getAllExtNames ([Export] -> [ExtName]) -> [Export] -> [ExtName]
forall a b. (a -> b) -> a -> b
$ Map ExtName Export -> [Export]
forall k a. Map k a -> [a]
M.elems (Map ExtName Export -> [Export]) -> Map ExtName Export -> [Export]
forall a b. (a -> b) -> a -> b
$ Module -> Map ExtName Export
moduleExports Module
m
        in [(ExtName, [Module])] -> Map ExtName [Module]
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(ExtName, [Module])] -> Map ExtName [Module])
-> [(ExtName, [Module])] -> Map ExtName [Module]
forall a b. (a -> b) -> a -> b
$ [ExtName] -> [[Module]] -> [(ExtName, [Module])]
forall a b. [a] -> [b] -> [(a, b)]
zip [ExtName]
extNames ([[Module]] -> [(ExtName, [Module])])
-> [[Module]] -> [(ExtName, [Module])]
forall a b. (a -> b) -> a -> b
$ [Module] -> [[Module]]
forall a. a -> [a]
repeat [Module
m]

      extNamesInMultipleModules :: [(ExtName, [Module])]
      extNamesInMultipleModules :: [(ExtName, [Module])]
extNamesInMultipleModules =
        Map ExtName [Module] -> [(ExtName, [Module])]
forall k a. Map k a -> [(k, a)]
M.toList (Map ExtName [Module] -> [(ExtName, [Module])])
-> Map ExtName [Module] -> [(ExtName, [Module])]
forall a b. (a -> b) -> a -> b
$
        ([Module] -> Bool) -> Map ExtName [Module] -> Map ExtName [Module]
forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter (\case
                     Module
_:Module
_:[Module]
_ -> Bool
True
                     [Module]
_ -> Bool
False)
        Map ExtName [Module]
extNamesToModules

  Bool -> Either HsImportName () -> Either HsImportName ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([(ExtName, [Module])] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(ExtName, [Module])]
extNamesInMultipleModules) (Either HsImportName () -> Either HsImportName ())
-> Either HsImportName () -> Either HsImportName ()
forall a b. (a -> b) -> a -> b
$
    HsImportName -> Either HsImportName ()
forall a b. a -> Either a b
Left (HsImportName -> Either HsImportName ())
-> HsImportName -> Either HsImportName ()
forall a b. (a -> b) -> a -> b
$ [HsImportName] -> HsImportName
unlines ([HsImportName] -> HsImportName) -> [HsImportName] -> HsImportName
forall a b. (a -> b) -> a -> b
$
    HsImportName
"Some external name(s) are exported by multiple modules:" HsImportName -> [HsImportName] -> [HsImportName]
forall a. a -> [a] -> [a]
:
    ((ExtName, [Module]) -> HsImportName)
-> [(ExtName, [Module])] -> [HsImportName]
forall a b. (a -> b) -> [a] -> [b]
map (\(ExtName
extName, [Module]
modules') ->
          [HsImportName] -> HsImportName
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([HsImportName] -> HsImportName) -> [HsImportName] -> HsImportName
forall a b. (a -> b) -> a -> b
$ HsImportName
"- " HsImportName -> [HsImportName] -> [HsImportName]
forall a. a -> [a] -> [a]
: ExtName -> HsImportName
forall a. Show a => a -> HsImportName
show ExtName
extName HsImportName -> [HsImportName] -> [HsImportName]
forall a. a -> [a] -> [a]
: HsImportName
": " HsImportName -> [HsImportName] -> [HsImportName]
forall a. a -> [a] -> [a]
: HsImportName -> [HsImportName] -> [HsImportName]
forall a. a -> [a] -> [a]
intersperse HsImportName
", " ((Module -> HsImportName) -> [Module] -> [HsImportName]
forall a b. (a -> b) -> [a] -> [b]
map Module -> HsImportName
forall a. Show a => a -> HsImportName
show [Module]
modules'))
        [(ExtName, [Module])]
extNamesInMultipleModules

  let haskellModuleImportNames :: Map Module HsImportName
haskellModuleImportNames =
        [(Module, HsImportName)] -> Map Module HsImportName
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Module, HsImportName)] -> Map Module HsImportName)
-> [(Module, HsImportName)] -> Map Module HsImportName
forall a b. (a -> b) -> a -> b
$
        (\[Module]
a [Int]
b Module -> Int -> (Module, HsImportName)
f -> (Module -> Int -> (Module, HsImportName))
-> [Module] -> [Int] -> [(Module, HsImportName)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Module -> Int -> (Module, HsImportName)
f [Module]
a [Int]
b) [Module]
modules [(Int
1::Int)..] ((Module -> Int -> (Module, HsImportName))
 -> [(Module, HsImportName)])
-> (Module -> Int -> (Module, HsImportName))
-> [(Module, HsImportName)]
forall a b. (a -> b) -> a -> b
$
        \Module
m Int
index -> (Module
m, Char
'M' Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> HsImportName
forall a. Show a => a -> HsImportName
show Int
index)

  -- Generate a unique exception ID integer for each exception class.  IDs 0 and
  -- 1 are reserved.
  let exceptionNamesToIds :: Map ExtName ExceptionId
exceptionNamesToIds =
        [(ExtName, ExceptionId)] -> Map ExtName ExceptionId
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(ExtName, ExceptionId)] -> Map ExtName ExceptionId)
-> [(ExtName, ExceptionId)] -> Map ExtName ExceptionId
forall a b. (a -> b) -> a -> b
$
        [ExtName] -> [ExceptionId] -> [(ExtName, ExceptionId)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Class -> ExtName) -> [Class] -> [ExtName]
forall a b. (a -> b) -> [a] -> [b]
map Class -> ExtName
classExtName ([Class] -> [ExtName]) -> [Class] -> [ExtName]
forall a b. (a -> b) -> a -> b
$ [Module] -> [Class]
interfaceAllExceptionClasses' [Module]
modules)
            ((Int -> ExceptionId) -> [Int] -> [ExceptionId]
forall a b. (a -> b) -> [a] -> [b]
map Int -> ExceptionId
ExceptionId [Int
exceptionFirstFreeId..])

  Interface -> Either HsImportName Interface
forall a. a -> Either HsImportName a
forall (m :: * -> *) a. Monad m => a -> m a
return Interface
    { interfaceName :: HsImportName
interfaceName = HsImportName
ifName
    , interfaceModules :: Map HsImportName Module
interfaceModules = [(HsImportName, Module)] -> Map HsImportName Module
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(HsImportName, Module)] -> Map HsImportName Module)
-> [(HsImportName, Module)] -> Map HsImportName Module
forall a b. (a -> b) -> a -> b
$ (Module -> (HsImportName, Module))
-> [Module] -> [(HsImportName, Module)]
forall a b. (a -> b) -> [a] -> [b]
map (Module -> HsImportName
moduleName (Module -> HsImportName)
-> (Module -> Module) -> Module -> (HsImportName, Module)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Module -> Module
forall a. a -> a
id) [Module]
modules
    , interfaceNamesToModules :: Map ExtName Module
interfaceNamesToModules = ([Module] -> Module) -> Map ExtName [Module] -> Map ExtName Module
forall a b k. (a -> b) -> Map k a -> Map k b
M.map (\[Module
x] -> Module
x) Map ExtName [Module]
extNamesToModules
    , interfaceHaskellModuleBase' :: Maybe [HsImportName]
interfaceHaskellModuleBase' = Maybe [HsImportName]
forall a. Maybe a
Nothing
    , interfaceHaskellModuleImportNames :: Map Module HsImportName
interfaceHaskellModuleImportNames = Map Module HsImportName
haskellModuleImportNames
    , interfaceExceptionHandlers :: ExceptionHandlers
interfaceExceptionHandlers = InterfaceOptions -> ExceptionHandlers
interfaceOptionsExceptionHandlers InterfaceOptions
options
    , interfaceCallbacksThrow :: Bool
interfaceCallbacksThrow = Bool
False
    , interfaceExceptionNamesToIds :: Map ExtName ExceptionId
interfaceExceptionNamesToIds = Map ExtName ExceptionId
exceptionNamesToIds
    , interfaceExceptionSupportModule :: Maybe Module
interfaceExceptionSupportModule = Maybe Module
forall a. Maybe a
Nothing
    , interfaceSharedPtr :: (Reqs, HsImportName)
interfaceSharedPtr = (Include -> Reqs
reqInclude (Include -> Reqs) -> Include -> Reqs
forall a b. (a -> b) -> a -> b
$ HsImportName -> Include
includeStd HsImportName
"memory", HsImportName
"std::shared_ptr")
    , interfaceCompiler :: Maybe SomeCompiler
interfaceCompiler = SomeCompiler -> Maybe SomeCompiler
forall a. a -> Maybe a
Just (SomeCompiler -> Maybe SomeCompiler)
-> SomeCompiler -> Maybe SomeCompiler
forall a b. (a -> b) -> a -> b
$ SimpleCompiler -> SomeCompiler
forall a. Compiler a => a -> SomeCompiler
SomeCompiler SimpleCompiler
defaultCompiler
    , interfaceHooks :: Hooks
interfaceHooks = Hooks
defaultHooks
    , interfaceValidateEnumTypes :: Bool
interfaceValidateEnumTypes = Bool
True
    }

-- | The name of the parent Haskell module under which a Haskell module will be
-- generated for a Hoppy 'Module'.  This is a list of Haskell module path
-- components, in other words, @'Data.List.intercalate' "."@ on the list
-- produces a Haskell module name.  Defaults to
-- 'interfaceDefaultHaskellModuleBase', and may be overridden with
-- 'interfaceAddHaskellModuleBase'.
interfaceHaskellModuleBase :: Interface -> [String]
interfaceHaskellModuleBase :: Interface -> [HsImportName]
interfaceHaskellModuleBase =
  [HsImportName] -> Maybe [HsImportName] -> [HsImportName]
forall a. a -> Maybe a -> a
fromMaybe [HsImportName]
interfaceDefaultHaskellModuleBase (Maybe [HsImportName] -> [HsImportName])
-> (Interface -> Maybe [HsImportName])
-> Interface
-> [HsImportName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Interface -> Maybe [HsImportName]
interfaceHaskellModuleBase'

-- | The default Haskell module under which Hoppy modules will be generated.
-- This is @Foreign.Hoppy.Generated@, that is:
--
-- > ["Foreign", "Hoppy", "Generated"]
interfaceDefaultHaskellModuleBase :: [String]
interfaceDefaultHaskellModuleBase :: [HsImportName]
interfaceDefaultHaskellModuleBase = [HsImportName
"Foreign", HsImportName
"Hoppy", HsImportName
"Generated"]

-- | Sets an interface to generate all of its modules under the given Haskell
-- module prefix.  See 'interfaceHaskellModuleBase'.
interfaceAddHaskellModuleBase :: [String] -> Interface -> Either String Interface
interfaceAddHaskellModuleBase :: [HsImportName] -> Interface -> Either HsImportName Interface
interfaceAddHaskellModuleBase [HsImportName]
modulePath Interface
iface = case Interface -> Maybe [HsImportName]
interfaceHaskellModuleBase' Interface
iface of
  Maybe [HsImportName]
Nothing -> Interface -> Either HsImportName Interface
forall a b. b -> Either a b
Right Interface
iface { interfaceHaskellModuleBase' = Just modulePath }
  Just [HsImportName]
existingPath ->
    HsImportName -> Either HsImportName Interface
forall a b. a -> Either a b
Left (HsImportName -> Either HsImportName Interface)
-> HsImportName -> Either HsImportName Interface
forall a b. (a -> b) -> a -> b
$ [HsImportName] -> HsImportName
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ HsImportName
"addInterfaceHaskellModuleBase: Trying to add Haskell module base "
    , HsImportName -> [HsImportName] -> HsImportName
forall a. [a] -> [[a]] -> [a]
intercalate HsImportName
"." [HsImportName]
modulePath, HsImportName
" to ", Interface -> HsImportName
forall a. Show a => a -> HsImportName
show Interface
iface
    , HsImportName
" which already has a module base ", HsImportName -> [HsImportName] -> HsImportName
forall a. [a] -> [[a]] -> [a]
intercalate HsImportName
"." [HsImportName]
existingPath
    ]

-- | Returns the the exception ID for a class in an interface, if it has one
-- (i.e. if it's been marked as an exception class with
-- 'Foreign.Hoppy.Generator.Spec.Class.classMakeException').
interfaceExceptionClassId :: Interface -> Class -> Maybe ExceptionId
interfaceExceptionClassId :: Interface -> Class -> Maybe ExceptionId
interfaceExceptionClassId Interface
iface Class
cls =
  ExtName -> Map ExtName ExceptionId -> Maybe ExceptionId
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Class -> ExtName
classExtName Class
cls) (Map ExtName ExceptionId -> Maybe ExceptionId)
-> Map ExtName ExceptionId -> Maybe ExceptionId
forall a b. (a -> b) -> a -> b
$ Interface -> Map ExtName ExceptionId
interfaceExceptionNamesToIds Interface
iface

-- | Returns all of the exception classes in an interface.
interfaceAllExceptionClasses :: Interface -> [Class]
interfaceAllExceptionClasses :: Interface -> [Class]
interfaceAllExceptionClasses = [Module] -> [Class]
interfaceAllExceptionClasses' ([Module] -> [Class])
-> (Interface -> [Module]) -> Interface -> [Class]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map HsImportName Module -> [Module]
forall k a. Map k a -> [a]
M.elems (Map HsImportName Module -> [Module])
-> (Interface -> Map HsImportName Module) -> Interface -> [Module]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Interface -> Map HsImportName Module
interfaceModules

interfaceAllExceptionClasses' :: [Module] -> [Class]
interfaceAllExceptionClasses' :: [Module] -> [Class]
interfaceAllExceptionClasses' [Module]
modules =
  ((Module -> [Class]) -> [Module] -> [Class])
-> [Module] -> (Module -> [Class]) -> [Class]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Module -> [Class]) -> [Module] -> [Class]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [Module]
modules ((Module -> [Class]) -> [Class]) -> (Module -> [Class]) -> [Class]
forall a b. (a -> b) -> a -> b
$ \Module
m ->
  [Maybe Class] -> [Class]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Class] -> [Class]) -> [Maybe Class] -> [Class]
forall a b. (a -> b) -> a -> b
$
  (Export -> Maybe Class) -> [Export] -> [Maybe Class]
forall a b. (a -> b) -> [a] -> [b]
map Export -> Maybe Class
forall a. Exportable a => a -> Maybe Class
getExportExceptionClass ([Export] -> [Maybe Class]) -> [Export] -> [Maybe Class]
forall a b. (a -> b) -> a -> b
$
  Map ExtName Export -> [Export]
forall k a. Map k a -> [a]
M.elems (Map ExtName Export -> [Export]) -> Map ExtName Export -> [Export]
forall a b. (a -> b) -> a -> b
$ Module -> Map ExtName Export
moduleExports Module
m

-- | Changes 'Foreign.Hoppy.Generator.Spec.Callback.callbackThrows' for all
-- callbacks in an interface that don't have it set explicitly at the module or
-- callback level.
interfaceSetCallbacksThrow :: Bool -> Interface -> Interface
interfaceSetCallbacksThrow :: Bool -> Interface -> Interface
interfaceSetCallbacksThrow Bool
b Interface
iface = Interface
iface { interfaceCallbacksThrow = b }

-- | Sets an interface's exception support module, for interfaces that use
-- exceptions.
interfaceSetExceptionSupportModule :: HasCallStack => Module -> Interface -> Interface
interfaceSetExceptionSupportModule :: HasCallStack => Module -> Interface -> Interface
interfaceSetExceptionSupportModule Module
m Interface
iface = case Interface -> Maybe Module
interfaceExceptionSupportModule Interface
iface of
  Maybe Module
Nothing -> Interface
iface { interfaceExceptionSupportModule = Just m }
  Just Module
existingMod ->
    if Module
m Module -> Module -> Bool
forall a. Eq a => a -> a -> Bool
== Module
existingMod
    then Interface
iface
    else HsImportName -> Interface
forall a. HasCallStack => HsImportName -> a
error (HsImportName -> Interface) -> HsImportName -> Interface
forall a b. (a -> b) -> a -> b
$ HsImportName
"interfaceSetExceptionSupportModule: " HsImportName -> ShowS
forall a. [a] -> [a] -> [a]
++ Interface -> HsImportName
forall a. Show a => a -> HsImportName
show Interface
iface HsImportName -> ShowS
forall a. [a] -> [a] -> [a]
++
         HsImportName
" already has exception support module " HsImportName -> ShowS
forall a. [a] -> [a] -> [a]
++ Module -> HsImportName
forall a. Show a => a -> HsImportName
show Module
existingMod HsImportName -> ShowS
forall a. [a] -> [a] -> [a]
++
         HsImportName
", trying to set " HsImportName -> ShowS
forall a. [a] -> [a] -> [a]
++ Module -> HsImportName
forall a. Show a => a -> HsImportName
show Module
m HsImportName -> ShowS
forall a. [a] -> [a] -> [a]
++ HsImportName
"."

-- | Installs a custom @std::shared_ptr@ implementation for use by an interface.
-- Hoppy uses shared pointers for generated callback code.  This function is
-- useful for building code with compilers that don't provide a conforming
-- @std::shared_ptr@ implementation.
--
-- @interfaceSetSharedPtr ident reqs iface@ modifies @iface@ to use as a
-- @shared_ptr@ class the C++ identifier @ident@, which needs @reqs@ in order to
-- be accessed.  @ident@ should be the name of a template to which an arbitrary
-- @\<T\>@ can be appended, for example @"std::shared_ptr"@.
--
-- A @shared_ptr\<T\>@ implementation @foo@ must at least provide the following
-- interface:
--
-- > foo();  // Initialization with a null pointer.
-- > foo(T*);  // Initialization with a given pointer.
-- > foo(const foo&);  // Copy-construction.
-- > T& operator*() const;  // Dereferencing (when non-null).
-- > T* operator->() const;  // Dereferencing and invocation (when non-null).
-- > explicit operator bool() const;  // Is the target object null?
interfaceSetSharedPtr :: String -> Reqs -> Interface -> Interface
interfaceSetSharedPtr :: HsImportName -> Reqs -> Interface -> Interface
interfaceSetSharedPtr HsImportName
identifier Reqs
reqs Interface
iface =
  Interface
iface { interfaceSharedPtr = (reqs, identifier) }

-- | Replaces the default compiler used by the interface.
--
-- @interfaceSetCompiler c = 'interfaceSetCompiler'' ('SomeCompiler' c)@
interfaceSetCompiler :: Compiler a => a -> Interface -> Interface
interfaceSetCompiler :: forall a. Compiler a => a -> Interface -> Interface
interfaceSetCompiler = Maybe SomeCompiler -> Interface -> Interface
interfaceSetCompiler' (Maybe SomeCompiler -> Interface -> Interface)
-> (a -> Maybe SomeCompiler) -> a -> Interface -> Interface
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeCompiler -> Maybe SomeCompiler
forall a. a -> Maybe a
Just (SomeCompiler -> Maybe SomeCompiler)
-> (a -> SomeCompiler) -> a -> Maybe SomeCompiler
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> SomeCompiler
forall a. Compiler a => a -> SomeCompiler
SomeCompiler

-- | Replaces the default compiler used by the interface.  When given @Nothing@,
-- the interface will not be allowed to compile any code when it generates
-- bindings.
interfaceSetCompiler' :: Maybe SomeCompiler -> Interface -> Interface
interfaceSetCompiler' :: Maybe SomeCompiler -> Interface -> Interface
interfaceSetCompiler' Maybe SomeCompiler
compiler Interface
iface = Interface
iface { interfaceCompiler = compiler }

-- | Sets an interface to never compile C++ code during binding generation.
--
-- This sets the interface to have no compiler, and also asks the interface not
-- to do things that require a compiler, which would otherwise cause a runtime
-- failure: currently just validation of provided enum numeric types
-- (@'interfaceSetValidateEnumTypes' False@).
interfaceSetNoCompiler :: Interface -> Interface
interfaceSetNoCompiler :: Interface -> Interface
interfaceSetNoCompiler =
  Bool -> Interface -> Interface
interfaceSetValidateEnumTypes Bool
False (Interface -> Interface)
-> (Interface -> Interface) -> Interface -> Interface
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Maybe SomeCompiler -> Interface -> Interface
interfaceSetCompiler' Maybe SomeCompiler
forall a. Maybe a
Nothing

-- | Controls whether the interface will validate manually specified enum types
-- ('Foreign.Hoppy.Generator.Spec.Enum.enumNumericType') by compiling a C++
-- program.
--
-- See 'interfaceValidateEnumTypes'.
interfaceSetValidateEnumTypes :: Bool -> Interface -> Interface
interfaceSetValidateEnumTypes :: Bool -> Interface -> Interface
interfaceSetValidateEnumTypes Bool
validate Interface
iface =
  Interface
iface { interfaceValidateEnumTypes = validate }

-- | Modifies the hooks associated with an interface.
interfaceModifyHooks :: (Hooks -> Hooks) -> Interface -> Interface
interfaceModifyHooks :: (Hooks -> Hooks) -> Interface -> Interface
interfaceModifyHooks Hooks -> Hooks
f Interface
iface =
  Interface
iface { interfaceHooks = f $ interfaceHooks iface }

-- | An @#include@ directive in a C++ file.
newtype Include = Include
  { Include -> HsImportName
includeToString :: String
    -- ^ Returns the complete @#include ...@ line for an include, including
    -- trailing newline.
  } deriving (Include -> Include -> Bool
(Include -> Include -> Bool)
-> (Include -> Include -> Bool) -> Eq Include
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Include -> Include -> Bool
== :: Include -> Include -> Bool
$c/= :: Include -> Include -> Bool
/= :: Include -> Include -> Bool
Eq, Eq Include
Eq Include =>
(Include -> Include -> Ordering)
-> (Include -> Include -> Bool)
-> (Include -> Include -> Bool)
-> (Include -> Include -> Bool)
-> (Include -> Include -> Bool)
-> (Include -> Include -> Include)
-> (Include -> Include -> Include)
-> Ord Include
Include -> Include -> Bool
Include -> Include -> Ordering
Include -> Include -> Include
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Include -> Include -> Ordering
compare :: Include -> Include -> Ordering
$c< :: Include -> Include -> Bool
< :: Include -> Include -> Bool
$c<= :: Include -> Include -> Bool
<= :: Include -> Include -> Bool
$c> :: Include -> Include -> Bool
> :: Include -> Include -> Bool
$c>= :: Include -> Include -> Bool
>= :: Include -> Include -> Bool
$cmax :: Include -> Include -> Include
max :: Include -> Include -> Include
$cmin :: Include -> Include -> Include
min :: Include -> Include -> Include
Ord, Int -> Include -> ShowS
[Include] -> ShowS
Include -> HsImportName
(Int -> Include -> ShowS)
-> (Include -> HsImportName)
-> ([Include] -> ShowS)
-> Show Include
forall a.
(Int -> a -> ShowS)
-> (a -> HsImportName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Include -> ShowS
showsPrec :: Int -> Include -> ShowS
$cshow :: Include -> HsImportName
show :: Include -> HsImportName
$cshowList :: [Include] -> ShowS
showList :: [Include] -> ShowS
Show)

-- | Creates an @#include \<...\>@ directive.
--
-- This can be added to most types of C++ entities with 'addReqIncludes'.
includeStd :: String -> Include
includeStd :: HsImportName -> Include
includeStd HsImportName
path = HsImportName -> Include
Include (HsImportName -> Include) -> HsImportName -> Include
forall a b. (a -> b) -> a -> b
$ HsImportName
"#include <" HsImportName -> ShowS
forall a. [a] -> [a] -> [a]
++ HsImportName
path HsImportName -> ShowS
forall a. [a] -> [a] -> [a]
++ HsImportName
">\n"

-- | Creates an @#include "..."@ directive.
--
-- This can be added to most types of C++ entities with 'addReqIncludes'.
includeLocal :: String -> Include
includeLocal :: HsImportName -> Include
includeLocal HsImportName
path = HsImportName -> Include
Include (HsImportName -> Include) -> HsImportName -> Include
forall a b. (a -> b) -> a -> b
$ HsImportName
"#include \"" HsImportName -> ShowS
forall a. [a] -> [a] -> [a]
++ HsImportName
path HsImportName -> ShowS
forall a. [a] -> [a] -> [a]
++ HsImportName
"\"\n"

-- | A portion of functionality in a C++ API.  An 'Interface' is composed of
-- multiple modules.  A module will generate a single compilation unit
-- containing bindings for all of the module's exports.  The C++ code for a
-- generated module will @#include@ everything necessary for what is written to
-- the header and source files separately.  You can declare include dependencies
-- with e.g. 'addReqIncludes', either for individual exports or at the module
-- level (via the @'HasReqs' 'Module'@ instance).  Dependencies between modules
-- are handled automatically, and circularity is supported to a certain extent.
-- See the documentation for the individual language modules for further
-- details.
data Module = Module
  { Module -> HsImportName
moduleName :: String
    -- ^ The module's name.  A module name must identify a unique module within
    -- an 'Interface'.
  , Module -> HsImportName
moduleHppPath :: String
    -- ^ A relative path under a C++ sources root to which the generator will
    -- write a header file for the module's C++ bindings.
  , Module -> HsImportName
moduleCppPath :: String
    -- ^ A relative path under a C++ sources root to which the generator will
    -- write a source file for the module's C++ bindings.
  , Module -> Map ExtName Export
moduleExports :: M.Map ExtName Export
    -- ^ All of the exports in a module.
  , Module -> Reqs
moduleReqs :: Reqs
    -- ^ Module-level requirements.
  , Module -> Maybe [HsImportName]
moduleHaskellName :: Maybe [String]
    -- ^ The generated Haskell module name, underneath the
    -- 'interfaceHaskellModuleBase'.  If absent (by default), the 'moduleName'
    -- is used.  May be modified with 'moduleAddHaskellName'.
  , Module -> ExceptionHandlers
moduleExceptionHandlers :: ExceptionHandlers
    -- ^ Exceptions that all functions in the module may throw.
  , Module -> Maybe Bool
moduleCallbacksThrow :: Maybe Bool
    -- ^ Whether callbacks exported from the module support exceptions being
    -- thrown during their execution.  When present, this overrides
    -- 'interfaceCallbacksThrow'.  This maybe overridden by
    -- 'Foreign.Hoppy.Generator.Spec.Callback.callbackThrows'.
  , Module -> Addendum
moduleAddendum :: Addendum
    -- ^ The module's addendum.
  }

instance Eq Module where
  == :: Module -> Module -> Bool
(==) = HsImportName -> HsImportName -> Bool
forall a. Eq a => a -> a -> Bool
(==) (HsImportName -> HsImportName -> Bool)
-> (Module -> HsImportName) -> Module -> Module -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Module -> HsImportName
moduleName

instance Ord Module where
  compare :: Module -> Module -> Ordering
compare = HsImportName -> HsImportName -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (HsImportName -> HsImportName -> Ordering)
-> (Module -> HsImportName) -> Module -> Module -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Module -> HsImportName
moduleName

instance Show Module where
  show :: Module -> HsImportName
show Module
m = [HsImportName] -> HsImportName
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [HsImportName
"<Module ", Module -> HsImportName
moduleName Module
m, HsImportName
">"]

instance HasExports Module where
  lookupExport :: ExtName -> Module -> Maybe Export
lookupExport ExtName
name Module
m = ExtName -> Map ExtName Export -> Maybe Export
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ExtName
name (Map ExtName Export -> Maybe Export)
-> Map ExtName Export -> Maybe Export
forall a b. (a -> b) -> a -> b
$ Module -> Map ExtName Export
moduleExports Module
m

instance HasReqs Module where
  getReqs :: Module -> Reqs
getReqs = Module -> Reqs
moduleReqs
  setReqs :: Reqs -> Module -> Module
setReqs Reqs
reqs Module
m = Module
m { moduleReqs = reqs }

instance HasAddendum Module where
  getAddendum :: Module -> Addendum
getAddendum = Module -> Addendum
moduleAddendum
  setAddendum :: Addendum -> Module -> Module
setAddendum Addendum
addendum Module
m = Module
m { moduleAddendum = addendum }

instance HandlesExceptions Module where
  getExceptionHandlers :: Module -> ExceptionHandlers
getExceptionHandlers = Module -> ExceptionHandlers
moduleExceptionHandlers
  modifyExceptionHandlers :: (ExceptionHandlers -> ExceptionHandlers) -> Module -> Module
modifyExceptionHandlers ExceptionHandlers -> ExceptionHandlers
f Module
m = Module
m { moduleExceptionHandlers = f $ moduleExceptionHandlers m }

-- | Creates an empty module, ready to be configured with 'moduleModify'.
makeModule :: String  -- ^ 'moduleName'
           -> String  -- ^ 'moduleHppPath'
           -> String  -- ^ 'moduleCppPath'
           -> Module
makeModule :: HsImportName -> HsImportName -> HsImportName -> Module
makeModule HsImportName
name HsImportName
hppPath HsImportName
cppPath = Module
  { moduleName :: HsImportName
moduleName = HsImportName
name
  , moduleHppPath :: HsImportName
moduleHppPath = HsImportName
hppPath
  , moduleCppPath :: HsImportName
moduleCppPath = HsImportName
cppPath
  , moduleExports :: Map ExtName Export
moduleExports = Map ExtName Export
forall k a. Map k a
M.empty
  , moduleReqs :: Reqs
moduleReqs = Reqs
forall a. Monoid a => a
mempty
  , moduleHaskellName :: Maybe [HsImportName]
moduleHaskellName = Maybe [HsImportName]
forall a. Maybe a
Nothing
  , moduleExceptionHandlers :: ExceptionHandlers
moduleExceptionHandlers = ExceptionHandlers
forall a. Monoid a => a
mempty
  , moduleCallbacksThrow :: Maybe Bool
moduleCallbacksThrow = Maybe Bool
forall a. Maybe a
Nothing
  , moduleAddendum :: Addendum
moduleAddendum = Addendum
forall a. Monoid a => a
mempty
  }

-- | Extends a module.  To be used with the module state-monad actions in this
-- package.
moduleModify :: Module -> StateT Module (Either String) () -> Either ErrorMsg Module
moduleModify :: Module
-> StateT Module (Either HsImportName) ()
-> Either HsImportName Module
moduleModify = (StateT Module (Either HsImportName) ()
 -> Module -> Either HsImportName Module)
-> Module
-> StateT Module (Either HsImportName) ()
-> Either HsImportName Module
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT Module (Either HsImportName) ()
-> Module -> Either HsImportName Module
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT

-- | Same as 'moduleModify', but calls 'error' in the case of failure, which is
-- okay in for a generator which would abort in this case anyway.
moduleModify' :: HasCallStack => Module -> StateT Module (Either String) () -> Module
moduleModify' :: HasCallStack =>
Module -> StateT Module (Either HsImportName) () -> Module
moduleModify' Module
m StateT Module (Either HsImportName) ()
action = case Module
-> StateT Module (Either HsImportName) ()
-> Either HsImportName Module
moduleModify Module
m StateT Module (Either HsImportName) ()
action of
  Left HsImportName
errorMsg ->
    HsImportName -> Module
forall a. HasCallStack => HsImportName -> a
error (HsImportName -> Module) -> HsImportName -> Module
forall a b. (a -> b) -> a -> b
$ [HsImportName] -> HsImportName
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [HsImportName
"moduleModify' failed to modify ", Module -> HsImportName
forall a. Show a => a -> HsImportName
show Module
m, HsImportName
": ", HsImportName
errorMsg]
  Right Module
m' -> Module
m'

-- | Replaces a module's 'moduleHppPath'.
moduleSetHppPath :: MonadState Module m => String -> m ()
moduleSetHppPath :: forall (m :: * -> *). MonadState Module m => HsImportName -> m ()
moduleSetHppPath HsImportName
path = (Module -> Module) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Module -> Module) -> m ()) -> (Module -> Module) -> m ()
forall a b. (a -> b) -> a -> b
$ \Module
m -> Module
m { moduleHppPath = path }

-- | Replaces a module's 'moduleCppPath'.
moduleSetCppPath :: MonadState Module m => String -> m ()
moduleSetCppPath :: forall (m :: * -> *). MonadState Module m => HsImportName -> m ()
moduleSetCppPath HsImportName
path = (Module -> Module) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Module -> Module) -> m ()) -> (Module -> Module) -> m ()
forall a b. (a -> b) -> a -> b
$ \Module
m -> Module
m { moduleCppPath = path }

-- | Adds exports to a module.  An export must only be added to any module at
-- most once, and must not be added to multiple modules.
moduleAddExports :: (MonadError String m, MonadState Module m) => [Export] -> m ()
moduleAddExports :: forall (m :: * -> *).
(MonadError HsImportName m, MonadState Module m) =>
[Export] -> m ()
moduleAddExports [Export]
exports = do
  Module
m <- m Module
forall s (m :: * -> *). MonadState s m => m s
get
  let existingExports :: Map ExtName Export
existingExports = Module -> Map ExtName Export
moduleExports Module
m
      newExports :: Map ExtName Export
newExports = [(ExtName, Export)] -> Map ExtName Export
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(ExtName, Export)] -> Map ExtName Export)
-> [(ExtName, Export)] -> Map ExtName Export
forall a b. (a -> b) -> a -> b
$ (Export -> (ExtName, Export)) -> [Export] -> [(ExtName, Export)]
forall a b. (a -> b) -> [a] -> [b]
map (Export -> ExtName
forall a. HasExtNames a => a -> ExtName
getPrimaryExtName (Export -> ExtName)
-> (Export -> Export) -> Export -> (ExtName, Export)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Export -> Export
forall a. a -> a
id) [Export]
exports
      duplicateNames :: Set ExtName
duplicateNames = (Set ExtName -> Set ExtName -> Set ExtName
forall a. Ord a => Set a -> Set a -> Set a
S.intersection (Set ExtName -> Set ExtName -> Set ExtName)
-> (Map ExtName Export -> Set ExtName)
-> Map ExtName Export
-> Map ExtName Export
-> Set ExtName
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Map ExtName Export -> Set ExtName
forall k a. Map k a -> Set k
M.keysSet) Map ExtName Export
existingExports Map ExtName Export
newExports
  if Set ExtName -> Bool
forall a. Set a -> Bool
S.null Set ExtName
duplicateNames
    then Module -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put Module
m { moduleExports = existingExports `mappend` newExports }
    else HsImportName -> m ()
forall a. HsImportName -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (HsImportName -> m ()) -> HsImportName -> m ()
forall a b. (a -> b) -> a -> b
$ [HsImportName] -> HsImportName
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
         [HsImportName
"moduleAddExports: ", Module -> HsImportName
forall a. Show a => a -> HsImportName
show Module
m, HsImportName
" defines external names multiple times: ",
          Set ExtName -> HsImportName
forall a. Show a => a -> HsImportName
show Set ExtName
duplicateNames]

-- | Changes a module's 'moduleHaskellName' from the default.  This can only be
-- called once on a module.
moduleAddHaskellName :: (MonadError String m, MonadState Module m) => [String] -> m ()
moduleAddHaskellName :: forall (m :: * -> *).
(MonadError HsImportName m, MonadState Module m) =>
[HsImportName] -> m ()
moduleAddHaskellName [HsImportName]
name = do
  Module
m <- m Module
forall s (m :: * -> *). MonadState s m => m s
get
  case Module -> Maybe [HsImportName]
moduleHaskellName Module
m of
    Maybe [HsImportName]
Nothing -> Module -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put Module
m { moduleHaskellName = Just name }
    Just [HsImportName]
name' ->
      HsImportName -> m ()
forall a. HsImportName -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (HsImportName -> m ()) -> HsImportName -> m ()
forall a b. (a -> b) -> a -> b
$ [HsImportName] -> HsImportName
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      [HsImportName
"moduleAddHaskellName: ", Module -> HsImportName
forall a. Show a => a -> HsImportName
show Module
m, HsImportName
" already has Haskell name ",
       [HsImportName] -> HsImportName
forall a. Show a => a -> HsImportName
show [HsImportName]
name', HsImportName
"; trying to add name ", [HsImportName] -> HsImportName
forall a. Show a => a -> HsImportName
show [HsImportName]
name, HsImportName
"."]

-- | Changes 'Foreign.Hoppy.Generator.Spec.Callback.callbackThrows' for all
-- callbacks in a module that don't have it set explicitly.
moduleSetCallbacksThrow :: MonadState Module m => Maybe Bool -> m ()
moduleSetCallbacksThrow :: forall (m :: * -> *). MonadState Module m => Maybe Bool -> m ()
moduleSetCallbacksThrow Maybe Bool
b = (Module -> Module) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Module -> Module) -> m ()) -> (Module -> Module) -> m ()
forall a b. (a -> b) -> a -> b
$ \Module
m -> Module
m { moduleCallbacksThrow = b }

-- | A set of requirements of needed to use an identifier in C++ (function,
-- type, etc.), via a set of 'Include's.  The monoid instance has 'mempty' as an
-- empty set of includes, and 'mappend' unions two include sets.
newtype Reqs = Reqs
  { Reqs -> Set Include
reqsIncludes :: S.Set Include
    -- ^ The includes specified by a 'Reqs'.
  } deriving (Int -> Reqs -> ShowS
[Reqs] -> ShowS
Reqs -> HsImportName
(Int -> Reqs -> ShowS)
-> (Reqs -> HsImportName) -> ([Reqs] -> ShowS) -> Show Reqs
forall a.
(Int -> a -> ShowS)
-> (a -> HsImportName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Reqs -> ShowS
showsPrec :: Int -> Reqs -> ShowS
$cshow :: Reqs -> HsImportName
show :: Reqs -> HsImportName
$cshowList :: [Reqs] -> ShowS
showList :: [Reqs] -> ShowS
Show)

instance Sem.Semigroup Reqs where
  <> :: Reqs -> Reqs -> Reqs
(<>) (Reqs Set Include
incl) (Reqs Set Include
incl') = Set Include -> Reqs
Reqs (Set Include -> Reqs) -> Set Include -> Reqs
forall a b. (a -> b) -> a -> b
$ Set Include -> Set Include -> Set Include
forall a. Monoid a => a -> a -> a
mappend Set Include
incl Set Include
incl'

instance Monoid Reqs where
  mempty :: Reqs
mempty = Set Include -> Reqs
Reqs Set Include
forall a. Monoid a => a
mempty

  mappend :: Reqs -> Reqs -> Reqs
mappend = Reqs -> Reqs -> Reqs
forall a. Semigroup a => a -> a -> a
(<>)

  mconcat :: [Reqs] -> Reqs
mconcat [Reqs]
reqs = Set Include -> Reqs
Reqs (Set Include -> Reqs) -> Set Include -> Reqs
forall a b. (a -> b) -> a -> b
$ [Set Include] -> Set Include
forall a. Monoid a => [a] -> a
mconcat ([Set Include] -> Set Include) -> [Set Include] -> Set Include
forall a b. (a -> b) -> a -> b
$ (Reqs -> Set Include) -> [Reqs] -> [Set Include]
forall a b. (a -> b) -> [a] -> [b]
map Reqs -> Set Include
reqsIncludes [Reqs]
reqs

-- | Creates a 'Reqs' that contains the given include.
reqInclude :: Include -> Reqs
reqInclude :: Include -> Reqs
reqInclude Include
include = Reqs
forall a. Monoid a => a
mempty { reqsIncludes = S.singleton include }

-- | Contains the data types for bindings to C++ entities:
-- 'Foreign.Hoppy.Generator.Spec.Function.Function',
-- 'Foreign.Hoppy.Generator.Spec.Class.Class', etc.  Use 'addReqs' or
-- 'addReqIncludes' to specify requirements for these entities, e.g. header
-- files that must be included in order to access the underlying entities that
-- are being bound.

-- | C++ types that have requirements in order to use them in generated
-- bindings.
class HasReqs a where
  {-# MINIMAL getReqs, (setReqs | modifyReqs) #-}

  -- | Returns an object's requirements.
  getReqs :: a -> Reqs

  -- | Replaces an object's requirements with new ones.
  setReqs :: Reqs -> a -> a
  setReqs = (Reqs -> Reqs) -> a -> a
forall a. HasReqs a => (Reqs -> Reqs) -> a -> a
modifyReqs ((Reqs -> Reqs) -> a -> a)
-> (Reqs -> Reqs -> Reqs) -> Reqs -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reqs -> Reqs -> Reqs
forall a b. a -> b -> a
const

  -- | Modifies an object's requirements.
  modifyReqs :: (Reqs -> Reqs) -> a -> a
  modifyReqs Reqs -> Reqs
f a
x = Reqs -> a -> a
forall a. HasReqs a => Reqs -> a -> a
setReqs (Reqs -> Reqs
f (Reqs -> Reqs) -> Reqs -> Reqs
forall a b. (a -> b) -> a -> b
$ a -> Reqs
forall a. HasReqs a => a -> Reqs
getReqs a
x) a
x

-- | Adds to a object's requirements.
addReqs :: HasReqs a => Reqs -> a -> a
addReqs :: forall a. HasReqs a => Reqs -> a -> a
addReqs Reqs
reqs = (Reqs -> Reqs) -> a -> a
forall a. HasReqs a => (Reqs -> Reqs) -> a -> a
modifyReqs ((Reqs -> Reqs) -> a -> a) -> (Reqs -> Reqs) -> a -> a
forall a b. (a -> b) -> a -> b
$ Reqs -> Reqs -> Reqs
forall a. Monoid a => a -> a -> a
mappend Reqs
reqs

-- | Adds a list of includes to the requirements of an object.
addReqIncludes :: HasReqs a => [Include] -> a -> a
addReqIncludes :: forall a. HasReqs a => [Include] -> a -> a
addReqIncludes [Include]
includes =
  (Reqs -> Reqs) -> a -> a
forall a. HasReqs a => (Reqs -> Reqs) -> a -> a
modifyReqs ((Reqs -> Reqs) -> a -> a) -> (Reqs -> Reqs) -> a -> a
forall a b. (a -> b) -> a -> b
$ Reqs -> Reqs -> Reqs
forall a. Monoid a => a -> a -> a
mappend Reqs
forall a. Monoid a => a
mempty { reqsIncludes = S.fromList includes }

-- | An external name is a string that generated bindings use to uniquely
-- identify an object at runtime.  An external name must start with an
-- alphabetic character, and may only contain alphanumeric characters and @'_'@.
-- You are free to use whatever naming style you like; case conversions will be
-- performed automatically when required.  Hoppy does make use of some
-- conventions though, for example with 'Operator's and in the provided bindings
-- for the C++ standard library.
--
-- External names must be unique within an interface.  They may not be reused
-- between modules.  This assumption is used for symbol naming in compiled
-- shared objects and to freely import modules in Haskell bindings.
newtype ExtName = ExtName
  { ExtName -> HsImportName
fromExtName :: String
    -- ^ Returns the string an an 'ExtName' contains.
  } deriving (ExtName -> ExtName -> Bool
(ExtName -> ExtName -> Bool)
-> (ExtName -> ExtName -> Bool) -> Eq ExtName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExtName -> ExtName -> Bool
== :: ExtName -> ExtName -> Bool
$c/= :: ExtName -> ExtName -> Bool
/= :: ExtName -> ExtName -> Bool
Eq, NonEmpty ExtName -> ExtName
ExtName -> ExtName -> ExtName
(ExtName -> ExtName -> ExtName)
-> (NonEmpty ExtName -> ExtName)
-> (forall b. Integral b => b -> ExtName -> ExtName)
-> Semigroup ExtName
forall b. Integral b => b -> ExtName -> ExtName
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: ExtName -> ExtName -> ExtName
<> :: ExtName -> ExtName -> ExtName
$csconcat :: NonEmpty ExtName -> ExtName
sconcat :: NonEmpty ExtName -> ExtName
$cstimes :: forall b. Integral b => b -> ExtName -> ExtName
stimes :: forall b. Integral b => b -> ExtName -> ExtName
Sem.Semigroup, Semigroup ExtName
ExtName
Semigroup ExtName =>
ExtName
-> (ExtName -> ExtName -> ExtName)
-> ([ExtName] -> ExtName)
-> Monoid ExtName
[ExtName] -> ExtName
ExtName -> ExtName -> ExtName
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: ExtName
mempty :: ExtName
$cmappend :: ExtName -> ExtName -> ExtName
mappend :: ExtName -> ExtName -> ExtName
$cmconcat :: [ExtName] -> ExtName
mconcat :: [ExtName] -> ExtName
Monoid, Eq ExtName
Eq ExtName =>
(ExtName -> ExtName -> Ordering)
-> (ExtName -> ExtName -> Bool)
-> (ExtName -> ExtName -> Bool)
-> (ExtName -> ExtName -> Bool)
-> (ExtName -> ExtName -> Bool)
-> (ExtName -> ExtName -> ExtName)
-> (ExtName -> ExtName -> ExtName)
-> Ord ExtName
ExtName -> ExtName -> Bool
ExtName -> ExtName -> Ordering
ExtName -> ExtName -> ExtName
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ExtName -> ExtName -> Ordering
compare :: ExtName -> ExtName -> Ordering
$c< :: ExtName -> ExtName -> Bool
< :: ExtName -> ExtName -> Bool
$c<= :: ExtName -> ExtName -> Bool
<= :: ExtName -> ExtName -> Bool
$c> :: ExtName -> ExtName -> Bool
> :: ExtName -> ExtName -> Bool
$c>= :: ExtName -> ExtName -> Bool
>= :: ExtName -> ExtName -> Bool
$cmax :: ExtName -> ExtName -> ExtName
max :: ExtName -> ExtName -> ExtName
$cmin :: ExtName -> ExtName -> ExtName
min :: ExtName -> ExtName -> ExtName
Ord)

instance Show ExtName where
  show :: ExtName -> HsImportName
show ExtName
extName = [HsImportName] -> HsImportName
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [HsImportName
"$\"", ExtName -> HsImportName
fromExtName ExtName
extName, HsImportName
"\"$"]

-- | Creates an 'ExtName' that contains the given string, erroring if the string
-- is an invalid 'ExtName'.
toExtName :: HasCallStack => String -> ExtName
toExtName :: HasCallStack => HsImportName -> ExtName
toExtName HsImportName
str = case HsImportName
str of
  -- Keep this logic in sync with isValidExtName.
  [] -> HsImportName -> ExtName
forall a. HasCallStack => HsImportName -> a
error HsImportName
"An ExtName cannot be empty."
  HsImportName
_ -> if HsImportName -> Bool
isValidExtName HsImportName
str
       then HsImportName -> ExtName
ExtName HsImportName
str
       else HsImportName -> ExtName
forall a. HasCallStack => HsImportName -> a
error (HsImportName -> ExtName) -> HsImportName -> ExtName
forall a b. (a -> b) -> a -> b
$
            HsImportName
"An ExtName must start with a letter and only contain letters, numbers, and '_': " HsImportName -> ShowS
forall a. [a] -> [a] -> [a]
++
            ShowS
forall a. Show a => a -> HsImportName
show HsImportName
str

-- | Returns true if the given string is represents a valid 'ExtName'.
isValidExtName :: String -> Bool
isValidExtName :: HsImportName -> Bool
isValidExtName HsImportName
str = case HsImportName
str of
  -- Keep this logic in sync with toExtName.
  [] -> Bool
False
  Char
c:HsImportName
cs -> Char -> Bool
isAlpha Char
c Bool -> Bool -> Bool
&& (Char -> Bool) -> HsImportName -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool -> Bool -> Bool
(||) (Bool -> Bool -> Bool) -> (Char -> Bool) -> Char -> Bool -> Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> Bool
isAlphaNum (Char -> Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall a b. (Char -> a -> b) -> (Char -> a) -> Char -> b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_')) HsImportName
cs

-- | Generates an 'ExtName' from an 'Identifier', if the given name is absent.
extNameOrIdentifier :: HasCallStack => Identifier -> Maybe ExtName -> ExtName
extNameOrIdentifier :: HasCallStack => Identifier -> Maybe ExtName -> ExtName
extNameOrIdentifier Identifier
identifier = ExtName -> Maybe ExtName -> ExtName
forall a. a -> Maybe a -> a
fromMaybe (ExtName -> Maybe ExtName -> ExtName)
-> ExtName -> Maybe ExtName -> ExtName
forall a b. (a -> b) -> a -> b
$ case Identifier -> [IdPart]
identifierParts Identifier
identifier of
  [] -> HsImportName -> ExtName
forall a. HasCallStack => HsImportName -> a
error HsImportName
"extNameOrIdentifier: Invalid empty identifier."
  [IdPart]
parts -> HasCallStack => HsImportName -> ExtName
HsImportName -> ExtName
toExtName (HsImportName -> ExtName) -> HsImportName -> ExtName
forall a b. (a -> b) -> a -> b
$ IdPart -> HsImportName
idPartBase (IdPart -> HsImportName) -> IdPart -> HsImportName
forall a b. (a -> b) -> a -> b
$ [IdPart] -> IdPart
forall a. HasCallStack => [a] -> a
last [IdPart]
parts

-- | Generates an 'ExtName' from an @'FnName' 'Identifier'@, if the given name
-- is absent.
extNameOrFnIdentifier :: HasCallStack => FnName Identifier -> Maybe ExtName -> ExtName
extNameOrFnIdentifier :: HasCallStack => FnName Identifier -> Maybe ExtName -> ExtName
extNameOrFnIdentifier FnName Identifier
name =
  ExtName -> Maybe ExtName -> ExtName
forall a. a -> Maybe a -> a
fromMaybe (ExtName -> Maybe ExtName -> ExtName)
-> ExtName -> Maybe ExtName -> ExtName
forall a b. (a -> b) -> a -> b
$ case FnName Identifier
name of
    FnName Identifier
identifier -> case Identifier -> [IdPart]
identifierParts Identifier
identifier of
      [] -> HsImportName -> ExtName
forall a. HasCallStack => HsImportName -> a
error HsImportName
"extNameOrFnIdentifier: Empty idenfitier."
      [IdPart]
parts -> HasCallStack => HsImportName -> ExtName
HsImportName -> ExtName
toExtName (HsImportName -> ExtName) -> HsImportName -> ExtName
forall a b. (a -> b) -> a -> b
$ IdPart -> HsImportName
idPartBase (IdPart -> HsImportName) -> IdPart -> HsImportName
forall a b. (a -> b) -> a -> b
$ [IdPart] -> IdPart
forall a. HasCallStack => [a] -> a
last [IdPart]
parts
    FnOp Operator
op -> HasCallStack => Operator -> ExtName
Operator -> ExtName
operatorPreferredExtName Operator
op

-- | Generates an 'ExtName' from a string, if the given name is absent.
extNameOrString :: String -> Maybe ExtName -> ExtName
extNameOrString :: HsImportName -> Maybe ExtName -> ExtName
extNameOrString HsImportName
str = ExtName -> Maybe ExtName -> ExtName
forall a. a -> Maybe a -> a
fromMaybe (ExtName -> Maybe ExtName -> ExtName)
-> ExtName -> Maybe ExtName -> ExtName
forall a b. (a -> b) -> a -> b
$ HasCallStack => HsImportName -> ExtName
HsImportName -> ExtName
toExtName HsImportName
str

-- | Types that have an external name, and also optionally have nested entities
-- with external names as well.  See 'getAllExtNames'.
class HasExtNames a where
  -- | Returns the external name by which a given entity is referenced.
  getPrimaryExtName :: a -> ExtName

  -- | Returns external names nested within the given entity.  Does not include
  -- the primary external name.
  getNestedExtNames :: a -> [ExtName]
  getNestedExtNames a
_ = []

-- | Returns a list of all of the external names an entity contains.  This
-- combines both 'getPrimaryExtName' and 'getNestedExtNames'.
getAllExtNames :: HasExtNames a => a -> [ExtName]
getAllExtNames :: forall a. HasExtNames a => a -> [ExtName]
getAllExtNames a
x = a -> ExtName
forall a. HasExtNames a => a -> ExtName
getPrimaryExtName a
x ExtName -> [ExtName] -> [ExtName]
forall a. a -> [a] -> [a]
: a -> [ExtName]
forall a. HasExtNames a => a -> [ExtName]
getNestedExtNames a
x

-- | The C++ name of a function or method.
data FnName name =
  FnName name
  -- ^ A regular, \"alphanumeric\" name.  The exact type depends on what kind of
  -- object is being named.
  | FnOp Operator
    -- ^ An operator name.
  deriving (FnName name -> FnName name -> Bool
(FnName name -> FnName name -> Bool)
-> (FnName name -> FnName name -> Bool) -> Eq (FnName name)
forall name. Eq name => FnName name -> FnName name -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall name. Eq name => FnName name -> FnName name -> Bool
== :: FnName name -> FnName name -> Bool
$c/= :: forall name. Eq name => FnName name -> FnName name -> Bool
/= :: FnName name -> FnName name -> Bool
Eq, Eq (FnName name)
Eq (FnName name) =>
(FnName name -> FnName name -> Ordering)
-> (FnName name -> FnName name -> Bool)
-> (FnName name -> FnName name -> Bool)
-> (FnName name -> FnName name -> Bool)
-> (FnName name -> FnName name -> Bool)
-> (FnName name -> FnName name -> FnName name)
-> (FnName name -> FnName name -> FnName name)
-> Ord (FnName name)
FnName name -> FnName name -> Bool
FnName name -> FnName name -> Ordering
FnName name -> FnName name -> FnName name
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall name. Ord name => Eq (FnName name)
forall name. Ord name => FnName name -> FnName name -> Bool
forall name. Ord name => FnName name -> FnName name -> Ordering
forall name. Ord name => FnName name -> FnName name -> FnName name
$ccompare :: forall name. Ord name => FnName name -> FnName name -> Ordering
compare :: FnName name -> FnName name -> Ordering
$c< :: forall name. Ord name => FnName name -> FnName name -> Bool
< :: FnName name -> FnName name -> Bool
$c<= :: forall name. Ord name => FnName name -> FnName name -> Bool
<= :: FnName name -> FnName name -> Bool
$c> :: forall name. Ord name => FnName name -> FnName name -> Bool
> :: FnName name -> FnName name -> Bool
$c>= :: forall name. Ord name => FnName name -> FnName name -> Bool
>= :: FnName name -> FnName name -> Bool
$cmax :: forall name. Ord name => FnName name -> FnName name -> FnName name
max :: FnName name -> FnName name -> FnName name
$cmin :: forall name. Ord name => FnName name -> FnName name -> FnName name
min :: FnName name -> FnName name -> FnName name
Ord)

instance Show name => Show (FnName name) where
  show :: FnName name -> HsImportName
show (FnName name
name) = [HsImportName] -> HsImportName
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [HsImportName
"<FnName ", name -> HsImportName
forall a. Show a => a -> HsImportName
show name
name, HsImportName
">"]
  show (FnOp Operator
op) = [HsImportName] -> HsImportName
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [HsImportName
"<FnOp ", Operator -> HsImportName
forall a. Show a => a -> HsImportName
show Operator
op, HsImportName
">"]

-- | Enables implementing automatic conversions to a @'FnName' t@.
class IsFnName t a where
  toFnName :: a -> FnName t

instance IsFnName t (FnName t) where
  toFnName :: FnName t -> FnName t
toFnName = FnName t -> FnName t
forall a. a -> a
id

instance IsFnName t t where
  toFnName :: t -> FnName t
toFnName = t -> FnName t
forall t. t -> FnName t
FnName

instance IsFnName t Operator where
  toFnName :: Operator -> FnName t
toFnName = Operator -> FnName t
forall t. Operator -> FnName t
FnOp

-- | Overloadable C++ operators.
data Operator =
  OpCall  -- ^ @x(...)@
  | OpComma -- ^ @x, y@
  | OpAssign  -- ^ @x = y@
  | OpArray  -- ^ @x[y]@
  | OpDeref  -- ^ @*x@
  | OpAddress  -- ^ @&x@
  | OpAdd  -- ^ @x + y@
  | OpAddAssign  -- ^ @x += y@
  | OpSubtract  -- ^ @x - y@
  | OpSubtractAssign  -- ^ @x -= y@
  | OpMultiply  -- ^ @x * y@
  | OpMultiplyAssign  -- ^ @x *= y@
  | OpDivide  -- ^ @x / y@
  | OpDivideAssign  -- ^ @x /= y@
  | OpModulo  -- ^ @x % y@
  | OpModuloAssign  -- ^ @x %= y@
  | OpPlus  -- ^ @+x@
  | OpMinus  -- ^ @-x@
  | OpIncPre  -- ^ @++x@
  | OpIncPost  -- ^ @x++@
  | OpDecPre  -- ^ @--x@
  | OpDecPost  -- ^ @x--@
  | OpEq  -- ^ @x == y@
  | OpNe  -- ^ @x != y@
  | OpLt  -- ^ @x < y@
  | OpLe  -- ^ @x <= y@
  | OpGt  -- ^ @x > y@
  | OpGe  -- ^ @x >= y@
  | OpNot  -- ^ @!x@
  | OpAnd  -- ^ @x && y@
  | OpOr  -- ^ @x || y@
  | OpBitNot  -- ^ @~x@
  | OpBitAnd  -- ^ @x & y@
  | OpBitAndAssign  -- ^ @x &= y@
  | OpBitOr  -- ^ @x | y@
  | OpBitOrAssign  -- ^ @x |= y@
  | OpBitXor  -- ^ @x ^ y@
  | OpBitXorAssign  -- ^ @x ^= y@
  | OpShl  -- ^ @x << y@
  | OpShlAssign  -- ^ @x <<= y@
  | OpShr  -- ^ @x >> y@
  | OpShrAssign  -- ^ @x >>= y@
  deriving (Operator
Operator -> Operator -> Bounded Operator
forall a. a -> a -> Bounded a
$cminBound :: Operator
minBound :: Operator
$cmaxBound :: Operator
maxBound :: Operator
Bounded, Int -> Operator
Operator -> Int
Operator -> [Operator]
Operator -> Operator
Operator -> Operator -> [Operator]
Operator -> Operator -> Operator -> [Operator]
(Operator -> Operator)
-> (Operator -> Operator)
-> (Int -> Operator)
-> (Operator -> Int)
-> (Operator -> [Operator])
-> (Operator -> Operator -> [Operator])
-> (Operator -> Operator -> [Operator])
-> (Operator -> Operator -> Operator -> [Operator])
-> Enum Operator
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Operator -> Operator
succ :: Operator -> Operator
$cpred :: Operator -> Operator
pred :: Operator -> Operator
$ctoEnum :: Int -> Operator
toEnum :: Int -> Operator
$cfromEnum :: Operator -> Int
fromEnum :: Operator -> Int
$cenumFrom :: Operator -> [Operator]
enumFrom :: Operator -> [Operator]
$cenumFromThen :: Operator -> Operator -> [Operator]
enumFromThen :: Operator -> Operator -> [Operator]
$cenumFromTo :: Operator -> Operator -> [Operator]
enumFromTo :: Operator -> Operator -> [Operator]
$cenumFromThenTo :: Operator -> Operator -> Operator -> [Operator]
enumFromThenTo :: Operator -> Operator -> Operator -> [Operator]
Enum, Operator -> Operator -> Bool
(Operator -> Operator -> Bool)
-> (Operator -> Operator -> Bool) -> Eq Operator
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Operator -> Operator -> Bool
== :: Operator -> Operator -> Bool
$c/= :: Operator -> Operator -> Bool
/= :: Operator -> Operator -> Bool
Eq, Eq Operator
Eq Operator =>
(Operator -> Operator -> Ordering)
-> (Operator -> Operator -> Bool)
-> (Operator -> Operator -> Bool)
-> (Operator -> Operator -> Bool)
-> (Operator -> Operator -> Bool)
-> (Operator -> Operator -> Operator)
-> (Operator -> Operator -> Operator)
-> Ord Operator
Operator -> Operator -> Bool
Operator -> Operator -> Ordering
Operator -> Operator -> Operator
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Operator -> Operator -> Ordering
compare :: Operator -> Operator -> Ordering
$c< :: Operator -> Operator -> Bool
< :: Operator -> Operator -> Bool
$c<= :: Operator -> Operator -> Bool
<= :: Operator -> Operator -> Bool
$c> :: Operator -> Operator -> Bool
> :: Operator -> Operator -> Bool
$c>= :: Operator -> Operator -> Bool
>= :: Operator -> Operator -> Bool
$cmax :: Operator -> Operator -> Operator
max :: Operator -> Operator -> Operator
$cmin :: Operator -> Operator -> Operator
min :: Operator -> Operator -> Operator
Ord, Int -> Operator -> ShowS
[Operator] -> ShowS
Operator -> HsImportName
(Int -> Operator -> ShowS)
-> (Operator -> HsImportName)
-> ([Operator] -> ShowS)
-> Show Operator
forall a.
(Int -> a -> ShowS)
-> (a -> HsImportName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Operator -> ShowS
showsPrec :: Int -> Operator -> ShowS
$cshow :: Operator -> HsImportName
show :: Operator -> HsImportName
$cshowList :: [Operator] -> ShowS
showList :: [Operator] -> ShowS
Show)

-- | The arity and syntax of an operator.
data OperatorType =
  UnaryPrefixOperator String  -- ^ Prefix unary operators.  Examples: @!x@, @*x@, @++x@.
  | UnaryPostfixOperator String  -- ^ Postfix unary operators.  Examples: @x--, x++@.
  | BinaryOperator String  -- ^ Infix binary operators.  Examples: @x * y@, @x >>= y@.
  | CallOperator  -- ^ @x(...)@ with arbitrary arity.
  | ArrayOperator  -- ^ @x[y]@, a binary operator with non-infix syntax.

data OperatorInfo = OperatorInfo
  { OperatorInfo -> ExtName
operatorPreferredExtName'' :: ExtName
  , OperatorInfo -> OperatorType
operatorType' :: OperatorType
  }

makeOperatorInfo :: String -> OperatorType -> OperatorInfo
makeOperatorInfo :: HsImportName -> OperatorType -> OperatorInfo
makeOperatorInfo = ExtName -> OperatorType -> OperatorInfo
OperatorInfo (ExtName -> OperatorType -> OperatorInfo)
-> (HsImportName -> ExtName)
-> HsImportName
-> OperatorType
-> OperatorInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => HsImportName -> ExtName
HsImportName -> ExtName
toExtName

-- | Returns a conventional string to use for the 'ExtName' of an operator.
operatorPreferredExtName :: HasCallStack => Operator -> ExtName
operatorPreferredExtName :: HasCallStack => Operator -> ExtName
operatorPreferredExtName Operator
op = case Operator -> Map Operator OperatorInfo -> Maybe OperatorInfo
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Operator
op Map Operator OperatorInfo
operatorInfo of
  Just OperatorInfo
info -> OperatorInfo -> ExtName
operatorPreferredExtName'' OperatorInfo
info
  Maybe OperatorInfo
Nothing ->
    HsImportName -> ExtName
forall a. HasCallStack => HsImportName -> a
error (HsImportName -> ExtName) -> HsImportName -> ExtName
forall a b. (a -> b) -> a -> b
$ [HsImportName] -> HsImportName
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [HsImportName
"operatorPreferredExtName: Internal error, missing info for operator ", Operator -> HsImportName
forall a. Show a => a -> HsImportName
show Operator
op, HsImportName
"."]

-- | Returns a conventional name for an operator, as with
-- 'operatorPreferredExtName', but as a string.
operatorPreferredExtName' :: Operator -> String
operatorPreferredExtName' :: Operator -> HsImportName
operatorPreferredExtName' = ExtName -> HsImportName
fromExtName (ExtName -> HsImportName)
-> (Operator -> ExtName) -> Operator -> HsImportName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Operator -> ExtName
Operator -> ExtName
operatorPreferredExtName

-- | Returns the type of an operator.
operatorType :: HasCallStack => Operator -> OperatorType
operatorType :: HasCallStack => Operator -> OperatorType
operatorType Operator
op = case Operator -> Map Operator OperatorInfo -> Maybe OperatorInfo
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Operator
op Map Operator OperatorInfo
operatorInfo of
  Just OperatorInfo
info -> OperatorInfo -> OperatorType
operatorType' OperatorInfo
info
  Maybe OperatorInfo
Nothing ->
    HsImportName -> OperatorType
forall a. HasCallStack => HsImportName -> a
error (HsImportName -> OperatorType) -> HsImportName -> OperatorType
forall a b. (a -> b) -> a -> b
$ [HsImportName] -> HsImportName
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [HsImportName
"operatorType: Internal error, missing info for operator ", Operator -> HsImportName
forall a. Show a => a -> HsImportName
show Operator
op, HsImportName
"."]

-- | Metadata for operators.
--
-- TODO Test out this missing data.
operatorInfo :: M.Map Operator OperatorInfo
operatorInfo :: Map Operator OperatorInfo
operatorInfo =
  let input :: [(Operator, OperatorInfo)]
input =
        [ (Operator
OpCall, HsImportName -> OperatorType -> OperatorInfo
makeOperatorInfo HsImportName
"CALL" OperatorType
CallOperator)
        , (Operator
OpComma, HsImportName -> OperatorType -> OperatorInfo
makeOperatorInfo HsImportName
"COMMA" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ HsImportName -> OperatorType
BinaryOperator HsImportName
",")
        , (Operator
OpAssign, HsImportName -> OperatorType -> OperatorInfo
makeOperatorInfo HsImportName
"ASSIGN" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ HsImportName -> OperatorType
BinaryOperator HsImportName
"=")
        , (Operator
OpArray, HsImportName -> OperatorType -> OperatorInfo
makeOperatorInfo HsImportName
"ARRAY" OperatorType
ArrayOperator)
        , (Operator
OpDeref, HsImportName -> OperatorType -> OperatorInfo
makeOperatorInfo HsImportName
"DEREF" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ HsImportName -> OperatorType
UnaryPrefixOperator HsImportName
"*")
        , (Operator
OpAddress, HsImportName -> OperatorType -> OperatorInfo
makeOperatorInfo HsImportName
"ADDRESS" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ HsImportName -> OperatorType
UnaryPrefixOperator HsImportName
"&")
        , (Operator
OpAdd, HsImportName -> OperatorType -> OperatorInfo
makeOperatorInfo HsImportName
"ADD" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ HsImportName -> OperatorType
BinaryOperator HsImportName
"+")
        , (Operator
OpAddAssign, HsImportName -> OperatorType -> OperatorInfo
makeOperatorInfo HsImportName
"ADDA" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ HsImportName -> OperatorType
BinaryOperator HsImportName
"+=")
        , (Operator
OpSubtract, HsImportName -> OperatorType -> OperatorInfo
makeOperatorInfo HsImportName
"SUB" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ HsImportName -> OperatorType
BinaryOperator HsImportName
"-")
        , (Operator
OpSubtractAssign, HsImportName -> OperatorType -> OperatorInfo
makeOperatorInfo HsImportName
"SUBA" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ HsImportName -> OperatorType
BinaryOperator HsImportName
"-=")
        , (Operator
OpMultiply, HsImportName -> OperatorType -> OperatorInfo
makeOperatorInfo HsImportName
"MUL" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ HsImportName -> OperatorType
BinaryOperator HsImportName
"*")
        , (Operator
OpMultiplyAssign, HsImportName -> OperatorType -> OperatorInfo
makeOperatorInfo HsImportName
"MULA" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ HsImportName -> OperatorType
BinaryOperator HsImportName
"*=")
        , (Operator
OpDivide, HsImportName -> OperatorType -> OperatorInfo
makeOperatorInfo HsImportName
"DIV" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ HsImportName -> OperatorType
BinaryOperator HsImportName
"/")
        , (Operator
OpDivideAssign, HsImportName -> OperatorType -> OperatorInfo
makeOperatorInfo HsImportName
"DIVA" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ HsImportName -> OperatorType
BinaryOperator HsImportName
"/=")
        , (Operator
OpModulo, HsImportName -> OperatorType -> OperatorInfo
makeOperatorInfo HsImportName
"MOD" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ HsImportName -> OperatorType
BinaryOperator HsImportName
"%")
        , (Operator
OpModuloAssign, HsImportName -> OperatorType -> OperatorInfo
makeOperatorInfo HsImportName
"MODA" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ HsImportName -> OperatorType
BinaryOperator HsImportName
"%=")
        , (Operator
OpPlus, HsImportName -> OperatorType -> OperatorInfo
makeOperatorInfo HsImportName
"PLUS" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ HsImportName -> OperatorType
UnaryPrefixOperator HsImportName
"+")
        , (Operator
OpMinus, HsImportName -> OperatorType -> OperatorInfo
makeOperatorInfo HsImportName
"NEG" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ HsImportName -> OperatorType
UnaryPrefixOperator HsImportName
"-")
        , (Operator
OpIncPre, HsImportName -> OperatorType -> OperatorInfo
makeOperatorInfo HsImportName
"INC" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ HsImportName -> OperatorType
UnaryPrefixOperator HsImportName
"++")
        , (Operator
OpIncPost, HsImportName -> OperatorType -> OperatorInfo
makeOperatorInfo HsImportName
"INCPOST" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ HsImportName -> OperatorType
UnaryPostfixOperator HsImportName
"++")
        , (Operator
OpDecPre, HsImportName -> OperatorType -> OperatorInfo
makeOperatorInfo HsImportName
"DEC" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ HsImportName -> OperatorType
UnaryPrefixOperator HsImportName
"--")
        , (Operator
OpDecPost, HsImportName -> OperatorType -> OperatorInfo
makeOperatorInfo HsImportName
"DECPOST" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ HsImportName -> OperatorType
UnaryPostfixOperator HsImportName
"--")
        , (Operator
OpEq, HsImportName -> OperatorType -> OperatorInfo
makeOperatorInfo HsImportName
"EQ" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ HsImportName -> OperatorType
BinaryOperator HsImportName
"==")
        , (Operator
OpNe, HsImportName -> OperatorType -> OperatorInfo
makeOperatorInfo HsImportName
"NE" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ HsImportName -> OperatorType
BinaryOperator HsImportName
"!=")
        , (Operator
OpLt, HsImportName -> OperatorType -> OperatorInfo
makeOperatorInfo HsImportName
"LT" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ HsImportName -> OperatorType
BinaryOperator HsImportName
"<")
        , (Operator
OpLe, HsImportName -> OperatorType -> OperatorInfo
makeOperatorInfo HsImportName
"LE" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ HsImportName -> OperatorType
BinaryOperator HsImportName
"<=")
        , (Operator
OpGt, HsImportName -> OperatorType -> OperatorInfo
makeOperatorInfo HsImportName
"GT" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ HsImportName -> OperatorType
BinaryOperator HsImportName
">")
        , (Operator
OpGe, HsImportName -> OperatorType -> OperatorInfo
makeOperatorInfo HsImportName
"GE" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ HsImportName -> OperatorType
BinaryOperator HsImportName
">=")
        , (Operator
OpNot, HsImportName -> OperatorType -> OperatorInfo
makeOperatorInfo HsImportName
"NOT" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ HsImportName -> OperatorType
UnaryPrefixOperator HsImportName
"!")
        , (Operator
OpAnd, HsImportName -> OperatorType -> OperatorInfo
makeOperatorInfo HsImportName
"AND" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ HsImportName -> OperatorType
BinaryOperator HsImportName
"&&")
        , (Operator
OpOr, HsImportName -> OperatorType -> OperatorInfo
makeOperatorInfo HsImportName
"OR" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ HsImportName -> OperatorType
BinaryOperator HsImportName
"||")
        , (Operator
OpBitNot, HsImportName -> OperatorType -> OperatorInfo
makeOperatorInfo HsImportName
"BNOT" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ HsImportName -> OperatorType
UnaryPrefixOperator HsImportName
"~")
        , (Operator
OpBitAnd, HsImportName -> OperatorType -> OperatorInfo
makeOperatorInfo HsImportName
"BAND" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ HsImportName -> OperatorType
BinaryOperator HsImportName
"&")
        , (Operator
OpBitAndAssign, HsImportName -> OperatorType -> OperatorInfo
makeOperatorInfo HsImportName
"BANDA" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ HsImportName -> OperatorType
BinaryOperator HsImportName
"&=")
        , (Operator
OpBitOr, HsImportName -> OperatorType -> OperatorInfo
makeOperatorInfo HsImportName
"BOR" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ HsImportName -> OperatorType
BinaryOperator HsImportName
"|")
        , (Operator
OpBitOrAssign, HsImportName -> OperatorType -> OperatorInfo
makeOperatorInfo HsImportName
"BORA" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ HsImportName -> OperatorType
BinaryOperator HsImportName
"|=")
        , (Operator
OpBitXor, HsImportName -> OperatorType -> OperatorInfo
makeOperatorInfo HsImportName
"BXOR" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ HsImportName -> OperatorType
BinaryOperator HsImportName
"^")
        , (Operator
OpBitXorAssign, HsImportName -> OperatorType -> OperatorInfo
makeOperatorInfo HsImportName
"BXORA" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ HsImportName -> OperatorType
BinaryOperator HsImportName
"^=")
        , (Operator
OpShl, HsImportName -> OperatorType -> OperatorInfo
makeOperatorInfo HsImportName
"SHL" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ HsImportName -> OperatorType
BinaryOperator HsImportName
"<<")
        , (Operator
OpShlAssign, HsImportName -> OperatorType -> OperatorInfo
makeOperatorInfo HsImportName
"SHLA" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ HsImportName -> OperatorType
BinaryOperator HsImportName
"<<=")
        , (Operator
OpShr, HsImportName -> OperatorType -> OperatorInfo
makeOperatorInfo HsImportName
"SHR" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ HsImportName -> OperatorType
BinaryOperator HsImportName
">>")
        , (Operator
OpShrAssign, HsImportName -> OperatorType -> OperatorInfo
makeOperatorInfo HsImportName
"SHR" (OperatorType -> OperatorInfo) -> OperatorType -> OperatorInfo
forall a b. (a -> b) -> a -> b
$ HsImportName -> OperatorType
BinaryOperator HsImportName
">>=")
        ]
  in if ((Operator, OperatorInfo) -> Operator)
-> [(Operator, OperatorInfo)] -> [Operator]
forall a b. (a -> b) -> [a] -> [b]
map (Operator, OperatorInfo) -> Operator
forall a b. (a, b) -> a
fst [(Operator, OperatorInfo)]
input [Operator] -> [Operator] -> Bool
forall a. Eq a => a -> a -> Bool
== [Operator
forall a. Bounded a => a
minBound..]
     then [(Operator, OperatorInfo)] -> Map Operator OperatorInfo
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Operator, OperatorInfo)]
input
     else HsImportName -> Map Operator OperatorInfo
forall a. HasCallStack => HsImportName -> a
error HsImportName
"operatorInfo: Operator info list is out of sync with Operator data type."

-- | Types that contain 'Export's that can be looked up by their 'ExtName's.
class HasExports a where
  -- | Looks up the 'Export' for an 'ExtName' in the given object.
  lookupExport :: ExtName -> a -> Maybe Export

-- | A path to some C++ object, including namespaces.  An identifier consists of
-- multiple parts separated by @\"::\"@.  Each part has a name string followed
-- by an optional template argument list, where each argument gets rendered from
-- a 'Type' (non-type arguments for template metaprogramming are not supported).
--
-- The 'Monoid' instance inserts a @::@ between joined identifiers.  Usually an
-- identifier needs to contain at least one part, so 'mempty' is an invalid
-- argument to many functions in Hoppy, but it is useful as a base case for
-- appending.
newtype Identifier = Identifier
  { Identifier -> [IdPart]
identifierParts :: [IdPart]
    -- ^ The separate parts of the identifier, between @::@s.
  } deriving (Identifier -> Identifier -> Bool
(Identifier -> Identifier -> Bool)
-> (Identifier -> Identifier -> Bool) -> Eq Identifier
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Identifier -> Identifier -> Bool
== :: Identifier -> Identifier -> Bool
$c/= :: Identifier -> Identifier -> Bool
/= :: Identifier -> Identifier -> Bool
Eq, Semigroup Identifier
Identifier
Semigroup Identifier =>
Identifier
-> (Identifier -> Identifier -> Identifier)
-> ([Identifier] -> Identifier)
-> Monoid Identifier
[Identifier] -> Identifier
Identifier -> Identifier -> Identifier
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: Identifier
mempty :: Identifier
$cmappend :: Identifier -> Identifier -> Identifier
mappend :: Identifier -> Identifier -> Identifier
$cmconcat :: [Identifier] -> Identifier
mconcat :: [Identifier] -> Identifier
Monoid, NonEmpty Identifier -> Identifier
Identifier -> Identifier -> Identifier
(Identifier -> Identifier -> Identifier)
-> (NonEmpty Identifier -> Identifier)
-> (forall b. Integral b => b -> Identifier -> Identifier)
-> Semigroup Identifier
forall b. Integral b => b -> Identifier -> Identifier
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: Identifier -> Identifier -> Identifier
<> :: Identifier -> Identifier -> Identifier
$csconcat :: NonEmpty Identifier -> Identifier
sconcat :: NonEmpty Identifier -> Identifier
$cstimes :: forall b. Integral b => b -> Identifier -> Identifier
stimes :: forall b. Integral b => b -> Identifier -> Identifier
Sem.Semigroup)

instance Show Identifier where
  show :: Identifier -> HsImportName
show Identifier
identifier =
    (\[HsImportName]
wordList -> [HsImportName] -> HsImportName
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([HsImportName] -> HsImportName) -> [HsImportName] -> HsImportName
forall a b. (a -> b) -> a -> b
$ HsImportName
"<Identifier " HsImportName -> [HsImportName] -> [HsImportName]
forall a. a -> [a] -> [a]
: [HsImportName]
wordList [HsImportName] -> [HsImportName] -> [HsImportName]
forall a. [a] -> [a] -> [a]
++ [HsImportName
">"]) ([HsImportName] -> HsImportName) -> [HsImportName] -> HsImportName
forall a b. (a -> b) -> a -> b
$
    HsImportName -> [HsImportName] -> [HsImportName]
forall a. a -> [a] -> [a]
intersperse HsImportName
"::" ([HsImportName] -> [HsImportName])
-> [HsImportName] -> [HsImportName]
forall a b. (a -> b) -> a -> b
$
    (IdPart -> HsImportName) -> [IdPart] -> [HsImportName]
forall a b. (a -> b) -> [a] -> [b]
map (\IdPart
part -> case IdPart -> Maybe [Type]
idPartArgs IdPart
part of
            Maybe [Type]
Nothing -> IdPart -> HsImportName
idPartBase IdPart
part
            Just [Type]
args ->
              [HsImportName] -> HsImportName
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([HsImportName] -> HsImportName) -> [HsImportName] -> HsImportName
forall a b. (a -> b) -> a -> b
$
              IdPart -> HsImportName
idPartBase IdPart
part HsImportName -> [HsImportName] -> [HsImportName]
forall a. a -> [a] -> [a]
: HsImportName
"<" HsImportName -> [HsImportName] -> [HsImportName]
forall a. a -> [a] -> [a]
:
              HsImportName -> [HsImportName] -> [HsImportName]
forall a. a -> [a] -> [a]
intersperse HsImportName
", " ((Type -> HsImportName) -> [Type] -> [HsImportName]
forall a b. (a -> b) -> [a] -> [b]
map Type -> HsImportName
forall a. Show a => a -> HsImportName
show [Type]
args) [HsImportName] -> [HsImportName] -> [HsImportName]
forall a. [a] -> [a] -> [a]
++ [HsImportName
">"]) ([IdPart] -> [HsImportName]) -> [IdPart] -> [HsImportName]
forall a b. (a -> b) -> a -> b
$
    Identifier -> [IdPart]
identifierParts Identifier
identifier

-- | A single component of an 'Identifier', between @::@s.
data IdPart = IdPart
  { IdPart -> HsImportName
idPartBase :: String
    -- ^ The name within the enclosing scope.
  , IdPart -> Maybe [Type]
idPartArgs :: Maybe [Type]
    -- ^ Template arguments, if present.
  } deriving (IdPart -> IdPart -> Bool
(IdPart -> IdPart -> Bool)
-> (IdPart -> IdPart -> Bool) -> Eq IdPart
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IdPart -> IdPart -> Bool
== :: IdPart -> IdPart -> Bool
$c/= :: IdPart -> IdPart -> Bool
/= :: IdPart -> IdPart -> Bool
Eq, Int -> IdPart -> ShowS
[IdPart] -> ShowS
IdPart -> HsImportName
(Int -> IdPart -> ShowS)
-> (IdPart -> HsImportName) -> ([IdPart] -> ShowS) -> Show IdPart
forall a.
(Int -> a -> ShowS)
-> (a -> HsImportName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IdPart -> ShowS
showsPrec :: Int -> IdPart -> ShowS
$cshow :: IdPart -> HsImportName
show :: IdPart -> HsImportName
$cshowList :: [IdPart] -> ShowS
showList :: [IdPart] -> ShowS
Show)

-- | Creates an identifier from a collection of 'IdPart's, with @::@s between.
makeIdentifier :: [IdPart] -> Identifier
makeIdentifier :: [IdPart] -> Identifier
makeIdentifier = [IdPart] -> Identifier
Identifier

-- | Creates an object representing one component of an identifier.
makeIdPart :: String -> Maybe [Type] -> IdPart
makeIdPart :: HsImportName -> Maybe [Type] -> IdPart
makeIdPart = HsImportName -> Maybe [Type] -> IdPart
IdPart

-- | Creates a identifier of the form @a@, without any namespace operators
-- (@::@).
ident :: String -> Identifier
ident :: HsImportName -> Identifier
ident HsImportName
a = [IdPart] -> Identifier
Identifier [HsImportName -> Maybe [Type] -> IdPart
IdPart HsImportName
a Maybe [Type]
forall a. Maybe a
Nothing]

-- | Creates an identifier of the form @a1::a2::...::aN@.
ident' :: [String] -> Identifier
ident' :: [HsImportName] -> Identifier
ident' = [IdPart] -> Identifier
Identifier ([IdPart] -> Identifier)
-> ([HsImportName] -> [IdPart]) -> [HsImportName] -> Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsImportName -> IdPart) -> [HsImportName] -> [IdPart]
forall a b. (a -> b) -> [a] -> [b]
map (\HsImportName
x -> IdPart { idPartBase :: HsImportName
idPartBase = HsImportName
x, idPartArgs :: Maybe [Type]
idPartArgs = Maybe [Type]
forall a. Maybe a
Nothing })

-- | Creates an identifier of the form @a::b@.
ident1 :: String -> String -> Identifier
ident1 :: HsImportName -> HsImportName -> Identifier
ident1 HsImportName
a HsImportName
b = [HsImportName] -> Identifier
ident' [HsImportName
a, HsImportName
b]

-- | Creates an identifier of the form @a::b::c@.
ident2 :: String -> String -> String -> Identifier
ident2 :: HsImportName -> HsImportName -> HsImportName -> Identifier
ident2 HsImportName
a HsImportName
b HsImportName
c = [HsImportName] -> Identifier
ident' [HsImportName
a, HsImportName
b, HsImportName
c]

-- | Creates an identifier of the form @a::b::c::d@.
ident3 :: String -> String -> String -> String -> Identifier
ident3 :: HsImportName
-> HsImportName -> HsImportName -> HsImportName -> Identifier
ident3 HsImportName
a HsImportName
b HsImportName
c HsImportName
d = [HsImportName] -> Identifier
ident' [HsImportName
a, HsImportName
b, HsImportName
c, HsImportName
d]

-- | Creates an identifier of the form @a::b::c::d::e@.
ident4 :: String -> String -> String -> String -> String -> Identifier
ident4 :: HsImportName
-> HsImportName
-> HsImportName
-> HsImportName
-> HsImportName
-> Identifier
ident4 HsImportName
a HsImportName
b HsImportName
c HsImportName
d HsImportName
e = [HsImportName] -> Identifier
ident' [HsImportName
a, HsImportName
b, HsImportName
c, HsImportName
d, HsImportName
e]

-- | Creates an identifier of the form @a::b::c::d::e::f@.
ident5 :: String -> String -> String -> String -> String -> String -> Identifier
ident5 :: HsImportName
-> HsImportName
-> HsImportName
-> HsImportName
-> HsImportName
-> HsImportName
-> Identifier
ident5 HsImportName
a HsImportName
b HsImportName
c HsImportName
d HsImportName
e HsImportName
f = [HsImportName] -> Identifier
ident' [HsImportName
a, HsImportName
b, HsImportName
c, HsImportName
d, HsImportName
e, HsImportName
f]

-- | Creates an identifier of the form @a\<...\>@.
identT :: String -> [Type] -> Identifier
identT :: HsImportName -> [Type] -> Identifier
identT HsImportName
a [Type]
ts = [IdPart] -> Identifier
Identifier [HsImportName -> Maybe [Type] -> IdPart
IdPart HsImportName
a (Maybe [Type] -> IdPart) -> Maybe [Type] -> IdPart
forall a b. (a -> b) -> a -> b
$ [Type] -> Maybe [Type]
forall a. a -> Maybe a
Just [Type]
ts]

-- | Creates an identifier with arbitrary many templated and non-templated
-- parts.
identT' :: [(String, Maybe [Type])] -> Identifier
identT' :: [(HsImportName, Maybe [Type])] -> Identifier
identT' = [IdPart] -> Identifier
Identifier ([IdPart] -> Identifier)
-> ([(HsImportName, Maybe [Type])] -> [IdPart])
-> [(HsImportName, Maybe [Type])]
-> Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((HsImportName, Maybe [Type]) -> IdPart)
-> [(HsImportName, Maybe [Type])] -> [IdPart]
forall a b. (a -> b) -> [a] -> [b]
map ((HsImportName -> Maybe [Type] -> IdPart)
-> (HsImportName, Maybe [Type]) -> IdPart
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry HsImportName -> Maybe [Type] -> IdPart
IdPart)

-- | Creates an identifier of the form @a::b\<...\>@.
ident1T :: String -> String -> [Type] -> Identifier
ident1T :: HsImportName -> HsImportName -> [Type] -> Identifier
ident1T HsImportName
a HsImportName
b [Type]
ts = [IdPart] -> Identifier
Identifier [HsImportName -> Maybe [Type] -> IdPart
IdPart HsImportName
a Maybe [Type]
forall a. Maybe a
Nothing, HsImportName -> Maybe [Type] -> IdPart
IdPart HsImportName
b (Maybe [Type] -> IdPart) -> Maybe [Type] -> IdPart
forall a b. (a -> b) -> a -> b
$ [Type] -> Maybe [Type]
forall a. a -> Maybe a
Just [Type]
ts]

-- | Creates an identifier of the form @a::b::c\<...\>@.
ident2T :: String -> String -> String -> [Type] -> Identifier
ident2T :: HsImportName
-> HsImportName -> HsImportName -> [Type] -> Identifier
ident2T HsImportName
a HsImportName
b HsImportName
c [Type]
ts = [IdPart] -> Identifier
Identifier [HsImportName -> Maybe [Type] -> IdPart
IdPart HsImportName
a Maybe [Type]
forall a. Maybe a
Nothing, HsImportName -> Maybe [Type] -> IdPart
IdPart HsImportName
b Maybe [Type]
forall a. Maybe a
Nothing, HsImportName -> Maybe [Type] -> IdPart
IdPart HsImportName
c (Maybe [Type] -> IdPart) -> Maybe [Type] -> IdPart
forall a b. (a -> b) -> a -> b
$ [Type] -> Maybe [Type]
forall a. a -> Maybe a
Just [Type]
ts]

-- | Creates an identifier of the form @a::b::c::d\<...\>@.
ident3T :: String -> String -> String -> String -> [Type] -> Identifier
ident3T :: HsImportName
-> HsImportName
-> HsImportName
-> HsImportName
-> [Type]
-> Identifier
ident3T HsImportName
a HsImportName
b HsImportName
c HsImportName
d [Type]
ts =
  [IdPart] -> Identifier
Identifier [HsImportName -> Maybe [Type] -> IdPart
IdPart HsImportName
a Maybe [Type]
forall a. Maybe a
Nothing, HsImportName -> Maybe [Type] -> IdPart
IdPart HsImportName
b Maybe [Type]
forall a. Maybe a
Nothing, HsImportName -> Maybe [Type] -> IdPart
IdPart HsImportName
c Maybe [Type]
forall a. Maybe a
Nothing,
              HsImportName -> Maybe [Type] -> IdPart
IdPart HsImportName
d (Maybe [Type] -> IdPart) -> Maybe [Type] -> IdPart
forall a b. (a -> b) -> a -> b
$ [Type] -> Maybe [Type]
forall a. a -> Maybe a
Just [Type]
ts]

-- | Creates an identifier of the form @a::b::c::d::e\<...\>@.
ident4T :: String -> String -> String -> String -> String -> [Type] -> Identifier
ident4T :: HsImportName
-> HsImportName
-> HsImportName
-> HsImportName
-> HsImportName
-> [Type]
-> Identifier
ident4T HsImportName
a HsImportName
b HsImportName
c HsImportName
d HsImportName
e [Type]
ts =
  [IdPart] -> Identifier
Identifier [HsImportName -> Maybe [Type] -> IdPart
IdPart HsImportName
a Maybe [Type]
forall a. Maybe a
Nothing, HsImportName -> Maybe [Type] -> IdPart
IdPart HsImportName
b Maybe [Type]
forall a. Maybe a
Nothing, HsImportName -> Maybe [Type] -> IdPart
IdPart HsImportName
c Maybe [Type]
forall a. Maybe a
Nothing,
              HsImportName -> Maybe [Type] -> IdPart
IdPart HsImportName
d Maybe [Type]
forall a. Maybe a
Nothing, HsImportName -> Maybe [Type] -> IdPart
IdPart HsImportName
e (Maybe [Type] -> IdPart) -> Maybe [Type] -> IdPart
forall a b. (a -> b) -> a -> b
$ [Type] -> Maybe [Type]
forall a. a -> Maybe a
Just [Type]
ts]

-- | Creates an identifier of the form @a::b::c::d::e::f\<...\>@.
ident5T :: String -> String -> String -> String -> String -> String -> [Type] -> Identifier
ident5T :: HsImportName
-> HsImportName
-> HsImportName
-> HsImportName
-> HsImportName
-> HsImportName
-> [Type]
-> Identifier
ident5T HsImportName
a HsImportName
b HsImportName
c HsImportName
d HsImportName
e HsImportName
f [Type]
ts =
  [IdPart] -> Identifier
Identifier [HsImportName -> Maybe [Type] -> IdPart
IdPart HsImportName
a Maybe [Type]
forall a. Maybe a
Nothing, HsImportName -> Maybe [Type] -> IdPart
IdPart HsImportName
b Maybe [Type]
forall a. Maybe a
Nothing, HsImportName -> Maybe [Type] -> IdPart
IdPart HsImportName
c Maybe [Type]
forall a. Maybe a
Nothing,
              HsImportName -> Maybe [Type] -> IdPart
IdPart HsImportName
d Maybe [Type]
forall a. Maybe a
Nothing, HsImportName -> Maybe [Type] -> IdPart
IdPart HsImportName
e Maybe [Type]
forall a. Maybe a
Nothing, HsImportName -> Maybe [Type] -> IdPart
IdPart HsImportName
f (Maybe [Type] -> IdPart) -> Maybe [Type] -> IdPart
forall a b. (a -> b) -> a -> b
$ [Type] -> Maybe [Type]
forall a. a -> Maybe a
Just [Type]
ts]

-- | Instances of this typeclass are C++ entities that Hoppy can expose to
-- foreign languages: functions, classes, global variables, etc.  'Interface's
-- are largely composed of exports (grouped into modules).  Hoppy uses this
-- interface to perform code generation for each entity.
class (HasAddendum a, HasExtNames a, HasReqs a, Typeable a, Show a) => Exportable a where
  -- | Wraps an exportable object in an existential data type.
  --
  -- The default instance is just @toExport = 'Export'@, which does not need to
  -- be overridden in general.
  toExport :: a -> Export
  toExport = a -> Export
forall a. Exportable a => a -> Export
Export

  -- | Attempts to cast an exportable object to a specific type, pulling off
  -- 'Export' wrappers as necessary.
  --
  -- The default @castExport = 'cast'@ is fine.
  castExport :: (Typeable a, Exportable b, Typeable b) => a -> Maybe b
  castExport = a -> Maybe b
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast

  -- | Generates the C++ side of the binding for an entity.
  --
  -- For an entity, Hoppy invokes this function once with 'LC.SayHeader' when
  -- generating the header file for a module, and once with 'LC.SaySource' when
  -- generating the corresponding source file.
  sayExportCpp :: LC.SayExportMode -> a -> LC.Generator ()

  -- | Generates the Haskell side of the binding for an entity.
  --
  -- For an entity, Hoppy invokes this function once with
  -- 'LH.SayExportForeignImports' when it is time to emit foreign imports, and
  -- once with 'LH.SayExportDecls' when it is time to generate Haskell binding
  -- code later in the module.  Hoppy may also call the function with
  -- 'LH.SayExportBoot', if necessary.
  --
  -- See 'LH.SayExportMode'.
  sayExportHaskell :: LH.SayExportMode -> a -> LH.Generator ()

  -- | If the export is backed by an C++ enum, then this returns known
  -- structural information about the enum.  This provides information to the
  -- \"evaluate enums\" hook so that Hoppy can determine enum values on its own.
  --
  -- By default, this returns @Nothing@.
  --
  -- See 'Hooks'.
  getExportEnumInfo :: a -> Maybe EnumInfo
  getExportEnumInfo a
_ = Maybe EnumInfo
forall a. Maybe a
Nothing

  -- | If the export is backed by a C++ class that is marked as supporting
  -- exceptions, then this returns the class definition.
  --
  -- By default, this returns @Nothing@.
  getExportExceptionClass :: a -> Maybe Class
  getExportExceptionClass a
_ = Maybe Class
forall a. Maybe a
Nothing

-- | Specifies some C++ declaration (function, class, etc.) to give access to.
data Export = forall a. Exportable a => Export a

instance HasAddendum Export where
  getAddendum :: Export -> Addendum
getAddendum (Export a
e) = a -> Addendum
forall a. HasAddendum a => a -> Addendum
getAddendum a
e
  setAddendum :: Addendum -> Export -> Export
setAddendum Addendum
a (Export a
e) = a -> Export
forall a. Exportable a => a -> Export
Export (a -> Export) -> a -> Export
forall a b. (a -> b) -> a -> b
$ Addendum -> a -> a
forall a. HasAddendum a => Addendum -> a -> a
setAddendum Addendum
a a
e
  modifyAddendum :: (Addendum -> Addendum) -> Export -> Export
modifyAddendum Addendum -> Addendum
f (Export a
e) = a -> Export
forall a. Exportable a => a -> Export
Export (a -> Export) -> a -> Export
forall a b. (a -> b) -> a -> b
$ (Addendum -> Addendum) -> a -> a
forall a. HasAddendum a => (Addendum -> Addendum) -> a -> a
modifyAddendum Addendum -> Addendum
f a
e

instance HasExtNames Export where
  getPrimaryExtName :: Export -> ExtName
getPrimaryExtName (Export a
e) = a -> ExtName
forall a. HasExtNames a => a -> ExtName
getPrimaryExtName a
e
  getNestedExtNames :: Export -> [ExtName]
getNestedExtNames (Export a
e) = a -> [ExtName]
forall a. HasExtNames a => a -> [ExtName]
getNestedExtNames a
e

instance HasReqs Export where
  getReqs :: Export -> Reqs
getReqs (Export a
e) = a -> Reqs
forall a. HasReqs a => a -> Reqs
getReqs a
e
  setReqs :: Reqs -> Export -> Export
setReqs Reqs
reqs (Export a
e) = a -> Export
forall a. Exportable a => a -> Export
Export (a -> Export) -> a -> Export
forall a b. (a -> b) -> a -> b
$ Reqs -> a -> a
forall a. HasReqs a => Reqs -> a -> a
setReqs Reqs
reqs a
e
  modifyReqs :: (Reqs -> Reqs) -> Export -> Export
modifyReqs Reqs -> Reqs
f (Export a
e) = a -> Export
forall a. Exportable a => a -> Export
Export (a -> Export) -> a -> Export
forall a b. (a -> b) -> a -> b
$ (Reqs -> Reqs) -> a -> a
forall a. HasReqs a => (Reqs -> Reqs) -> a -> a
modifyReqs Reqs -> Reqs
f a
e

instance Exportable Export where
  toExport :: Export -> Export
toExport = Export -> Export
forall a. a -> a
id

  castExport :: forall b.
(Typeable Export, Exportable b, Typeable b) =>
Export -> Maybe b
castExport (Export a
e) = a -> Maybe b
forall b. (Typeable a, Exportable b, Typeable b) => a -> Maybe b
forall a b.
(Exportable a, Typeable a, Exportable b, Typeable b) =>
a -> Maybe b
castExport a
e

  sayExportCpp :: SayExportMode -> Export -> Generator ()
sayExportCpp SayExportMode
sayBody (Export a
e) = SayExportMode -> a -> Generator ()
forall a. Exportable a => SayExportMode -> a -> Generator ()
sayExportCpp SayExportMode
sayBody a
e

  sayExportHaskell :: SayExportMode -> Export -> Generator ()
sayExportHaskell SayExportMode
mode (Export a
e) = SayExportMode -> a -> Generator ()
forall a. Exportable a => SayExportMode -> a -> Generator ()
sayExportHaskell SayExportMode
mode a
e

  getExportEnumInfo :: Export -> Maybe EnumInfo
getExportEnumInfo (Export a
e) = a -> Maybe EnumInfo
forall a. Exportable a => a -> Maybe EnumInfo
getExportEnumInfo a
e

  getExportExceptionClass :: Export -> Maybe Class
getExportExceptionClass (Export a
e) = a -> Maybe Class
forall a. Exportable a => a -> Maybe Class
getExportExceptionClass a
e

instance Show Export where
  show :: Export -> HsImportName
show (Export a
e) = HsImportName
"<Export " HsImportName -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> HsImportName
forall a. Show a => a -> HsImportName
show a
e HsImportName -> ShowS
forall a. [a] -> [a] -> [a]
++ HsImportName
">"

-- | A concrete C++ type.  Use the bindings in "Foreign.Hoppy.Generator.Types"
-- for values of this type; these data constructors are subject to change
-- without notice.
data Type =
    Internal_TVoid
  | Internal_TPtr Type
  | Internal_TRef Type
  | Internal_TFn [Parameter] Type
  | Internal_TObj Class
  | Internal_TObjToHeap Class
  | Internal_TToGc Type
  | Internal_TManual ConversionSpec
  | Internal_TConst Type
  -- When changing the declarations here, be sure to update the Eq instance.
  deriving (Int -> Type -> ShowS
[Type] -> ShowS
Type -> HsImportName
(Int -> Type -> ShowS)
-> (Type -> HsImportName) -> ([Type] -> ShowS) -> Show Type
forall a.
(Int -> a -> ShowS)
-> (a -> HsImportName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Type -> ShowS
showsPrec :: Int -> Type -> ShowS
$cshow :: Type -> HsImportName
show :: Type -> HsImportName
$cshowList :: [Type] -> ShowS
showList :: [Type] -> ShowS
Show)

instance Eq Type where
  Type
Internal_TVoid == :: Type -> Type -> Bool
== Type
Internal_TVoid = Bool
True
  (Internal_TPtr Type
t) == (Internal_TPtr Type
t') = Type
t Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
== Type
t'
  (Internal_TRef Type
t) == (Internal_TRef Type
t') = Type
t Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
== Type
t'
  (Internal_TFn [Parameter]
ps Type
r) == (Internal_TFn [Parameter]
ps' Type
r') =
    ([Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ (Parameter -> Parameter -> Bool)
-> [Parameter] -> [Parameter] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Type -> Type -> Bool)
-> (Parameter -> Type) -> Parameter -> Parameter -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Parameter -> Type
parameterType) [Parameter]
ps [Parameter]
ps') Bool -> Bool -> Bool
&& Type
r Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
== Type
r'
  (Internal_TObj Class
cls) == (Internal_TObj Class
cls') = Class
cls Class -> Class -> Bool
forall a. Eq a => a -> a -> Bool
== Class
cls'
  (Internal_TObjToHeap Class
cls) == (Internal_TObjToHeap Class
cls') = Class
cls Class -> Class -> Bool
forall a. Eq a => a -> a -> Bool
== Class
cls'
  (Internal_TToGc Type
t) == (Internal_TToGc Type
t') = Type
t Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
== Type
t'
  (Internal_TManual ConversionSpec
s) == (Internal_TManual ConversionSpec
s') = ConversionSpec
s ConversionSpec -> ConversionSpec -> Bool
forall a. Eq a => a -> a -> Bool
== ConversionSpec
s'
  (Internal_TConst Type
t) == (Internal_TConst Type
t') = Type
t Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
== Type
t'
  Type
_ == Type
_ = Bool
False

-- | Canonicalizes a 'Type' without changing its meaning.  Multiple nested
-- 'Internal_TConst's are collapsed into a single one.
normalizeType :: Type -> Type
normalizeType :: Type -> Type
normalizeType Type
t = case Type
t of
  Type
Internal_TVoid -> Type
t
  Internal_TPtr Type
t' -> Type -> Type
Internal_TPtr (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
normalizeType Type
t'
  Internal_TRef Type
t' -> Type -> Type
Internal_TRef (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
normalizeType Type
t'
  Internal_TFn [Parameter]
params Type
retType ->
    [Parameter] -> Type -> Type
Internal_TFn ((Parameter -> Parameter) -> [Parameter] -> [Parameter]
forall a b. (a -> b) -> [a] -> [b]
map ((Type -> Type) -> Parameter -> Parameter
onParameterType Type -> Type
normalizeType) [Parameter]
params) (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
normalizeType Type
retType
  Internal_TObj Class
_ -> Type
t
  Internal_TObjToHeap Class
_ -> Type
t
  Internal_TToGc Type
_ -> Type
t
  Internal_TManual ConversionSpec
_ -> Type
t
  Internal_TConst (Internal_TConst Type
t') -> Type -> Type
normalizeType (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
Internal_TConst Type
t'
  Internal_TConst Type
_ -> Type
t

-- | Strips leading 'Internal_TConst's off of a type.
stripConst :: Type -> Type
stripConst :: Type -> Type
stripConst Type
t = case Type
t of
  Internal_TConst Type
t' -> Type -> Type
stripConst Type
t'
  Type
_ -> Type
t

-- | Strips a leading 'Internal_TToGc' off of a type.
stripToGc :: Type -> Type
stripToGc :: Type -> Type
stripToGc Type
t = case Type
t of
  Internal_TToGc Type
t' -> Type
t'
  Type
_ -> Type
t

-- | Indicates whether an entity is scoped or unscoped.
--
-- This is used to distinguish unscoped enums (@enum@) or scoped ones (@enum
-- class@ or @enum struct@).
data Scoped =
    Unscoped  -- ^ Indicates an unscoped entity (e.g. an enum).
  | Scoped  -- ^ Indicates a scoped entity (e.g. an enum).
  deriving (Scoped -> Scoped -> Bool
(Scoped -> Scoped -> Bool)
-> (Scoped -> Scoped -> Bool) -> Eq Scoped
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Scoped -> Scoped -> Bool
== :: Scoped -> Scoped -> Bool
$c/= :: Scoped -> Scoped -> Bool
/= :: Scoped -> Scoped -> Bool
Eq, Eq Scoped
Eq Scoped =>
(Scoped -> Scoped -> Ordering)
-> (Scoped -> Scoped -> Bool)
-> (Scoped -> Scoped -> Bool)
-> (Scoped -> Scoped -> Bool)
-> (Scoped -> Scoped -> Bool)
-> (Scoped -> Scoped -> Scoped)
-> (Scoped -> Scoped -> Scoped)
-> Ord Scoped
Scoped -> Scoped -> Bool
Scoped -> Scoped -> Ordering
Scoped -> Scoped -> Scoped
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Scoped -> Scoped -> Ordering
compare :: Scoped -> Scoped -> Ordering
$c< :: Scoped -> Scoped -> Bool
< :: Scoped -> Scoped -> Bool
$c<= :: Scoped -> Scoped -> Bool
<= :: Scoped -> Scoped -> Bool
$c> :: Scoped -> Scoped -> Bool
> :: Scoped -> Scoped -> Bool
$c>= :: Scoped -> Scoped -> Bool
>= :: Scoped -> Scoped -> Bool
$cmax :: Scoped -> Scoped -> Scoped
max :: Scoped -> Scoped -> Scoped
$cmin :: Scoped -> Scoped -> Scoped
min :: Scoped -> Scoped -> Scoped
Ord, Int -> Scoped -> ShowS
[Scoped] -> ShowS
Scoped -> HsImportName
(Int -> Scoped -> ShowS)
-> (Scoped -> HsImportName) -> ([Scoped] -> ShowS) -> Show Scoped
forall a.
(Int -> a -> ShowS)
-> (a -> HsImportName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Scoped -> ShowS
showsPrec :: Int -> Scoped -> ShowS
$cshow :: Scoped -> HsImportName
show :: Scoped -> HsImportName
$cshowList :: [Scoped] -> ShowS
showList :: [Scoped] -> ShowS
Show)

-- | Returns true if a 'Scoped' value is scoped, and false if it is unscoped.
isScoped :: Scoped -> Bool
isScoped :: Scoped -> Bool
isScoped Scoped
Unscoped = Bool
False
isScoped Scoped
Scoped = Bool
True

-- | Whether or not @const@ is applied to an entity.
data Constness = Nonconst | Const
               deriving (Constness
Constness -> Constness -> Bounded Constness
forall a. a -> a -> Bounded a
$cminBound :: Constness
minBound :: Constness
$cmaxBound :: Constness
maxBound :: Constness
Bounded, Int -> Constness
Constness -> Int
Constness -> [Constness]
Constness -> Constness
Constness -> Constness -> [Constness]
Constness -> Constness -> Constness -> [Constness]
(Constness -> Constness)
-> (Constness -> Constness)
-> (Int -> Constness)
-> (Constness -> Int)
-> (Constness -> [Constness])
-> (Constness -> Constness -> [Constness])
-> (Constness -> Constness -> [Constness])
-> (Constness -> Constness -> Constness -> [Constness])
-> Enum Constness
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Constness -> Constness
succ :: Constness -> Constness
$cpred :: Constness -> Constness
pred :: Constness -> Constness
$ctoEnum :: Int -> Constness
toEnum :: Int -> Constness
$cfromEnum :: Constness -> Int
fromEnum :: Constness -> Int
$cenumFrom :: Constness -> [Constness]
enumFrom :: Constness -> [Constness]
$cenumFromThen :: Constness -> Constness -> [Constness]
enumFromThen :: Constness -> Constness -> [Constness]
$cenumFromTo :: Constness -> Constness -> [Constness]
enumFromTo :: Constness -> Constness -> [Constness]
$cenumFromThenTo :: Constness -> Constness -> Constness -> [Constness]
enumFromThenTo :: Constness -> Constness -> Constness -> [Constness]
Enum, Constness -> Constness -> Bool
(Constness -> Constness -> Bool)
-> (Constness -> Constness -> Bool) -> Eq Constness
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Constness -> Constness -> Bool
== :: Constness -> Constness -> Bool
$c/= :: Constness -> Constness -> Bool
/= :: Constness -> Constness -> Bool
Eq, Int -> Constness -> ShowS
[Constness] -> ShowS
Constness -> HsImportName
(Int -> Constness -> ShowS)
-> (Constness -> HsImportName)
-> ([Constness] -> ShowS)
-> Show Constness
forall a.
(Int -> a -> ShowS)
-> (a -> HsImportName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Constness -> ShowS
showsPrec :: Int -> Constness -> ShowS
$cshow :: Constness -> HsImportName
show :: Constness -> HsImportName
$cshowList :: [Constness] -> ShowS
showList :: [Constness] -> ShowS
Show)

-- | Returns the opposite constness value.
constNegate :: Constness -> Constness
constNegate :: Constness -> Constness
constNegate Constness
Nonconst = Constness
Const
constNegate Constness
Const = Constness
Nonconst

-- | Whether or not a function may cause side-effects.
--
-- Haskell bindings for pure functions will not be in 'IO', and calls to pure
-- functions will be executed non-strictly.  Calls to impure functions will
-- execute in the IO monad.
--
-- Member functions for mutable classes should not be made pure, because it is
-- difficult in general to control when the call will be made.
data Purity = Nonpure  -- ^ Side-affects are possible.
            | Pure  -- ^ Side-affects will not happen.
            deriving (Purity -> Purity -> Bool
(Purity -> Purity -> Bool)
-> (Purity -> Purity -> Bool) -> Eq Purity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Purity -> Purity -> Bool
== :: Purity -> Purity -> Bool
$c/= :: Purity -> Purity -> Bool
/= :: Purity -> Purity -> Bool
Eq, Int -> Purity -> ShowS
[Purity] -> ShowS
Purity -> HsImportName
(Int -> Purity -> ShowS)
-> (Purity -> HsImportName) -> ([Purity] -> ShowS) -> Show Purity
forall a.
(Int -> a -> ShowS)
-> (a -> HsImportName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Purity -> ShowS
showsPrec :: Int -> Purity -> ShowS
$cshow :: Purity -> HsImportName
show :: Purity -> HsImportName
$cshowList :: [Purity] -> ShowS
showList :: [Purity] -> ShowS
Show)

-- | A parameter to a function, including a type and an optional name.  A name
-- can be conveniently associated with a type with the @('~:')@ operator.
--
-- Two @Parameter@s are equal if their types are equal.
data Parameter = Parameter
  { Parameter -> Type
parameterType :: Type
    -- ^ The parameter's data type.
  , Parameter -> Maybe HsImportName
parameterName :: Maybe String
    -- ^ An optional variable name to describe the parameter.  This name should
    -- follow the same rules as 'ExtName' for its contents.
  } deriving (Int -> Parameter -> ShowS
[Parameter] -> ShowS
Parameter -> HsImportName
(Int -> Parameter -> ShowS)
-> (Parameter -> HsImportName)
-> ([Parameter] -> ShowS)
-> Show Parameter
forall a.
(Int -> a -> ShowS)
-> (a -> HsImportName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Parameter -> ShowS
showsPrec :: Int -> Parameter -> ShowS
$cshow :: Parameter -> HsImportName
show :: Parameter -> HsImportName
$cshowList :: [Parameter] -> ShowS
showList :: [Parameter] -> ShowS
Show)

-- | Objects that can be coerced to function parameter definitions.
class Show a => IsParameter a where
  toParameter :: a -> Parameter

instance IsParameter Parameter where
  toParameter :: Parameter -> Parameter
toParameter = Parameter -> Parameter
forall a. a -> a
id

instance IsParameter Type where
  toParameter :: Type -> Parameter
toParameter Type
t =
    Parameter
    { parameterType :: Type
parameterType = Type
t
    , parameterName :: Maybe HsImportName
parameterName = Maybe HsImportName
forall a. Maybe a
Nothing
    }

-- | Maps a function over a parameter's type.
onParameterType :: (Type -> Type) -> (Parameter -> Parameter)
onParameterType :: (Type -> Type) -> Parameter -> Parameter
onParameterType Type -> Type
f Parameter
p = Parameter
p { parameterType = f $ parameterType p }

-- | An empty parameter list.  This should be used instead of a literal @[]@
-- when declaring an empty parameter list, because in the context of
-- @'IsParameter' a => [a]@, the empty list is ambiguously typed, even though it
-- doesn't matter which instance is selected.
np :: [Parameter]
np :: [Parameter]
np = []

-- | Converts a list of parameter-like objects to parameters.
toParameters :: IsParameter a => [a] -> [Parameter]
toParameters :: forall a. IsParameter a => [a] -> [Parameter]
toParameters = (a -> Parameter) -> [a] -> [Parameter]
forall a b. (a -> b) -> [a] -> [b]
map a -> Parameter
forall a. IsParameter a => a -> Parameter
toParameter

-- | Associates a name string with a type to create a 'Parameter' that
-- can be given as a function or method parameter, instead of a raw 'Type'.  The
-- name given here will be included as documentation in the generated code.
--
-- An empty string given for the name means not to associate a name with the
-- parameter.  This is useful to leave some parameters unnamed in a parameter
-- list while naming other parameters, since the list must either contain all
-- 'Type's or all 'Parameter's.
(~:) :: IsParameter a => String -> a -> Parameter
~: :: forall a. IsParameter a => HsImportName -> a -> Parameter
(~:) HsImportName
name a
param =
  (a -> Parameter
forall a. IsParameter a => a -> Parameter
toParameter a
param) { parameterName = if null name then Nothing else Just name }
infixr 0 ~:

-- | Defines the process for converting a value in one direction between C++ and
-- a foreign language.  The type parameter varies depending on the actual
-- conversion being defined.
data ConversionMethod c =
    ConversionUnsupported
    -- ^ The conversion is unsupported.  If part of an interface depends on
    -- performing this conversion, code generation will fail.
  | BinaryCompatible
    -- ^ The input value and its corresponding output have the same binary
    -- representation in memory, and require no explicit conversion.  Numeric
    -- types may use this conversion method.
  | CustomConversion c
    -- ^ Conversion requires a custom process as specified by the argument.
    --
    -- TODO Split into pure (let) vs nonpure (<-)?
  deriving (Int -> ConversionMethod c -> ShowS
[ConversionMethod c] -> ShowS
ConversionMethod c -> HsImportName
(Int -> ConversionMethod c -> ShowS)
-> (ConversionMethod c -> HsImportName)
-> ([ConversionMethod c] -> ShowS)
-> Show (ConversionMethod c)
forall c. Show c => Int -> ConversionMethod c -> ShowS
forall c. Show c => [ConversionMethod c] -> ShowS
forall c. Show c => ConversionMethod c -> HsImportName
forall a.
(Int -> a -> ShowS)
-> (a -> HsImportName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall c. Show c => Int -> ConversionMethod c -> ShowS
showsPrec :: Int -> ConversionMethod c -> ShowS
$cshow :: forall c. Show c => ConversionMethod c -> HsImportName
show :: ConversionMethod c -> HsImportName
$cshowList :: forall c. Show c => [ConversionMethod c] -> ShowS
showList :: [ConversionMethod c] -> ShowS
Show)

-- | The root data type for specifying how conversions happen between C++ and foreign
-- values.
--
-- Prefer 'makeConversionSpec' to using this data constructor directly, then
-- override the record to specify conversions for foreign languages.
--
-- The @Cpp@ component of this data structure specifies a C++ type, and
-- conversions between it and something that can be marshalled over a C FFI
-- layer, if such a conversion is possible in each direction.
--
-- Each foreign language has its own component that must be specified in order
-- for types using this specification to be usable in that language.
data ConversionSpec = ConversionSpec
  { ConversionSpec -> HsImportName
conversionSpecName :: String
    -- ^ An identifying name, used for rendering in e.g. error messages.
  , ConversionSpec -> ConversionSpecCpp
conversionSpecCpp :: ConversionSpecCpp
    -- ^ Fundamental information about the C++ type.
  , ConversionSpec -> Maybe ConversionSpecHaskell
conversionSpecHaskell :: Maybe ConversionSpecHaskell
    -- ^ A specification for how values can be used in Haskell.
  }

instance Eq ConversionSpec where
  == :: ConversionSpec -> ConversionSpec -> Bool
(==) = HsImportName -> HsImportName -> Bool
forall a. Eq a => a -> a -> Bool
(==) (HsImportName -> HsImportName -> Bool)
-> (ConversionSpec -> HsImportName)
-> ConversionSpec
-> ConversionSpec
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ConversionSpec -> HsImportName
conversionSpecName

instance Show ConversionSpec where
  show :: ConversionSpec -> HsImportName
show ConversionSpec
x = HsImportName
"<ConversionSpec " HsImportName -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> HsImportName
show (ConversionSpec -> HsImportName
conversionSpecName ConversionSpec
x) HsImportName -> ShowS
forall a. [a] -> [a] -> [a]
++ HsImportName
">"

-- | Creates a 'ConversionSpec' from an identifying name and a specification of
-- the C++ conversion behaviour.  By default, no foreign language conversion
-- behaviour is configured.  For Haskell, this should be done by using
-- 'makeConversionSpecHaskell' to specify behaviour, then writing that to the
-- 'conversionSpecHaskell' field of the 'ConversionSpec' returned here.
makeConversionSpec ::
     String  -- ^ 'conversionSpecName'
  -> ConversionSpecCpp  -- ^ 'conversionSpecCpp'
  -> ConversionSpec
makeConversionSpec :: HsImportName -> ConversionSpecCpp -> ConversionSpec
makeConversionSpec HsImportName
name ConversionSpecCpp
cppSpec =
  ConversionSpec
  { conversionSpecName :: HsImportName
conversionSpecName = HsImportName
name
  , conversionSpecCpp :: ConversionSpecCpp
conversionSpecCpp = ConversionSpecCpp
cppSpec
  , conversionSpecHaskell :: Maybe ConversionSpecHaskell
conversionSpecHaskell = Maybe ConversionSpecHaskell
forall a. Maybe a
Nothing
  }

-- | For a 'ConversionSpec', defines the C++ type and conversions to and from a
-- C FFI layer.
--
-- Prefer 'makeConversionSpecCpp' to using this data constructor directly, then
-- override the record to specify additional conversion properties.
--
-- 'conversionSpecCppName' specifies the C++ type of the conversion.  This will
-- be the type that is passed over the C FFI as well, unless
-- 'conversionSpecCppConversionType' overrides it.
-- 'conversionSpecCppConversionToCppExpr' and
-- 'conversionSpecCppConversionFromCppExpr' may define custom code generation
-- for passing values over the FFI.
data ConversionSpecCpp = ConversionSpecCpp
  { ConversionSpecCpp -> HsImportName
conversionSpecCppName :: String
    -- ^ The name of the C++ type.  May identify a primitive C++ type such as
    -- @\"unsigned int\"@, or a more complex type like
    -- @std::list\<std::string\>@.

  , ConversionSpecCpp -> Generator Reqs
conversionSpecCppReqs :: LC.Generator Reqs
    -- ^ Computes requirements to refer to the C++ type.  Being in the generator
    -- monad, this may use its environment, but should not emit code or 'Reqs'
    -- to the generator directly.

  , ConversionSpecCpp -> Generator (Maybe Type)
conversionSpecCppConversionType :: LC.Generator (Maybe Type)
    -- ^ Specifies the type that will be passed over the C FFI.
    --
    -- If absent (default), then the type named by 'conversionSpecCppName' is
    -- also used for marshalling to foreign languages.
    --
    -- If present, this represents a type distinct from 'conversionSpecCppName'
    -- that will be exchanged across the FFI boundary.  In this case, you may
    -- also want to define one or both of 'conversionSpecCppConversionToCppExpr'
    -- and 'conversionSpecCppConversionFromCppExpr'.
    --
    -- This is a monadic value so that it has access to the generator's
    -- environment.  The action should not add imports or emit code.

  , ConversionSpecCpp
-> Maybe (Generator () -> Maybe (Generator ()) -> Generator ())
conversionSpecCppConversionToCppExpr ::
      Maybe (LC.Generator () -> Maybe (LC.Generator ()) -> LC.Generator ())
    -- ^ This controls behaviour for receiving a value passed into C++ over the
    -- FFI.  Specifically, this powers the @ConversionSpec@ being used as
    -- 'Foreign.Hoppy.Generator.Spec.Function.Function' arguments and
    -- 'Foreign.Hoppy.Generator.Spec.Callback.Callback' return values.
    --
    -- When absent (default), generated code assumes that it can implicitly
    -- convert a value passed over the FFI from the C FFI type (see
    -- 'conversionSpecCppConversionType') to the C++ type
    -- (i.e. 'conversionSpecCppName').  When the former is absent, this is
    -- always fine.  "Implicitly" here means in the sense of a C++ implicit
    -- conversion, not necessarily binary compatibility.
    --
    -- When present, this provides custom conversion behaviour for receiving a
    -- value passed into C++ over the FFI.  The function should generate C++
    -- code to convert a value from the type passed over the C FFI into the
    -- actual C++ type.
    --
    -- This is a function of the form:
    --
    -- > \emitFromExpr maybeEmitToVar -> ...
    --
    -- If the function's second argument is present, then the function should
    -- emit a variable declaration for that name, created from the expression
    -- emitted by the first argument.
    --
    -- If the function's second argument is absent, then the function should
    -- emit an expression that converts the expression emitted by the first
    -- argument into the appropriate type.
    --
    -- In both cases, the first generator argument should only be evaluated once
    -- by the resulting C++ expression; it is not guaranteed to be pure.

  , ConversionSpecCpp
-> Maybe (Generator () -> Maybe (Generator ()) -> Generator ())
conversionSpecCppConversionFromCppExpr ::
      Maybe (LC.Generator () -> Maybe (LC.Generator ()) -> LC.Generator ())
    -- ^ This is the opposite of 'conversionSpecCppConversionToCppExpr'.  This
    -- being present enables custom conversion behaviour for passing a value
    -- /out of/ C++ through the FFI.  This powers the @ConversionSpec@ being
    -- used as 'Foreign.Hoppy.Generator.Spec.Function.Function' return values
    -- and 'Foreign.Hoppy.Generator.Spec.Callback.Callback' arguments.
    --
    -- Arguments are the same as with 'conversionSpecCppConversionToCppExpr'.
  }

-- | Builds a 'ConversionSpecCpp' with a C++ type, with no conversions defined.
makeConversionSpecCpp :: String -> LC.Generator Reqs -> ConversionSpecCpp
makeConversionSpecCpp :: HsImportName -> Generator Reqs -> ConversionSpecCpp
makeConversionSpecCpp HsImportName
cppName Generator Reqs
cppReqs =
  ConversionSpecCpp
  { conversionSpecCppName :: HsImportName
conversionSpecCppName = HsImportName
cppName
  , conversionSpecCppReqs :: Generator Reqs
conversionSpecCppReqs = Generator Reqs
cppReqs
  , conversionSpecCppConversionType :: Generator (Maybe Type)
conversionSpecCppConversionType = Maybe Type -> Generator (Maybe Type)
forall a.
a -> ReaderT Env (WriterT [Chunk] (Either HsImportName)) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Type
forall a. Maybe a
Nothing
  , conversionSpecCppConversionToCppExpr :: Maybe (Generator () -> Maybe (Generator ()) -> Generator ())
conversionSpecCppConversionToCppExpr = Maybe (Generator () -> Maybe (Generator ()) -> Generator ())
forall a. Maybe a
Nothing
  , conversionSpecCppConversionFromCppExpr :: Maybe (Generator () -> Maybe (Generator ()) -> Generator ())
conversionSpecCppConversionFromCppExpr = Maybe (Generator () -> Maybe (Generator ()) -> Generator ())
forall a. Maybe a
Nothing
  }

-- | Controls how conversions between C++ values and Haskell values happen in
-- Haskell bindings.
--
-- Prefer 'makeConversionSpecHaskell' to using this data constructor directly.
data ConversionSpecHaskell = ConversionSpecHaskell
  { ConversionSpecHaskell -> Generator HsType
conversionSpecHaskellHsType :: LH.Generator HsType
    -- ^ The type exposed to users of the Haskell side of a binding.  Functions
    -- that take one of these values as an argument will expect this type, and
    -- functions returning one of these values will return this type.
    --
    -- This type is wrapped in a generator in order to be able to specify any
    -- necessary imports.  This generator should not generate code or add
    -- exports.

  , ConversionSpecHaskell -> Maybe (HsName -> Generator HsQualType)
conversionSpecHaskellHsArgType :: Maybe (HsName -> LH.Generator HsQualType)
    -- ^ If present, then for bindings for C++ functions that expect one of
    -- these values as an argument, rather than taking a fixed concrete type
    -- ('conversionSpecHaskellHsType'), this qualified type will be used
    -- instead.  The 'HsName' parameter receives a unique name from the
    -- generator that can be used with 'Language.Haskell.Syntax.HsTyVar' like
    -- so:
    --
    -- > \name -> return $ HsQualType [...constraints...] (HsTyVar name)
    --
    -- 'conversionSpecHaskellHsType' should satisfy this constraint, when
    -- present.
    --
    -- This type is wrapped in a generator in order to be able to specify any
    -- necessary imports.  This generator should not generate code or add
    -- exports.

  , ConversionSpecHaskell -> Maybe (Generator HsType)
conversionSpecHaskellCType :: Maybe (LH.Generator HsType)
    -- ^ If present, then rather than passing a value of native Haskell type
    -- ('conversionSpecHaskellHsType') directly over the FFI, this is an
    -- intermediate type that will be passed instead.  This is needed any time
    -- that the former type isn't a simple type that the FFI supports.
    --
    -- 'conversionSpecHaskellToCppFn' and 'conversionSpecHaskellFromCppFn'
    -- marshal values into and out of this type, respsectively.
    --
    -- This type is wrapped in a generator in order to be able to specify any
    -- necessary imports.  This generator should not generate code or add
    -- exports.

  , ConversionSpecHaskell -> ConversionMethod (Generator ())
conversionSpecHaskellToCppFn :: ConversionMethod (LH.Generator ())
    -- ^ This defines how a Haskell value is passed to C++.  If this is
    -- 'CustomConversion', then 'conversionSpecHaskellCType' must be present,
    -- and the generator should output a function that takes a value of type
    -- 'conversionSpecHaskellHsType' and return a value of
    -- 'conversionSpecHaskellCType'.
    --
    -- If 'conversionSpecHaskellHsArgType' is present, then the function should
    -- be able to accept that more general type instead.  This is used for
    -- bindings that call into C++ functions.  This function is still
    -- specialized to 'conversionSpecHaskellHsType' when generating code for
    -- callback return values.
    --
    -- The generator should output code and may add imports, but should not add
    -- exports.

  , ConversionSpecHaskell -> ConversionMethod (Generator ())
conversionSpecHaskellFromCppFn :: ConversionMethod (LH.Generator ())
    -- ^ This defines how a Haskell value is passed from C++.  If this is
    -- 'CustomConversion', then 'conversionSpecHaskellCType' must be present,
    -- and the generator should output a function that takes a value of type
    -- 'conversionSpecHaskellCType' and return a value of
    -- 'conversionSpecHaskellHsType'.
    --
    -- The generator should output code and may add imports, but should not add
    -- exports.
  }

-- | Builds a 'ConversionSpecHaskell' with the mandatory parameters given.
makeConversionSpecHaskell ::
  LH.Generator HsType  -- ^ 'conversionSpecHaskellHsType'
  -> Maybe (LH.Generator HsType)  -- ^ 'conversionSpecHaskellCType'
  -> ConversionMethod (LH.Generator ())  -- ^ 'conversionSpecHaskellToCppFn'
  -> ConversionMethod (LH.Generator ())  -- ^ 'conversionSpecHaskellFromCppFn'
  -> ConversionSpecHaskell
makeConversionSpecHaskell :: Generator HsType
-> Maybe (Generator HsType)
-> ConversionMethod (Generator ())
-> ConversionMethod (Generator ())
-> ConversionSpecHaskell
makeConversionSpecHaskell Generator HsType
hsType Maybe (Generator HsType)
cType ConversionMethod (Generator ())
toCppFn ConversionMethod (Generator ())
fromCppFn =
  ConversionSpecHaskell
  { conversionSpecHaskellHsType :: Generator HsType
conversionSpecHaskellHsType = Generator HsType
hsType
  , conversionSpecHaskellHsArgType :: Maybe (HsName -> Generator HsQualType)
conversionSpecHaskellHsArgType = Maybe (HsName -> Generator HsQualType)
forall a. Maybe a
Nothing
  , conversionSpecHaskellCType :: Maybe (Generator HsType)
conversionSpecHaskellCType = Maybe (Generator HsType)
cType
  , conversionSpecHaskellToCppFn :: ConversionMethod (Generator ())
conversionSpecHaskellToCppFn = ConversionMethod (Generator ())
toCppFn
  , conversionSpecHaskellFromCppFn :: ConversionMethod (Generator ())
conversionSpecHaskellFromCppFn = ConversionMethod (Generator ())
fromCppFn
  }

-- | Each exception class has a unique exception ID.
newtype ExceptionId = ExceptionId
  { ExceptionId -> Int
getExceptionId :: Int  -- ^ Internal.
  } deriving (ExceptionId -> ExceptionId -> Bool
(ExceptionId -> ExceptionId -> Bool)
-> (ExceptionId -> ExceptionId -> Bool) -> Eq ExceptionId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExceptionId -> ExceptionId -> Bool
== :: ExceptionId -> ExceptionId -> Bool
$c/= :: ExceptionId -> ExceptionId -> Bool
/= :: ExceptionId -> ExceptionId -> Bool
Eq, Int -> ExceptionId -> ShowS
[ExceptionId] -> ShowS
ExceptionId -> HsImportName
(Int -> ExceptionId -> ShowS)
-> (ExceptionId -> HsImportName)
-> ([ExceptionId] -> ShowS)
-> Show ExceptionId
forall a.
(Int -> a -> ShowS)
-> (a -> HsImportName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExceptionId -> ShowS
showsPrec :: Int -> ExceptionId -> ShowS
$cshow :: ExceptionId -> HsImportName
show :: ExceptionId -> HsImportName
$cshowList :: [ExceptionId] -> ShowS
showList :: [ExceptionId] -> ShowS
Show)

-- | The exception ID that represents the catch-all type.
exceptionCatchAllId :: ExceptionId
exceptionCatchAllId :: ExceptionId
exceptionCatchAllId = Int -> ExceptionId
ExceptionId Int
1

-- | The lowest exception ID to be used for classes.
exceptionFirstFreeId :: Int
exceptionFirstFreeId :: Int
exceptionFirstFreeId = ExceptionId -> Int
getExceptionId ExceptionId
exceptionCatchAllId Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

-- | Indicates the ability to handle a certain type of C++ exception.
data ExceptionHandler =
    CatchClass Class
    -- ^ Indicates that instances of the given class are handled (including
    -- derived types).
  | CatchAll
    -- ^ Indicates that all C++ exceptions are handled, i.e. @catch (...)@.
  deriving (ExceptionHandler -> ExceptionHandler -> Bool
(ExceptionHandler -> ExceptionHandler -> Bool)
-> (ExceptionHandler -> ExceptionHandler -> Bool)
-> Eq ExceptionHandler
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExceptionHandler -> ExceptionHandler -> Bool
== :: ExceptionHandler -> ExceptionHandler -> Bool
$c/= :: ExceptionHandler -> ExceptionHandler -> Bool
/= :: ExceptionHandler -> ExceptionHandler -> Bool
Eq, Eq ExceptionHandler
Eq ExceptionHandler =>
(ExceptionHandler -> ExceptionHandler -> Ordering)
-> (ExceptionHandler -> ExceptionHandler -> Bool)
-> (ExceptionHandler -> ExceptionHandler -> Bool)
-> (ExceptionHandler -> ExceptionHandler -> Bool)
-> (ExceptionHandler -> ExceptionHandler -> Bool)
-> (ExceptionHandler -> ExceptionHandler -> ExceptionHandler)
-> (ExceptionHandler -> ExceptionHandler -> ExceptionHandler)
-> Ord ExceptionHandler
ExceptionHandler -> ExceptionHandler -> Bool
ExceptionHandler -> ExceptionHandler -> Ordering
ExceptionHandler -> ExceptionHandler -> ExceptionHandler
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ExceptionHandler -> ExceptionHandler -> Ordering
compare :: ExceptionHandler -> ExceptionHandler -> Ordering
$c< :: ExceptionHandler -> ExceptionHandler -> Bool
< :: ExceptionHandler -> ExceptionHandler -> Bool
$c<= :: ExceptionHandler -> ExceptionHandler -> Bool
<= :: ExceptionHandler -> ExceptionHandler -> Bool
$c> :: ExceptionHandler -> ExceptionHandler -> Bool
> :: ExceptionHandler -> ExceptionHandler -> Bool
$c>= :: ExceptionHandler -> ExceptionHandler -> Bool
>= :: ExceptionHandler -> ExceptionHandler -> Bool
$cmax :: ExceptionHandler -> ExceptionHandler -> ExceptionHandler
max :: ExceptionHandler -> ExceptionHandler -> ExceptionHandler
$cmin :: ExceptionHandler -> ExceptionHandler -> ExceptionHandler
min :: ExceptionHandler -> ExceptionHandler -> ExceptionHandler
Ord)

-- | Represents a list of exception handlers to be used for a body of code.
-- Order is important; a 'CatchAll' will prevent all subsequent handlers from
-- being invoked.
newtype ExceptionHandlers = ExceptionHandlers
  { ExceptionHandlers -> [ExceptionHandler]
exceptionHandlersList :: [ExceptionHandler]
    -- ^ Extracts the list of exception handlers.
  }

instance Sem.Semigroup ExceptionHandlers where
  <> :: ExceptionHandlers -> ExceptionHandlers -> ExceptionHandlers
(<>) ExceptionHandlers
e1 ExceptionHandlers
e2 =
    [ExceptionHandler] -> ExceptionHandlers
ExceptionHandlers ([ExceptionHandler] -> ExceptionHandlers)
-> [ExceptionHandler] -> ExceptionHandlers
forall a b. (a -> b) -> a -> b
$ ExceptionHandlers -> [ExceptionHandler]
exceptionHandlersList ExceptionHandlers
e1 [ExceptionHandler] -> [ExceptionHandler] -> [ExceptionHandler]
forall a. [a] -> [a] -> [a]
++ ExceptionHandlers -> [ExceptionHandler]
exceptionHandlersList ExceptionHandlers
e2

instance Monoid ExceptionHandlers where
  mempty :: ExceptionHandlers
mempty = [ExceptionHandler] -> ExceptionHandlers
ExceptionHandlers []

  mappend :: ExceptionHandlers -> ExceptionHandlers -> ExceptionHandlers
mappend = ExceptionHandlers -> ExceptionHandlers -> ExceptionHandlers
forall a. Semigroup a => a -> a -> a
(<>)

-- | Types that can handle exceptions.
class HandlesExceptions a where
  -- | Extracts the exception handlers for an object.
  getExceptionHandlers :: a -> ExceptionHandlers

  -- | Modifies an object's exception handlers with a given function.
  modifyExceptionHandlers :: (ExceptionHandlers -> ExceptionHandlers) -> a -> a

-- | Appends additional exception handlers to an object.
handleExceptions :: HandlesExceptions a => [ExceptionHandler] -> a -> a
handleExceptions :: forall a. HandlesExceptions a => [ExceptionHandler] -> a -> a
handleExceptions [ExceptionHandler]
classes =
  (ExceptionHandlers -> ExceptionHandlers) -> a -> a
forall a.
HandlesExceptions a =>
(ExceptionHandlers -> ExceptionHandlers) -> a -> a
modifyExceptionHandlers ((ExceptionHandlers -> ExceptionHandlers) -> a -> a)
-> (ExceptionHandlers -> ExceptionHandlers) -> a -> a
forall a b. (a -> b) -> a -> b
$ ExceptionHandlers -> ExceptionHandlers -> ExceptionHandlers
forall a. Monoid a => a -> a -> a
mappend ExceptionHandlers
forall a. Monoid a => a
mempty { exceptionHandlersList = classes }

-- | A literal piece of code that will be inserted into a generated source file
-- after the regular binding glue.  The 'Monoid' instance concatenates code
-- (actions).
newtype Addendum = Addendum
  { Addendum -> Generator ()
addendumHaskell :: LH.Generator ()
    -- ^ Code to be output into the Haskell binding.  May also add imports and
    -- exports.
  }

instance Sem.Semigroup Addendum where
  <> :: Addendum -> Addendum -> Addendum
(<>) (Addendum Generator ()
a) (Addendum Generator ()
b) = Generator () -> Addendum
Addendum (Generator () -> Addendum) -> Generator () -> Addendum
forall a b. (a -> b) -> a -> b
$ Generator ()
a Generator () -> Generator () -> Generator ()
forall a b.
ReaderT Env (WriterT Output (Except HsImportName)) a
-> ReaderT Env (WriterT Output (Except HsImportName)) b
-> ReaderT Env (WriterT Output (Except HsImportName)) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Generator ()
b

instance Monoid Addendum where
  mempty :: Addendum
mempty = Generator () -> Addendum
Addendum (Generator () -> Addendum) -> Generator () -> Addendum
forall a b. (a -> b) -> a -> b
$ () -> Generator ()
forall a. a -> ReaderT Env (WriterT Output (Except HsImportName)) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  mappend :: Addendum -> Addendum -> Addendum
mappend = Addendum -> Addendum -> Addendum
forall a. Semigroup a => a -> a -> a
(<>)

-- | A typeclass for types that have an addendum.
class HasAddendum a where
  {-# MINIMAL getAddendum, (setAddendum | modifyAddendum) #-}

  -- | Returns an object's addendum.
  getAddendum :: a -> Addendum

  -- | Replaces and object's addendum with another.
  setAddendum :: Addendum -> a -> a
  setAddendum Addendum
addendum = (Addendum -> Addendum) -> a -> a
forall a. HasAddendum a => (Addendum -> Addendum) -> a -> a
modifyAddendum ((Addendum -> Addendum) -> a -> a)
-> (Addendum -> Addendum) -> a -> a
forall a b. (a -> b) -> a -> b
$ Addendum -> Addendum -> Addendum
forall a b. a -> b -> a
const Addendum
addendum

  -- | Modified an object's addendum.
  modifyAddendum :: (Addendum -> Addendum) -> a -> a
  modifyAddendum Addendum -> Addendum
f a
x = Addendum -> a -> a
forall a. HasAddendum a => Addendum -> a -> a
setAddendum (Addendum -> Addendum
f (Addendum -> Addendum) -> Addendum -> Addendum
forall a b. (a -> b) -> a -> b
$ a -> Addendum
forall a. HasAddendum a => a -> Addendum
getAddendum a
x) a
x

-- | Adds a Haskell addendum to an object.
addAddendumHaskell :: HasAddendum a => LH.Generator () -> a -> a
addAddendumHaskell :: forall a. HasAddendum a => Generator () -> a -> a
addAddendumHaskell Generator ()
gen = (Addendum -> Addendum) -> a -> a
forall a. HasAddendum a => (Addendum -> Addendum) -> a -> a
modifyAddendum ((Addendum -> Addendum) -> a -> a)
-> (Addendum -> Addendum) -> a -> a
forall a b. (a -> b) -> a -> b
$ \Addendum
addendum ->
  Addendum
addendum Addendum -> Addendum -> Addendum
forall a. Monoid a => a -> a -> a
`mappend` Addendum
forall a. Monoid a => a
mempty { addendumHaskell = gen }

-- | Structural information about a C++ enum.  This is used when Hoppy is
-- evaluating enum data, see 'getExportEnumInfo'.
--
-- See 'Foreign.Hoppy.Generator.Spec.Enum.CppEnum'.
data EnumInfo = EnumInfo
  { EnumInfo -> ExtName
enumInfoExtName :: ExtName
    -- ^ The external name of the enum.
  , EnumInfo -> Identifier
enumInfoIdentifier :: Identifier
    -- ^ The enum's identifier.
  , EnumInfo -> Maybe Type
enumInfoNumericType :: Maybe Type
    -- ^ The enum's numeric type, if explicitly known to the bindings.  This
    -- does not need to be provided.  If absent, then Hoppy will calculate the
    -- enum's numeric type on its own, using a C++ compiler.  If this is present
    -- however, Hoppy will use it, and additionally validate it against what the
    -- C++ compiler thinks, if validation is enabled (see
    -- 'interfaceValidateEnumTypes').
  , EnumInfo -> Reqs
enumInfoReqs :: Reqs
    -- ^ Requirements for accessing the enum.
  , EnumInfo -> Scoped
enumInfoScoped :: Scoped
    -- ^ Whether the enum is scoped or unscoped.
  , EnumInfo -> EnumValueMap
enumInfoValues :: EnumValueMap
    -- ^ The entries in the enum.
  }

-- | A list of words that comprise the name of an enum entry.  Each string in
-- this list is treated as a distinct word for the purpose of performing case
-- conversion to create identifiers in foreign languages.  These values are most
-- easily created from a C++ identifier using
-- 'Foreign.Hoppy.Generator.Util.splitIntoWords'.
type EnumEntryWords = [String]

-- | Describes the entries in a C++ enum.
--
-- Equality is defined as having the same 'enumValueMapValues'.
data EnumValueMap = EnumValueMap
  { EnumValueMap -> [[HsImportName]]
enumValueMapNames :: [EnumEntryWords]
    -- ^ The names of all entries in the enum being generated, in the order
    -- specified by the enum definition.  These are the strings used to name
    -- generated bindings.  Each name is broken up into words.  How the words
    -- and get combined to make a name in a particular foreign language depends
    -- on the language.
  , EnumValueMap
-> MapWithForeignLanguageOverrides [HsImportName] [HsImportName]
enumValueMapForeignNames :: MapWithForeignLanguageOverrides EnumEntryWords EnumEntryWords
    -- ^ Per-language renames of enum value entries.
  , EnumValueMap -> Map [HsImportName] EnumValue
enumValueMapValues :: M.Map EnumEntryWords EnumValue
    -- ^ A map specifying for each entry in 'enumValueMapNames', how to
    -- determine the entry's numeric value.
  }

instance Eq EnumValueMap where
  == :: EnumValueMap -> EnumValueMap -> Bool
(==) = Map [HsImportName] EnumValue
-> Map [HsImportName] EnumValue -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Map [HsImportName] EnumValue
 -> Map [HsImportName] EnumValue -> Bool)
-> (EnumValueMap -> Map [HsImportName] EnumValue)
-> EnumValueMap
-> EnumValueMap
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` EnumValueMap -> Map [HsImportName] EnumValue
enumValueMapValues

instance Show EnumValueMap where
  show :: EnumValueMap -> HsImportName
show EnumValueMap
x = HsImportName
"<EnumValueMap values=" HsImportName -> ShowS
forall a. [a] -> [a] -> [a]
++ Map [HsImportName] EnumValue -> HsImportName
forall a. Show a => a -> HsImportName
show (EnumValueMap -> Map [HsImportName] EnumValue
enumValueMapValues EnumValueMap
x) HsImportName -> ShowS
forall a. [a] -> [a] -> [a]
++ HsImportName
">"

-- | Describes the value of an entry in a C++ enum.  A numeric value may either
-- be provided manually, or if omitted, Hoppy can determine it automatically.
data EnumValue =
    EnumValueManual Integer
    -- ^ A manually specified numeric enum value.
  | EnumValueAuto Identifier
    -- ^ A numeric enum value that will be determined when the generator is run,
    -- by means of compiling a C++ program.
  deriving (EnumValue -> EnumValue -> Bool
(EnumValue -> EnumValue -> Bool)
-> (EnumValue -> EnumValue -> Bool) -> Eq EnumValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EnumValue -> EnumValue -> Bool
== :: EnumValue -> EnumValue -> Bool
$c/= :: EnumValue -> EnumValue -> Bool
/= :: EnumValue -> EnumValue -> Bool
Eq, Int -> EnumValue -> ShowS
[EnumValue] -> ShowS
EnumValue -> HsImportName
(Int -> EnumValue -> ShowS)
-> (EnumValue -> HsImportName)
-> ([EnumValue] -> ShowS)
-> Show EnumValue
forall a.
(Int -> a -> ShowS)
-> (a -> HsImportName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EnumValue -> ShowS
showsPrec :: Int -> EnumValue -> ShowS
$cshow :: EnumValue -> HsImportName
show :: EnumValue -> HsImportName
$cshowList :: [EnumValue] -> ShowS
showList :: [EnumValue] -> ShowS
Show)

-- | Languages that Hoppy supports binding to.  Currently this is only Haskell.
data ForeignLanguage =
  Haskell  -- ^ The Haskell language.
  deriving (ForeignLanguage -> ForeignLanguage -> Bool
(ForeignLanguage -> ForeignLanguage -> Bool)
-> (ForeignLanguage -> ForeignLanguage -> Bool)
-> Eq ForeignLanguage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ForeignLanguage -> ForeignLanguage -> Bool
== :: ForeignLanguage -> ForeignLanguage -> Bool
$c/= :: ForeignLanguage -> ForeignLanguage -> Bool
/= :: ForeignLanguage -> ForeignLanguage -> Bool
Eq, Eq ForeignLanguage
Eq ForeignLanguage =>
(ForeignLanguage -> ForeignLanguage -> Ordering)
-> (ForeignLanguage -> ForeignLanguage -> Bool)
-> (ForeignLanguage -> ForeignLanguage -> Bool)
-> (ForeignLanguage -> ForeignLanguage -> Bool)
-> (ForeignLanguage -> ForeignLanguage -> Bool)
-> (ForeignLanguage -> ForeignLanguage -> ForeignLanguage)
-> (ForeignLanguage -> ForeignLanguage -> ForeignLanguage)
-> Ord ForeignLanguage
ForeignLanguage -> ForeignLanguage -> Bool
ForeignLanguage -> ForeignLanguage -> Ordering
ForeignLanguage -> ForeignLanguage -> ForeignLanguage
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ForeignLanguage -> ForeignLanguage -> Ordering
compare :: ForeignLanguage -> ForeignLanguage -> Ordering
$c< :: ForeignLanguage -> ForeignLanguage -> Bool
< :: ForeignLanguage -> ForeignLanguage -> Bool
$c<= :: ForeignLanguage -> ForeignLanguage -> Bool
<= :: ForeignLanguage -> ForeignLanguage -> Bool
$c> :: ForeignLanguage -> ForeignLanguage -> Bool
> :: ForeignLanguage -> ForeignLanguage -> Bool
$c>= :: ForeignLanguage -> ForeignLanguage -> Bool
>= :: ForeignLanguage -> ForeignLanguage -> Bool
$cmax :: ForeignLanguage -> ForeignLanguage -> ForeignLanguage
max :: ForeignLanguage -> ForeignLanguage -> ForeignLanguage
$cmin :: ForeignLanguage -> ForeignLanguage -> ForeignLanguage
min :: ForeignLanguage -> ForeignLanguage -> ForeignLanguage
Ord, Int -> ForeignLanguage -> ShowS
[ForeignLanguage] -> ShowS
ForeignLanguage -> HsImportName
(Int -> ForeignLanguage -> ShowS)
-> (ForeignLanguage -> HsImportName)
-> ([ForeignLanguage] -> ShowS)
-> Show ForeignLanguage
forall a.
(Int -> a -> ShowS)
-> (a -> HsImportName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ForeignLanguage -> ShowS
showsPrec :: Int -> ForeignLanguage -> ShowS
$cshow :: ForeignLanguage -> HsImportName
show :: ForeignLanguage -> HsImportName
$cshowList :: [ForeignLanguage] -> ShowS
showList :: [ForeignLanguage] -> ShowS
Show)

-- | A value that may be overridden based on a 'ForeignLanguage'.
type WithForeignLanguageOverrides = WithOverrides ForeignLanguage

-- | A map whose values may be overridden based on a 'ForeignLanguage'.
type MapWithForeignLanguageOverrides = MapWithOverrides ForeignLanguage

-- | A collection of imports for a Haskell module.  This is a monoid: import
-- Statements are merged to give the union of imported bindings.
--
-- This structure supports two specific types of imports:
--     - @import Foo (...)@
--     - @import qualified Foo as Bar@
-- Imports with @as@ but without @qualified@, and @qualified@ imports with a
-- spec list, are not supported.  This satisfies the needs of the code
-- generator, and keeps the merging logic simple.
data HsImportSet = HsImportSet
  { HsImportSet -> Map HsImportKey HsImportSpecs
getHsImportSet :: M.Map HsImportKey HsImportSpecs
    -- ^ Returns the import set's internal map from module names to imported
    -- bindings.
  } deriving (Int -> HsImportSet -> ShowS
[HsImportSet] -> ShowS
HsImportSet -> HsImportName
(Int -> HsImportSet -> ShowS)
-> (HsImportSet -> HsImportName)
-> ([HsImportSet] -> ShowS)
-> Show HsImportSet
forall a.
(Int -> a -> ShowS)
-> (a -> HsImportName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HsImportSet -> ShowS
showsPrec :: Int -> HsImportSet -> ShowS
$cshow :: HsImportSet -> HsImportName
show :: HsImportSet -> HsImportName
$cshowList :: [HsImportSet] -> ShowS
showList :: [HsImportSet] -> ShowS
Show)

-- TODO Make HsImportSet back into a newtype when it doesn't involve listing out
-- its contents recursively in Base.hs-boot.

instance Sem.Semigroup HsImportSet where
  <> :: HsImportSet -> HsImportSet -> HsImportSet
(<>) (HsImportSet Map HsImportKey HsImportSpecs
m) (HsImportSet Map HsImportKey HsImportSpecs
m') =
    Map HsImportKey HsImportSpecs -> HsImportSet
HsImportSet (Map HsImportKey HsImportSpecs -> HsImportSet)
-> Map HsImportKey HsImportSpecs -> HsImportSet
forall a b. (a -> b) -> a -> b
$ (HsImportSpecs -> HsImportSpecs -> HsImportSpecs)
-> Map HsImportKey HsImportSpecs
-> Map HsImportKey HsImportSpecs
-> Map HsImportKey HsImportSpecs
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith HsImportSpecs -> HsImportSpecs -> HsImportSpecs
mergeImportSpecs Map HsImportKey HsImportSpecs
m Map HsImportKey HsImportSpecs
m'

instance Monoid HsImportSet where
  mempty :: HsImportSet
mempty = Map HsImportKey HsImportSpecs -> HsImportSet
HsImportSet Map HsImportKey HsImportSpecs
forall k a. Map k a
M.empty

  mappend :: HsImportSet -> HsImportSet -> HsImportSet
mappend = HsImportSet -> HsImportSet -> HsImportSet
forall a. Semigroup a => a -> a -> a
(<>)

  mconcat :: [HsImportSet] -> HsImportSet
mconcat [HsImportSet]
sets =
    Map HsImportKey HsImportSpecs -> HsImportSet
HsImportSet (Map HsImportKey HsImportSpecs -> HsImportSet)
-> Map HsImportKey HsImportSpecs -> HsImportSet
forall a b. (a -> b) -> a -> b
$ (HsImportSpecs -> HsImportSpecs -> HsImportSpecs)
-> [Map HsImportKey HsImportSpecs] -> Map HsImportKey HsImportSpecs
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
M.unionsWith HsImportSpecs -> HsImportSpecs -> HsImportSpecs
mergeImportSpecs ([Map HsImportKey HsImportSpecs] -> Map HsImportKey HsImportSpecs)
-> [Map HsImportKey HsImportSpecs] -> Map HsImportKey HsImportSpecs
forall a b. (a -> b) -> a -> b
$ (HsImportSet -> Map HsImportKey HsImportSpecs)
-> [HsImportSet] -> [Map HsImportKey HsImportSpecs]
forall a b. (a -> b) -> [a] -> [b]
map HsImportSet -> Map HsImportKey HsImportSpecs
getHsImportSet [HsImportSet]
sets

-- | Constructor for an import set.
makeHsImportSet :: M.Map HsImportKey HsImportSpecs -> HsImportSet
makeHsImportSet :: Map HsImportKey HsImportSpecs -> HsImportSet
makeHsImportSet = Map HsImportKey HsImportSpecs -> HsImportSet
HsImportSet

-- | Sets all of the import specifications in an import set to be
-- @{-#SOURCE#-}@ imports.
hsImportSetMakeSource :: HsImportSet -> HsImportSet
hsImportSetMakeSource :: HsImportSet -> HsImportSet
hsImportSetMakeSource (HsImportSet Map HsImportKey HsImportSpecs
m) =
  Map HsImportKey HsImportSpecs -> HsImportSet
HsImportSet (Map HsImportKey HsImportSpecs -> HsImportSet)
-> Map HsImportKey HsImportSpecs -> HsImportSet
forall a b. (a -> b) -> a -> b
$ (HsImportSpecs -> HsImportSpecs)
-> Map HsImportKey HsImportSpecs -> Map HsImportKey HsImportSpecs
forall a b k. (a -> b) -> Map k a -> Map k b
M.map (\HsImportSpecs
specs -> HsImportSpecs
specs { hsImportSource = True }) Map HsImportKey HsImportSpecs
m

-- | A Haskell module name.
type HsModuleName = String

-- | References an occurrence of an import statement, under which bindings can
-- be imported.  Only imported specs under equal 'HsImportKey's may be merged.
data HsImportKey = HsImportKey
  { HsImportKey -> HsImportName
hsImportModule :: HsModuleName
  , HsImportKey -> Maybe HsImportName
hsImportQualifiedName :: Maybe HsModuleName
  } deriving (HsImportKey -> HsImportKey -> Bool
(HsImportKey -> HsImportKey -> Bool)
-> (HsImportKey -> HsImportKey -> Bool) -> Eq HsImportKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HsImportKey -> HsImportKey -> Bool
== :: HsImportKey -> HsImportKey -> Bool
$c/= :: HsImportKey -> HsImportKey -> Bool
/= :: HsImportKey -> HsImportKey -> Bool
Eq, Eq HsImportKey
Eq HsImportKey =>
(HsImportKey -> HsImportKey -> Ordering)
-> (HsImportKey -> HsImportKey -> Bool)
-> (HsImportKey -> HsImportKey -> Bool)
-> (HsImportKey -> HsImportKey -> Bool)
-> (HsImportKey -> HsImportKey -> Bool)
-> (HsImportKey -> HsImportKey -> HsImportKey)
-> (HsImportKey -> HsImportKey -> HsImportKey)
-> Ord HsImportKey
HsImportKey -> HsImportKey -> Bool
HsImportKey -> HsImportKey -> Ordering
HsImportKey -> HsImportKey -> HsImportKey
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: HsImportKey -> HsImportKey -> Ordering
compare :: HsImportKey -> HsImportKey -> Ordering
$c< :: HsImportKey -> HsImportKey -> Bool
< :: HsImportKey -> HsImportKey -> Bool
$c<= :: HsImportKey -> HsImportKey -> Bool
<= :: HsImportKey -> HsImportKey -> Bool
$c> :: HsImportKey -> HsImportKey -> Bool
> :: HsImportKey -> HsImportKey -> Bool
$c>= :: HsImportKey -> HsImportKey -> Bool
>= :: HsImportKey -> HsImportKey -> Bool
$cmax :: HsImportKey -> HsImportKey -> HsImportKey
max :: HsImportKey -> HsImportKey -> HsImportKey
$cmin :: HsImportKey -> HsImportKey -> HsImportKey
min :: HsImportKey -> HsImportKey -> HsImportKey
Ord, Int -> HsImportKey -> ShowS
[HsImportKey] -> ShowS
HsImportKey -> HsImportName
(Int -> HsImportKey -> ShowS)
-> (HsImportKey -> HsImportName)
-> ([HsImportKey] -> ShowS)
-> Show HsImportKey
forall a.
(Int -> a -> ShowS)
-> (a -> HsImportName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HsImportKey -> ShowS
showsPrec :: Int -> HsImportKey -> ShowS
$cshow :: HsImportKey -> HsImportName
show :: HsImportKey -> HsImportName
$cshowList :: [HsImportKey] -> ShowS
showList :: [HsImportKey] -> ShowS
Show)

-- | A specification of bindings to import from a module.  If 'Nothing', then
-- the entire module is imported.  If @'Just' 'M.empty'@, then only instances
-- are imported.
data HsImportSpecs = HsImportSpecs
  { HsImportSpecs -> Maybe (Map HsImportName HsImportVal)
getHsImportSpecs :: Maybe (M.Map HsImportName HsImportVal)
  , HsImportSpecs -> Bool
hsImportSource :: Bool
  } deriving (Int -> HsImportSpecs -> ShowS
[HsImportSpecs] -> ShowS
HsImportSpecs -> HsImportName
(Int -> HsImportSpecs -> ShowS)
-> (HsImportSpecs -> HsImportName)
-> ([HsImportSpecs] -> ShowS)
-> Show HsImportSpecs
forall a.
(Int -> a -> ShowS)
-> (a -> HsImportName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HsImportSpecs -> ShowS
showsPrec :: Int -> HsImportSpecs -> ShowS
$cshow :: HsImportSpecs -> HsImportName
show :: HsImportSpecs -> HsImportName
$cshowList :: [HsImportSpecs] -> ShowS
showList :: [HsImportSpecs] -> ShowS
Show)

-- | Combines two 'HsImportSpecs's into one that imports everything that the two
-- did separately.
mergeImportSpecs :: HsImportSpecs -> HsImportSpecs -> HsImportSpecs
mergeImportSpecs :: HsImportSpecs -> HsImportSpecs -> HsImportSpecs
mergeImportSpecs (HsImportSpecs Maybe (Map HsImportName HsImportVal)
mm Bool
s) (HsImportSpecs Maybe (Map HsImportName HsImportVal)
mm' Bool
s') =
  Maybe (Map HsImportName HsImportVal) -> Bool -> HsImportSpecs
HsImportSpecs ((Map HsImportName HsImportVal
 -> Map HsImportName HsImportVal -> Map HsImportName HsImportVal)
-> Maybe (Map HsImportName HsImportVal)
-> Maybe (Map HsImportName HsImportVal)
-> Maybe (Map HsImportName HsImportVal)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Map HsImportName HsImportVal
-> Map HsImportName HsImportVal -> Map HsImportName HsImportVal
mergeMaps Maybe (Map HsImportName HsImportVal)
mm Maybe (Map HsImportName HsImportVal)
mm') (Bool
s Bool -> Bool -> Bool
|| Bool
s')
  where mergeMaps :: Map HsImportName HsImportVal
-> Map HsImportName HsImportVal -> Map HsImportName HsImportVal
mergeMaps = (HsImportVal -> HsImportVal -> HsImportVal)
-> Map HsImportName HsImportVal
-> Map HsImportName HsImportVal
-> Map HsImportName HsImportVal
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith HsImportVal -> HsImportVal -> HsImportVal
mergeValues
        mergeValues :: HsImportVal -> HsImportVal -> HsImportVal
mergeValues HsImportVal
v HsImportVal
v' = case (HsImportVal
v, HsImportVal
v') of
          (HsImportVal
HsImportValAll, HsImportVal
_) -> HsImportVal
HsImportValAll
          (HsImportVal
_, HsImportVal
HsImportValAll) -> HsImportVal
HsImportValAll
          (HsImportValSome [HsImportName]
x, HsImportValSome [HsImportName]
x') -> [HsImportName] -> HsImportVal
HsImportValSome ([HsImportName] -> HsImportVal) -> [HsImportName] -> HsImportVal
forall a b. (a -> b) -> a -> b
$ [HsImportName]
x [HsImportName] -> [HsImportName] -> [HsImportName]
forall a. [a] -> [a] -> [a]
++ [HsImportName]
x'
          (x :: HsImportVal
x@(HsImportValSome [HsImportName]
_), HsImportVal
_) -> HsImportVal
x
          (HsImportVal
_, x :: HsImportVal
x@(HsImportValSome [HsImportName]
_)) -> HsImportVal
x
          (HsImportVal
HsImportVal, HsImportVal
HsImportVal) -> HsImportVal
HsImportVal

-- | An identifier that can be imported from a module.  Symbols may be used here
-- when surrounded by parentheses.  Examples are @\"fmap\"@ and @\"(++)\"@.
type HsImportName = String

-- | Specifies how a name is imported.
data HsImportVal =
  HsImportVal
  -- ^ The name is imported, and nothing underneath it is.
  | HsImportValSome [HsImportName]
    -- ^ The name is imported, as are specific names underneath it.  This is a
    -- @X (a, b, c)@ import.
  | HsImportValAll
    -- ^ The name is imported, along with all names underneath it.  This is a @X
    -- (..)@ import.
  deriving (Int -> HsImportVal -> ShowS
[HsImportVal] -> ShowS
HsImportVal -> HsImportName
(Int -> HsImportVal -> ShowS)
-> (HsImportVal -> HsImportName)
-> ([HsImportVal] -> ShowS)
-> Show HsImportVal
forall a.
(Int -> a -> ShowS)
-> (a -> HsImportName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HsImportVal -> ShowS
showsPrec :: Int -> HsImportVal -> ShowS
$cshow :: HsImportVal -> HsImportName
show :: HsImportVal -> HsImportName
$cshowList :: [HsImportVal] -> ShowS
showList :: [HsImportVal] -> ShowS
Show)

-- | An import for the entire contents of a Haskell module.
hsWholeModuleImport :: HsModuleName -> HsImportSet
hsWholeModuleImport :: HsImportName -> HsImportSet
hsWholeModuleImport HsImportName
modName =
  Map HsImportKey HsImportSpecs -> HsImportSet
HsImportSet (Map HsImportKey HsImportSpecs -> HsImportSet)
-> Map HsImportKey HsImportSpecs -> HsImportSet
forall a b. (a -> b) -> a -> b
$ HsImportKey -> HsImportSpecs -> Map HsImportKey HsImportSpecs
forall k a. k -> a -> Map k a
M.singleton (HsImportName -> Maybe HsImportName -> HsImportKey
HsImportKey HsImportName
modName Maybe HsImportName
forall a. Maybe a
Nothing) (HsImportSpecs -> Map HsImportKey HsImportSpecs)
-> HsImportSpecs -> Map HsImportKey HsImportSpecs
forall a b. (a -> b) -> a -> b
$
  Maybe (Map HsImportName HsImportVal) -> Bool -> HsImportSpecs
HsImportSpecs Maybe (Map HsImportName HsImportVal)
forall a. Maybe a
Nothing Bool
False

-- | A qualified import of a Haskell module.
hsQualifiedImport :: HsModuleName -> HsModuleName -> HsImportSet
hsQualifiedImport :: HsImportName -> HsImportName -> HsImportSet
hsQualifiedImport HsImportName
modName HsImportName
qualifiedName =
  Map HsImportKey HsImportSpecs -> HsImportSet
HsImportSet (Map HsImportKey HsImportSpecs -> HsImportSet)
-> Map HsImportKey HsImportSpecs -> HsImportSet
forall a b. (a -> b) -> a -> b
$ HsImportKey -> HsImportSpecs -> Map HsImportKey HsImportSpecs
forall k a. k -> a -> Map k a
M.singleton (HsImportName -> Maybe HsImportName -> HsImportKey
HsImportKey HsImportName
modName (Maybe HsImportName -> HsImportKey)
-> Maybe HsImportName -> HsImportKey
forall a b. (a -> b) -> a -> b
$ HsImportName -> Maybe HsImportName
forall a. a -> Maybe a
Just HsImportName
qualifiedName) (HsImportSpecs -> Map HsImportKey HsImportSpecs)
-> HsImportSpecs -> Map HsImportKey HsImportSpecs
forall a b. (a -> b) -> a -> b
$
  Maybe (Map HsImportName HsImportVal) -> Bool -> HsImportSpecs
HsImportSpecs Maybe (Map HsImportName HsImportVal)
forall a. Maybe a
Nothing Bool
False

-- | An import of a single name from a Haskell module.
hsImport1 :: HsModuleName -> HsImportName -> HsImportSet
hsImport1 :: HsImportName -> HsImportName -> HsImportSet
hsImport1 HsImportName
modName HsImportName
valueName = HsImportName -> HsImportName -> HsImportVal -> HsImportSet
hsImport1' HsImportName
modName HsImportName
valueName HsImportVal
HsImportVal

-- | A detailed import of a single name from a Haskell module.
hsImport1' :: HsModuleName -> HsImportName -> HsImportVal -> HsImportSet
hsImport1' :: HsImportName -> HsImportName -> HsImportVal -> HsImportSet
hsImport1' HsImportName
modName HsImportName
valueName HsImportVal
valueType =
  Map HsImportKey HsImportSpecs -> HsImportSet
HsImportSet (Map HsImportKey HsImportSpecs -> HsImportSet)
-> Map HsImportKey HsImportSpecs -> HsImportSet
forall a b. (a -> b) -> a -> b
$ HsImportKey -> HsImportSpecs -> Map HsImportKey HsImportSpecs
forall k a. k -> a -> Map k a
M.singleton (HsImportName -> Maybe HsImportName -> HsImportKey
HsImportKey HsImportName
modName Maybe HsImportName
forall a. Maybe a
Nothing) (HsImportSpecs -> Map HsImportKey HsImportSpecs)
-> HsImportSpecs -> Map HsImportKey HsImportSpecs
forall a b. (a -> b) -> a -> b
$
  Maybe (Map HsImportName HsImportVal) -> Bool -> HsImportSpecs
HsImportSpecs (Map HsImportName HsImportVal
-> Maybe (Map HsImportName HsImportVal)
forall a. a -> Maybe a
Just (Map HsImportName HsImportVal
 -> Maybe (Map HsImportName HsImportVal))
-> Map HsImportName HsImportVal
-> Maybe (Map HsImportName HsImportVal)
forall a b. (a -> b) -> a -> b
$ HsImportName -> HsImportVal -> Map HsImportName HsImportVal
forall k a. k -> a -> Map k a
M.singleton HsImportName
valueName HsImportVal
valueType) Bool
False

-- | An import of multiple names from a Haskell module.
hsImports :: HsModuleName -> [HsImportName] -> HsImportSet
hsImports :: HsImportName -> [HsImportName] -> HsImportSet
hsImports HsImportName
modName [HsImportName]
names =
  HsImportName -> [(HsImportName, HsImportVal)] -> HsImportSet
hsImports' HsImportName
modName ([(HsImportName, HsImportVal)] -> HsImportSet)
-> [(HsImportName, HsImportVal)] -> HsImportSet
forall a b. (a -> b) -> a -> b
$ (HsImportName -> (HsImportName, HsImportVal))
-> [HsImportName] -> [(HsImportName, HsImportVal)]
forall a b. (a -> b) -> [a] -> [b]
map (\HsImportName
name -> (HsImportName
name, HsImportVal
HsImportVal)) [HsImportName]
names

-- | A detailed import of multiple names from a Haskell module.
hsImports' :: HsModuleName -> [(HsImportName, HsImportVal)] -> HsImportSet
hsImports' :: HsImportName -> [(HsImportName, HsImportVal)] -> HsImportSet
hsImports' HsImportName
modName [(HsImportName, HsImportVal)]
values =
  Map HsImportKey HsImportSpecs -> HsImportSet
HsImportSet (Map HsImportKey HsImportSpecs -> HsImportSet)
-> Map HsImportKey HsImportSpecs -> HsImportSet
forall a b. (a -> b) -> a -> b
$ HsImportKey -> HsImportSpecs -> Map HsImportKey HsImportSpecs
forall k a. k -> a -> Map k a
M.singleton (HsImportName -> Maybe HsImportName -> HsImportKey
HsImportKey HsImportName
modName Maybe HsImportName
forall a. Maybe a
Nothing) (HsImportSpecs -> Map HsImportKey HsImportSpecs)
-> HsImportSpecs -> Map HsImportKey HsImportSpecs
forall a b. (a -> b) -> a -> b
$
  Maybe (Map HsImportName HsImportVal) -> Bool -> HsImportSpecs
HsImportSpecs (Map HsImportName HsImportVal
-> Maybe (Map HsImportName HsImportVal)
forall a. a -> Maybe a
Just (Map HsImportName HsImportVal
 -> Maybe (Map HsImportName HsImportVal))
-> Map HsImportName HsImportVal
-> Maybe (Map HsImportName HsImportVal)
forall a b. (a -> b) -> a -> b
$ [(HsImportName, HsImportVal)] -> Map HsImportName HsImportVal
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(HsImportName, HsImportVal)]
values) Bool
False

-- | Imports "Data.Bits" qualified as @HoppyDB@.
hsImportForBits :: HsImportSet
hsImportForBits :: HsImportSet
hsImportForBits = HsImportName -> HsImportName -> HsImportSet
hsQualifiedImport HsImportName
"Data.Bits" HsImportName
"HoppyDB"

-- | Imports "Control.Exception" qualified as @HoppyCE@.
hsImportForException :: HsImportSet
hsImportForException :: HsImportSet
hsImportForException = HsImportName -> HsImportName -> HsImportSet
hsQualifiedImport HsImportName
"Control.Exception" HsImportName
"HoppyCE"

-- | Imports "Data.Int" qualified as @HoppyDI@.
hsImportForInt :: HsImportSet
hsImportForInt :: HsImportSet
hsImportForInt = HsImportName -> HsImportName -> HsImportSet
hsQualifiedImport HsImportName
"Data.Int" HsImportName
"HoppyDI"

-- | Imports "Data.Word" qualified as @HoppyDW@.
hsImportForWord :: HsImportSet
hsImportForWord :: HsImportSet
hsImportForWord = HsImportName -> HsImportName -> HsImportSet
hsQualifiedImport HsImportName
"Data.Word" HsImportName
"HoppyDW"

-- | Imports "Foreign" qualified as @HoppyF@.
hsImportForForeign :: HsImportSet
hsImportForForeign :: HsImportSet
hsImportForForeign = HsImportName -> HsImportName -> HsImportSet
hsQualifiedImport HsImportName
"Foreign" HsImportName
"HoppyF"

-- | Imports "Foreign.C" qualified as @HoppyFC@.
hsImportForForeignC :: HsImportSet
hsImportForForeignC :: HsImportSet
hsImportForForeignC = HsImportName -> HsImportName -> HsImportSet
hsQualifiedImport HsImportName
"Foreign.C" HsImportName
"HoppyFC"

-- | Imports "Data.Map" qualified as @HoppyDM@.
hsImportForMap :: HsImportSet
hsImportForMap :: HsImportSet
hsImportForMap = HsImportName -> HsImportName -> HsImportSet
hsQualifiedImport HsImportName
"Data.Map" HsImportName
"HoppyDM"

-- | Imports "Prelude" qualified as @HoppyP@.
hsImportForPrelude :: HsImportSet
hsImportForPrelude :: HsImportSet
hsImportForPrelude = HsImportName -> HsImportName -> HsImportSet
hsQualifiedImport HsImportName
"Prelude" HsImportName
"HoppyP"

-- | Imports "Foreign.Hoppy.Runtime" qualified as @HoppyFHR@.
hsImportForRuntime :: HsImportSet
hsImportForRuntime :: HsImportSet
hsImportForRuntime = HsImportName -> HsImportName -> HsImportSet
hsQualifiedImport HsImportName
"Foreign.Hoppy.Runtime" HsImportName
"HoppyFHR"

-- | Imports "System.Posix.Types" qualified as @HoppySPT@.
hsImportForSystemPosixTypes :: HsImportSet
hsImportForSystemPosixTypes :: HsImportSet
hsImportForSystemPosixTypes = HsImportName -> HsImportName -> HsImportSet
hsQualifiedImport HsImportName
"System.Posix.Types" HsImportName
"HoppySPT"

-- | Imports "System.IO.Unsafe" qualified as @HoppySIU@.
hsImportForUnsafeIO :: HsImportSet
hsImportForUnsafeIO :: HsImportSet
hsImportForUnsafeIO = HsImportName -> HsImportName -> HsImportSet
hsQualifiedImport HsImportName
"System.IO.Unsafe" HsImportName
"HoppySIU"

-- | Returns an error message indicating that
-- 'Foreign.Hoppy.Generator.Types.objToHeapT' is used where data is going from a
-- foreign language into C++.
objToHeapTWrongDirectionErrorMsg :: Maybe String -> Class -> String
objToHeapTWrongDirectionErrorMsg :: Maybe HsImportName -> Class -> HsImportName
objToHeapTWrongDirectionErrorMsg Maybe HsImportName
maybeCaller Class
cls =
  [HsImportName] -> HsImportName
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [HsImportName -> ShowS -> Maybe HsImportName -> HsImportName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe HsImportName
"" (HsImportName -> ShowS
forall a. [a] -> [a] -> [a]
++ HsImportName
": ") Maybe HsImportName
maybeCaller,
          HsImportName
"(TObjToHeap ", Class -> HsImportName
forall a. Show a => a -> HsImportName
show Class
cls, HsImportName
") cannot be passed into C++",
          HsImportName -> ShowS -> Maybe HsImportName -> HsImportName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe HsImportName
"" (HsImportName -> ShowS
forall a b. a -> b -> a
const HsImportName
".") Maybe HsImportName
maybeCaller]

-- | Returns an error message indicating that
-- 'Foreign.Hoppy.Generator.Types.objToHeapT' is used where data is going from a
-- foreign language into C++.
tToGcInvalidFormErrorMessage :: Maybe String -> Type -> String
tToGcInvalidFormErrorMessage :: Maybe HsImportName -> Type -> HsImportName
tToGcInvalidFormErrorMessage Maybe HsImportName
maybeCaller Type
typeArg =
  [HsImportName] -> HsImportName
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [HsImportName -> ShowS -> Maybe HsImportName -> HsImportName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe HsImportName
"" (HsImportName -> ShowS
forall a. [a] -> [a] -> [a]
++ HsImportName
": ") Maybe HsImportName
maybeCaller,
          HsImportName
"(", Type -> HsImportName
forall a. Show a => a -> HsImportName
show (Type -> Type
Internal_TToGc Type
typeArg), HsImportName
") is an invalid form for TToGc.",
          HsImportName -> ShowS -> Maybe HsImportName -> HsImportName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe HsImportName
"" (HsImportName -> ShowS
forall a b. a -> b -> a
const HsImportName
".") Maybe HsImportName
maybeCaller]

-- | Returns an error message indicating that
-- 'Foreign.Hoppy.Generator.Types.toGcT' is used where data is going from a
-- foreign language into C++.
toGcTWrongDirectionErrorMsg :: Maybe String -> Type -> String
toGcTWrongDirectionErrorMsg :: Maybe HsImportName -> Type -> HsImportName
toGcTWrongDirectionErrorMsg Maybe HsImportName
maybeCaller Type
typeArg =
  [HsImportName] -> HsImportName
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [HsImportName -> ShowS -> Maybe HsImportName -> HsImportName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe HsImportName
"" (HsImportName -> ShowS
forall a. [a] -> [a] -> [a]
++ HsImportName
": ") Maybe HsImportName
maybeCaller,
          HsImportName
"(", Type -> HsImportName
forall a. Show a => a -> HsImportName
show (Type -> Type
Internal_TToGc Type
typeArg), HsImportName
") cannot be passed into C++",
          HsImportName -> ShowS -> Maybe HsImportName -> HsImportName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe HsImportName
"" (HsImportName -> ShowS
forall a b. a -> b -> a
const HsImportName
".") Maybe HsImportName
maybeCaller]