-- This file is part of Hoppy.
--
-- Copyright 2015-2024 Bryan Gardiner <bog@khumba.net>
--
-- Licensed under the Apache License, Version 2.0 (the "License");
-- you may not use this file except in compliance with the License.
-- You may obtain a copy of the License at
--
--     http://www.apache.org/licenses/LICENSE-2.0
--
-- Unless required by applicable law or agreed to in writing, software
-- distributed under the License is distributed on an "AS IS" BASIS,
-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-- See the License for the specific language governing permissions and
-- limitations under the License.

{-# LANGUAGE CPP #-}

-- | Bindings for @std::wstring@.
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),
  )

-- | @std::wstring@
c_wstring :: Class
c_wstring :: Class
c_wstring =
  [Include] -> Class -> Class
forall a. HasReqs a => [Include] -> a -> a
addReqIncludes [ErrorMsg -> Include
includeStd ErrorMsg
"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
      { 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 a. a -> ReaderT Env (WriterT Output (Except ErrorMsg)) a
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
$ ErrorMsg -> HsName
HsIdent ErrorMsg
"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]
        ErrorMsg -> Generator ()
sayLn ErrorMsg
"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 [ErrorMsg -> ErrorMsg -> HsImportSet
hsImport1 ErrorMsg
"Control.Applicative" ErrorMsg
"(<*)",
                              HsImportSet
hsImportForForeignC,
                              HsImportSet
hsImportForPrelude,
                              HsImportSet
hsImportForRuntime]
        ErrorMsg -> Generator ()
sayLn ErrorMsg
"\\s -> do"
        Generator () -> Generator ()
forall a. Generator a -> Generator a
indent (Generator () -> Generator ()) -> Generator () -> Generator ()
forall a b. (a -> b) -> a -> b
$ do
          ErrorMsg -> Generator ()
sayLn ErrorMsg
"p <- stdWstring_data s"
          ErrorMsg -> Generator ()
sayLn ErrorMsg
"n <- stdWstring_size s"
          ErrorMsg -> Generator ()
sayLn ErrorMsg
"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 (ErrorMsg -> ErrorMsg -> Identifier
ident1 ErrorMsg
"std" ErrorMsg
"wstring") (ExtName -> Maybe ExtName
forall a. a -> Maybe a
Just (ExtName -> Maybe ExtName) -> ExtName -> Maybe ExtName
forall a b. (a -> b) -> a -> b
$ HasCallStack => ErrorMsg -> ExtName
ErrorMsg -> ExtName
toExtName ErrorMsg
"StdWstring") []
  [ ErrorMsg -> [Parameter] -> ClassEntity
forall p. IsParameter p => ErrorMsg -> [p] -> ClassEntity
mkCtor ErrorMsg
"new" [Parameter]
np
  , ErrorMsg -> [Type] -> ClassEntity
forall p. IsParameter p => ErrorMsg -> [p] -> ClassEntity
mkCtor ErrorMsg
"newFromCWString" [Type -> Type
ptrT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
constT Type
wcharT]
  , ErrorMsg -> [Type] -> ClassEntity
forall p. IsParameter p => ErrorMsg -> [p] -> ClassEntity
mkCtor ErrorMsg
"newFromCWStringLen_raw" [Type -> Type
ptrT (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type -> Type
constT Type
wcharT, Type
sizeT]
  , ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkMethod' ErrorMsg
"at" ErrorMsg
"at" [Type
intT] (Type -> ClassEntity) -> Type -> ClassEntity
forall a b. (a -> b) -> a -> b
$ Type -> Type
refT Type
wcharT
  , ErrorMsg -> ErrorMsg -> [Type] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> ErrorMsg -> [p] -> Type -> ClassEntity
mkConstMethod' ErrorMsg
"at" ErrorMsg
"get" [Type
intT] Type
wcharT
  , ErrorMsg -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkConstMethod ErrorMsg
"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
  , ErrorMsg -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkConstMethod ErrorMsg
"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
  , ErrorMsg -> [Parameter] -> Type -> ClassEntity
forall name p.
(IsFnName ErrorMsg name, IsParameter p) =>
name -> [p] -> Type -> ClassEntity
mkConstMethod ErrorMsg
"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]
      ErrorMsg -> Generator ()
addExport ErrorMsg
"stdWstring_newFromCWStringLen"
      ErrorMsg -> Generator ()
sayLn ErrorMsg
"stdWstring_newFromCWStringLen :: HoppyFC.CWStringLen -> HoppyP.IO StdWstring"
      ErrorMsg -> Generator ()
sayLn ErrorMsg
"stdWstring_newFromCWStringLen (p,n) ="
      Generator () -> Generator ()
forall a. Generator a -> Generator a
indent (Generator () -> Generator ()) -> Generator () -> Generator ()
forall a b. (a -> b) -> a -> b
$ ErrorMsg -> Generator ()
sayLn ErrorMsg
"stdWstring_newFromCWStringLen_raw p (HoppyP.fromIntegral n)"