{-# LANGUAGE DeriveDataTypeable, RecordWildCards, TypeFamilies #-}
module Database.PostgreSQL.PQTypes.Interval (
    Interval(..)
  , iyears
  , imonths
  , idays
  , ihours
  , iminutes
  , iseconds
  , imicroseconds
  ) where

import Control.Applicative
import Data.Int
import Data.List
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

#let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__);}, y__)

#include <libpqtypes.h>

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

-- | 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, Typeable)

instance Show Interval where
  showsPrec _ Interval{..} = (++) . intercalate ", " $ filter (not . null) [
      f intYears "year"
    , f intMonths "month"
    , f intDays "day"
    , f intHours "hour"
    , f intMinutes "minute"
    , f intSeconds "second"
    , f intMicroseconds "microsecond"
    ]
    where
      f n desc = case n of
        0 -> ""
        1 -> show n ++ " " ++ desc
        _ -> show n ++ " " ++ desc ++ "s"

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 _ = #{size PGinterval}
  alignment _ = #{alignment PGinterval}
  peek ptr = Interval
    <$> #{peek PGinterval, years} ptr
    <*> #{peek PGinterval, mons} ptr
    <*> #{peek PGinterval, days} ptr
    <*> #{peek PGinterval, hours} ptr
    <*> #{peek PGinterval, mins} ptr
    <*> #{peek PGinterval, secs} ptr
    <*> #{peek PGinterval, usecs} ptr
  poke ptr Interval{..} = do
    #{poke PGinterval, years} ptr intYears
    #{poke PGinterval, mons} ptr intMonths
    #{poke PGinterval, days} ptr intDays
    #{poke PGinterval, hours} ptr intHours
    #{poke PGinterval, mins} ptr intMinutes
    #{poke PGinterval, secs} ptr intSeconds
    #{poke PGinterval, usecs} ptr intMicroseconds

instance PQFormat Interval where
  pqFormat = const $ 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 }