Created
January 28, 2019 11:13
-
-
Save naohaq/0a39e8614d288b562c47a2f67e781d2d to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{-# OPTIONS_GHC -Wall #-} | |
{-# LANGUAGE DeriveGeneric #-} | |
{-# LANGUAGE StandaloneDeriving #-} | |
{-# LANGUAGE FlexibleInstances #-} | |
module Vec3DList where | |
import GHC.Generics (Generic) | |
import Foreign.Ptr (Ptr, nullPtr) | |
import Foreign.Storable | |
import Foreign.Storable.Generic | |
import Foreign.Marshal.Alloc | |
import Test.QuickCheck | |
data Vec3DList f = | |
Vec3DList | |
{ x :: Double | |
, y :: Double | |
, z :: Double | |
, next :: f (Vec3DList f) | |
} deriving Generic | |
deriving instance Eq (Vec3DList Maybe) | |
deriving instance Show (Vec3DList Maybe) | |
deriving instance Show (Vec3DList Ptr) | |
type HVec3DList = Vec3DList Maybe | |
type CVec3DList = Vec3DList Ptr | |
instance GStorable (Vec3DList Ptr) | |
instance Arbitrary (Vec3DList Maybe) where | |
arbitrary = Vec3DList <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary | |
toCVec3DList :: HVec3DList -> IO (Ptr CVec3DList) | |
toCVec3DList (Vec3DList x' y' z' r) = do | |
r' <- case r of | |
Just v -> toCVec3DList v | |
Nothing -> return nullPtr | |
p <- malloc :: IO (Ptr CVec3DList) | |
poke p (Vec3DList x' y' z' r') | |
return p | |
fromCVec3DList :: Ptr CVec3DList -> IO (Maybe HVec3DList) | |
fromCVec3DList p | |
| p == nullPtr = return Nothing | |
| otherwise = do | |
(Vec3DList x' y' z' r) <- peek p | |
r' <- fromCVec3DList r | |
return (Just $ Vec3DList x' y' z' r') | |
freeCVec3DList :: Ptr CVec3DList -> IO () | |
freeCVec3DList p | |
| p == nullPtr = return () | |
| otherwise = do | |
(Vec3DList _ _ _ r) <- peek p | |
freeCVec3DList r | |
free p |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment