{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- | @std::set@
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 ()

-- | Helper for defining templated instances
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)