packages feed

hoppy-std (empty) → 0.1.0

raw patch · 16 files changed

+1752/−0 lines, 16 filesdep +basedep +filepathdep +haskell-srcsetup-changed

Dependencies added: base, filepath, haskell-src, hoppy-generator

Files

+ LICENSE view
@@ -0,0 +1,202 @@++                                 Apache License+                           Version 2.0, January 2004+                        http://www.apache.org/licenses/++   TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION++   1. Definitions.++      "License" shall mean the terms and conditions for use, reproduction,+      and distribution as defined by Sections 1 through 9 of this document.++      "Licensor" shall mean the copyright owner or entity authorized by+      the copyright owner that is granting the License.++      "Legal Entity" shall mean the union of the acting entity and all+      other entities that control, are controlled by, or are under common+      control with that entity. For the purposes of this definition,+      "control" means (i) the power, direct or indirect, to cause the+      direction or management of such entity, whether by contract or+      otherwise, or (ii) ownership of fifty percent (50%) or more of the+      outstanding shares, or (iii) beneficial ownership of such entity.++      "You" (or "Your") shall mean an individual or Legal Entity+      exercising permissions granted by this License.++      "Source" form shall mean the preferred form for making modifications,+      including but not limited to software source code, documentation+      source, and configuration files.++      "Object" form shall mean any form resulting from mechanical+      transformation or translation of a Source form, including but+      not limited to compiled object code, generated documentation,+      and conversions to other media types.++      "Work" shall mean the work of authorship, whether in Source or+      Object form, made available under the License, as indicated by a+      copyright notice that is included in or attached to the work+      (an example is provided in the Appendix below).++      "Derivative Works" shall mean any work, whether in Source or Object+      form, that is based on (or derived from) the Work and for which the+      editorial revisions, annotations, elaborations, or other modifications+      represent, as a whole, an original work of authorship. For the purposes+      of this License, Derivative Works shall not include works that remain+      separable from, or merely link (or bind by name) to the interfaces of,+      the Work and Derivative Works thereof.++      "Contribution" shall mean any work of authorship, including+      the original version of the Work and any modifications or additions+      to that Work or Derivative Works thereof, that is intentionally+      submitted to Licensor for inclusion in the Work by the copyright owner+      or by an individual or Legal Entity authorized to submit on behalf of+      the copyright owner. For the purposes of this definition, "submitted"+      means any form of electronic, verbal, or written communication sent+      to the Licensor or its representatives, including but not limited to+      communication on electronic mailing lists, source code control systems,+      and issue tracking systems that are managed by, or on behalf of, the+      Licensor for the purpose of discussing and improving the Work, but+      excluding communication that is conspicuously marked or otherwise+      designated in writing by the copyright owner as "Not a Contribution."++      "Contributor" shall mean Licensor and any individual or Legal Entity+      on behalf of whom a Contribution has been received by Licensor and+      subsequently incorporated within the Work.++   2. Grant of Copyright License. Subject to the terms and conditions of+      this License, each Contributor hereby grants to You a perpetual,+      worldwide, non-exclusive, no-charge, royalty-free, irrevocable+      copyright license to reproduce, prepare Derivative Works of,+      publicly display, publicly perform, sublicense, and distribute the+      Work and such Derivative Works in Source or Object form.++   3. Grant of Patent License. Subject to the terms and conditions of+      this License, each Contributor hereby grants to You a perpetual,+      worldwide, non-exclusive, no-charge, royalty-free, irrevocable+      (except as stated in this section) patent license to make, have made,+      use, offer to sell, sell, import, and otherwise transfer the Work,+      where such license applies only to those patent claims licensable+      by such Contributor that are necessarily infringed by their+      Contribution(s) alone or by combination of their Contribution(s)+      with the Work to which such Contribution(s) was submitted. If You+      institute patent litigation against any entity (including a+      cross-claim or counterclaim in a lawsuit) alleging that the Work+      or a Contribution incorporated within the Work constitutes direct+      or contributory patent infringement, then any patent licenses+      granted to You under this License for that Work shall terminate+      as of the date such litigation is filed.++   4. Redistribution. You may reproduce and distribute copies of the+      Work or Derivative Works thereof in any medium, with or without+      modifications, and in Source or Object form, provided that You+      meet the following conditions:++      (a) You must give any other recipients of the Work or+          Derivative Works a copy of this License; and++      (b) You must cause any modified files to carry prominent notices+          stating that You changed the files; and++      (c) You must retain, in the Source form of any Derivative Works+          that You distribute, all copyright, patent, trademark, and+          attribution notices from the Source form of the Work,+          excluding those notices that do not pertain to any part of+          the Derivative Works; and++      (d) If the Work includes a "NOTICE" text file as part of its+          distribution, then any Derivative Works that You distribute must+          include a readable copy of the attribution notices contained+          within such NOTICE file, excluding those notices that do not+          pertain to any part of the Derivative Works, in at least one+          of the following places: within a NOTICE text file distributed+          as part of the Derivative Works; within the Source form or+          documentation, if provided along with the Derivative Works; or,+          within a display generated by the Derivative Works, if and+          wherever such third-party notices normally appear. The contents+          of the NOTICE file are for informational purposes only and+          do not modify the License. You may add Your own attribution+          notices within Derivative Works that You distribute, alongside+          or as an addendum to the NOTICE text from the Work, provided+          that such additional attribution notices cannot be construed+          as modifying the License.++      You may add Your own copyright statement to Your modifications and+      may provide additional or different license terms and conditions+      for use, reproduction, or distribution of Your modifications, or+      for any such Derivative Works as a whole, provided Your use,+      reproduction, and distribution of the Work otherwise complies with+      the conditions stated in this License.++   5. Submission of Contributions. Unless You explicitly state otherwise,+      any Contribution intentionally submitted for inclusion in the Work+      by You to the Licensor shall be under the terms and conditions of+      this License, without any additional terms or conditions.+      Notwithstanding the above, nothing herein shall supersede or modify+      the terms of any separate license agreement you may have executed+      with Licensor regarding such Contributions.++   6. Trademarks. This License does not grant permission to use the trade+      names, trademarks, service marks, or product names of the Licensor,+      except as required for reasonable and customary use in describing the+      origin of the Work and reproducing the content of the NOTICE file.++   7. Disclaimer of Warranty. Unless required by applicable law or+      agreed to in writing, Licensor provides the Work (and each+      Contributor provides its Contributions) on an "AS IS" BASIS,+      WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or+      implied, including, without limitation, any warranties or conditions+      of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A+      PARTICULAR PURPOSE. You are solely responsible for determining the+      appropriateness of using or redistributing the Work and assume any+      risks associated with Your exercise of permissions under this License.++   8. Limitation of Liability. In no event and under no legal theory,+      whether in tort (including negligence), contract, or otherwise,+      unless required by applicable law (such as deliberate and grossly+      negligent acts) or agreed to in writing, shall any Contributor be+      liable to You for damages, including any direct, indirect, special,+      incidental, or consequential damages of any character arising as a+      result of this License or out of the use or inability to use the+      Work (including but not limited to damages for loss of goodwill,+      work stoppage, computer failure or malfunction, or any and all+      other commercial damages or losses), even if such Contributor+      has been advised of the possibility of such damages.++   9. Accepting Warranty or Additional Liability. While redistributing+      the Work or Derivative Works thereof, You may choose to offer,+      and charge a fee for, acceptance of support, warranty, indemnity,+      or other liability obligations and/or rights consistent with this+      License. However, in accepting such obligations, You may act only+      on Your own behalf and on Your sole responsibility, not on behalf+      of any other Contributor, and only if You agree to indemnify,+      defend, and hold each Contributor harmless for any liability+      incurred by, or claims asserted against, such Contributor by reason+      of your accepting any such warranty or additional liability.++   END OF TERMS AND CONDITIONS++   APPENDIX: How to apply the Apache License to your work.++      To apply the Apache License to your work, attach the following+      boilerplate notice, with the fields enclosed by brackets "[]"+      replaced with your own identifying information. (Don't include+      the brackets!)  The text should be enclosed in the appropriate+      comment syntax for the file format. We also recommend that a+      file or class name and description of purpose be included on the+      same "printed page" as the copyright notice for easier+      identification within third-party archives.++   Copyright [yyyy] [name of copyright owner]++   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.
+ Setup.hs view
@@ -0,0 +1,18 @@+-- This file is part of Hoppy.+--+-- Copyright 2016 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.++import Distribution.Simple+main = defaultMain
+ hoppy-std.cabal view
@@ -0,0 +1,44 @@+name: hoppy-std+version: 0.1.0+synopsis: C++ FFI generator - Standard library bindings+homepage: http://khumba.net/projects/hoppy+license: Apache-2.0+license-file: LICENSE+author: Bryan Gardiner <bog@khumba.net>+maintainer: Bryan Gardiner <bog@khumba.net>+copyright: Copyright 2015-2016 Bryan Gardiner+category: Foreign+build-type: Simple+cabal-version: >=1.10+description:+    Hoppy generates Haskell bindings to C++ libraries.+    .+    This package contains definitions for the C++ standard library.++data-files:+    include/hoppy/std/iterator.hpp+  , include/hoppy/std/map.hpp+  , include/hoppy/std/set.hpp+  , include/hoppy/std/utility.hpp++library+  exposed-modules:+      Foreign.Hoppy.Generator.Std+    , Foreign.Hoppy.Generator.Std.Iterator+    , Foreign.Hoppy.Generator.Std.List+    , Foreign.Hoppy.Generator.Std.Map+    , Foreign.Hoppy.Generator.Std.Pair+    , Foreign.Hoppy.Generator.Std.Set+    , Foreign.Hoppy.Generator.Std.String+    , Foreign.Hoppy.Generator.Std.Vector+  other-modules:+      Foreign.Hoppy.Generator.Std.Internal+    , Paths_hoppy_std+  build-depends:+      base >=4.7 && <4.9+    , filepath >=1.0 && <1.5+    , haskell-src >=1.0 && <1.1+    , hoppy-generator >=0.1 && <0.2+  hs-source-dirs: src+  ghc-options: -W -fwarn-incomplete-patterns -fwarn-unused-do-bind+  default-language: Haskell2010
+ include/hoppy/std/iterator.hpp view
@@ -0,0 +1,40 @@+#ifndef HOPPY_STD_ITERATOR_HPP+#define HOPPY_STD_ITERATOR_HPP++// This file is part of Hoppy.+//+// Copyright 2015-2016 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.++#include <iterator>++namespace hoppy {+namespace iterator {++template <typename Iter, typename T>+T& put(Iter* self, const T& value) {+    return (**self = value);+}++template <typename Container>+typename Container::iterator deconst(+    typename Container::const_iterator iterator,+    Container& container) {+    return container.erase(iterator, iterator);+}++}  // namespace iterator+}  // namespace hoppy++#endif
+ include/hoppy/std/map.hpp view
@@ -0,0 +1,43 @@+#ifndef HOPPY_STD_MAP_HPP+#define HOPPY_STD_MAP_HPP++// This file is part of Hoppy.+//+// Copyright 2015-2016 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.++#include <map>++namespace hoppy {+namespace map {++template <typename K, typename V>+const K& getIteratorKey(const typename std::map<K, V>::const_iterator& iterator) {+    return iterator->first;+}++template <typename K, typename V>+V& getIteratorValue(typename std::map<K, V>::iterator& iterator) {+    return iterator->second;+}++template <typename K, typename V>+const V& getIteratorValue(const typename std::map<K, V>::const_iterator& iterator) {+    return iterator->second;+}++}  // namespace map+}  // namespace hoppy++#endif
+ include/hoppy/std/set.hpp view
@@ -0,0 +1,38 @@+#ifndef HOPPY_STD_SET_HPP+#define HOPPY_STD_SET_HPP++// This file is part of Hoppy.+//+// Copyright 2015-2016 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.++#include <set>++namespace hoppy {+namespace set {++template <typename T>+bool insert(std::set<T>& set, const T& value) {+    return set.insert(value).second;+}++template <typename T>+typename std::set<T>::iterator insertAndGetIterator(std::set<T>& set, const T& value) {+    return set.insert(value).first;+}++}  // namespace set+}  // namespace hoppy++#endif
+ include/hoppy/std/utility.hpp view
@@ -0,0 +1,48 @@+#ifndef HOPPY_STD_UTILITY_HPP+#define HOPPY_STD_UTILITY_HPP++// This file is part of Hoppy.+//+// Copyright 2015-2016 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.++#include <utility>++namespace hoppy {+namespace utility {++template <typename A, typename B>+A& pairFirst(std::pair<A, B>& pair) {+    return pair.first;+}++template <typename A, typename B>+const A& pairFirst(const std::pair<A, B>& pair) {+    return pair.first;+}++template <typename A, typename B>+B& pairSecond(std::pair<A, B>& pair) {+    return pair.second;+}++template <typename A, typename B>+const B& pairSecond(const std::pair<A, B>& pair) {+    return pair.second;+}++}  // namespace utility+}  // namespace hoppy++#endif
+ src/Foreign/Hoppy/Generator/Std.hs view
@@ -0,0 +1,45 @@+-- This file is part of Hoppy.+--+-- Copyright 2015-2016 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.++-- | Bindings for @std@ that aren't in other modules.+module Foreign.Hoppy.Generator.Std (+  ValueConversion (..),+  mod_std,+  c_string,+  ) where++import Foreign.Hoppy.Generator.Spec+import Foreign.Hoppy.Generator.Std.String (c_string)++{-# ANN module "HLint: ignore Use camelCase" #-}++-- | Specifies how values in a collection should be converted when converting+-- the collection as a whole.+data ValueConversion =+    ConvertPtr+    -- ^ A C++ value of type @t@ will convert to a foreign value of type @'TPtr'+    -- t@.+  | ConvertValue+    -- ^ A C++ value of type @t@ will convert to a foreign value of type @t@.+    -- For an object type ('TObj'), the class must have conversions+    -- ('ClassConversion').+  deriving (Bounded, Enum, Eq, Ord, Show)++-- | Include @std::string@.+mod_std :: Module+mod_std = moduleModify' (makeModule "std" "std.hpp" "std.cpp") $+  moduleAddExports+  [ ExportClass c_string ]
+ src/Foreign/Hoppy/Generator/Std/Internal.hs view
@@ -0,0 +1,35 @@+-- This file is part of Hoppy.+--+-- Copyright 2015-2016 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.++-- | Package-specific utilities.+module Foreign.Hoppy.Generator.Std.Internal (+  includeHelper,+  ) where++import Foreign.Hoppy.Generator.Spec (Include, includeLocal)+import Paths_hoppy_std (getDataFileName)+import System.IO.Unsafe (unsafePerformIO)+import System.FilePath ((</>))++includeDir :: FilePath+{-# NOINLINE includeDir #-}+includeDir = unsafePerformIO $ getDataFileName $ "include" </> "hoppy" </> "std"++-- | Returns a C++ include pointing to the header specified, within the+-- installed location corresponding to the @include/hoppy/std@ path in the @std@+-- sources.  (Example: @includeHelper \"utility.hpp\"@)+includeHelper :: FilePath -> Include+includeHelper filename = includeLocal $ includeDir </> filename
+ src/Foreign/Hoppy/Generator/Std/Iterator.hs view
@@ -0,0 +1,162 @@+-- This file is part of Hoppy.+--+-- Copyright 2015-2016 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.++-- | Support for STL-style iterators.  The functions in this module modify a+-- class to add functionality that is provided by different types of STL+-- iterators.  In the method pseudotypes documented here, the parameter types+-- are 'Type's, and all methods are nonpure.+module Foreign.Hoppy.Generator.Std.Iterator (+  IteratorMutability (..),+  makeTrivialIterator,+  makeForwardIterator,+  makeBidirectionalIterator,+  makeRandomIterator,+  ) where++import Data.Maybe (catMaybes, isJust)+import Foreign.Hoppy.Generator.Spec (+  Class,+  MethodApplicability (MNormal),+  Operator (+    OpAdd,+    OpAddAssign,+    OpArray,+    OpDecPre,+    OpDeref,+    OpIncPre,+    OpSubtract,+    OpSubtractAssign),+  Purity (Nonpure),+  Type (TConst, TObj, TObjToHeap, TPtr, TRef, TVoid),+  addReqIncludes,+  classAddCtors,+  classAddMethods,+  ident2,+  makeFnMethod,+  mkConstMethod',+  mkCtor,+  mkMethod',+  )+import Foreign.Hoppy.Generator.Spec.ClassFeature (+  ClassFeature (Assignable, Copyable, Equatable),+  classAddFeatures,+  )+import Foreign.Hoppy.Generator.Std.Internal (includeHelper)++-- | Whether an iterator may be used to modify the underlying collection.+data IteratorMutability = Constant | Mutable+  deriving (Eq, Ord, Show)++-- | @makeTrivialIteartor mutable valueTypeMaybe cls@ turns a class into a+-- trivial iterator, adding:+--+-- * A default constructor named @new@.+--+-- * The class features 'Assignable', 'Copyable', and 'Equatable'.+--+-- * __operator*:__ @getConst :: this -> 'TRef' ('TConst' valueType)@; if+-- @valueTypeMaybe@ is present.+--+-- * __operator*:__ @get :: this -> 'TRef' valueType@; if @valueTypeMaybe@ is+-- present and @mutable@ is 'Mutable'.+--+-- * __*iter = x:__ @put :: this -> valueType -> 'TVoid'@; if @valueTypeMaybe@+-- is present and @mutable@ is 'Mutable'.+makeTrivialIterator :: IteratorMutability -> Maybe Type -> Class -> Class+makeTrivialIterator mutable valueTypeMaybe cls =+  (if isJust valueTypeMaybe && mutable == Mutable+   then addReqIncludes [includeHelper "iterator.hpp"]+   else id) $+  classAddFeatures [Assignable, Copyable, Equatable] $+  classAddCtors ctors $+  classAddMethods methods cls+  where ctors =+          [ mkCtor "new" []+          ]+        methods =+          catMaybes+          [ do valueType <- valueTypeMaybe+               Mutable <- Just mutable+               return $ mkMethod' OpDeref "get" [] $ TRef valueType+          , do valueType <- valueTypeMaybe+               return $ mkConstMethod' OpDeref "getConst" [] $ TRef $ TConst valueType+          , do valueType <- valueTypeMaybe+               Mutable <- Just mutable+               return $+                 makeFnMethod (ident2 "hoppy" "iterator" "put") "put"+                 MNormal Nonpure [TPtr $ TObj cls, valueType] TVoid+          ]++-- | Turns a class into a forward iterator, including everything from+-- 'makeTrivialIterator' plus the pre-increment operator:+--+-- * __operator++:__ @next :: this -> 'TRef' ('TObj' cls)@.+makeForwardIterator :: IteratorMutability -> Maybe Type -> Class -> Class+makeForwardIterator mutable valueTypeMaybe cls =+  classAddMethods methods $+  makeTrivialIterator mutable valueTypeMaybe cls+  where methods =+          [ mkMethod' OpIncPre "next" [] $ TRef $ TObj cls+          ]++-- | Turns a class into a bidirectional iterator, including everything from+-- 'makeForwardIterator' plus the pre-decrement operator:+--+-- * __operator--:__ @prev :: this -> 'TRef' ('TObj' cls)@.+makeBidirectionalIterator :: IteratorMutability -> Maybe Type -> Class -> Class+makeBidirectionalIterator mutability valueTypeMaybe cls =+  classAddMethods methods $+  makeForwardIterator mutability valueTypeMaybe cls+  where methods =+          [ mkMethod' OpDecPre "prev" [] $ TRef $ TObj cls+          ]++-- | @makeRandomIterator mutable valueTypeMaybe distanceType cls@ turns a class+-- into a random iterator, including everything from 'makeBidirectionalIterator'+-- plus some methods:+--+-- * __operator+=:__ @add :: this -> distanceType -> 'TRef' ('TObj' cls)@.+--+-- * __operator+:__ @plusNew :: this -> distanceType -> 'TObjToHeap' cls@.+--+-- * __operator-=:__ @subtract :: distanceType -> 'TRef' ('TObj' cls)@.+--+-- * __operator-:__ @minusNew :: distanceType -> 'TObjToHeap' cls@.+--+-- * __operator-:__ @difference :: this -> this -> distanceType@.+--+-- * __operator[]:__ @atConst :: distanceType -> 'TRef' ('TConst' valueType)@;+-- if @valueTypeMaybe@ is present.+--+-- * __operator[]:__ @at :: distanceType -> 'TRef' valueType@; if+-- @valueTypeMaybe@ is present and @mutable@ is 'Mutable'.+makeRandomIterator :: IteratorMutability -> Maybe Type -> Type -> Class -> Class+makeRandomIterator mutable valueTypeMaybe distanceType cls =+  classAddMethods methods $+  makeBidirectionalIterator mutable valueTypeMaybe cls+  where methods =+          catMaybes+          [ Just $ mkMethod' OpAdd "plusNew" [distanceType] $ TObjToHeap cls+          , Just $ mkMethod' OpAddAssign "add" [distanceType] $ TRef $ TObj cls+          , Just $ mkMethod' OpSubtract "minusNew" [distanceType] $ TObjToHeap cls+          , Just $ mkMethod' OpSubtract "difference" [TObj cls] distanceType+          , Just $ mkMethod' OpSubtractAssign "subtract" [distanceType] $ TRef $ TObj cls+          , do valueType <- valueTypeMaybe+               Mutable <- Just mutable+               return $ mkMethod' OpArray "at" [distanceType] $ TRef valueType+          , do valueType <- valueTypeMaybe+               return $ mkConstMethod' OpArray "atConst" [distanceType] $ TRef $ TConst valueType+          ]
+ src/Foreign/Hoppy/Generator/Std/List.hs view
@@ -0,0 +1,241 @@+-- This file is part of Hoppy.+--+-- Copyright 2015-2016 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::list@.+module Foreign.Hoppy.Generator.Std.List (+  Options (..),+  defaultOptions,+  Contents (..),+  instantiate,+  instantiate',+  toExports,+  ) where++import Control.Monad (forM_, when)+#if !MIN_VERSION_base(4,8,0)+import Data.Monoid (mconcat)+#endif+import Foreign.Hoppy.Generator.Language.Haskell (+  HsTypeSide (HsHsSide),+  addImports,+  cppTypeToHsTypeAndUse,+  indent,+  ln,+  prettyPrint,+  sayLn,+  saysLn,+  toHsDataTypeName,+  toHsMethodName',+  )+import Foreign.Hoppy.Generator.Spec+import Foreign.Hoppy.Generator.Spec.ClassFeature (+  ClassFeature (Assignable, Comparable, Copyable, Equatable),+  classAddFeatures,+  )+import Foreign.Hoppy.Generator.Std (ValueConversion (ConvertPtr, ConvertValue))+import Foreign.Hoppy.Generator.Std.Iterator+import Foreign.Hoppy.Generator.Version (collect, just, test)++-- | Options for instantiating the list classes.+data Options = Options+  { optListClassFeatures :: [ClassFeature]+    -- ^ Additional features to add to the @std::list@ class.  Lists are always+    -- 'Assignable' and 'Copyable', but you may want to add 'Equatable' and+    -- 'Comparable' if your value type supports those.+  , optValueConversion :: Maybe ValueConversion+  }++-- | The default options have no additional 'ClassFeature's.+defaultOptions :: Options+defaultOptions = Options [] Nothing++-- | A set of instantiated list classes.+data Contents = Contents+  { c_list :: Class  -- ^ @std::list\<T>@+  , c_iterator :: Class  -- ^ @std::list\<T>::iterator@+  , c_constIterator :: Class  -- ^ @std::list\<T>::const_iterator@+  }++-- | @instantiate className t tReqs@ creates a set of bindings for an+-- instantiation of @std::list@ and associated types (e.g. iterators).  In the+-- result, the 'c_list' class has an external name of @className@, and the+-- iterator classes are further suffixed with @\"Iterator\"@ and+-- @\"ConstIterator\"@ respectively.+instantiate :: String -> Type -> Reqs -> Contents+instantiate listName t tReqs = instantiate' listName t tReqs defaultOptions++-- | 'instantiate' with additional options.+instantiate' :: String -> Type -> Reqs -> Options -> Contents+instantiate' listName t tReqs opts =+  let reqs = mconcat [tReqs, reqInclude $ includeStd "list"]+      iteratorName = listName ++ "Iterator"+      constIteratorName = listName ++ "ConstIterator"+      features = Assignable : Copyable : optListClassFeatures opts++      list =+        (case optValueConversion opts of+           Nothing -> id+           Just conversion -> addAddendumHaskell $ makeAddendum conversion) $+        addReqs reqs $+        classAddFeatures features $+        makeClass (ident1T "std" "list" [t]) (Just $ toExtName listName) []+        [ mkCtor "new" []+        ] $+        collect+        [ just $ mkMethod' "back" "back" [] $ TRef t+        , just $ mkConstMethod' "back" "backConst" [] $ TRef $ TConst t+        , just $ mkMethod' "begin" "begin" [] $ TObjToHeap iterator+        , just $ mkConstMethod' "begin" "beginConst" [] $ TObjToHeap constIterator+        , just $ mkMethod "clear" [] TVoid+        , just $ mkConstMethod "empty" [] TBool+        , just $ mkMethod' "end" "end" [] $ TObjToHeap iterator+        , just $ mkConstMethod' "end" "endConst" [] $ TObjToHeap constIterator+        , just $ mkMethod' "erase" "erase" [TObj iterator] TVoid+        , just $ mkMethod' "erase" "eraseRange" [TObj iterator, TObj iterator] TVoid+        , just $ mkMethod' "front" "front" [] $ TRef t+        , just $ mkConstMethod' "front" "frontConst" [] $ TRef $ TConst t+        , just $ mkMethod' "insert" "insert" [TObj iterator, t] TVoid+        , just $ mkMethod' "insert" "insertAndGetIterator"+          [TObj iterator, t] $ TObjToHeap iterator+        , just $ mkConstMethod' "max_size" "maxSize" [] TSize+        , test (elem Comparable features) $ mkMethod "merge" [TRef $ TObj list] TVoid+          -- TODO merge(list&, Comparator)+        , just $ mkMethod' "pop_back" "popBack" [] TVoid+        , just $ mkMethod' "pop_front" "popFront" [] TVoid+        , just $ mkMethod' "push_back" "pushBack" [t] TVoid+        , just $ mkMethod' "push_front" "pushFront" [t] TVoid+        , test (elem Equatable features) $ mkMethod "remove" [t] TVoid+          -- TODO remove_if(UnaryPredicate)+        , just $ mkMethod' "resize" "resize" [TSize] TVoid+        , just $ mkMethod' "resize" "resizeWith" [TSize, t] TVoid+        , just $ mkMethod "reverse" [] TVoid+        , just $ mkConstMethod "size" [] TSize+        , test (elem Comparable features) $ mkMethod "sort" [] TVoid+          -- TODO sort(Comparator)+        , just $ mkMethod' "splice" "spliceAll" [TObj iterator, TRef $ TObj list] TVoid+        , just $ mkMethod' "splice" "spliceOne"+          [TObj iterator, TRef $ TObj list, TObj iterator] TVoid+        , just $ mkMethod' "splice" "spliceRange"+          [TObj iterator, TRef $ TObj list, TObj iterator, TObj iterator] TVoid+        , just $ mkMethod "swap" [TRef $ TObj list] TVoid+        , test (Equatable `elem` features) $ mkMethod "unique" [] TVoid+          -- TODO unique(BinaryPredicate)+        ]++      iterator =+        addReqs reqs $+        makeBidirectionalIterator Mutable (Just t) $+        makeClass (identT' [("std", Nothing), ("list", Just [t]), ("iterator", Nothing)])+        (Just $ toExtName iteratorName) [] [] []++      constIterator =+        addReqs reqs $+        makeBidirectionalIterator Constant (Just t) $+        makeClass (identT' [("std", Nothing), ("list", Just [t]), ("const_iterator", Nothing)])+        (Just $ toExtName constIteratorName)+        []+        [ mkCtor "newFromConst" [TObj iterator]+        ]+        [ makeFnMethod (ident2 "hoppy" "iterator" "deconst") "deconst" MConst Nonpure+          [TObj constIterator, TRef $ TObj list] $ TObjToHeap iterator+        ]++      -- The addendum for the list class contains HasContents and FromContents+      -- instances.+      makeAddendum conversion = do+        addImports $ mconcat [hsImport1 "Prelude" "($)",+                              hsImportForPrelude,+                                hsImportForRuntime]+        when (conversion == ConvertValue) $+          addImports $ hsImport1 "Prelude" "(=<<)"++        forM_ [Const, Nonconst] $ \cst -> do+          let hsDataTypeName = toHsDataTypeName cst list+          hsValueType <-+            cppTypeToHsTypeAndUse HsHsSide $+            (case conversion of+               ConvertPtr -> TPtr+               ConvertValue -> id) $+            case cst of+              Const -> TConst t+              Nonconst -> t++          -- Generate const and nonconst HasContents instances.+          ln+          saysLn ["instance HoppyFHR.HasContents ", hsDataTypeName,+                  " (", prettyPrint hsValueType, ") where"]+          indent $ do+            sayLn "toContents this' = do"+            indent $ do+              let listBegin = case cst of+                    Const -> "beginConst"+                    Nonconst -> "begin"+                  listEnd = case cst of+                    Const -> "endConst"+                    Nonconst -> "end"+                  iter = case cst of+                    Const -> constIterator+                    Nonconst -> iterator+                  iterGet = case cst of+                    Const -> "getConst"+                    Nonconst -> "get"+              saysLn ["empty' <- ", toHsMethodName' list "empty", " this'"]+              sayLn "if empty' then HoppyP.return [] else"+              indent $ do+                saysLn ["HoppyFHR.withScopedPtr (", toHsMethodName' list listBegin,+                        " this') $ \\begin' ->"]+                saysLn ["HoppyFHR.withScopedPtr (", toHsMethodName' list listEnd,+                        " this') $ \\iter' ->"]+                sayLn "go' iter' begin' []"+              sayLn "where"+              indent $ do+                sayLn "go' iter' begin' acc' = do"+                indent $ do+                  saysLn ["stop' <- ", toHsMethodName' iter OpEq, " iter' begin'"]+                  sayLn "if stop' then HoppyP.return acc' else do"+                  indent $ do+                    saysLn ["_ <- ", toHsMethodName' iter "prev", " iter'"]+                    saysLn ["value' <- ",+                            case conversion of+                              ConvertPtr -> ""+                              ConvertValue -> "HoppyFHR.decode =<< ",+                            toHsMethodName' iter iterGet, " iter'"]+                    sayLn "go' iter' begin' $ value':acc'"++          -- Only generate a nonconst FromContents instance.+          when (cst == Nonconst) $ do+            ln+            saysLn ["instance HoppyFHR.FromContents ", hsDataTypeName,+                    " (", prettyPrint hsValueType, ") where"]+            indent $ do+              sayLn "fromContents values' = do"+              indent $ do+                saysLn ["list' <- ", toHsMethodName' list "new"]+                saysLn ["HoppyP.mapM_ (", toHsMethodName' list "pushBack", " list') values'"]+                sayLn "HoppyP.return list'"++  in Contents+     { c_list = list+     , c_iterator = iterator+     , c_constIterator = constIterator+     }++-- | Converts an instantiation into a list of exports to be included in a+-- module.+toExports :: Contents -> [Export]+toExports m = map (ExportClass . ($ m)) [c_list, c_iterator, c_constIterator]
+ src/Foreign/Hoppy/Generator/Std/Map.hs view
@@ -0,0 +1,266 @@+-- This file is part of Hoppy.+--+-- Copyright 2015-2016 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::map@.+module Foreign.Hoppy.Generator.Std.Map (+  Options (..),+  defaultOptions,+  Contents (..),+  instantiate,+  instantiate',+  toExports,+  ) where++import Control.Monad (forM_, when)+#if !MIN_VERSION_base(4,8,0)+import Data.Monoid (mconcat)+#endif+import Foreign.Hoppy.Generator.Language.Haskell (+  HsTypeSide (HsHsSide),+  addImports,+  cppTypeToHsTypeAndUse,+  indent,+  ln,+  prettyPrint,+  sayLn,+  saysLn,+  toHsDataTypeName,+  toHsMethodName',+  )+import Foreign.Hoppy.Generator.Spec+import Foreign.Hoppy.Generator.Spec.ClassFeature (+  ClassFeature (Assignable, Copyable),+  classAddFeatures,+  )+import Foreign.Hoppy.Generator.Std (ValueConversion (ConvertPtr, ConvertValue))+import Foreign.Hoppy.Generator.Std.Internal (includeHelper)+import Foreign.Hoppy.Generator.Std.Iterator++-- | Options for instantiating the map classes.+data Options = Options+  { optMapClassFeatures :: [ClassFeature]+    -- ^ Additional features to add to the @std::map@ class.  Maps are always+    -- 'Assignable' and 'Copyable'.+  , optKeyConversion :: Maybe ValueConversion+    -- ^ How to convert values of the key type.+  , optValueConversion :: Maybe ValueConversion+    -- ^ How to convert values of the value type.+  }++-- | The default options have no additional 'ClassFeature's.+defaultOptions :: Options+defaultOptions = Options [] Nothing Nothing++-- | A set of instantiated map classes.+data Contents = Contents+  { c_map :: Class  -- ^ @std::map\<K, V>@+  , c_iterator :: Class  -- ^ @std::map\<K, V>::iterator@+  , c_constIterator :: Class  -- ^ @std::map\<K, V>::const_iterator@+  }++-- | @instantiate className k v reqs@ creates a set of bindings for an+-- instantiation of @std::map\<k, v\>@ and associated types (e.g. iterators).+-- In the result, the 'c_map' class has an external name of @className@, and the+-- iterator classes are further suffixed with @\"Iterator\"@ and+-- @\"ConstIterator\"@ respectively.+instantiate :: String -> Type -> Type -> Reqs -> Contents+instantiate mapName k v reqs = instantiate' mapName k v reqs defaultOptions++-- | 'instantiate' with additional options.+instantiate' :: String -> Type -> Type -> Reqs -> Options -> Contents+instantiate' mapName k v userReqs opts =+  let extName = toExtName mapName+      reqs = mconcat+             [ userReqs+             , reqInclude $ includeHelper "map.hpp"+             , reqInclude $ includeStd "map"+             ]+      iteratorName = mapName ++ "Iterator"+      constIteratorName = mapName ++ "ConstIterator"++      getIteratorKeyIdent = ident2T "hoppy" "map" "getIteratorKey" [k, v]+      getIteratorValueIdent = ident2T "hoppy" "map" "getIteratorValue" [k, v]++      map =+        (case (optKeyConversion opts, optValueConversion opts) of+           (Nothing, Nothing) -> id+           (Just keyConv, Just valueConv) -> addAddendumHaskell $ makeAddendum keyConv valueConv+           (maybeKeyConv, maybeValueConv) ->+             error $ concat+             ["Error instantiating std::map<", show k, ", ", show v, "> (external name ",+              show extName, "), key and value conversions must either both be specified or ",+              "absent; they are, repectively, ", show maybeKeyConv, " and ", show maybeValueConv,+              "."]) $+        addReqs reqs $+        classAddFeatures (Assignable : Copyable : optMapClassFeatures opts) $+        makeClass (ident1T "std" "map" [k, v]) (Just extName) []+        [ mkCtor "new" []+        ]+        [ mkMethod' "at" "at" [k] $ TRef v+        , mkConstMethod' "at" "atConst" [k] $ TRef $ TConst v+        , mkMethod' "begin" "begin" [] $ TObjToHeap iterator+        , mkConstMethod' "begin" "beginConst" [] $ TObjToHeap constIterator+        , mkMethod "clear" [] TVoid+        , mkConstMethod "count" [k] TSize+        , mkConstMethod "empty" [] TBool+        , mkMethod' "end" "end" [] $ TObjToHeap iterator+        , mkConstMethod' "end" "endConst" [] $ TObjToHeap constIterator+          -- equal_range: find is good enough.+        , mkMethod' "erase" "erase" [TObj iterator] TVoid+        , mkMethod' "erase" "eraseKey" [k] TSize+        , mkMethod' "erase" "eraseRange" [TObj iterator, TObj iterator] TVoid+        , mkMethod' "find" "find" [k] $ TObjToHeap iterator+        , mkConstMethod' "find" "findConst" [k] $ TObjToHeap constIterator+          -- TODO insert+          -- lower_bound: find is good enough.+        , mkConstMethod' "max_size" "maxSize" [] TSize+        , mkConstMethod "size" [] TSize+        , mkMethod "swap" [TRef $ TObj map] TVoid+          -- upper_bound: find is good enough.+        , mkMethod OpArray [k] $ TRef v+        ]++      iterator =+        addReqs reqs $+        makeBidirectionalIterator Mutable Nothing $+        makeClass (identT' [("std", Nothing),+                            ("map", Just [k, v]),+                            ("iterator", Nothing)])+        (Just $ toExtName iteratorName) [] []+        [ makeFnMethod getIteratorKeyIdent "getKey" MConst Nonpure+          [TObj iterator] $ TRef $ TConst k+        , makeFnMethod getIteratorValueIdent "getValue" MNormal Nonpure+          [TRef $ TObj iterator] $ TRef v+        , makeFnMethod getIteratorValueIdent "getValueConst" MConst Nonpure+          [TObj iterator] $ TRef $ TConst v+        ]++      constIterator =+        addReqs reqs $+        makeBidirectionalIterator Constant Nothing $+        makeClass (identT' [("std", Nothing),+                            ("map", Just [k, v]),+                            ("const_iterator", Nothing)])+        (Just $ toExtName constIteratorName)+        []+        [ mkCtor "newFromConst" [TObj iterator]+        ]+        [ makeFnMethod (ident2 "hoppy" "iterator" "deconst") "deconst" MConst Nonpure+          [TObj constIterator, TRef $ TObj map] $ TObjToHeap iterator+        , makeFnMethod getIteratorKeyIdent "getKey" MConst Nonpure+          [TObj constIterator] $ TRef $ TConst k+        , makeFnMethod getIteratorValueIdent "getValueConst" MConst Nonpure+          [TObj constIterator] $ TRef $ TConst v+        ]++      -- The addendum for the map class contains HasContents and FromContents+      -- instances with that work with key-value pairs.+      makeAddendum keyConv valueConv = do+        addImports $ mconcat [hsImports "Prelude" ["($)", "(=<<)"],+                              hsImportForPrelude,+                              hsImportForRuntime]++        forM_ [Const, Nonconst] $ \cst -> do+          let hsDataTypeName = toHsDataTypeName cst map++          keyHsType <-+            cppTypeToHsTypeAndUse HsHsSide $+            (case keyConv of+               ConvertPtr -> TPtr+               ConvertValue -> id) $+            TConst k++          valueHsType <-+            cppTypeToHsTypeAndUse HsHsSide $+            (case valueConv of+               ConvertPtr -> TPtr+               ConvertValue -> id) $+            case cst of+              Const -> TConst v+              Nonconst -> v++          -- Generate const and nonconst HasContents instances.+          ln+          saysLn ["instance HoppyFHR.HasContents ", hsDataTypeName,+                  " ((", prettyPrint keyHsType, "), (", prettyPrint valueHsType, ")) where"]+          indent $ do+            sayLn "toContents this' = do"+            indent $ do+              let mapBegin = case cst of+                    Const -> "beginConst"+                    Nonconst -> "begin"+                  mapEnd = case cst of+                    Const -> "endConst"+                    Nonconst -> "end"+                  iter = case cst of+                    Const -> constIterator+                    Nonconst -> iterator+                  iterGetValue = case cst of+                    Const -> "getValueConst"+                    Nonconst -> "getValue"+              saysLn ["empty' <- ", toHsMethodName' map "empty", " this'"]+              sayLn "if empty' then HoppyP.return [] else"+              indent $ do+                saysLn ["HoppyFHR.withScopedPtr (", toHsMethodName' map mapBegin,+                        " this') $ \\begin' ->"]+                saysLn ["HoppyFHR.withScopedPtr (", toHsMethodName' map mapEnd,+                        " this') $ \\iter' ->"]+                sayLn "go' iter' begin' []"+              sayLn "where"+              indent $ do+                sayLn "go' iter' begin' acc' = do"+                indent $ do+                  saysLn ["stop' <- ", toHsMethodName' iter OpEq, " iter' begin'"]+                  sayLn "if stop' then HoppyP.return acc' else do"+                  indent $ do+                    saysLn ["_ <- ", toHsMethodName' iter "prev", " iter'"]+                    saysLn ["key' <- ",+                            case keyConv of+                              ConvertPtr -> ""+                              ConvertValue -> "HoppyFHR.decode =<< ",+                            toHsMethodName' iter "getKey", " iter'"]+                    saysLn ["value' <- ",+                            case valueConv of+                              ConvertPtr -> ""+                              ConvertValue -> "HoppyFHR.decode =<< ",+                            toHsMethodName' iter iterGetValue, " iter'"]+                    sayLn "go' iter' begin' $ (key', value'):acc'"++          -- Only generate a nonconst FromContents instance.+          when (cst == Nonconst) $ do+            ln+            saysLn ["instance HoppyFHR.FromContents ", hsDataTypeName,+                    " ((", prettyPrint keyHsType, "), (", prettyPrint valueHsType, ")) where"]+            indent $ do+              sayLn "fromContents values' = do"+              indent $ do+                saysLn ["map' <- ", toHsMethodName' map "new"]+                saysLn ["HoppyP.mapM_ (\\(k, v) -> HoppyP.flip HoppyFHR.assign v =<< ",+                        toHsMethodName' map "at", " map' k) values'"]+                sayLn "HoppyP.return map'"++  in Contents+     { c_map = map+     , c_iterator = iterator+     , c_constIterator = constIterator+     }++-- | Converts an instantiation into a list of exports to be included in a+-- module.+toExports :: Contents -> [Export]+toExports m = map (ExportClass . ($ m)) [c_map, c_iterator, c_constIterator]
+ src/Foreign/Hoppy/Generator/Std/Pair.hs view
@@ -0,0 +1,97 @@+-- This file is part of Hoppy.+--+-- Copyright 2015-2016 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::pair@.+module Foreign.Hoppy.Generator.Std.Pair (+  Options (..),+  defaultOptions,+  Contents (..),+  instantiate,+  instantiate',+  toExports,+  ) where++#if !MIN_VERSION_base(4,8,0)+import Data.Monoid (mconcat)+#endif+import Foreign.Hoppy.Generator.Spec+import Foreign.Hoppy.Generator.Spec.ClassFeature (+  ClassFeature (Assignable, Copyable),+  classAddFeatures,+  )+import Foreign.Hoppy.Generator.Std.Internal (includeHelper)+import Foreign.Hoppy.Generator.Version (CppVersion (Cpp2011), activeCppVersion, collect, just, test)++-- | Options for instantiating @pair@.+data Options = Options+  { optPairClassFeatures :: [ClassFeature]+    -- ^ Additional features to add to the @std::pair@ class.  Pairs are always+    -- 'Assignable' and 'Copyable'.+  }++-- | The default options have no additional 'ClassFeature's.+defaultOptions :: Options+defaultOptions = Options []++-- | A set of instantiated pair classes.+data Contents = Contents+  { c_pair :: Class  -- ^ @std::pair\<A, B>@+  }++-- | @instantiate className a b reqs@ creates a set of bindings for an+-- instantiation of @std::pair\<a, b\>@.  In the result, the 'c_pair' class has+-- an external name of @className@.+instantiate :: String -> Type -> Type -> Reqs -> Contents+instantiate pairName a b reqs = instantiate' pairName a b reqs defaultOptions++-- | 'instantiate' with additional options.+instantiate' :: String -> Type -> Type -> Reqs -> Options -> Contents+instantiate' pairName a b userReqs opts =+  let reqs = mconcat+             [ userReqs+             , reqInclude $ includeHelper "utility.hpp"+             , reqInclude $ includeStd "utility"+             ]++      pair =+        addReqs reqs $+        classAddFeatures (Assignable : Copyable : optPairClassFeatures opts) $+        makeClass (ident1T "std" "pair" [a, b]) (Just $ toExtName pairName) []+        [ mkCtor "new" []+        , mkCtor "newWith" [a, b]+        ] $+        collect+        [ just $ makeFnMethod (ident2 "hoppy" "utility" "pairFirst") "first" MNormal Nonpure+          [TRef $ TObj pair] $ TRef a+        , just $ makeFnMethod (ident2 "hoppy" "utility" "pairFirst") "firstConst" MConst Nonpure+          [TRef $ TObj pair] $ TRef $ TConst a+        , just $ makeFnMethod (ident2 "hoppy" "utility" "pairSecond") "second" MNormal Nonpure+          [TRef $ TObj pair] $ TRef b+        , just $ makeFnMethod (ident2 "hoppy" "utility" "pairSecond") "secondConst" MConst Nonpure+          [TRef $ TObj pair] $ TRef $ TConst b+        , test (activeCppVersion >= Cpp2011) $ mkMethod "swap" [TRef $ TObj pair] TVoid+        ]++  in Contents+     { c_pair = pair+     }++-- | Converts an instantiation into a list of exports to be included in a+-- module.+toExports :: Contents -> [Export]+toExports m = map (ExportClass . ($ m)) [c_pair]
+ src/Foreign/Hoppy/Generator/Std/Set.hs view
@@ -0,0 +1,204 @@+-- This file is part of Hoppy.+--+-- Copyright 2015-2016 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::set@.+module Foreign.Hoppy.Generator.Std.Set (+  Options (..),+  defaultOptions,+  Contents (..),+  instantiate,+  instantiate',+  toExports,+  ) where++import Control.Monad (forM, when)+#if !MIN_VERSION_base(4,8,0)+import Data.Monoid (mconcat)+#endif+import Foreign.Hoppy.Generator.Language.Haskell (+  HsTypeSide (HsHsSide),+  addImports,+  cppTypeToHsTypeAndUse,+  indent,+  ln,+  prettyPrint,+  sayLn,+  saysLn,+  toHsCastMethodName,+  toHsDataTypeName,+  toHsMethodName',+  )+import Foreign.Hoppy.Generator.Spec+import Foreign.Hoppy.Generator.Spec.ClassFeature (+  ClassFeature (Assignable, Comparable, Copyable),+  classAddFeatures,+  )+import Foreign.Hoppy.Generator.Std (ValueConversion (ConvertPtr, ConvertValue))+import Foreign.Hoppy.Generator.Std.Internal (includeHelper)+import Foreign.Hoppy.Generator.Std.Iterator++-- | Options for instantiating the set classes.+data Options = Options+  { optSetClassFeatures :: [ClassFeature]+    -- ^ Additional features to add to the @std::set@ class.  Sets are always+    -- 'Assignable', 'Comparable', and 'Copyable', but you may want to add+    -- 'Foreign.Hoppy.Generator.Spec.ClassFeature.Equatable' if your value type+    -- supports those.+  , optValueConversion :: Maybe ValueConversion+  }++-- | The default options have no additional 'ClassFeature's.+defaultOptions :: Options+defaultOptions = Options [] Nothing++-- | A set of instantiated set classes.+data Contents = Contents+  { c_set :: Class  -- ^ @std::set\<T>@+  , c_iterator :: Class  -- ^ @std::set\<T>::iterator@+  }++-- | @instantiate className t tReqs@ creates a set of bindings for an+-- instantiation of @std::set@ and associated types (e.g. iterators).  In the+-- result, the 'c_set' class has an external name of @className@, and the+-- iterator class is further suffixed with @\"Iterator\"@.+instantiate :: String -> Type -> Reqs -> Contents+instantiate setName t tReqs = instantiate' setName t tReqs defaultOptions++-- | 'instantiate' with additional options.+instantiate' :: String -> Type -> Reqs -> Options -> Contents+instantiate' setName t tReqs opts =+  let reqs = mconcat+             [ tReqs+             , reqInclude $ includeHelper "set.hpp"+             , reqInclude $ includeStd "set"+             ]+      iteratorName = setName ++ "Iterator"++      set =+        (case optValueConversion opts of+           Nothing -> id+           Just conversion -> addAddendumHaskell $ makeAddendum conversion) $+        addReqs reqs $+        classAddFeatures (Assignable : Comparable : Copyable : optSetClassFeatures opts) $+        makeClass (ident1T "std" "set" [t]) (Just $ toExtName setName) []+        [ mkCtor "new" []+        ]+        [ mkConstMethod "begin" [] $ TObjToHeap iterator+        , mkMethod "clear" [] TVoid+        , mkConstMethod "count" [t] TSize+          -- TODO count+        , mkConstMethod "empty" [] TBool+        , mkConstMethod "end" [] $ TObjToHeap iterator+          -- equalRange: find is good enough.+        , mkMethod' "erase" "erase" [TObj iterator] TVoid+        , mkMethod' "erase" "eraseRange" [TObj iterator, TObj iterator] TVoid+        , mkMethod "find" [t] $ TObjToHeap iterator+        , makeFnMethod (ident2 "hoppy" "set" "insert") "insert"+          MNormal Nonpure [TRef $ TObj set, t] TBool+        , makeFnMethod (ident2 "hoppy" "set" "insertAndGetIterator") "insertAndGetIterator"+          MNormal Nonpure [TRef $ TObj set, t] $ TObjToHeap iterator+          -- lower_bound: find is good enough.+        , mkConstMethod' "max_size" "maxSize" [] TSize+        , mkConstMethod "size" [] TSize+        , mkMethod "swap" [TRef $ TObj set] TVoid+          -- upper_bound: find is good enough.+        ]++      -- Set iterators are always constant, because modifying elements in place+      -- will break the internal order of the set.+      iterator =+        addReqs reqs $+        makeBidirectionalIterator Constant (Just t) $+        makeClass (identT' [("std", Nothing), ("set", Just [t]), ("iterator", Nothing)])+        (Just $ toExtName iteratorName) [] [] []++      -- The addendum for the set class contains HasContents and FromContents+      -- instances.+      makeAddendum conversion = do+        addImports $ mconcat [hsImport1 "Prelude" "($)",+                              hsImportForPrelude,+                              hsImportForRuntime]+        when (conversion == ConvertValue) $+          addImports $ mconcat [hsImport1 "Prelude" "(=<<)"]++        let hsDataNameConst = toHsDataTypeName Const set+            hsDataName = toHsDataTypeName Nonconst set+        [hsValueTypeConst, hsValueType] <- forM [Const, Nonconst] $ \cst ->+            cppTypeToHsTypeAndUse HsHsSide $+            (case conversion of+               ConvertPtr -> TPtr+               ConvertValue -> id) $+            case cst of+              Const -> TConst t+              Nonconst -> t++        -- Generate const and nonconst HasContents instances.+        ln+        saysLn ["instance HoppyFHR.HasContents ", hsDataNameConst,+                " (", prettyPrint hsValueTypeConst, ") where"]+        indent $ do+          sayLn "toContents this' = do"+          indent $ do+            saysLn ["empty' <- ", toHsMethodName' set "empty", " this'"]+            sayLn "if empty' then HoppyP.return [] else"+            indent $ do+              saysLn ["HoppyFHR.withScopedPtr (", toHsMethodName' set "begin",+                      " this') $ \\begin' ->"]+              saysLn ["HoppyFHR.withScopedPtr (", toHsMethodName' set "end",+                      " this') $ \\iter' ->"]+              sayLn "go' iter' begin' []"+            sayLn "where"+            indent $ do+              sayLn "go' iter' begin' acc' = do"+              indent $ do+                saysLn ["stop' <- ", toHsMethodName' iterator OpEq, " iter' begin'"]+                sayLn "if stop' then HoppyP.return acc' else do"+                indent $ do+                  saysLn ["_ <- ", toHsMethodName' iterator "prev", " iter'"]+                  saysLn ["value' <- ",+                          case conversion of+                            ConvertPtr -> ""+                            ConvertValue -> "HoppyFHR.decode =<< ",+                          toHsMethodName' iterator "getConst", " iter'"]+                  sayLn "go' iter' begin' $ value':acc'"+        ln+        saysLn ["instance HoppyFHR.HasContents ", hsDataName,+                " (", prettyPrint hsValueTypeConst, ") where"]+        indent $+          saysLn ["toContents = HoppyFHR.toContents . ", toHsCastMethodName Const set]++        -- Only generate a nonconst FromContents instance.+        ln+        saysLn ["instance HoppyFHR.FromContents ", hsDataName,+                " (", prettyPrint hsValueType, ") where"]+        indent $ do+          sayLn "fromContents values' = do"+          indent $ do+            saysLn ["set' <- ", toHsMethodName' set "new"]+            saysLn ["HoppyP.mapM_ (", toHsMethodName' set "insert", " set') values'"]+            sayLn "HoppyP.return set'"++  in Contents+     { c_set = set+     , c_iterator = iterator+     }++-- | Converts an instantiation into a list of exports to be included in a+-- module.+toExports :: Contents -> [Export]+toExports m = map (ExportClass . ($ m)) [c_set, c_iterator]
+ src/Foreign/Hoppy/Generator/Std/String.hs view
@@ -0,0 +1,62 @@+-- This file is part of Hoppy.+--+-- Copyright 2015-2016 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::string@.+module Foreign.Hoppy.Generator.Std.String (c_string) where++#if !MIN_VERSION_base(4,8,0)+import Data.Monoid (mconcat)+#endif+import Foreign.Hoppy.Generator.Language.Haskell (addImports, sayLn)+import Foreign.Hoppy.Generator.Spec+import Foreign.Hoppy.Generator.Spec.ClassFeature+import Language.Haskell.Syntax (+  HsName (HsIdent),+  HsQName (UnQual),+  HsType (HsTyCon),+  )++-- | @std::string@+c_string :: Class+c_string =+  addReqIncludes [includeStd "string"] $+  classAddFeatures [Assignable, Comparable, Copyable, Equatable] $+  classModifyConversion+  (\c -> c { classHaskellConversion =+             Just ClassHaskellConversion+             { classHaskellConversionType = do+               addImports hsImportForPrelude+               return $ HsTyCon $ UnQual $ HsIdent "HoppyP.String"+             , classHaskellConversionToCppFn = do+               addImports $ mconcat [hsImportForPrelude, hsImportForForeignC]+               sayLn "HoppyP.flip HoppyFC.withCString stdString_newFromCString"+             , classHaskellConversionFromCppFn = do+               addImports $ mconcat [hsImport1 "Control.Monad" "(<=<)", hsImportForForeignC]+               sayLn "HoppyFC.peekCString <=< stdString_c_str"+             }+           }) $+  makeClass (ident1 "std" "string") (Just $ toExtName "StdString")+  []+  [ mkCtor "new" []+  , mkCtor "newFromCString" [TPtr $ TConst TChar]+  ]+  [ mkConstMethod' "at" "at" [TInt] $ TRef TChar+  , mkConstMethod' "at" "get" [TInt] TChar+  , mkConstMethod "c_str" [] $ TPtr $ TConst TChar+  , mkConstMethod "size" [] TSize+  ]
+ src/Foreign/Hoppy/Generator/Std/Vector.hs view
@@ -0,0 +1,207 @@+-- This file is part of Hoppy.+--+-- Copyright 2015-2016 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::vector@.+module Foreign.Hoppy.Generator.Std.Vector (+  Options (..),+  defaultOptions,+  Contents (..),+  instantiate,+  instantiate',+  toExports,+  ) where++import Control.Monad (forM_, when)+#if !MIN_VERSION_base(4,8,0)+import Data.Monoid (mconcat)+#endif+import Foreign.Hoppy.Generator.Language.Haskell (+  HsTypeSide (HsHsSide),+  addImports,+  cppTypeToHsTypeAndUse,+  indent,+  ln,+  prettyPrint,+  sayLn,+  saysLn,+  toHsDataTypeName,+  toHsMethodName',+  )+import Foreign.Hoppy.Generator.Spec+import Foreign.Hoppy.Generator.Spec.ClassFeature (+  ClassFeature (Assignable, Copyable),+  classAddFeatures,+  )+import Foreign.Hoppy.Generator.Std (ValueConversion (ConvertPtr, ConvertValue))+import Foreign.Hoppy.Generator.Std.Iterator+import Foreign.Hoppy.Generator.Version (CppVersion (Cpp2011), activeCppVersion, collect, just, test)++-- | Options for instantiating the vector classes.+data Options = Options+  { optVectorClassFeatures :: [ClassFeature]+    -- ^ Additional features to add to the @std::vector@ class.  Vectors are+    -- always 'Assignable' and 'Copyable', but you may want to add+    -- 'Foreign.Hoppy.Generator.Spec.ClassFeature.Equatable' and+    -- 'Foreign.Hoppy.Generator.Spec.ClassFeature.Comparable' if your value type+    -- supports those.+  , optValueConversion :: Maybe ValueConversion+  }++-- | The default options have no additional 'ClassFeature's.+defaultOptions :: Options+defaultOptions = Options [] Nothing++-- | A set of instantiated vector classes.+data Contents = Contents+  { c_vector :: Class  -- ^ @std::vector\<T>@+  , c_iterator :: Class  -- ^ @std::vector\<T>::iterator@+  , c_constIterator :: Class  -- ^ @std::vector\<T>::const_iterator@+  }++-- | @instantiate className t tReqs@ creates a set of bindings for an+-- instantiation of @std::vector@ and associated types (e.g. iterators).  In the+-- result, the 'c_vector' class has an external name of @className@, and the+-- iterator classes are further suffixed with @\"Iterator\"@ and+-- @\"ConstIterator\"@ respectively.+instantiate :: String -> Type -> Reqs -> Contents+instantiate vectorName t tReqs = instantiate' vectorName t tReqs defaultOptions++-- | 'instantiate' with additional options.+instantiate' :: String -> Type -> Reqs -> Options -> Contents+instantiate' vectorName t tReqs opts =+  let reqs = mconcat [tReqs, reqInclude $ includeStd "vector"]+      iteratorName = vectorName ++ "Iterator"+      constIteratorName = vectorName ++ "ConstIterator"++      vector =+        (case optValueConversion opts of+           Nothing -> id+           Just conversion -> addAddendumHaskell $ makeAddendum conversion) $+        addReqs reqs $+        classAddFeatures (Assignable : Copyable : optVectorClassFeatures opts) $+        makeClass (ident1T "std" "vector" [t]) (Just $ toExtName vectorName) []+        [ mkCtor "new" []+        ] $+        collect+        [ just $ mkMethod' "at" "at" [TSize] $ TRef t+        , just $ mkConstMethod' "at" "atConst" [TSize] $ TRef $ TConst t+        , just $ mkMethod' "back" "back" [] $ TRef t+        , just $ mkConstMethod' "back" "backConst" [] $ TRef $ TConst t+        , just $ mkMethod' "begin" "begin" [] $ TObjToHeap iterator+        , just $ mkConstMethod' "begin" "beginConst" [] $ TObjToHeap constIterator+        , just $ mkConstMethod "capacity" [] TSize+        , just $ mkMethod "clear" [] TVoid+        , just $ mkConstMethod "empty" [] TBool+        , just $ mkMethod' "end" "end" [] $ TObjToHeap iterator+        , just $ mkConstMethod' "end" "endConst" [] $ TObjToHeap constIterator+        , just $ mkMethod' "erase" "erase" [TObj iterator] TVoid+        , just $ mkMethod' "erase" "eraseRange" [TObj iterator, TObj iterator] TVoid+        , just $ mkMethod' "front" "front" [] $ TRef t+        , just $ mkConstMethod' "front" "frontConst" [] $ TRef $ TConst t+        , just $ mkMethod' "insert" "insert" [TObj iterator, TRef $ TConst t] TVoid+        , just $ mkMethod' "insert" "insertAndGetIterator"+          [TObj iterator, t] $ TObjToHeap iterator+        , just $ mkConstMethod' "max_size" "maxSize" [] TSize+        , just $ mkMethod' "pop_back" "popBack" [] TVoid+        , just $ mkMethod' "push_back" "pushBack" [t] TVoid+        , just $ mkMethod "reserve" [TSize] TVoid+        , just $ mkMethod' "resize" "resize" [TSize] TVoid+        , just $ mkMethod' "resize" "resizeWith" [TSize, t] TVoid+        , test (activeCppVersion >= Cpp2011) $ mkMethod' "shrink_to_fit" "shrinkToFit" [] TVoid+        , just $ mkConstMethod "size" [] TSize+        , just $ mkMethod "swap" [TRef $ TObj vector] TVoid+        ]++      iterator =+        addReqs reqs $+        makeRandomIterator Mutable (Just t) TPtrdiff $+        makeClass (identT' [("std", Nothing), ("vector", Just [t]), ("iterator", Nothing)])+        (Just $ toExtName iteratorName) [] [] []++      constIterator =+        addReqs reqs $+        makeRandomIterator Constant (Just t) TPtrdiff $+        makeClass (identT' [("std", Nothing), ("vector", Just [t]), ("const_iterator", Nothing)])+        (Just $ toExtName constIteratorName) []+        [ mkCtor "newFromNonconst" [TObj iterator]+        ]+        [ makeFnMethod (ident2 "hoppy" "iterator" "deconst") "deconst" MConst Nonpure+          [TObj constIterator, TRef $ TObj vector] $ TObjToHeap iterator+        ]++      -- The addendum for the vector class contains HasContents and FromContents+      -- instances.+      makeAddendum conversion = do+        addImports $ mconcat [hsImports "Prelude" ["($)", "(-)"],+                              hsImportForPrelude,+                              hsImportForRuntime]+        when (conversion == ConvertValue) $+          addImports $ hsImport1 "Control.Monad" "(<=<)"++        forM_ [Const, Nonconst] $ \cst -> do+          let hsDataTypeName = toHsDataTypeName cst vector+          hsValueType <-+            cppTypeToHsTypeAndUse HsHsSide $+            (case conversion of+               ConvertPtr -> TPtr+               ConvertValue -> id) $+            case cst of+              Const -> TConst t+              Nonconst -> t++          -- Generate const and nonconst HasContents instances.+          ln+          saysLn ["instance HoppyFHR.HasContents ", hsDataTypeName,+                  " (", prettyPrint hsValueType, ") where"]+          indent $ do+            sayLn "toContents this' = do"+            indent $ do+              let vectorAt = case cst of+                    Const -> "atConst"+                    Nonconst -> "at"+              saysLn ["size' <- ", toHsMethodName' vector "size", " this'"]+              saysLn ["HoppyP.mapM (",+                      case conversion of+                        ConvertPtr -> ""+                        ConvertValue -> "HoppyFHR.decode <=< ",+                      toHsMethodName' vector vectorAt, " this') [0..size'-1]"]++          -- Only generate a nonconst FromContents instance.+          when (cst == Nonconst) $ do+            ln+            saysLn ["instance HoppyFHR.FromContents ", hsDataTypeName,+                    " (", prettyPrint hsValueType, ") where"]+            indent $ do+              sayLn "fromContents values' = do"+              indent $ do+                saysLn ["vector' <- ", toHsMethodName' vector "new"]+                saysLn [toHsMethodName' vector "reserve",+                        " vector' $ HoppyFHR.coerceIntegral $ HoppyP.length values'"]+                saysLn ["HoppyP.mapM_ (", toHsMethodName' vector "pushBack", " vector') values'"]+                sayLn "HoppyP.return vector'"++  in Contents+     { c_vector = vector+     , c_iterator = iterator+     , c_constIterator = constIterator+     }++-- | Converts an instantiation into a list of exports to be included in a+-- module.+toExports :: Contents -> [Export]+toExports m = map (ExportClass . ($ m)) [c_vector, c_iterator, c_constIterator]