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

-- | Concrete C++ types.  It is possible to represent invalid C++ types with
-- these functions, but we try to catch these and fail cleanly as much as
-- possible.
module Foreign.Hoppy.Generator.Types (
  -- * Qualifiers
  constT,
  -- * Primtive types
  voidT,
  ptrT,
  refT,
  fnT,
  fnT',
  -- * Numeric types
  boolT,
  boolT',
  charT,
  ucharT,
  wcharT,
  shortT,
  ushortT,
  intT,
  intT',
  uintT,
  longT,
  ulongT,
  llongT,
  ullongT,
  floatT,
  floatT',
  doubleT,
  doubleT',
  int8T,
  int16T,
  int32T,
  int64T,
  word8T,
  word16T,
  word32T,
  word64T,
  ptrdiffT,
  sizeT,
  ssizeT,
  -- ** Custom numeric types
  makeNumericType,
  convertByCoercingIntegral,
  convertByCoercingFloating,
  -- * Complex types
  manualT,
  callbackT,
  enumT,
  objT,
  objToHeapT,
  toGcT,
  ) where

import {-# SOURCE #-} qualified Foreign.Hoppy.Generator.Language.Haskell as LH
import {-# SOURCE #-} Foreign.Hoppy.Generator.Spec.Callback (callbackT)
import {-# SOURCE #-} Foreign.Hoppy.Generator.Spec.Class (Class)
import {-# SOURCE #-} Foreign.Hoppy.Generator.Spec.Enum (enumT)
import {-# SOURCE #-} Foreign.Hoppy.Generator.Spec.Function (fnT, fnT')
import Foreign.Hoppy.Generator.Spec.Base
import Language.Haskell.Syntax (
  HsName (HsIdent),
  HsQName (UnQual),
  HsType (HsTyCon),
  )

-- | C++ @void@, Haskell @()@.
voidT :: Type
voidT :: Type
voidT = Type
Internal_TVoid

-- | C++ @bool@, Haskell 'Bool'.
--
-- C++ has sizeof(bool) == 1, whereas Haskell can > 1, so we have to convert.
boolT :: Type
boolT :: Type
boolT =
  String
-> Reqs
-> Generator HsType
-> Maybe (Generator HsType)
-> ConversionMethod (Generator ())
-> ConversionMethod (Generator ())
-> Type
makeNumericType String
"bool" Reqs
forall a. Monoid a => a
mempty
  (do HsImportSet -> Generator ()
LH.addImports HsImportSet
hsImportForPrelude
      HsType -> Generator HsType
forall (m :: * -> *) a. Monad m => a -> m a
return (HsType -> Generator HsType) -> HsType -> Generator HsType
forall a b. (a -> b) -> a -> b
$ HsQName -> HsType
HsTyCon (HsQName -> HsType) -> HsQName -> HsType
forall a b. (a -> b) -> a -> b
$ HsName -> HsQName
UnQual (HsName -> HsQName) -> HsName -> HsQName
forall a b. (a -> b) -> a -> b
$ String -> HsName
HsIdent String
"HoppyP.Bool")
  (Generator HsType -> Maybe (Generator HsType)
forall a. a -> Maybe a
Just (Generator HsType -> Maybe (Generator HsType))
-> Generator HsType -> Maybe (Generator HsType)
forall a b. (a -> b) -> a -> b
$ do HsImportSet -> Generator ()
LH.addImports HsImportSet
hsImportForForeignC
             HsType -> Generator HsType
forall (m :: * -> *) a. Monad m => a -> m a
return (HsType -> Generator HsType) -> HsType -> Generator HsType
forall a b. (a -> b) -> a -> b
$ HsQName -> HsType
HsTyCon (HsQName -> HsType) -> HsQName -> HsType
forall a b. (a -> b) -> a -> b
$ HsName -> HsQName
UnQual (HsName -> HsQName) -> HsName -> HsQName
forall a b. (a -> b) -> a -> b
$ String -> HsName
HsIdent String
"HoppyFC.CBool")
  (Generator () -> ConversionMethod (Generator ())
forall c. c -> ConversionMethod c
CustomConversion (Generator () -> ConversionMethod (Generator ()))
-> Generator () -> ConversionMethod (Generator ())
forall a b. (a -> b) -> a -> b
$ do
     HsImportSet -> Generator ()
LH.addImports (HsImportSet -> Generator ()) -> HsImportSet -> Generator ()
forall a b. (a -> b) -> a -> b
$ [HsImportSet] -> HsImportSet
forall a. Monoid a => [a] -> a
mconcat [String -> String -> HsImportSet
hsImport1 String
"Prelude" String
"(.)",
                              HsImportSet
hsImportForPrelude]
     String -> Generator ()
LH.sayLn String
"\\x -> HoppyP.return $ if x then 1 else 0")
  (Generator () -> ConversionMethod (Generator ())
forall c. c -> ConversionMethod c
CustomConversion (Generator () -> ConversionMethod (Generator ()))
-> Generator () -> ConversionMethod (Generator ())
forall a b. (a -> b) -> a -> b
$ do
     HsImportSet -> Generator ()
LH.addImports (HsImportSet -> Generator ()) -> HsImportSet -> Generator ()
forall a b. (a -> b) -> a -> b
$ [HsImportSet] -> HsImportSet
forall a. Monoid a => [a] -> a
mconcat [String -> [String] -> HsImportSet
hsImports String
"Prelude" [String
"(.)", String
"(/=)"],
                              HsImportSet
hsImportForPrelude]
     String -> Generator ()
LH.sayLn String
"(HoppyP.return . (/= 0))")

-- | C++ @bool@, Haskell 'Foreign.C.CBool'.
boolT' :: Type
boolT' :: Type
boolT' =
  String
-> Reqs
-> Generator HsType
-> Maybe (Generator HsType)
-> ConversionMethod (Generator ())
-> ConversionMethod (Generator ())
-> Type
makeNumericType String
"bool" Reqs
forall a. Monoid a => a
mempty
  (do HsImportSet -> Generator ()
LH.addImports HsImportSet
hsImportForForeignC
      HsType -> Generator HsType
forall (m :: * -> *) a. Monad m => a -> m a
return (HsType -> Generator HsType) -> HsType -> Generator HsType
forall a b. (a -> b) -> a -> b
$ HsQName -> HsType
HsTyCon (HsQName -> HsType) -> HsQName -> HsType
forall a b. (a -> b) -> a -> b
$ HsName -> HsQName
UnQual (HsName -> HsQName) -> HsName -> HsQName
forall a b. (a -> b) -> a -> b
$ String -> HsName
HsIdent String
"HoppyFC.CBool")
  Maybe (Generator HsType)
forall a. Maybe a
Nothing ConversionMethod (Generator ())
forall c. ConversionMethod c
BinaryCompatible ConversionMethod (Generator ())
forall c. ConversionMethod c
BinaryCompatible

-- | C++ @char@, Haskell 'Foreign.C.CChar'.
charT :: Type
charT :: Type
charT =
  String
-> Reqs
-> Generator HsType
-> Maybe (Generator HsType)
-> ConversionMethod (Generator ())
-> ConversionMethod (Generator ())
-> Type
makeNumericType String
"char" Reqs
forall a. Monoid a => a
mempty
  (do HsImportSet -> Generator ()
LH.addImports HsImportSet
hsImportForForeignC
      HsType -> Generator HsType
forall (m :: * -> *) a. Monad m => a -> m a
return (HsType -> Generator HsType) -> HsType -> Generator HsType
forall a b. (a -> b) -> a -> b
$ HsQName -> HsType
HsTyCon (HsQName -> HsType) -> HsQName -> HsType
forall a b. (a -> b) -> a -> b
$ HsName -> HsQName
UnQual (HsName -> HsQName) -> HsName -> HsQName
forall a b. (a -> b) -> a -> b
$ String -> HsName
HsIdent String
"HoppyFC.CChar")
  Maybe (Generator HsType)
forall a. Maybe a
Nothing ConversionMethod (Generator ())
forall c. ConversionMethod c
BinaryCompatible ConversionMethod (Generator ())
forall c. ConversionMethod c
BinaryCompatible

-- | C++ @unsigned char@, Haskell 'Foreign.C.CUChar'.
ucharT :: Type
ucharT :: Type
ucharT =
  String
-> Reqs
-> Generator HsType
-> Maybe (Generator HsType)
-> ConversionMethod (Generator ())
-> ConversionMethod (Generator ())
-> Type
makeNumericType String
"unsigned char" Reqs
forall a. Monoid a => a
mempty
  (do HsImportSet -> Generator ()
LH.addImports HsImportSet
hsImportForForeignC
      HsType -> Generator HsType
forall (m :: * -> *) a. Monad m => a -> m a
return (HsType -> Generator HsType) -> HsType -> Generator HsType
forall a b. (a -> b) -> a -> b
$ HsQName -> HsType
HsTyCon (HsQName -> HsType) -> HsQName -> HsType
forall a b. (a -> b) -> a -> b
$ HsName -> HsQName
UnQual (HsName -> HsQName) -> HsName -> HsQName
forall a b. (a -> b) -> a -> b
$ String -> HsName
HsIdent String
"HoppyFC.CUChar")
  Maybe (Generator HsType)
forall a. Maybe a
Nothing ConversionMethod (Generator ())
forall c. ConversionMethod c
BinaryCompatible ConversionMethod (Generator ())
forall c. ConversionMethod c
BinaryCompatible

-- | C++ @wchar_t@, Haskell 'Foreign.C.CWchar'.
wcharT :: Type
wcharT :: Type
wcharT =
  String
-> Reqs
-> Generator HsType
-> Maybe (Generator HsType)
-> ConversionMethod (Generator ())
-> ConversionMethod (Generator ())
-> Type
makeNumericType String
"wchar_t" Reqs
forall a. Monoid a => a
mempty
  (do HsImportSet -> Generator ()
LH.addImports HsImportSet
hsImportForForeignC
      HsType -> Generator HsType
forall (m :: * -> *) a. Monad m => a -> m a
return (HsType -> Generator HsType) -> HsType -> Generator HsType
forall a b. (a -> b) -> a -> b
$ HsQName -> HsType
HsTyCon (HsQName -> HsType) -> HsQName -> HsType
forall a b. (a -> b) -> a -> b
$ HsName -> HsQName
UnQual (HsName -> HsQName) -> HsName -> HsQName
forall a b. (a -> b) -> a -> b
$ String -> HsName
HsIdent String
"HoppyFC.CWchar")
  Maybe (Generator HsType)
forall a. Maybe a
Nothing ConversionMethod (Generator ())
forall c. ConversionMethod c
BinaryCompatible ConversionMethod (Generator ())
forall c. ConversionMethod c
BinaryCompatible

-- | C++ @short int@, Haskell 'Foreign.C.CShort'.
shortT :: Type
shortT :: Type
shortT =
  String
-> Reqs
-> Generator HsType
-> Maybe (Generator HsType)
-> ConversionMethod (Generator ())
-> ConversionMethod (Generator ())
-> Type
makeNumericType String
"short" Reqs
forall a. Monoid a => a
mempty
  (do HsImportSet -> Generator ()
LH.addImports HsImportSet
hsImportForForeignC
      HsType -> Generator HsType
forall (m :: * -> *) a. Monad m => a -> m a
return (HsType -> Generator HsType) -> HsType -> Generator HsType
forall a b. (a -> b) -> a -> b
$ HsQName -> HsType
HsTyCon (HsQName -> HsType) -> HsQName -> HsType
forall a b. (a -> b) -> a -> b
$ HsName -> HsQName
UnQual (HsName -> HsQName) -> HsName -> HsQName
forall a b. (a -> b) -> a -> b
$ String -> HsName
HsIdent String
"HoppyFC.CShort")
  Maybe (Generator HsType)
forall a. Maybe a
Nothing ConversionMethod (Generator ())
forall c. ConversionMethod c
BinaryCompatible ConversionMethod (Generator ())
forall c. ConversionMethod c
BinaryCompatible

-- | C++ @unsigned short int@, Haskell 'Foreign.C.CUShort'.
ushortT :: Type
ushortT :: Type
ushortT =
  String
-> Reqs
-> Generator HsType
-> Maybe (Generator HsType)
-> ConversionMethod (Generator ())
-> ConversionMethod (Generator ())
-> Type
makeNumericType String
"unsigned short" Reqs
forall a. Monoid a => a
mempty
  (do HsImportSet -> Generator ()
LH.addImports HsImportSet
hsImportForForeignC
      HsType -> Generator HsType
forall (m :: * -> *) a. Monad m => a -> m a
return (HsType -> Generator HsType) -> HsType -> Generator HsType
forall a b. (a -> b) -> a -> b
$ HsQName -> HsType
HsTyCon (HsQName -> HsType) -> HsQName -> HsType
forall a b. (a -> b) -> a -> b
$ HsName -> HsQName
UnQual (HsName -> HsQName) -> HsName -> HsQName
forall a b. (a -> b) -> a -> b
$ String -> HsName
HsIdent String
"HoppyFC.CUShort")
  Maybe (Generator HsType)
forall a. Maybe a
Nothing ConversionMethod (Generator ())
forall c. ConversionMethod c
BinaryCompatible ConversionMethod (Generator ())
forall c. ConversionMethod c
BinaryCompatible

-- | C++ @int@, Haskell 'Int'.  See also 'intT''.
intT :: Type
intT :: Type
intT =
  String
-> Reqs
-> Generator HsType
-> Maybe (Generator HsType)
-> ConversionMethod (Generator ())
-> ConversionMethod (Generator ())
-> Type
makeNumericType String
"int" Reqs
forall a. Monoid a => a
mempty
  (do HsImportSet -> Generator ()
LH.addImports HsImportSet
hsImportForPrelude
      HsType -> Generator HsType
forall (m :: * -> *) a. Monad m => a -> m a
return (HsType -> Generator HsType) -> HsType -> Generator HsType
forall a b. (a -> b) -> a -> b
$ HsQName -> HsType
HsTyCon (HsQName -> HsType) -> HsQName -> HsType
forall a b. (a -> b) -> a -> b
$ HsName -> HsQName
UnQual (HsName -> HsQName) -> HsName -> HsQName
forall a b. (a -> b) -> a -> b
$ String -> HsName
HsIdent String
"HoppyP.Int")
  (Generator HsType -> Maybe (Generator HsType)
forall a. a -> Maybe a
Just (Generator HsType -> Maybe (Generator HsType))
-> Generator HsType -> Maybe (Generator HsType)
forall a b. (a -> b) -> a -> b
$ do HsImportSet -> Generator ()
LH.addImports HsImportSet
hsImportForForeignC
             HsType -> Generator HsType
forall (m :: * -> *) a. Monad m => a -> m a
return (HsType -> Generator HsType) -> HsType -> Generator HsType
forall a b. (a -> b) -> a -> b
$ HsQName -> HsType
HsTyCon (HsQName -> HsType) -> HsQName -> HsType
forall a b. (a -> b) -> a -> b
$ HsName -> HsQName
UnQual (HsName -> HsQName) -> HsName -> HsQName
forall a b. (a -> b) -> a -> b
$ String -> HsName
HsIdent String
"HoppyFC.CInt")
  ConversionMethod (Generator ())
convertByCoercingIntegral ConversionMethod (Generator ())
convertByCoercingIntegral

-- | C++ @int@, Haskell 'Foreign.C.CInt'.  See also 'intT'.
intT' :: Type
intT' :: Type
intT' =
  String
-> Reqs
-> Generator HsType
-> Maybe (Generator HsType)
-> ConversionMethod (Generator ())
-> ConversionMethod (Generator ())
-> Type
makeNumericType String
"int" Reqs
forall a. Monoid a => a
mempty
  (do HsImportSet -> Generator ()
LH.addImports HsImportSet
hsImportForForeignC
      HsType -> Generator HsType
forall (m :: * -> *) a. Monad m => a -> m a
return (HsType -> Generator HsType) -> HsType -> Generator HsType
forall a b. (a -> b) -> a -> b
$ HsQName -> HsType
HsTyCon (HsQName -> HsType) -> HsQName -> HsType
forall a b. (a -> b) -> a -> b
$ HsName -> HsQName
UnQual (HsName -> HsQName) -> HsName -> HsQName
forall a b. (a -> b) -> a -> b
$ String -> HsName
HsIdent String
"HoppyFC.CInt")
  Maybe (Generator HsType)
forall a. Maybe a
Nothing ConversionMethod (Generator ())
forall c. ConversionMethod c
BinaryCompatible ConversionMethod (Generator ())
forall c. ConversionMethod c
BinaryCompatible

-- | C++ @unsigned int@, Haskell 'Foreign.C.CUInt'.
uintT :: Type
uintT :: Type
uintT =
  String
-> Reqs
-> Generator HsType
-> Maybe (Generator HsType)
-> ConversionMethod (Generator ())
-> ConversionMethod (Generator ())
-> Type
makeNumericType String
"unsigned int" Reqs
forall a. Monoid a => a
mempty
  (do HsImportSet -> Generator ()
LH.addImports HsImportSet
hsImportForForeignC
      HsType -> Generator HsType
forall (m :: * -> *) a. Monad m => a -> m a
return (HsType -> Generator HsType) -> HsType -> Generator HsType
forall a b. (a -> b) -> a -> b
$ HsQName -> HsType
HsTyCon (HsQName -> HsType) -> HsQName -> HsType
forall a b. (a -> b) -> a -> b
$ HsName -> HsQName
UnQual (HsName -> HsQName) -> HsName -> HsQName
forall a b. (a -> b) -> a -> b
$ String -> HsName
HsIdent String
"HoppyFC.CUInt")
  Maybe (Generator HsType)
forall a. Maybe a
Nothing ConversionMethod (Generator ())
forall c. ConversionMethod c
BinaryCompatible ConversionMethod (Generator ())
forall c. ConversionMethod c
BinaryCompatible

-- | C++ @long int@, Haskell 'Foreign.C.CLong'.
longT :: Type
longT :: Type
longT =
  String
-> Reqs
-> Generator HsType
-> Maybe (Generator HsType)
-> ConversionMethod (Generator ())
-> ConversionMethod (Generator ())
-> Type
makeNumericType String
"long" Reqs
forall a. Monoid a => a
mempty
  (do HsImportSet -> Generator ()
LH.addImports HsImportSet
hsImportForForeignC
      HsType -> Generator HsType
forall (m :: * -> *) a. Monad m => a -> m a
return (HsType -> Generator HsType) -> HsType -> Generator HsType
forall a b. (a -> b) -> a -> b
$ HsQName -> HsType
HsTyCon (HsQName -> HsType) -> HsQName -> HsType
forall a b. (a -> b) -> a -> b
$ HsName -> HsQName
UnQual (HsName -> HsQName) -> HsName -> HsQName
forall a b. (a -> b) -> a -> b
$ String -> HsName
HsIdent String
"HoppyFC.CLong")
  Maybe (Generator HsType)
forall a. Maybe a
Nothing ConversionMethod (Generator ())
forall c. ConversionMethod c
BinaryCompatible ConversionMethod (Generator ())
forall c. ConversionMethod c
BinaryCompatible

-- | C++ @unsigned long int@, Haskell 'Foreign.C.CULong'.
ulongT :: Type
ulongT :: Type
ulongT =
  String
-> Reqs
-> Generator HsType
-> Maybe (Generator HsType)
-> ConversionMethod (Generator ())
-> ConversionMethod (Generator ())
-> Type
makeNumericType String
"unsigned long" Reqs
forall a. Monoid a => a
mempty
  (do HsImportSet -> Generator ()
LH.addImports HsImportSet
hsImportForForeignC
      HsType -> Generator HsType
forall (m :: * -> *) a. Monad m => a -> m a
return (HsType -> Generator HsType) -> HsType -> Generator HsType
forall a b. (a -> b) -> a -> b
$ HsQName -> HsType
HsTyCon (HsQName -> HsType) -> HsQName -> HsType
forall a b. (a -> b) -> a -> b
$ HsName -> HsQName
UnQual (HsName -> HsQName) -> HsName -> HsQName
forall a b. (a -> b) -> a -> b
$ String -> HsName
HsIdent String
"HoppyFC.CULong")
  Maybe (Generator HsType)
forall a. Maybe a
Nothing ConversionMethod (Generator ())
forall c. ConversionMethod c
BinaryCompatible ConversionMethod (Generator ())
forall c. ConversionMethod c
BinaryCompatible

-- | C++ @long long int@, Haskell 'Foreign.C.CLLong'.
llongT :: Type
llongT :: Type
llongT =
  String
-> Reqs
-> Generator HsType
-> Maybe (Generator HsType)
-> ConversionMethod (Generator ())
-> ConversionMethod (Generator ())
-> Type
makeNumericType String
"long long" Reqs
forall a. Monoid a => a
mempty
  (do HsImportSet -> Generator ()
LH.addImports HsImportSet
hsImportForForeignC
      HsType -> Generator HsType
forall (m :: * -> *) a. Monad m => a -> m a
return (HsType -> Generator HsType) -> HsType -> Generator HsType
forall a b. (a -> b) -> a -> b
$ HsQName -> HsType
HsTyCon (HsQName -> HsType) -> HsQName -> HsType
forall a b. (a -> b) -> a -> b
$ HsName -> HsQName
UnQual (HsName -> HsQName) -> HsName -> HsQName
forall a b. (a -> b) -> a -> b
$ String -> HsName
HsIdent String
"HoppyFC.CLLong")
  Maybe (Generator HsType)
forall a. Maybe a
Nothing ConversionMethod (Generator ())
forall c. ConversionMethod c
BinaryCompatible ConversionMethod (Generator ())
forall c. ConversionMethod c
BinaryCompatible

-- | C++ @unsigned long long int@, Haskell 'Foreign.C.CULLong'.
ullongT :: Type
ullongT :: Type
ullongT =
  String
-> Reqs
-> Generator HsType
-> Maybe (Generator HsType)
-> ConversionMethod (Generator ())
-> ConversionMethod (Generator ())
-> Type
makeNumericType String
"unsigned long long" Reqs
forall a. Monoid a => a
mempty
  (do HsImportSet -> Generator ()
LH.addImports HsImportSet
hsImportForForeignC
      HsType -> Generator HsType
forall (m :: * -> *) a. Monad m => a -> m a
return (HsType -> Generator HsType) -> HsType -> Generator HsType
forall a b. (a -> b) -> a -> b
$ HsQName -> HsType
HsTyCon (HsQName -> HsType) -> HsQName -> HsType
forall a b. (a -> b) -> a -> b
$ HsName -> HsQName
UnQual (HsName -> HsQName) -> HsName -> HsQName
forall a b. (a -> b) -> a -> b
$ String -> HsName
HsIdent String
"HoppyFC.CULLong")
  Maybe (Generator HsType)
forall a. Maybe a
Nothing ConversionMethod (Generator ())
forall c. ConversionMethod c
BinaryCompatible ConversionMethod (Generator ())
forall c. ConversionMethod c
BinaryCompatible

-- | C++ @float@, Haskell 'Prelude.Float'.  See also 'floatT''.
floatT :: Type
floatT :: Type
floatT =
  String
-> Reqs
-> Generator HsType
-> Maybe (Generator HsType)
-> ConversionMethod (Generator ())
-> ConversionMethod (Generator ())
-> Type
makeNumericType String
"float" Reqs
forall a. Monoid a => a
mempty
  (do HsImportSet -> Generator ()
LH.addImports HsImportSet
hsImportForPrelude
      HsType -> Generator HsType
forall (m :: * -> *) a. Monad m => a -> m a
return (HsType -> Generator HsType) -> HsType -> Generator HsType
forall a b. (a -> b) -> a -> b
$ HsQName -> HsType
HsTyCon (HsQName -> HsType) -> HsQName -> HsType
forall a b. (a -> b) -> a -> b
$ HsName -> HsQName
UnQual (HsName -> HsQName) -> HsName -> HsQName
forall a b. (a -> b) -> a -> b
$ String -> HsName
HsIdent String
"HoppyP.Float")
  (Generator HsType -> Maybe (Generator HsType)
forall a. a -> Maybe a
Just (Generator HsType -> Maybe (Generator HsType))
-> Generator HsType -> Maybe (Generator HsType)
forall a b. (a -> b) -> a -> b
$ do HsImportSet -> Generator ()
LH.addImports HsImportSet
hsImportForForeignC
             HsType -> Generator HsType
forall (m :: * -> *) a. Monad m => a -> m a
return (HsType -> Generator HsType) -> HsType -> Generator HsType
forall a b. (a -> b) -> a -> b
$ HsQName -> HsType
HsTyCon (HsQName -> HsType) -> HsQName -> HsType
forall a b. (a -> b) -> a -> b
$ HsName -> HsQName
UnQual (HsName -> HsQName) -> HsName -> HsQName
forall a b. (a -> b) -> a -> b
$ String -> HsName
HsIdent String
"HoppyFC.CFloat")
  ConversionMethod (Generator ())
convertByCoercingFloating ConversionMethod (Generator ())
convertByCoercingFloating

-- | C++ @float@, Haskell 'Foreign.C.CFloat'.  See also 'floatT'.
floatT' :: Type
floatT' :: Type
floatT' =
  String
-> Reqs
-> Generator HsType
-> Maybe (Generator HsType)
-> ConversionMethod (Generator ())
-> ConversionMethod (Generator ())
-> Type
makeNumericType String
"float" Reqs
forall a. Monoid a => a
mempty
  (do HsImportSet -> Generator ()
LH.addImports HsImportSet
hsImportForForeignC
      HsType -> Generator HsType
forall (m :: * -> *) a. Monad m => a -> m a
return (HsType -> Generator HsType) -> HsType -> Generator HsType
forall a b. (a -> b) -> a -> b
$ HsQName -> HsType
HsTyCon (HsQName -> HsType) -> HsQName -> HsType
forall a b. (a -> b) -> a -> b
$ HsName -> HsQName
UnQual (HsName -> HsQName) -> HsName -> HsQName
forall a b. (a -> b) -> a -> b
$ String -> HsName
HsIdent String
"Foreign.C.CFloat")
  Maybe (Generator HsType)
forall a. Maybe a
Nothing ConversionMethod (Generator ())
forall c. ConversionMethod c
BinaryCompatible ConversionMethod (Generator ())
forall c. ConversionMethod c
BinaryCompatible

-- | C++ @double@, Haskell 'Prelude.Double'.  See also 'doubleT''.
doubleT :: Type
doubleT :: Type
doubleT =
  String
-> Reqs
-> Generator HsType
-> Maybe (Generator HsType)
-> ConversionMethod (Generator ())
-> ConversionMethod (Generator ())
-> Type
makeNumericType String
"double" Reqs
forall a. Monoid a => a
mempty
  (do HsImportSet -> Generator ()
LH.addImports HsImportSet
hsImportForPrelude
      HsType -> Generator HsType
forall (m :: * -> *) a. Monad m => a -> m a
return (HsType -> Generator HsType) -> HsType -> Generator HsType
forall a b. (a -> b) -> a -> b
$ HsQName -> HsType
HsTyCon (HsQName -> HsType) -> HsQName -> HsType
forall a b. (a -> b) -> a -> b
$ HsName -> HsQName
UnQual (HsName -> HsQName) -> HsName -> HsQName
forall a b. (a -> b) -> a -> b
$ String -> HsName
HsIdent String
"HoppyP.Double")
  (Generator HsType -> Maybe (Generator HsType)
forall a. a -> Maybe a
Just (Generator HsType -> Maybe (Generator HsType))
-> Generator HsType -> Maybe (Generator HsType)
forall a b. (a -> b) -> a -> b
$ do HsImportSet -> Generator ()
LH.addImports HsImportSet
hsImportForForeignC
             HsType -> Generator HsType
forall (m :: * -> *) a. Monad m => a -> m a
return (HsType -> Generator HsType) -> HsType -> Generator HsType
forall a b. (a -> b) -> a -> b
$ HsQName -> HsType
HsTyCon (HsQName -> HsType) -> HsQName -> HsType
forall a b. (a -> b) -> a -> b
$ HsName -> HsQName
UnQual (HsName -> HsQName) -> HsName -> HsQName
forall a b. (a -> b) -> a -> b
$ String -> HsName
HsIdent String
"HoppyFC.CDouble")
  ConversionMethod (Generator ())
convertByCoercingFloating ConversionMethod (Generator ())
convertByCoercingFloating

-- | C++ @double@, Haskell 'Foreign.C.CDouble'.  See also 'doubleT'.
doubleT' :: Type
doubleT' :: Type
doubleT' =
  String
-> Reqs
-> Generator HsType
-> Maybe (Generator HsType)
-> ConversionMethod (Generator ())
-> ConversionMethod (Generator ())
-> Type
makeNumericType String
"double" Reqs
forall a. Monoid a => a
mempty
  (do HsImportSet -> Generator ()
LH.addImports HsImportSet
hsImportForForeignC
      HsType -> Generator HsType
forall (m :: * -> *) a. Monad m => a -> m a
return (HsType -> Generator HsType) -> HsType -> Generator HsType
forall a b. (a -> b) -> a -> b
$ HsQName -> HsType
HsTyCon (HsQName -> HsType) -> HsQName -> HsType
forall a b. (a -> b) -> a -> b
$ HsName -> HsQName
UnQual (HsName -> HsQName) -> HsName -> HsQName
forall a b. (a -> b) -> a -> b
$ String -> HsName
HsIdent String
"Foreign.C.CDouble")
  Maybe (Generator HsType)
forall a. Maybe a
Nothing ConversionMethod (Generator ())
forall c. ConversionMethod c
BinaryCompatible ConversionMethod (Generator ())
forall c. ConversionMethod c
BinaryCompatible

-- | C++ @int8_t@, Haskell 'Data.Int.Int8'.
int8T :: Type
int8T :: Type
int8T =
  String
-> Reqs
-> Generator HsType
-> Maybe (Generator HsType)
-> ConversionMethod (Generator ())
-> ConversionMethod (Generator ())
-> Type
makeNumericType String
"int8_t" (Include -> Reqs
reqInclude (Include -> Reqs) -> Include -> Reqs
forall a b. (a -> b) -> a -> b
$ String -> Include
includeStd String
"cstdint")
  (do HsImportSet -> Generator ()
LH.addImports HsImportSet
hsImportForInt
      HsType -> Generator HsType
forall (m :: * -> *) a. Monad m => a -> m a
return (HsType -> Generator HsType) -> HsType -> Generator HsType
forall a b. (a -> b) -> a -> b
$ HsQName -> HsType
HsTyCon (HsQName -> HsType) -> HsQName -> HsType
forall a b. (a -> b) -> a -> b
$ HsName -> HsQName
UnQual (HsName -> HsQName) -> HsName -> HsQName
forall a b. (a -> b) -> a -> b
$ String -> HsName
HsIdent String
"HoppyDI.Int8")
  Maybe (Generator HsType)
forall a. Maybe a
Nothing ConversionMethod (Generator ())
forall c. ConversionMethod c
BinaryCompatible ConversionMethod (Generator ())
forall c. ConversionMethod c
BinaryCompatible

-- | C++ @int16_t@, Haskell 'Data.Int.Int16'.
int16T :: Type
int16T :: Type
int16T =
  String
-> Reqs
-> Generator HsType
-> Maybe (Generator HsType)
-> ConversionMethod (Generator ())
-> ConversionMethod (Generator ())
-> Type
makeNumericType String
"int16_t" (Include -> Reqs
reqInclude (Include -> Reqs) -> Include -> Reqs
forall a b. (a -> b) -> a -> b
$ String -> Include
includeStd String
"cstdint")
  (do HsImportSet -> Generator ()
LH.addImports HsImportSet
hsImportForInt
      HsType -> Generator HsType
forall (m :: * -> *) a. Monad m => a -> m a
return (HsType -> Generator HsType) -> HsType -> Generator HsType
forall a b. (a -> b) -> a -> b
$ HsQName -> HsType
HsTyCon (HsQName -> HsType) -> HsQName -> HsType
forall a b. (a -> b) -> a -> b
$ HsName -> HsQName
UnQual (HsName -> HsQName) -> HsName -> HsQName
forall a b. (a -> b) -> a -> b
$ String -> HsName
HsIdent String
"HoppyDI.Int16")
  Maybe (Generator HsType)
forall a. Maybe a
Nothing ConversionMethod (Generator ())
forall c. ConversionMethod c
BinaryCompatible ConversionMethod (Generator ())
forall c. ConversionMethod c
BinaryCompatible

-- | C++ @int32_t@, Haskell 'Data.Int.Int32'.
int32T :: Type
int32T :: Type
int32T =
  String
-> Reqs
-> Generator HsType
-> Maybe (Generator HsType)
-> ConversionMethod (Generator ())
-> ConversionMethod (Generator ())
-> Type
makeNumericType String
"int32_t" (Include -> Reqs
reqInclude (Include -> Reqs) -> Include -> Reqs
forall a b. (a -> b) -> a -> b
$ String -> Include
includeStd String
"cstdint")
  (do HsImportSet -> Generator ()
LH.addImports HsImportSet
hsImportForInt
      HsType -> Generator HsType
forall (m :: * -> *) a. Monad m => a -> m a
return (HsType -> Generator HsType) -> HsType -> Generator HsType
forall a b. (a -> b) -> a -> b
$ HsQName -> HsType
HsTyCon (HsQName -> HsType) -> HsQName -> HsType
forall a b. (a -> b) -> a -> b
$ HsName -> HsQName
UnQual (HsName -> HsQName) -> HsName -> HsQName
forall a b. (a -> b) -> a -> b
$ String -> HsName
HsIdent String
"HoppyDI.Int32")
  Maybe (Generator HsType)
forall a. Maybe a
Nothing ConversionMethod (Generator ())
forall c. ConversionMethod c
BinaryCompatible ConversionMethod (Generator ())
forall c. ConversionMethod c
BinaryCompatible

-- | C++ @int64_t@, Haskell 'Data.Int.Int64'.
int64T :: Type
int64T :: Type
int64T =
  String
-> Reqs
-> Generator HsType
-> Maybe (Generator HsType)
-> ConversionMethod (Generator ())
-> ConversionMethod (Generator ())
-> Type
makeNumericType String
"int64_t" (Include -> Reqs
reqInclude (Include -> Reqs) -> Include -> Reqs
forall a b. (a -> b) -> a -> b
$ String -> Include
includeStd String
"cstdint")
  (do HsImportSet -> Generator ()
LH.addImports HsImportSet
hsImportForInt
      HsType -> Generator HsType
forall (m :: * -> *) a. Monad m => a -> m a
return (HsType -> Generator HsType) -> HsType -> Generator HsType
forall a b. (a -> b) -> a -> b
$ HsQName -> HsType
HsTyCon (HsQName -> HsType) -> HsQName -> HsType
forall a b. (a -> b) -> a -> b
$ HsName -> HsQName
UnQual (HsName -> HsQName) -> HsName -> HsQName
forall a b. (a -> b) -> a -> b
$ String -> HsName
HsIdent String
"HoppyDI.Int64")
  Maybe (Generator HsType)
forall a. Maybe a
Nothing ConversionMethod (Generator ())
forall c. ConversionMethod c
BinaryCompatible ConversionMethod (Generator ())
forall c. ConversionMethod c
BinaryCompatible

-- | C++ @uint8_t@, Haskell 'Data.Word.Word8'.
word8T :: Type
word8T :: Type
word8T =
  String
-> Reqs
-> Generator HsType
-> Maybe (Generator HsType)
-> ConversionMethod (Generator ())
-> ConversionMethod (Generator ())
-> Type
makeNumericType String
"uint8_t" (Include -> Reqs
reqInclude (Include -> Reqs) -> Include -> Reqs
forall a b. (a -> b) -> a -> b
$ String -> Include
includeStd String
"cstdint")
  (do HsImportSet -> Generator ()
LH.addImports HsImportSet
hsImportForWord
      HsType -> Generator HsType
forall (m :: * -> *) a. Monad m => a -> m a
return (HsType -> Generator HsType) -> HsType -> Generator HsType
forall a b. (a -> b) -> a -> b
$ HsQName -> HsType
HsTyCon (HsQName -> HsType) -> HsQName -> HsType
forall a b. (a -> b) -> a -> b
$ HsName -> HsQName
UnQual (HsName -> HsQName) -> HsName -> HsQName
forall a b. (a -> b) -> a -> b
$ String -> HsName
HsIdent String
"HoppyDW.Word8")
  Maybe (Generator HsType)
forall a. Maybe a
Nothing ConversionMethod (Generator ())
forall c. ConversionMethod c
BinaryCompatible ConversionMethod (Generator ())
forall c. ConversionMethod c
BinaryCompatible

-- | C++ @uint16_t@, Haskell 'Data.Word.Word16'.
word16T :: Type
word16T :: Type
word16T =
  String
-> Reqs
-> Generator HsType
-> Maybe (Generator HsType)
-> ConversionMethod (Generator ())
-> ConversionMethod (Generator ())
-> Type
makeNumericType String
"uint16_t" (Include -> Reqs
reqInclude (Include -> Reqs) -> Include -> Reqs
forall a b. (a -> b) -> a -> b
$ String -> Include
includeStd String
"cstdint")
  (do HsImportSet -> Generator ()
LH.addImports HsImportSet
hsImportForWord
      HsType -> Generator HsType
forall (m :: * -> *) a. Monad m => a -> m a
return (HsType -> Generator HsType) -> HsType -> Generator HsType
forall a b. (a -> b) -> a -> b
$ HsQName -> HsType
HsTyCon (HsQName -> HsType) -> HsQName -> HsType
forall a b. (a -> b) -> a -> b
$ HsName -> HsQName
UnQual (HsName -> HsQName) -> HsName -> HsQName
forall a b. (a -> b) -> a -> b
$ String -> HsName
HsIdent String
"HoppyDW.Word16")
  Maybe (Generator HsType)
forall a. Maybe a
Nothing ConversionMethod (Generator ())
forall c. ConversionMethod c
BinaryCompatible ConversionMethod (Generator ())
forall c. ConversionMethod c
BinaryCompatible

-- | C++ @uint32_t@, Haskell 'Data.Word.Word32'.
word32T :: Type
word32T :: Type
word32T =
  String
-> Reqs
-> Generator HsType
-> Maybe (Generator HsType)
-> ConversionMethod (Generator ())
-> ConversionMethod (Generator ())
-> Type
makeNumericType String
"uint32_t" (Include -> Reqs
reqInclude (Include -> Reqs) -> Include -> Reqs
forall a b. (a -> b) -> a -> b
$ String -> Include
includeStd String
"cstdint")
  (do HsImportSet -> Generator ()
LH.addImports HsImportSet
hsImportForWord
      HsType -> Generator HsType
forall (m :: * -> *) a. Monad m => a -> m a
return (HsType -> Generator HsType) -> HsType -> Generator HsType
forall a b. (a -> b) -> a -> b
$ HsQName -> HsType
HsTyCon (HsQName -> HsType) -> HsQName -> HsType
forall a b. (a -> b) -> a -> b
$ HsName -> HsQName
UnQual (HsName -> HsQName) -> HsName -> HsQName
forall a b. (a -> b) -> a -> b
$ String -> HsName
HsIdent String
"HoppyDW.Word32")
  Maybe (Generator HsType)
forall a. Maybe a
Nothing ConversionMethod (Generator ())
forall c. ConversionMethod c
BinaryCompatible ConversionMethod (Generator ())
forall c. ConversionMethod c
BinaryCompatible

-- | C++ @uint64_t@, Haskell 'Data.Word.Word64'.
word64T :: Type
word64T :: Type
word64T =
  String
-> Reqs
-> Generator HsType
-> Maybe (Generator HsType)
-> ConversionMethod (Generator ())
-> ConversionMethod (Generator ())
-> Type
makeNumericType String
"uint64_t" (Include -> Reqs
reqInclude (Include -> Reqs) -> Include -> Reqs
forall a b. (a -> b) -> a -> b
$ String -> Include
includeStd String
"cstdint")
  (do HsImportSet -> Generator ()
LH.addImports HsImportSet
hsImportForWord
      HsType -> Generator HsType
forall (m :: * -> *) a. Monad m => a -> m a
return (HsType -> Generator HsType) -> HsType -> Generator HsType
forall a b. (a -> b) -> a -> b
$ HsQName -> HsType
HsTyCon (HsQName -> HsType) -> HsQName -> HsType
forall a b. (a -> b) -> a -> b
$ HsName -> HsQName
UnQual (HsName -> HsQName) -> HsName -> HsQName
forall a b. (a -> b) -> a -> b
$ String -> HsName
HsIdent String
"HoppyDW.Word64")
  Maybe (Generator HsType)
forall a. Maybe a
Nothing ConversionMethod (Generator ())
forall c. ConversionMethod c
BinaryCompatible ConversionMethod (Generator ())
forall c. ConversionMethod c
BinaryCompatible

-- | C++ @ptrdiff_t@, Haskell 'Foreign.C.CPtrdiff'.
ptrdiffT :: Type
ptrdiffT :: Type
ptrdiffT =
  String
-> Reqs
-> Generator HsType
-> Maybe (Generator HsType)
-> ConversionMethod (Generator ())
-> ConversionMethod (Generator ())
-> Type
makeNumericType String
"ptrdiff_t" (Include -> Reqs
reqInclude (Include -> Reqs) -> Include -> Reqs
forall a b. (a -> b) -> a -> b
$ String -> Include
includeStd String
"cstddef")
  (do HsImportSet -> Generator ()
LH.addImports HsImportSet
hsImportForForeignC
      HsType -> Generator HsType
forall (m :: * -> *) a. Monad m => a -> m a
return (HsType -> Generator HsType) -> HsType -> Generator HsType
forall a b. (a -> b) -> a -> b
$ HsQName -> HsType
HsTyCon (HsQName -> HsType) -> HsQName -> HsType
forall a b. (a -> b) -> a -> b
$ HsName -> HsQName
UnQual (HsName -> HsQName) -> HsName -> HsQName
forall a b. (a -> b) -> a -> b
$ String -> HsName
HsIdent String
"HoppyFC.CPtrdiff")
  Maybe (Generator HsType)
forall a. Maybe a
Nothing ConversionMethod (Generator ())
forall c. ConversionMethod c
BinaryCompatible ConversionMethod (Generator ())
forall c. ConversionMethod c
BinaryCompatible

-- | C++ @size_t@, Haskell 'Foreign.C.CSize'.
sizeT :: Type
sizeT :: Type
sizeT =
  String
-> Reqs
-> Generator HsType
-> Maybe (Generator HsType)
-> ConversionMethod (Generator ())
-> ConversionMethod (Generator ())
-> Type
makeNumericType String
"size_t" (Include -> Reqs
reqInclude (Include -> Reqs) -> Include -> Reqs
forall a b. (a -> b) -> a -> b
$ String -> Include
includeStd String
"cstddef")
  (do HsImportSet -> Generator ()
LH.addImports HsImportSet
hsImportForForeignC
      HsType -> Generator HsType
forall (m :: * -> *) a. Monad m => a -> m a
return (HsType -> Generator HsType) -> HsType -> Generator HsType
forall a b. (a -> b) -> a -> b
$ HsQName -> HsType
HsTyCon (HsQName -> HsType) -> HsQName -> HsType
forall a b. (a -> b) -> a -> b
$ HsName -> HsQName
UnQual (HsName -> HsQName) -> HsName -> HsQName
forall a b. (a -> b) -> a -> b
$ String -> HsName
HsIdent String
"HoppyFC.CSize")
  Maybe (Generator HsType)
forall a. Maybe a
Nothing ConversionMethod (Generator ())
forall c. ConversionMethod c
BinaryCompatible ConversionMethod (Generator ())
forall c. ConversionMethod c
BinaryCompatible

-- | C++ @ssize_t@, Haskell 'System.Posix.Types.CSsize'.
ssizeT :: Type
ssizeT :: Type
ssizeT =
  String
-> Reqs
-> Generator HsType
-> Maybe (Generator HsType)
-> ConversionMethod (Generator ())
-> ConversionMethod (Generator ())
-> Type
makeNumericType String
"ssize_t" (Include -> Reqs
reqInclude (Include -> Reqs) -> Include -> Reqs
forall a b. (a -> b) -> a -> b
$ String -> Include
includeStd String
"cstddef")
  (do HsImportSet -> Generator ()
LH.addImports HsImportSet
hsImportForSystemPosixTypes
      HsType -> Generator HsType
forall (m :: * -> *) a. Monad m => a -> m a
return (HsType -> Generator HsType) -> HsType -> Generator HsType
forall a b. (a -> b) -> a -> b
$ HsQName -> HsType
HsTyCon (HsQName -> HsType) -> HsQName -> HsType
forall a b. (a -> b) -> a -> b
$ HsName -> HsQName
UnQual (HsName -> HsQName) -> HsName -> HsQName
forall a b. (a -> b) -> a -> b
$ String -> HsName
HsIdent String
"HoppySPT.CSsize")
  Maybe (Generator HsType)
forall a. Maybe a
Nothing ConversionMethod (Generator ())
forall c. ConversionMethod c
BinaryCompatible ConversionMethod (Generator ())
forall c. ConversionMethod c
BinaryCompatible

-- | Builds a new numeric type definition.
--
-- For convenience, 'convertByCoercingIntegral' and 'convertByCoercingFloating'
-- may be used as conversion methods, for both 'ConversionMethod' arguments this
-- function takes.
makeNumericType ::
     String
     -- ^ The name of the C++ type.
  -> Reqs
     -- ^ Includes necessary to use the C++ type.
  -> LH.Generator HsType
     -- ^ Generator for rendering the Haskell type to be used, along with any
     -- required imports.  See 'conversionSpecHaskellHsType'.
  -> Maybe (LH.Generator HsType)
     -- ^ If there is a Haskell type distinct from the previous argument to be
     -- used for passing over the FFI boundary, then provide it here.  See
     -- 'conversionSpecHaskellCType'.
  -> ConversionMethod (LH.Generator ())
     -- ^ Method to use to convert a Haskell value to a value to be passed over
     -- the FFI.  See 'conversionSpecHaskellToCppFn'.
  -> ConversionMethod (LH.Generator ())
     -- ^ Method to use to convert a value received over the FFI into a Haskell
     -- value.  See 'conversionSpecHaskellFromCppFn'.
  -> Type
makeNumericType :: String
-> Reqs
-> Generator HsType
-> Maybe (Generator HsType)
-> ConversionMethod (Generator ())
-> ConversionMethod (Generator ())
-> Type
makeNumericType String
cppName Reqs
cppReqs Generator HsType
hsTypeGen Maybe (Generator HsType)
hsCTypeGen ConversionMethod (Generator ())
convertToCpp ConversionMethod (Generator ())
convertFromCpp =
  ConversionSpec -> Type
Internal_TManual ConversionSpec
spec
  where spec :: ConversionSpec
spec =
          (String -> ConversionSpecCpp -> ConversionSpec
makeConversionSpec String
cppName (ConversionSpecCpp -> ConversionSpec)
-> ConversionSpecCpp -> ConversionSpec
forall a b. (a -> b) -> a -> b
$ String -> Generator Reqs -> ConversionSpecCpp
makeConversionSpecCpp String
cppName (Generator Reqs -> ConversionSpecCpp)
-> Generator Reqs -> ConversionSpecCpp
forall a b. (a -> b) -> a -> b
$ Reqs -> Generator Reqs
forall (m :: * -> *) a. Monad m => a -> m a
return Reqs
cppReqs)
          { conversionSpecHaskell :: Maybe ConversionSpecHaskell
conversionSpecHaskell =
              ConversionSpecHaskell -> Maybe ConversionSpecHaskell
forall a. a -> Maybe a
Just (ConversionSpecHaskell -> Maybe ConversionSpecHaskell)
-> ConversionSpecHaskell -> Maybe ConversionSpecHaskell
forall a b. (a -> b) -> a -> b
$ Generator HsType
-> Maybe (Generator HsType)
-> ConversionMethod (Generator ())
-> ConversionMethod (Generator ())
-> ConversionSpecHaskell
makeConversionSpecHaskell
                Generator HsType
hsTypeGen
                Maybe (Generator HsType)
hsCTypeGen
                ConversionMethod (Generator ())
convertToCpp
                ConversionMethod (Generator ())
convertFromCpp
          }

-- | Conversion method for passing a numeric values to and from Haskell by using
-- @Foreign.Hoppy.Runtime.coerceIntegral@.
convertByCoercingIntegral :: ConversionMethod (LH.Generator ())
convertByCoercingIntegral :: ConversionMethod (Generator ())
convertByCoercingIntegral = Generator () -> ConversionMethod (Generator ())
forall c. c -> ConversionMethod c
CustomConversion (Generator () -> ConversionMethod (Generator ()))
-> Generator () -> ConversionMethod (Generator ())
forall a b. (a -> b) -> a -> b
$ do
  HsImportSet -> Generator ()
LH.addImports (HsImportSet -> Generator ()) -> HsImportSet -> Generator ()
forall a b. (a -> b) -> a -> b
$ [HsImportSet] -> HsImportSet
forall a. Monoid a => [a] -> a
mconcat [String -> String -> HsImportSet
hsImport1 String
"Prelude" String
"(.)",
                           HsImportSet
hsImportForPrelude,
                           HsImportSet
hsImportForRuntime]
  String -> Generator ()
LH.sayLn String
"HoppyP.return . HoppyFHR.coerceIntegral"

-- | Conversion method for passing a numeric values to and from Haskell by using
-- 'realToFrac'.
convertByCoercingFloating :: ConversionMethod (LH.Generator ())
convertByCoercingFloating :: ConversionMethod (Generator ())
convertByCoercingFloating = Generator () -> ConversionMethod (Generator ())
forall c. c -> ConversionMethod c
CustomConversion (Generator () -> ConversionMethod (Generator ()))
-> Generator () -> ConversionMethod (Generator ())
forall a b. (a -> b) -> a -> b
$ do
  HsImportSet -> Generator ()
LH.addImports (HsImportSet -> Generator ()) -> HsImportSet -> Generator ()
forall a b. (a -> b) -> a -> b
$ [HsImportSet] -> HsImportSet
forall a. Monoid a => [a] -> a
mconcat [String -> String -> HsImportSet
hsImport1 String
"Prelude" String
"(.)",
                           HsImportSet
hsImportForPrelude]
  String -> Generator ()
LH.sayLn String
"HoppyP.return . HoppyP.realToFrac"

-- | A pointer to another type.
ptrT :: Type -> Type
ptrT :: Type -> Type
ptrT = Type -> Type
Internal_TPtr

-- | A reference to another type.
refT :: Type -> Type
refT :: Type -> Type
refT = Type -> Type
Internal_TRef

-- | An instance of a class.  When used in a parameter or return type and not
-- wrapped in a 'ptrT' or 'refT', this is a by-value object.
objT :: Class -> Type
objT :: Class -> Type
objT = Class -> Type
Internal_TObj

-- | A special case of 'objT' that is only allowed when passing objects from
-- C++ to a foreign language.  Rather than looking at the object's
-- 'Foreign.Hoppy.Generator.Spec.Class.ClassConversion', the object will be
-- copied to the heap, and a pointer to the heap object will be passed.  The
-- object must be copy-constructable.
--
-- __The foreign language owns the pointer, even for callback arguments.__
objToHeapT :: Class -> Type
objToHeapT :: Class -> Type
objToHeapT = Class -> Type
Internal_TObjToHeap

-- | This type transfers ownership of the object to the foreign language's
-- garbage collector, and results in a managed pointer in the foreign language.
-- This may only be used in one of the forms below, when passing data from C++
-- to a foreign language (i.e. in a C++ function return type or in a callback
-- argument).  In the first case, the temporary object is copied to the heap,
-- and the result is a managed pointer to the heap object instead of the
-- temporary.
--
-- - @'toGcT' ('objT' cls)@
-- - @'toGcT' ('refT' ('constT' ('objT' cls)))@
-- - @'toGcT' ('refT' ('objT' cls))@
-- - @'toGcT' ('ptrT' ('constT' ('objT' cls)))@
-- - @'toGcT' ('ptrT' ('objT' cls))@
toGcT :: Type -> Type
toGcT :: Type -> Type
toGcT = Type -> Type
Internal_TToGc

-- | Constructs a type from a specification of how to convert values.
manualT :: ConversionSpec -> Type
manualT :: ConversionSpec -> Type
manualT = ConversionSpec -> Type
Internal_TManual

-- | A @const@ version of another type.
constT :: Type -> Type
constT :: Type -> Type
constT = Type -> Type
Internal_TConst