{-# LANGUAGE CPP #-}
module Foreign.Hoppy.Generator.Std.Wstring (c_wstring) where
#if !MIN_VERSION_base(4,8,0)
import Data.Monoid (mconcat)
#endif
import Foreign.Hoppy.Generator.Language.Haskell (addExport, addImports, indent, sayLn)
import Foreign.Hoppy.Generator.Spec (
addAddendumHaskell,
addReqIncludes,
hsImport1,
hsImportForForeignC,
hsImportForPrelude,
hsImportForRuntime,
ident1,
includeStd,
np,
toExtName,
)
import Foreign.Hoppy.Generator.Spec.Class (
Class,
ClassHaskellConversion (..),
classSetHaskellConversion,
makeClass,
mkCtor,
mkConstMethod,
mkConstMethod',
mkMethod',
)
import Foreign.Hoppy.Generator.Spec.ClassFeature (
ClassFeature (Assignable, Comparable, Copyable, Equatable),
classAddFeatures,
)
import Foreign.Hoppy.Generator.Types
import Language.Haskell.Syntax (
HsName (HsIdent),
HsQName (UnQual),
HsType (HsTyCon),
)
c_wstring :: Class
c_wstring :: Class
c_wstring =
[Include] -> Class -> Class
forall a. HasReqs a => [Include] -> a -> a
addReqIncludes [String -> Include
includeStd String
"string"] (Class -> Class) -> Class -> Class
forall a b. (a -> b) -> a -> b
$
[ClassFeature] -> Class -> Class
classAddFeatures [ClassFeature
Assignable, ClassFeature
Comparable, ClassFeature
Copyable, ClassFeature
Equatable] (Class -> Class) -> Class -> Class
forall a b. (a -> b) -> a -> b
$
Generator () -> Class -> Class
forall a. HasAddendum a => Generator () -> a -> a
addAddendumHaskell Generator ()
addendum (Class -> Class) -> Class -> Class
forall a b. (a -> b) -> a -> b
$
ClassHaskellConversion -> Class -> Class
classSetHaskellConversion
ClassHaskellConversion :: Maybe (Generator HsType)
-> Maybe (Generator ())
-> Maybe (Generator ())
-> ClassHaskellConversion
ClassHaskellConversion
{ classHaskellConversionType :: Maybe (Generator HsType)
classHaskellConversionType = 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 ()
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.String"
, classHaskellConversionToCppFn :: Maybe (Generator ())
classHaskellConversionToCppFn = Generator () -> Maybe (Generator ())
forall a. a -> Maybe a
Just (Generator () -> Maybe (Generator ()))
-> Generator () -> Maybe (Generator ())
forall a b. (a -> b) -> a -> b
$ do
HsImportSet -> Generator ()
addImports (HsImportSet -> Generator ()) -> HsImportSet -> Generator ()
forall a b. (a -> b) -> a -> b
$ [HsImportSet] -> HsImportSet
forall a. Monoid a => [a] -> a
mconcat [HsImportSet
hsImportForPrelude, HsImportSet
hsImportForForeignC]
String -> Generator ()
sayLn String
"HoppyP.flip HoppyFC.withCWStringLen stdWstring_newFromCWStringLen"
, classHaskellConversionFromCppFn :: Maybe (Generator ())
classHaskellConversionFromCppFn = Generator () -> Maybe (Generator ())
forall a. a -> Maybe a
Just (Generator () -> Maybe (Generator ()))
-> Generator () -> Maybe (Generator ())
forall a b. (a -> b) -> a -> b
$ do
HsImportSet -> Generator ()
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
"Control.Applicative" String
"(<*)",
HsImportSet
hsImportForForeignC,
HsImportSet
hsImportForPrelude,
HsImportSet
hsImportForRuntime]
String -> Generator ()
sayLn String
"\\s -> do"
Generator () -> Generator ()
forall a. Generator a -> Generator a
indent (Generator () -> Generator ()) -> Generator () -> Generator ()
forall a b. (a -> b) -> a -> b
$ do
String -> Generator ()
sayLn String
"p <- stdWstring_data s"
String -> Generator ()
sayLn String
"n <- stdWstring_size s"
String -> Generator ()
sayLn String
"HoppyFC.peekCWStringLen (p, HoppyP.fromIntegral n) <* HoppyFHR.touchCppPtr s"
} (Class -> Class) -> Class -> Class
forall a b. (a -> b) -> a -> b
$
Identifier -> Maybe ExtName -> [Class] -> [ClassEntity] -> Class
makeClass (String -> String -> Identifier
ident1 String
"std" String
"wstring") (ExtName -> Maybe ExtName
forall a. a -> Maybe a
Just (ExtName -> Maybe ExtName) -> ExtName -> Maybe ExtName
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> ExtName
String -> ExtName
toExtName String
"StdWstring") []
[ String -> [Parameter] -> ClassEntity
forall p. IsParameter p => String -> [p] -> ClassEntity
mkCtor String
"new" [Parameter]
np
, String -> [Type] -> ClassEntity
forall p. IsParameter p => String -> [p] -> ClassEntity
mkCtor String
"newFromCWString" [Type -> Type
ptrT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
constT Type
wcharT]
, String -> [Type] -> ClassEntity
forall p. IsParameter p => String -> [p] -> ClassEntity
mkCtor String
"newFromCWStringLen_raw" [Type -> Type
ptrT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
constT Type
wcharT, Type
sizeT]
, String -> String -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkMethod' String
"at" String
"at" [Type
intT] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
refT Type
wcharT
, String -> String -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> String -> [p] -> Type -> ClassEntity
mkConstMethod' String
"at" String
"get" [Type
intT] Type
wcharT
, String -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkConstMethod String
"c_str" [Parameter]
np (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
ptrT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
constT Type
wcharT
, String -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkConstMethod String
"data" [Parameter]
np (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
ptrT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
constT Type
wcharT
, String -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName String name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkConstMethod String
"size" [Parameter]
np Type
sizeT
]
where
addendum :: Generator ()
addendum = do
HsImportSet -> Generator ()
addImports (HsImportSet -> Generator ()) -> HsImportSet -> Generator ()
forall a b. (a -> b) -> a -> b
$ [HsImportSet] -> HsImportSet
forall a. Monoid a => [a] -> a
mconcat [HsImportSet
hsImportForPrelude, HsImportSet
hsImportForForeignC]
String -> Generator ()
addExport String
"stdWstring_newFromCWStringLen"
String -> Generator ()
sayLn String
"stdWstring_newFromCWStringLen :: HoppyFC.CWStringLen -> HoppyP.IO StdWstring"
String -> Generator ()
sayLn String
"stdWstring_newFromCWStringLen (p,n) ="
Generator () -> Generator ()
forall a. Generator a -> Generator a
indent (Generator () -> Generator ()) -> Generator () -> Generator ()
forall a b. (a -> b) -> a -> b
$ String -> Generator ()
sayLn String
"stdWstring_newFromCWStringLen_raw p (HoppyP.fromIntegral n)"