Vec3DList.hs

{-# 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