{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}
module Hercules.CNix.Std.Set
( stdSetCtx,
instanceStdSet,
instanceStdSetCopyable,
CStdSet,
StdSet (StdSet),
Hercules.CNix.Std.Set.new,
size,
toSet,
fromList,
fromListP,
fromListFP,
Hercules.CNix.Std.Set.toList,
insert,
insertP,
insertFP,
toListFP,
)
where
import Control.Exception (mask_)
import Data.Coerce (Coercible, coerce)
import Data.Foldable (for_)
import qualified Data.Set as S
import Data.Traversable (for)
import qualified Data.Vector.Storable as VS
import qualified Data.Vector.Storable.Mutable as VSM
import Foreign
( ForeignPtr,
FunPtr,
Ptr,
Storable,
newForeignPtr,
withForeignPtr,
)
import Foreign.C (CSize)
import Hercules.CNix.Encapsulation (HasEncapsulation (..))
import qualified Language.C.Inline as C
import qualified Language.C.Inline.Cpp as C
import qualified Language.C.Inline.Unsafe as CU
import Language.Haskell.TH (DecsQ)
import Language.Haskell.TH.Syntax (Dec, Q)
import Prelude
data CStdSet a
stdSetCtx :: C.Context
stdSetCtx :: Context
stdSetCtx = Context
C.cppCtx forall a. Monoid a => a -> a -> a
`mappend` [(CIdentifier, TypeQ)] -> Context
C.cppTypePairs [(CIdentifier
"std::set", [t|CStdSet|])]
newtype StdSet a = StdSet (ForeignPtr (CStdSet a))
instance HasStdSet a => HasEncapsulation (CStdSet a) (StdSet a) where
moveToForeignPtrWrapper :: Ptr (CStdSet a) -> IO (StdSet a)
moveToForeignPtrWrapper = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. ForeignPtr (CStdSet a) -> StdSet a
StdSet forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr forall a. HasStdSet a => FunPtr (Ptr (CStdSet a) -> IO ())
cDelete
class HasStdSet a where
cNew :: IO (Ptr (CStdSet a))
cDelete :: FunPtr (Ptr (CStdSet a) -> IO ())
cSize :: Ptr (CStdSet a) -> IO CSize
cInsertByPtr :: Ptr a -> Ptr (CStdSet a) -> IO ()
cCopies :: Ptr (CStdSet a) -> Ptr (Ptr a) -> IO ()
class HasStdSet a => HasStdSetCopyable a where
cCopyTo :: Ptr (CStdSet a) -> Ptr a -> IO ()
cInsert :: a -> Ptr (CStdSet a) -> IO ()
roll :: String -> Q [Dec] -> Q [Dec]
roll :: [Char] -> Q [Dec] -> Q [Dec]
roll [Char]
cType Q [Dec]
d =
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
[ [Char] -> Q [Dec]
C.include [Char]
"<set>",
[Char] -> Q [Dec]
C.include [Char]
"<algorithm>",
forall a. [([Char], [Char] -> [Char])] -> Q a -> Q a
C.substitute
[ ([Char]
"T", forall a b. a -> b -> a
const [Char]
cType),
([Char]
"SET", \[Char]
var -> [Char]
"$(std::set<" forall a. [a] -> [a] -> [a]
++ [Char]
cType forall a. [a] -> [a] -> [a]
++ [Char]
">* " forall a. [a] -> [a] -> [a]
++ [Char]
var forall a. [a] -> [a] -> [a]
++ [Char]
")")
]
Q [Dec]
d
]
instanceStdSet :: String -> DecsQ
instanceStdSet :: [Char] -> Q [Dec]
instanceStdSet [Char]
cType =
[Char] -> Q [Dec] -> Q [Dec]
roll
[Char]
cType
[d|
instance HasStdSet $(C.getHaskellType False cType) where
cNew = [CU.exp| std::set<@T()>* { new std::set<@T()>() } |]
cDelete = [C.funPtr| void deleteStdSet(std::set<@T()>* set) { delete set; } |]
cSize set = [CU.exp| size_t { @SET(set)->size() } |]
cInsertByPtr ptr set = [CU.exp| void { @SET(set)->insert(*$(@T() *ptr)) } |]
cCopies set dstPtr =
[CU.block| void {
const std::set<@T()>& set = *@SET(set);
@T()** aim = $(@T()** dstPtr);
for (auto item : set) {
*aim = new @T()(item);
aim++;
}
}|]
|]
instanceStdSetCopyable :: String -> DecsQ
instanceStdSetCopyable :: [Char] -> Q [Dec]
instanceStdSetCopyable [Char]
cType =
[Char] -> Q [Dec] -> Q [Dec]
roll
[Char]
cType
[d|
instance HasStdSetCopyable $(C.getHaskellType False cType) where
cCopyTo set dstPtr =
[CU.block| void {
const std::set<@T()>* set = @SET(set);
std::copy(set->begin(), set->end(), $(@T()* dstPtr));
} |]
cInsert value set =
[CU.exp| void { @SET(set)->insert($(@T() value)) }
|]
|]
new :: forall a. HasStdSet a => IO (StdSet a)
new :: forall a. HasStdSet a => IO (StdSet a)
new = forall a. IO a -> IO a
mask_ forall a b. (a -> b) -> a -> b
$ do
forall a b. HasEncapsulation a b => Ptr a -> IO b
moveToForeignPtrWrapper forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. HasStdSet a => IO (Ptr (CStdSet a))
cNew @a
size :: HasStdSet a => StdSet a -> IO Int
size :: forall a. HasStdSet a => StdSet a -> IO Int
size (StdSet ForeignPtr (CStdSet a)
fptr) = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr (CStdSet a)
fptr forall a. HasStdSet a => Ptr (CStdSet a) -> IO CSize
cSize
fromList :: HasStdSetCopyable a => [a] -> IO (StdSet a)
fromList :: forall a. HasStdSetCopyable a => [a] -> IO (StdSet a)
fromList [a]
as = do
StdSet a
set <- forall a. HasStdSet a => IO (StdSet a)
new
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [a]
as forall a b. (a -> b) -> a -> b
$ forall a. HasStdSetCopyable a => StdSet a -> a -> IO ()
insert StdSet a
set
forall (f :: * -> *) a. Applicative f => a -> f a
pure StdSet a
set
fromListP :: HasStdSet a => [Ptr a] -> IO (StdSet a)
fromListP :: forall a. HasStdSet a => [Ptr a] -> IO (StdSet a)
fromListP [Ptr a]
as = do
StdSet a
set <- forall a. HasStdSet a => IO (StdSet a)
new
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Ptr a]
as forall a b. (a -> b) -> a -> b
$ forall a. HasStdSet a => StdSet a -> Ptr a -> IO ()
insertP StdSet a
set
forall (f :: * -> *) a. Applicative f => a -> f a
pure StdSet a
set
fromListFP :: (Coercible a' (ForeignPtr a), HasStdSet a) => [a'] -> IO (StdSet a)
fromListFP :: forall a' a.
(Coercible a' (ForeignPtr a), HasStdSet a) =>
[a'] -> IO (StdSet a)
fromListFP [a']
as = do
StdSet a
set <- forall a. HasStdSet a => IO (StdSet a)
new
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [a']
as forall a b. (a -> b) -> a -> b
$ forall a' a.
(Coercible a' (ForeignPtr a), HasStdSet a) =>
StdSet a -> a' -> IO ()
insertFP StdSet a
set
forall (f :: * -> *) a. Applicative f => a -> f a
pure StdSet a
set
toSet :: (HasStdSetCopyable a, Storable a, Ord a) => StdSet a -> IO (S.Set a)
toSet :: forall a.
(HasStdSetCopyable a, Storable a, Ord a) =>
StdSet a -> IO (Set a)
toSet StdSet a
stdSet = do
forall a. Ord a => [a] -> Set a
S.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Storable a => Vector a -> [a]
VS.toList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
(HasStdSetCopyable a, Storable a) =>
StdSet a -> IO (Vector a)
toVector StdSet a
stdSet
toVector :: (HasStdSetCopyable a, Storable a) => StdSet a -> IO (VS.Vector a)
toVector :: forall a.
(HasStdSetCopyable a, Storable a) =>
StdSet a -> IO (Vector a)
toVector stdSet :: StdSet a
stdSet@(StdSet ForeignPtr (CStdSet a)
stdSetFPtr) = do
Int
vecSize <- forall a. HasStdSet a => StdSet a -> IO Int
size StdSet a
stdSet
IOVector a
hsVec <- forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
Int -> m (MVector (PrimState m) a)
VSM.new Int
vecSize
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr (CStdSet a)
stdSetFPtr forall a b. (a -> b) -> a -> b
$ \Ptr (CStdSet a)
stdSetPtr ->
forall a b. Storable a => IOVector a -> (Ptr a -> IO b) -> IO b
VSM.unsafeWith IOVector a
hsVec forall a b. (a -> b) -> a -> b
$ \Ptr a
hsVecPtr ->
forall a. HasStdSetCopyable a => Ptr (CStdSet a) -> Ptr a -> IO ()
cCopyTo Ptr (CStdSet a)
stdSetPtr Ptr a
hsVecPtr
forall a (m :: * -> *).
(Storable a, PrimMonad m) =>
MVector (PrimState m) a -> m (Vector a)
VS.unsafeFreeze IOVector a
hsVec
toList :: (HasStdSetCopyable a, Storable a) => StdSet a -> IO [a]
toList :: forall a. (HasStdSetCopyable a, Storable a) => StdSet a -> IO [a]
toList StdSet a
vec = forall a. Storable a => Vector a -> [a]
VS.toList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
(HasStdSetCopyable a, Storable a) =>
StdSet a -> IO (Vector a)
toVector StdSet a
vec
toVectorP :: (HasStdSet a) => StdSet a -> IO (VS.Vector (Ptr a))
toVectorP :: forall a. HasStdSet a => StdSet a -> IO (Vector (Ptr a))
toVectorP stdSet :: StdSet a
stdSet@(StdSet ForeignPtr (CStdSet a)
stdSetFPtr) = do
Int
vecSize <- forall a. HasStdSet a => StdSet a -> IO Int
size StdSet a
stdSet
IOVector (Ptr a)
hsVec <- forall (m :: * -> *) a.
(PrimMonad m, Storable a) =>
Int -> m (MVector (PrimState m) a)
VSM.new Int
vecSize
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr (CStdSet a)
stdSetFPtr forall a b. (a -> b) -> a -> b
$ \Ptr (CStdSet a)
stdSetPtr ->
forall a b. Storable a => IOVector a -> (Ptr a -> IO b) -> IO b
VSM.unsafeWith IOVector (Ptr a)
hsVec forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr a)
hsVecPtr ->
forall a. HasStdSet a => Ptr (CStdSet a) -> Ptr (Ptr a) -> IO ()
cCopies Ptr (CStdSet a)
stdSetPtr Ptr (Ptr a)
hsVecPtr
forall a (m :: * -> *).
(Storable a, PrimMonad m) =>
MVector (PrimState m) a -> m (Vector a)
VS.unsafeFreeze IOVector (Ptr a)
hsVec
toListP :: (HasStdSet a) => StdSet a -> IO [Ptr a]
toListP :: forall a. HasStdSet a => StdSet a -> IO [Ptr a]
toListP StdSet a
vec = forall a. Storable a => Vector a -> [a]
VS.toList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. HasStdSet a => StdSet a -> IO (Vector (Ptr a))
toVectorP StdSet a
vec
toListFP :: (HasStdSet a, HasEncapsulation a b) => StdSet a -> IO [b]
toListFP :: forall a b.
(HasStdSet a, HasEncapsulation a b) =>
StdSet a -> IO [b]
toListFP StdSet a
vec = forall a. IO a -> IO a
mask_ forall a b. (a -> b) -> a -> b
$ do
[Ptr a]
ptrs <- forall a. HasStdSet a => StdSet a -> IO [Ptr a]
toListP StdSet a
vec
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Ptr a]
ptrs forall a b. HasEncapsulation a b => Ptr a -> IO b
moveToForeignPtrWrapper
insert :: HasStdSetCopyable a => StdSet a -> a -> IO ()
insert :: forall a. HasStdSetCopyable a => StdSet a -> a -> IO ()
insert (StdSet ForeignPtr (CStdSet a)
fptr) a
value = forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr (CStdSet a)
fptr (forall a. HasStdSetCopyable a => a -> Ptr (CStdSet a) -> IO ()
cInsert a
value)
insertP :: HasStdSet a => StdSet a -> Ptr a -> IO ()
insertP :: forall a. HasStdSet a => StdSet a -> Ptr a -> IO ()
insertP (StdSet ForeignPtr (CStdSet a)
fptr) Ptr a
ptr = forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr (CStdSet a)
fptr (forall a. HasStdSet a => Ptr a -> Ptr (CStdSet a) -> IO ()
cInsertByPtr Ptr a
ptr)
insertFP :: (Coercible a' (ForeignPtr a), HasStdSet a) => StdSet a -> a' -> IO ()
insertFP :: forall a' a.
(Coercible a' (ForeignPtr a), HasStdSet a) =>
StdSet a -> a' -> IO ()
insertFP (StdSet ForeignPtr (CStdSet a)
fptr) a'
vfptr =
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr (CStdSet a)
fptr forall a b. (a -> b) -> a -> b
$ \Ptr (CStdSet a)
setPtr ->
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr (coerce :: forall a b. Coercible a b => a -> b
coerce a'
vfptr) (\Ptr a
valPtr -> forall a. HasStdSet a => Ptr a -> Ptr (CStdSet a) -> IO ()
cInsertByPtr Ptr a
valPtr Ptr (CStdSet a)
setPtr)