module StorableInstance where
import Foreign.Storable (Storable (..), )
import Foreign.Ptr (castPtr, )
import qualified Number.Complex as Complex
import qualified Number.Ratio as Ratio
import qualified Algebra.PrincipalIdealDomain as PID
roundUp :: Int -> Int -> Int
roundUp m x = x + mod (x) m
instance (Storable a, Storable b) => Storable (a,b) where
sizeOf ~(a,b) =
roundUp (alignment b) (sizeOf a) + sizeOf b
alignment ~(a,b) = gcd (alignment a) (alignment b)
peek ptr =
do a <- peekByteOff ptr 0
let peekSecond :: Storable b => b -> IO b
peekSecond bu =
peekByteOff ptr (roundUp (alignment bu) (sizeOf a))
b <- peekSecond undefined
return (a, b)
poke ptr (a,b) =
pokeByteOff ptr 0 a >>
pokeByteOff ptr (roundUp (alignment b) (sizeOf a)) b
instance (Storable a, Storable b, Storable c) => Storable (a,b,c) where
sizeOf = sizeOf . tripleToPair
alignment = alignment . tripleToPair
peek ptr = fmap (\ ~(~(a,b),c) -> (a,b,c)) (peek (castPtr ptr))
poke ptr = poke (castPtr ptr) . tripleToPair
tripleToPair :: (a,b,c) -> ((a,b),c)
tripleToPair ~(a,b,c) = ((a,b),c)
instance (Storable a) => Storable (Complex.T a) where
sizeOf = sizeOf . complexToPair
alignment = alignment . complexToPair
peek ptr = fmap (uncurry (Complex.+:)) (peek (castPtr ptr))
poke ptr = poke (castPtr ptr) . complexToPair
complexToPair :: Complex.T a -> (a,a)
complexToPair a = (Complex.real a, Complex.imag a)
instance (Storable a, PID.C a) => Storable (Ratio.T a) where
sizeOf = sizeOf . ratioToPair
alignment = alignment . ratioToPair
peek ptr = fmap (uncurry (Ratio.%)) (peek (castPtr ptr))
poke ptr = poke (castPtr ptr) . ratioToPair
ratioToPair :: Ratio.T a -> (a,a)
ratioToPair x = (Ratio.numerator x, Ratio.denominator x)