packages feed

hoppy-std 0.4.0 → 0.5.0

raw patch · 7 files changed

+622/−14 lines, 7 filesdep ~hoppy-generatorPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: hoppy-generator

API changes (from Hackage documentation)

+ Foreign.Hoppy.Generator.Std.Set: [c_constIterator] :: Contents -> Class
+ Foreign.Hoppy.Generator.Std.UnorderedMap: Contents :: Class -> Class -> Class -> Contents
+ Foreign.Hoppy.Generator.Std.UnorderedMap: Options :: [ClassFeature] -> Maybe ValueConversion -> Maybe ValueConversion -> Options
+ Foreign.Hoppy.Generator.Std.UnorderedMap: [c_constIterator] :: Contents -> Class
+ Foreign.Hoppy.Generator.Std.UnorderedMap: [c_iterator] :: Contents -> Class
+ Foreign.Hoppy.Generator.Std.UnorderedMap: [c_map] :: Contents -> Class
+ Foreign.Hoppy.Generator.Std.UnorderedMap: [optKeyConversion] :: Options -> Maybe ValueConversion
+ Foreign.Hoppy.Generator.Std.UnorderedMap: [optUnorderedMapClassFeatures] :: Options -> [ClassFeature]
+ Foreign.Hoppy.Generator.Std.UnorderedMap: [optValueConversion] :: Options -> Maybe ValueConversion
+ Foreign.Hoppy.Generator.Std.UnorderedMap: data Contents
+ Foreign.Hoppy.Generator.Std.UnorderedMap: data Options
+ Foreign.Hoppy.Generator.Std.UnorderedMap: defaultOptions :: Options
+ Foreign.Hoppy.Generator.Std.UnorderedMap: instantiate :: String -> Type -> Type -> Reqs -> Contents
+ Foreign.Hoppy.Generator.Std.UnorderedMap: instantiate' :: String -> Type -> Type -> Reqs -> Options -> Contents
+ Foreign.Hoppy.Generator.Std.UnorderedMap: toExports :: Contents -> [Export]
+ Foreign.Hoppy.Generator.Std.UnorderedSet: Contents :: Class -> Class -> Class -> Contents
+ Foreign.Hoppy.Generator.Std.UnorderedSet: Options :: [ClassFeature] -> Maybe ValueConversion -> Options
+ Foreign.Hoppy.Generator.Std.UnorderedSet: [c_constIterator] :: Contents -> Class
+ Foreign.Hoppy.Generator.Std.UnorderedSet: [c_iterator] :: Contents -> Class
+ Foreign.Hoppy.Generator.Std.UnorderedSet: [c_set] :: Contents -> Class
+ Foreign.Hoppy.Generator.Std.UnorderedSet: [optUnorderedSetClassFeatures] :: Options -> [ClassFeature]
+ Foreign.Hoppy.Generator.Std.UnorderedSet: [optValueConversion] :: Options -> Maybe ValueConversion
+ Foreign.Hoppy.Generator.Std.UnorderedSet: data Contents
+ Foreign.Hoppy.Generator.Std.UnorderedSet: data Options
+ Foreign.Hoppy.Generator.Std.UnorderedSet: defaultOptions :: Options
+ Foreign.Hoppy.Generator.Std.UnorderedSet: instantiate :: String -> Type -> Reqs -> Contents
+ Foreign.Hoppy.Generator.Std.UnorderedSet: instantiate' :: String -> Type -> Reqs -> Options -> Contents
+ Foreign.Hoppy.Generator.Std.UnorderedSet: toExports :: Contents -> [Export]
- Foreign.Hoppy.Generator.Std.Set: Contents :: Class -> Class -> Contents
+ Foreign.Hoppy.Generator.Std.Set: Contents :: Class -> Class -> Class -> Contents

Files

hoppy-std.cabal view
@@ -1,5 +1,5 @@ name: hoppy-std-version: 0.4.0+version: 0.5.0 synopsis: C++ FFI generator - Standard library bindings homepage: http://khumba.net/projects/hoppy license: Apache-2.0@@ -19,6 +19,8 @@     include/hoppy/std/iterator.hpp   , include/hoppy/std/map.hpp   , include/hoppy/std/set.hpp+  , include/hoppy/std/unordered_map.hpp+  , include/hoppy/std/unordered_set.hpp   , include/hoppy/std/utility.hpp  library@@ -30,6 +32,8 @@     , Foreign.Hoppy.Generator.Std.Pair     , Foreign.Hoppy.Generator.Std.Set     , Foreign.Hoppy.Generator.Std.String+    , Foreign.Hoppy.Generator.Std.UnorderedMap+    , Foreign.Hoppy.Generator.Std.UnorderedSet     , Foreign.Hoppy.Generator.Std.Vector   other-modules:       Foreign.Hoppy.Generator.Std.Internal@@ -38,7 +42,7 @@       base >=4.7 && <5     , filepath >=1.0 && <1.5     , haskell-src >=1.0 && <1.1-    , hoppy-generator >=0.4 && <0.5+    , hoppy-generator >=0.5 && <0.6   hs-source-dirs: src   ghc-options: -W -fwarn-incomplete-patterns -fwarn-unused-do-bind   default-language: Haskell2010
+ include/hoppy/std/unordered_map.hpp view
@@ -0,0 +1,43 @@+#ifndef HOPPY_STD_UNORDERED_MAP_HPP+#define HOPPY_STD_UNORDERED_MAP_HPP++// This file is part of Hoppy.+//+// Copyright 2015-2018 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 <unordered_map>++namespace hoppy {+namespace unordered_map {++template <typename K, typename V>+const K& getIteratorKey(const typename std::unordered_map<K, V>::const_iterator& iterator) {+    return iterator->first;+}++template <typename K, typename V>+V& getIteratorValue(typename std::unordered_map<K, V>::iterator& iterator) {+    return iterator->second;+}++template <typename K, typename V>+const V& getIteratorValue(const typename std::unordered_map<K, V>::const_iterator& iterator) {+    return iterator->second;+}++}  // namespace unordered_map+}  // namespace hoppy++#endif
+ include/hoppy/std/unordered_set.hpp view
@@ -0,0 +1,41 @@+#ifndef HOPPY_STD_UNORDERED_SET_HPP+#define HOPPY_STD_UNORDERED_SET_HPP++// This file is part of Hoppy.+//+// Copyright 2015-2018 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 <unordered_set>++namespace hoppy {+namespace unordered_set {++template <typename T>+bool insert(std::unordered_set<T>& set, const T& value) {+    return set.insert(value).second;+}++template <typename T>+typename std::unordered_set<T>::iterator insertAndGetIterator(+    std::unordered_set<T>& set,+    const T& value+) {+    return set.insert(value).first;+}++}  // namespace unordered_set+}  // namespace hoppy++#endif
src/Foreign/Hoppy/Generator/Std/Set.hs view
@@ -67,6 +67,7 @@ data Contents = Contents   { c_set :: Class  -- ^ @std::set\<T>@   , c_iterator :: Class  -- ^ @std::set\<T>::iterator@+  , c_constIterator :: Class  -- ^ @std::set\<T>::const_iterator@   }  -- | @instantiate className t tReqs@ creates a set of bindings for an@@ -94,12 +95,14 @@         classAddFeatures (Assignable : Comparable : Copyable : optSetClassFeatures opts) $         makeClass (ident1T "std" "set" [t]) (Just $ toExtName setName) []         [ mkCtor "new" []-        , mkConstMethod "begin" [] $ toGcT $ objT iterator+        , mkMethod' "begin" "begin" [] $ toGcT $ objT iterator+        , mkConstMethod' "begin" "beginConst" [] $ toGcT $ objT constIterator         , mkMethod "clear" [] voidT         , mkConstMethod "count" [t] sizeT           -- TODO count         , mkConstMethod "empty" [] boolT-        , mkConstMethod "end" [] $ toGcT $ objT iterator+        , mkMethod' "end" "end" [] $ toGcT $ objT iterator+        , mkConstMethod' "end" "endConst" [] $ toGcT $ objT constIterator           -- equalRange: find is good enough.         , mkMethod' "erase" "erase" [objT iterator] voidT         , mkMethod' "erase" "eraseRange" [objT iterator, objT iterator] voidT@@ -117,13 +120,21 @@         ]        -- Set iterators are always constant, because modifying elements in place-      -- will break the internal order of the set.+      -- will break the internal order of the set.  That said, 'iterator' and+      -- 'const_iterator' aren't guaranteed to be the same type; only that+      -- 'iterator' is convertible to 'const_iterator'.       iterator =         addReqs reqs $         makeBidirectionalIterator Constant (Just t) $         makeClass (identT' [("std", Nothing), ("set", Just [t]), ("iterator", Nothing)])         (Just $ toExtName iteratorName) [] [] +      constIterator =+        addReqs reqs $+        makeBidirectionalIterator Constant (Just t) $+        makeClass (identT' [("std", Nothing), ("set", Just [t]), ("const_iterator", Nothing)])+        (Just $ toExtName iteratorName) [] []+       -- The addendum for the set class contains HasContents and FromContents       -- instances.       makeAddendum conversion = do@@ -146,8 +157,8 @@          setConstCast <- toHsCastMethodName Const set         setEmpty <- toHsClassEntityName set "empty"-        setBegin <- toHsClassEntityName set "begin"-        setEnd <- toHsClassEntityName set "end"+        setBeginConst <- toHsClassEntityName set "beginConst"+        setEndConst <- toHsClassEntityName set "endConst"         iterEq <- toHsClassEntityName iterator OpEq         iterGetConst <- toHsClassEntityName iterator "getConst"         iterPrev <- toHsClassEntityName iterator "prev"@@ -162,8 +173,8 @@             saysLn ["empty' <- ", setEmpty, " this'"]             sayLn "if empty' then HoppyP.return [] else do"             indent $ do-              saysLn ["begin' <- ", setBegin, " this'"]-              saysLn ["iter' <- ", setEnd, " this'"]+              saysLn ["begin' <- ", setBeginConst, " this'"]+              saysLn ["iter' <- ", setEndConst, " this'"]               sayLn "go' iter' begin' []"             sayLn "where"             indent $ do@@ -201,9 +212,10 @@   in Contents      { c_set = set      , 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_set, c_iterator]+toExports m = map (ExportClass . ($ m)) [c_set, c_iterator, c_constIterator]
src/Foreign/Hoppy/Generator/Std/String.hs view
@@ -22,7 +22,7 @@ #if !MIN_VERSION_base(4,8,0) import Data.Monoid (mconcat) #endif-import Foreign.Hoppy.Generator.Language.Haskell (addImports, sayLn)+import Foreign.Hoppy.Generator.Language.Haskell (addExport, addImports, indent, sayLn) import Foreign.Hoppy.Generator.Spec import Foreign.Hoppy.Generator.Types import Language.Haskell.Syntax (@@ -36,6 +36,7 @@ c_string =   addReqIncludes [includeStd "string"] $   classAddFeatures [Assignable, Comparable, Copyable, Equatable] $+  addAddendumHaskell addendum $   classSetHaskellConversion     ClassHaskellConversion       { classHaskellConversionType = Just $ do@@ -43,16 +44,33 @@         return $ HsTyCon $ UnQual $ HsIdent "HoppyP.String"       , classHaskellConversionToCppFn = Just $ do         addImports $ mconcat [hsImportForPrelude, hsImportForForeignC]-        sayLn "HoppyP.flip HoppyFC.withCString stdString_newFromCString"+        sayLn "HoppyP.flip HoppyFC.withCStringLen stdString_newFromCStringLen"       , classHaskellConversionFromCppFn = Just $ do-        addImports $ mconcat [hsImport1 "Control.Monad" "(<=<)", hsImportForForeignC]-        sayLn "HoppyFC.peekCString <=< stdString_c_str"+        addImports $ mconcat [hsImport1 "Control.Applicative" "(<*)",+                              hsImportForForeignC,+                              hsImportForPrelude,+                              hsImportForRuntime]+        sayLn "\\s -> do"+        indent $ do+          sayLn "p <- stdString_data s"+          sayLn "n <- stdString_size s"+          sayLn "HoppyFC.peekCStringLen (p, HoppyP.fromIntegral n) <* HoppyFHR.touchCppPtr s"       } $   makeClass (ident1 "std" "string") (Just $ toExtName "StdString") []   [ mkCtor "new" []   , mkCtor "newFromCString" [ptrT $ constT charT]+  , mkCtor "newFromCStringLen_raw" [ptrT $ constT charT, sizeT]   , mkMethod' "at" "at" [intT] $ refT charT   , mkConstMethod' "at" "get" [intT] charT   , mkConstMethod "c_str" [] $ ptrT $ constT charT+  , mkConstMethod "data" [] $ ptrT $ constT charT   , mkConstMethod "size" [] sizeT   ]+  where+    addendum = do+      addImports $ mconcat [hsImportForPrelude, hsImportForForeignC]+      addExport "stdString_newFromCStringLen"+      sayLn "stdString_newFromCStringLen :: HoppyFC.CStringLen -> HoppyP.IO StdString"+      sayLn "stdString_newFromCStringLen (p,n) ="+      indent $ do+        sayLn "stdString_newFromCStringLen_raw p (HoppyP.fromIntegral n)"
+ src/Foreign/Hoppy/Generator/Std/UnorderedMap.hs view
@@ -0,0 +1,266 @@+-- This file is part of Hoppy.+--+-- Copyright 2015-2018 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::unordered_map@.+module Foreign.Hoppy.Generator.Std.UnorderedMap (+  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,+  toHsClassEntityName,+  )+import Foreign.Hoppy.Generator.Spec+import Foreign.Hoppy.Generator.Std (ValueConversion (ConvertPtr, ConvertValue))+import Foreign.Hoppy.Generator.Std.Internal (includeHelper)+import Foreign.Hoppy.Generator.Std.Iterator+import Foreign.Hoppy.Generator.Types++-- | Options for instantiating the map classes.+data Options = Options+  { optUnorderedMapClassFeatures :: [ClassFeature]+    -- ^ Additional features to add to the @std::unordered_map@ class.  UnorderedMaps 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::unordered_map\<K, V>@+  , c_iterator :: Class  -- ^ @std::unordered_map\<K, V>::iterator@+  , c_constIterator :: Class  -- ^ @std::unordered_map\<K, V>::const_iterator@+  }++-- | @instantiate className k v reqs@ creates a set of bindings for an+-- instantiation of @std::unordered_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 "unordered_map.hpp"+             , reqInclude $ includeStd "unordered_map"+             ]+      iteratorName = mapName ++ "Iterator"+      constIteratorName = mapName ++ "ConstIterator"++      getIteratorKeyIdent = ident2T "hoppy" "unordered_map" "getIteratorKey" [k, v]+      getIteratorValueIdent = ident2T "hoppy" "unordered_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::unordered_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 : optUnorderedMapClassFeatures opts) $+        makeClass (ident1T "std" "unordered_map" [k, v]) (Just extName) []+        [ mkCtor "new" []+        , mkMethod' "at" "at" [k] $ refT v+        , mkConstMethod' "at" "atConst" [k] $ refT $ constT v+        , mkMethod' "begin" "begin" [] $ toGcT $ objT iterator+        , mkConstMethod' "begin" "beginConst" [] $ toGcT $ objT constIterator+        , mkMethod "clear" [] voidT+        , mkConstMethod "count" [k] sizeT+        , mkConstMethod "empty" [] boolT+        , mkMethod' "end" "end" [] $ toGcT $ objT iterator+        , mkConstMethod' "end" "endConst" [] $ toGcT $ objT constIterator+          -- equal_range: find is good enough.+        , mkMethod' "erase" "erase" [objT iterator] voidT+        , mkMethod' "erase" "eraseKey" [k] sizeT+        , mkMethod' "erase" "eraseRange" [objT iterator, objT iterator] voidT+        , mkMethod' "find" "find" [k] $ toGcT $ objT iterator+        , mkConstMethod' "find" "findConst" [k] $ toGcT $ objT constIterator+          -- TODO insert+          -- lower_bound: find is good enough.+        , mkConstMethod' "max_size" "maxSize" [] sizeT+        , mkConstMethod "size" [] sizeT+        , mkMethod "swap" [refT $ objT map] voidT+          -- upper_bound: find is good enough.+        , mkMethod OpArray [k] $ refT v+        ]++      iterator =+        addReqs reqs $+        makeForwardIterator Mutable Nothing $+        makeClass (identT' [("std", Nothing),+                            ("unordered_map", Just [k, v]),+                            ("iterator", Nothing)])+        (Just $ toExtName iteratorName) []+        [ makeFnMethod getIteratorKeyIdent "getKey" MConst Nonpure+          [objT iterator] $ refT $ constT k+        , makeFnMethod getIteratorValueIdent "getValue" MNormal Nonpure+          [refT $ objT iterator] $ refT v+        , makeFnMethod getIteratorValueIdent "getValueConst" MConst Nonpure+          [objT iterator] $ refT $ constT v+        ]++      constIterator =+        addReqs reqs $+        makeForwardIterator Constant Nothing $+        makeClass (identT' [("std", Nothing),+                            ("unordered_map", Just [k, v]),+                            ("const_iterator", Nothing)])+        (Just $ toExtName constIteratorName)+        []+        [ mkCtor "newFromConst" [objT iterator]+        , makeFnMethod (ident2 "hoppy" "iterator" "deconst") "deconst" MConst Nonpure+          [objT constIterator, refT $ objT map] $ toGcT $ objT iterator+        , makeFnMethod getIteratorKeyIdent "getKey" MConst Nonpure+          [objT constIterator] $ refT $ constT k+        , makeFnMethod getIteratorValueIdent "getValueConst" MConst Nonpure+          [objT constIterator] $ refT $ constT 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+          hsDataTypeName <- toHsDataTypeName cst map++          keyHsType <-+            cppTypeToHsTypeAndUse HsHsSide $+            (case keyConv of+               ConvertPtr -> ptrT+               ConvertValue -> id) $+            constT k++          valueHsType <-+            cppTypeToHsTypeAndUse HsHsSide $+            (case valueConv of+               ConvertPtr -> ptrT+               ConvertValue -> id) $+            case cst of+              Const -> constT 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+              mapEmpty <- toHsClassEntityName map "empty"+              mapBegin <- toHsClassEntityName map $ case cst of+                Const -> "beginConst"+                Nonconst -> "begin"+              mapEnd <- toHsClassEntityName map $ case cst of+                Const -> "endConst"+                Nonconst -> "end"+              let iter = case cst of+                    Const -> constIterator+                    Nonconst -> iterator+              iterEq <- toHsClassEntityName iter OpEq+              iterGetKey <- toHsClassEntityName iter "getKey"+              iterGetValue <- toHsClassEntityName iter $ case cst of+                Const -> "getValueConst"+                Nonconst -> "getValue"+              iterNext <- toHsClassEntityName iter "next"++              saysLn ["empty' <- ", mapEmpty, " this'"]+              sayLn "if empty' then HoppyP.return [] else do"+              indent $ do+                saysLn ["end' <- ", mapEnd, " this'"]+                saysLn ["iter' <- ", mapBegin, " this'"]+                sayLn "go' iter' end' []"+              sayLn "where"+              indent $ do+                sayLn "go' iter' end' acc' = do"+                indent $ do+                  saysLn ["stop' <- ", iterEq, " iter' end'"]+                  sayLn "if stop' then HoppyP.return (HoppyP.reverse acc') else do"+                  indent $ do+                    saysLn ["_ <- ", iterNext, " iter'"]+                    saysLn ["key' <- ",+                            case keyConv of+                              ConvertPtr -> ""+                              ConvertValue -> "HoppyFHR.decode =<< ",+                            iterGetKey, " iter'"]+                    saysLn ["value' <- ",+                            case valueConv of+                              ConvertPtr -> ""+                              ConvertValue -> "HoppyFHR.decode =<< ",+                            iterGetValue, " iter'"]+                    sayLn "go' iter' end' $ (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+                mapNew <- toHsClassEntityName map "new"+                mapAt <- toHsClassEntityName map "at"+                saysLn ["map' <- ", mapNew]+                saysLn ["HoppyP.mapM_ (\\(k, v) -> HoppyP.flip HoppyFHR.assign v =<< ",+                        mapAt, " 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/UnorderedSet.hs view
@@ -0,0 +1,224 @@+-- This file is part of Hoppy.+--+-- Copyright 2015-2018 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::unordered_set@.+module Foreign.Hoppy.Generator.Std.UnorderedSet (+  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,+  toHsClassEntityName,+  )+import Foreign.Hoppy.Generator.Spec+import Foreign.Hoppy.Generator.Std (ValueConversion (ConvertPtr, ConvertValue))+import Foreign.Hoppy.Generator.Std.Internal (includeHelper)+import Foreign.Hoppy.Generator.Std.Iterator+import Foreign.Hoppy.Generator.Types++-- | Options for instantiating the set classes.+data Options = Options+  { optUnorderedSetClassFeatures :: [ClassFeature]+    -- ^ Additional features to add to the @std::unordered_set@ class.  UnorderedSets 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::unordered_set\<T>@+  , c_iterator :: Class  -- ^ @std::unordered_set\<T>::iterator@+  , c_constIterator :: Class  -- ^ @std::unordered_set\<T>::const_iterator@+  }++-- | @instantiate className t tReqs@ creates a set of bindings for an+-- instantiation of @std::unordered_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 "unordered_set.hpp"+             , reqInclude $ includeStd "unordered_set"+             ]+      iteratorName = setName ++ "Iterator"++      set =+        (case optValueConversion opts of+           Nothing -> id+           Just conversion -> addAddendumHaskell $ makeAddendum conversion) $+        addReqs reqs $+        classAddFeatures (Assignable : Copyable : optUnorderedSetClassFeatures opts) $+        makeClass (ident1T "std" "unordered_set" [t]) (Just $ toExtName setName) []+        [ mkCtor "new" []+        , mkMethod' "begin" "begin" [] $ toGcT $ objT iterator+        , mkConstMethod' "begin" "beginConst" [] $ toGcT $ objT constIterator+        , mkMethod "clear" [] voidT+        , mkConstMethod "count" [t] sizeT+          -- TODO count+        , mkConstMethod "empty" [] boolT+        , mkMethod' "end" "end" [] $ toGcT $ objT iterator+        , mkConstMethod' "end" "endConst" [] $ toGcT $ objT constIterator+          -- equalRange: find is good enough.+        , mkMethod' "erase" "erase" [objT iterator] voidT+        , mkMethod' "erase" "eraseRange" [objT iterator, objT iterator] voidT+        , mkMethod "find" [t] $ toGcT $ objT iterator+          -- TODO Replace these with a single version that returns a (toGcT std::pair).+        , makeFnMethod (ident2 "hoppy" "unordered_set" "insert") "insert"+          MNormal Nonpure [refT $ objT set, t] boolT+        , makeFnMethod (ident2 "hoppy" "unordered_set" "insertAndGetIterator")+          "insertAndGetIterator" MNormal Nonpure [refT $ objT set, t] $ toGcT $ objT iterator+          -- lower_bound: find is good enough.+        , mkConstMethod' "max_size" "maxSize" [] sizeT+        , mkConstMethod "size" [] sizeT+        , mkMethod "swap" [refT $ objT set] voidT+          -- upper_bound: find is good enough.+        ]++      -- Unordered set iterators are always constant, because modifying elements+      -- in place will break the internal order of the set.  That said,+      -- 'iterator' and 'const_iterator' aren't guaranteed to be the same type+      -- (indeed they're not for g++ 7.2.0 on Kubuntu 17.10 amd64); only that+      -- 'iterator' is convertible to 'const_iterator'.+      iterator =+        addReqs reqs $+        makeForwardIterator Constant (Just t) $+        makeClass (identT' [("std", Nothing), ("unordered_set", Just [t]), ("iterator", Nothing)])+        (Just $ toExtName iteratorName) [] []++      constIterator =+        addReqs reqs $+        makeForwardIterator Constant (Just t) $+        makeClass (identT' [("std", Nothing),+                            ("unordered_set", Just [t]),+                            ("const_iterator", Nothing)])+        (Just $ toExtName iteratorName) [] []++      -- The addendum for the unordered_set class contains HasContents and FromContents+      -- instances.+      makeAddendum conversion = do+        addImports $ mconcat [hsImport1 "Prelude" "($)",+                              hsImportForPrelude,+                              hsImportForRuntime]+        when (conversion == ConvertValue) $+          addImports $ mconcat [hsImport1 "Prelude" "(=<<)"]++        hsDataNameConst <- toHsDataTypeName Const set+        hsDataName <- toHsDataTypeName Nonconst set+        [hsValueTypeConst, hsValueType] <- forM [Const, Nonconst] $ \cst ->+            cppTypeToHsTypeAndUse HsHsSide $+            (case conversion of+               ConvertPtr -> ptrT+               ConvertValue -> id) $+            case cst of+              Const -> constT t+              Nonconst -> t++        setConstCast <- toHsCastMethodName Const set+        setEmpty <- toHsClassEntityName set "empty"+        setBeginConst <- toHsClassEntityName set "beginConst"+        setEndConst <- toHsClassEntityName set "endConst"+        iterEq <- toHsClassEntityName iterator OpEq+        iterGetConst <- toHsClassEntityName iterator "getConst"+        iterNext <- toHsClassEntityName iterator "next"++        -- 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' <- ", setEmpty, " this'"]+            sayLn "if empty' then HoppyP.return [] else do"+            indent $ do+              saysLn ["end' <- ", setEndConst, " this'"]+              saysLn ["iter' <- ", setBeginConst, " this'"]+              sayLn "go' iter' end' []"+            sayLn "where"+            indent $ do+              sayLn "go' iter' end' acc' = do"+              indent $ do+                saysLn ["stop' <- ", iterEq, " iter' end'"]+                sayLn "if stop' then HoppyP.return (HoppyP.reverse acc') else do"+                indent $ do+                  saysLn ["_ <- ", iterNext, " iter'"]+                  saysLn ["value' <- ",+                          case conversion of+                            ConvertPtr -> ""+                            ConvertValue -> "HoppyFHR.decode =<< ",+                          iterGetConst, " iter'"]+                  sayLn "go' iter' end' $ value':acc'"+        ln+        saysLn ["instance HoppyFHR.HasContents ", hsDataName,+                " (", prettyPrint hsValueTypeConst, ") where"]+        indent $+          saysLn ["toContents = HoppyFHR.toContents . ", setConstCast]++        -- Only generate a nonconst FromContents instance.+        ln+        saysLn ["instance HoppyFHR.FromContents ", hsDataName,+                " (", prettyPrint hsValueType, ") where"]+        indent $ do+          sayLn "fromContents values' = do"+          indent $ do+            setNew <- toHsClassEntityName set "new"+            setInsert <- toHsClassEntityName set "insert"+            saysLn ["set' <- ", setNew]+            saysLn ["HoppyP.mapM_ (", setInsert, " set') values'"]+            sayLn "HoppyP.return set'"++  in Contents+     { c_set = set+     , 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_set, c_iterator, c_constIterator]