{-# LINE 1 "src/Data/Time/Internal.hsc" #-}
{-
{-# LINE 2 "src/Data/Time/Internal.hsc" #-}
    Copyright 2016 Markus Ongyerth

    This file is part of pulseaudio-hs.

    Monky is free software: you can redistribute it and/or modify
    it under the terms of the GNU Lesser General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    Monky is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU Lesser General Public License for more details.

    You should have received a copy of the GNU Lesser General Public License
    along with pulseaudio-hs.  If not, see <http://www.gnu.org/licenses/>.
-}
{-# LANGUAGE ForeignFunctionInterface, CPP #-}
{-|
Module      : Data.Time.Internal
Description : Internal handling of time, and conversion between struct timeval and struct timespec
Maintianer  : ongy
Stability   : experimental
-}
module Data.Time.Internal
    ( PAITime
    , PATime(..)

    , toPAI
    , fromPAI
    )
where


{-# LINE 38 "src/Data/Time/Internal.hsc" #-}

{-# LINE 39 "src/Data/Time/Internal.hsc" #-}

{-# LINE 40 "src/Data/Time/Internal.hsc" #-}

import Data.Word (Word)
import Control.Applicative ((<$>), (<*>))
import Foreign.Storable
import Foreign.C.Types

-- Seconds and nanoseconds, compare with struct timespec (clock-gettime)
-- I'll make this Word Word, a few bytes more don't hurt that much
-- |The time used by the library level api
data PATime = PATime Word CLong deriving (Show, Eq, Ord)

instance Storable PATime where
    sizeOf _ = (16)
{-# LINE 53 "src/Data/Time/Internal.hsc" #-}
    alignment _ = (8)
{-# LINE 54 "src/Data/Time/Internal.hsc" #-}
    peek p = PATime
        <$> (\hsc_ptr -> peekByteOff hsc_ptr 0)  p
{-# LINE 56 "src/Data/Time/Internal.hsc" #-}
        <*> (\hsc_ptr -> peekByteOff hsc_ptr 8) p
{-# LINE 57 "src/Data/Time/Internal.hsc" #-}
    poke p (PATime sec nsec) = do
        (\hsc_ptr -> pokeByteOff hsc_ptr 0) p sec
{-# LINE 59 "src/Data/Time/Internal.hsc" #-}
        (\hsc_ptr -> pokeByteOff hsc_ptr 8) p nsec
{-# LINE 60 "src/Data/Time/Internal.hsc" #-}


-- |Internal time struct used to convert to pulseaudio compatible format
data PAITime = PAITime Word CLong deriving (Show, Eq, Ord)

instance Storable PAITime where
    sizeOf _ = (16)
{-# LINE 67 "src/Data/Time/Internal.hsc" #-}
    alignment _ = (8)
{-# LINE 68 "src/Data/Time/Internal.hsc" #-}
    peek p = PAITime
        <$> (\hsc_ptr -> peekByteOff hsc_ptr 0)  p
{-# LINE 70 "src/Data/Time/Internal.hsc" #-}
        <*> (\hsc_ptr -> peekByteOff hsc_ptr 8) p
{-# LINE 71 "src/Data/Time/Internal.hsc" #-}
    poke p (PAITime sec usec) = do
        (\hsc_ptr -> pokeByteOff hsc_ptr 0) p sec
{-# LINE 73 "src/Data/Time/Internal.hsc" #-}
        (\hsc_ptr -> pokeByteOff hsc_ptr 8) p usec
{-# LINE 74 "src/Data/Time/Internal.hsc" #-}

-- |Convert from 'PATime' to 'PAITime' before passing to pulse
toPAI :: PATime -> PAITime
toPAI (PATime s ns) = PAITime s (ns `div` 1000)

-- |Convert from 'PAITime' to 'PATime' after getting value form pulse
fromPAI :: PAITime -> PATime
fromPAI (PAITime s ns) = PATime s (ns * 1000)