{-# OPTIONS_GHC -optc-D_LARGEFILE_SOURCE #-}
{-# OPTIONS_GHC -optc-D_LARGEFILE64_SOURCE #-}
{-# OPTIONS_GHC -optc-D_THREAD_SAFE #-}
{-# OPTIONS_GHC -optc-D_REENTRANT #-}
{-# OPTIONS_GHC -optc-DBUILD_DIR="build/debug" #-}
{-# OPTIONS_GHC -optc-DGHC_VERSION=90202 #-}
{-# OPTIONS_GHC -optc-D__APPLE__ #-}
{-# LINE 1 "Util/TimeVectorStorable.hsc" #-}
-- Copyright 2013 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
-- | Storable instances for unboxed TimeVector values, declared separately to
-- avoid an hsc dependence for TimeVector.
--
-- The Storable instances are used both by vector and when the signals are
-- copied to C, so they have to produce structs as expected by C.
module Util.TimeVectorStorable where
import qualified Data.Aeson as Aeson
import Foreign

import qualified Util.FFI as FFI
import qualified ForeignC as C
import qualified Util.Serialize as Serialize

import qualified Perform.RealTime as RealTime




data Sample y = Sample {
    sx :: {-# UNPACK #-} !X
    , sy :: !y
    } deriving (Show, Eq)

type X = RealTime.RealTime

instance Storable (Sample Double) where
    sizeOf _ = (16)
{-# LINE 33 "Util/TimeVectorStorable.hsc" #-}
    alignment _ = alignment (0 :: C.CDouble)
    poke sp (Sample time val) = do
        ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) sp time
{-# LINE 36 "Util/TimeVectorStorable.hsc" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) sp (FFI.c_double val)
{-# LINE 37 "Util/TimeVectorStorable.hsc" #-}
    peek sp = do
        time <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) sp
{-# LINE 39 "Util/TimeVectorStorable.hsc" #-}
        val <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) sp
{-# LINE 40 "Util/TimeVectorStorable.hsc" #-}
        return $ Sample time (FFI.hs_double val)

-- TODO I think this is necessary all-vector implementations in Util.Segment
-- instance (Storable a, Storable b) => Storable (a, b) where
--     -- vector uses undefined internally, so I can't look at the arguments.
--     -- Proxy or explicit type arguments wouldn't have this problem!
--     sizeOf _ = sizeOf (undefined :: a) + sizeOf (undefined :: b)
--     alignment _ = alignment (undefined :: a)
--     poke p (a, b) = do
--         poke (castPtr p) a
--         poke (castPtr (p `plusPtr` sizeOf a)) b
--     peek p = do
--         a <- peek (castPtr p)
--         b <- peek (castPtr (p `plusPtr` sizeOf a))
--         return (a, b)

instance C.CStorable (Sample Double) where
    sizeOf = sizeOf
    alignment = alignment
    peek = peek
    poke = poke

instance (Serialize.Serialize y) => Serialize.Serialize (Sample y) where
    put (Sample a b) = Serialize.put a >> Serialize.put b
    get = Serialize.get >>= \a -> Serialize.get >>= \b -> return $ Sample a b

instance Aeson.ToJSON (Sample Double) where
    toJSON (Sample x y) = Aeson.toJSON (x, y)
instance Aeson.FromJSON (Sample Double) where
    parseJSON = fmap (uncurry Sample) . Aeson.parseJSON