-- This file is part of Hoppy.
--
-- Copyright 2015-2021 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 [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)"