{-# LINE 1 "src/Database/PostgreSQL/PQTypes/Interval.hsc" #-}
{-# LANGUAGE DeriveDataTypeable, RecordWildCards, TypeFamilies #-}
{-# LINE 2 "src/Database/PostgreSQL/PQTypes/Interval.hsc" #-}
module Database.PostgreSQL.PQTypes.Interval (
    Interval(..)
  , iyears
  , imonths
  , idays
  , ihours
  , iminutes
  , iseconds
  , imicroseconds
  ) where

import Control.Applicative
import Data.Int
import Data.Monoid
import Data.Typeable
import Foreign.Storable
import qualified Data.ByteString.Char8 as BS

import Database.PostgreSQL.PQTypes.Format
import Database.PostgreSQL.PQTypes.FromSQL
import Database.PostgreSQL.PQTypes.Internal.Utils
import Database.PostgreSQL.PQTypes.ToSQL


{-# LINE 26 "src/Database/PostgreSQL/PQTypes/Interval.hsc" #-}


{-# LINE 28 "src/Database/PostgreSQL/PQTypes/Interval.hsc" #-}

----------------------------------------

-- | Representation of INTERVAL PostgreSQL type.
data Interval = Interval {
  intYears         :: !Int32
, intMonths        :: !Int32
, intDays          :: !Int32
, intHours         :: !Int32
, intMinutes       :: !Int32
, intSeconds       :: !Int32
, intMicroseconds  :: !Int32
} deriving (Eq, Ord, Show, Typeable)

instance Monoid Interval where
  mempty = Interval 0 0 0 0 0 0 0
  mappend a b = Interval {
    intYears = intYears a + intYears b
  , intMonths = intMonths a + intMonths b
  , intDays = intDays a + intDays b
  , intHours = intHours a + intHours b
  , intMinutes = intMinutes a + intMinutes b
  , intSeconds = intSeconds a + intSeconds b
  , intMicroseconds = intMicroseconds a + intMicroseconds b
  }

instance Storable Interval where
  sizeOf _ = (28)
{-# LINE 56 "src/Database/PostgreSQL/PQTypes/Interval.hsc" #-}
  alignment _ = 4
{-# LINE 57 "src/Database/PostgreSQL/PQTypes/Interval.hsc" #-}
  peek ptr = Interval
    <$> (\hsc_ptr -> peekByteOff hsc_ptr 0) ptr
{-# LINE 59 "src/Database/PostgreSQL/PQTypes/Interval.hsc" #-}
    <*> (\hsc_ptr -> peekByteOff hsc_ptr 4) ptr
{-# LINE 60 "src/Database/PostgreSQL/PQTypes/Interval.hsc" #-}
    <*> (\hsc_ptr -> peekByteOff hsc_ptr 8) ptr
{-# LINE 61 "src/Database/PostgreSQL/PQTypes/Interval.hsc" #-}
    <*> (\hsc_ptr -> peekByteOff hsc_ptr 12) ptr
{-# LINE 62 "src/Database/PostgreSQL/PQTypes/Interval.hsc" #-}
    <*> (\hsc_ptr -> peekByteOff hsc_ptr 16) ptr
{-# LINE 63 "src/Database/PostgreSQL/PQTypes/Interval.hsc" #-}
    <*> (\hsc_ptr -> peekByteOff hsc_ptr 20) ptr
{-# LINE 64 "src/Database/PostgreSQL/PQTypes/Interval.hsc" #-}
    <*> (\hsc_ptr -> peekByteOff hsc_ptr 24) ptr
{-# LINE 65 "src/Database/PostgreSQL/PQTypes/Interval.hsc" #-}
  poke ptr Interval{..} = do
    (\hsc_ptr -> pokeByteOff hsc_ptr 0) ptr intYears
{-# LINE 67 "src/Database/PostgreSQL/PQTypes/Interval.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 4) ptr intMonths
{-# LINE 68 "src/Database/PostgreSQL/PQTypes/Interval.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 8) ptr intDays
{-# LINE 69 "src/Database/PostgreSQL/PQTypes/Interval.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 12) ptr intHours
{-# LINE 70 "src/Database/PostgreSQL/PQTypes/Interval.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 16) ptr intMinutes
{-# LINE 71 "src/Database/PostgreSQL/PQTypes/Interval.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 20) ptr intSeconds
{-# LINE 72 "src/Database/PostgreSQL/PQTypes/Interval.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 24) ptr intMicroseconds
{-# LINE 73 "src/Database/PostgreSQL/PQTypes/Interval.hsc" #-}

instance PQFormat Interval where
  pqFormat _ = BS.pack "%interval"

instance FromSQL Interval where
  type PQBase Interval = Interval
  fromSQL Nothing = unexpectedNULL
  fromSQL (Just int) = return int

instance ToSQL Interval where
  type PQDest Interval = Interval
  toSQL int _ = put int

----------------------------------------

-- | Convert 'Int32' to appropriate 'Interval'
-- representation of given number of years.
iyears :: Int32 -> Interval
iyears v = mempty { intYears = v }

-- | Convert 'Int32' to appropriate 'Interval'
-- representation of given number of months.
imonths :: Int32 -> Interval
imonths v = mempty { intMonths = v }

-- | Convert 'Int32' to appropriate 'Interval'
-- representation of given number of days.
idays :: Int32 -> Interval
idays v = mempty { intDays = v }

-- | Convert 'Int32' to appropriate 'Interval'
-- representation of given number of hours.
ihours :: Int32 -> Interval
ihours v = mempty { intHours = v }

-- | Convert 'Int32' to appropriate 'Interval'
-- representation of given number of minutes.
iminutes :: Int32 -> Interval
iminutes v = mempty { intMinutes = v }

-- | Convert 'Int32' to appropriate 'Interval'
-- representation of given number of seconds.
iseconds :: Int32 -> Interval
iseconds v = mempty { intSeconds = v }

-- | Convert 'Int32' to appropriate 'Interval'
-- representation of given number of microseconds.
imicroseconds :: Int32 -> Interval
imicroseconds v = mempty { intMicroseconds = v }