{-# LINE 2 "./System/Glib/GDateTime.chs" #-}
-- -*-haskell-*-
-- GIMP Toolkit (GTK)
--
-- Author : Peter Gavin
--
-- Created: July 2007
--
-- Copyright (C) 2007 Peter Gavin
--
-- This library 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 2.1 of the License, or (at your option) any later version.
--
-- This library 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.
--
-- |
-- Maintainer : gtk2hs-users@lists.sourceforge.net
-- Stability : provisional
-- Portability : portable (depends on GHC)
--
module System.Glib.GDateTime (
  GTimeValPart,
  GTimeVal(..),
  gGetCurrentTime,
  gUSleep,
  gTimeValAdd,

  gTimeValFromISO8601,
  gTimeValToISO8601,

  GDate(..),
  GDateDay,
  GDateMonth,
  GDateYear,
  GDateJulianDay,
  GDateWeekday,
  gDateValidJulian,
  gDateValidDMY,
  gDateNewJulian,
  gDateNewDMY,
  gDateSetDay,
  gDateSetMonth,
  gDateSetYear,

  gDateNewTimeVal,

  gDateParse,
  gDateAddDays,
  gDateSubtractDays,
  gDateAddMonths,
  gDateSubtractMonths,
  gDateAddYears,
  gDateSubtractYears,
  gDateDaysBetween,
  gDateCompare,
  gDateClamp,
  gDateDay,
  gDateMonth,
  gDateYear,
  gDateWeekday
  ) where

import Control.Monad (liftM)
import System.Glib.FFI
import System.Glib.UTFString

type GTimeValPart = (CLong)
{-# LINE 73 "./System/Glib/GDateTime.chs" #-}
data GTimeVal = GTimeVal { gTimeValSec :: GTimeValPart
                         , gTimeValUSec :: GTimeValPart }
                deriving (Eq, Ord)
instance Storable GTimeVal where
    sizeOf _ = 16
{-# LINE 78 "./System/Glib/GDateTime.chs" #-}
    alignment _ = alignment (undefined :: CString)
    peek ptr =
        do sec <- (\ptr -> do {peekByteOff ptr 0 ::IO CLong}) ptr
           uSec <- (\ptr -> do {peekByteOff ptr 8 ::IO CLong}) ptr
           return $ GTimeVal sec uSec
    poke ptr (GTimeVal sec uSec) =
        do (\ptr val -> do {pokeByteOff ptr 0 (val::CLong)}) ptr sec
           (\ptr val -> do {pokeByteOff ptr 8 (val::CLong)}) ptr uSec

gGetCurrentTime :: IO GTimeVal
gGetCurrentTime =
    alloca $ \ptr ->
        do g_get_current_time $ castPtr ptr
           peek ptr

gUSleep :: GTimeValPart
        -> IO ()
gUSleep microseconds =
    g_usleep $ fromIntegral microseconds

gTimeValAdd :: GTimeVal
            -> GTimeValPart
            -> GTimeVal
gTimeValAdd time microseconds =
    unsafePerformIO $ with time $ \ptr ->
        do g_time_val_add (castPtr ptr) microseconds
           peek ptr


gTimeValFromISO8601 :: GlibString string
                    => string
                    -> Maybe GTimeVal
gTimeValFromISO8601 isoDate =
    unsafePerformIO $ withUTFString isoDate $ \cISODate ->
        alloca $ \ptr ->
            do success <- liftM toBool $ g_time_val_from_iso8601 cISODate $ castPtr ptr
               if success
                   then liftM Just $ peek ptr
                   else return Nothing

gTimeValToISO8601 :: GlibString string
                  => GTimeVal
                  -> string
gTimeValToISO8601 time =
    unsafePerformIO $ with time $ \ptr ->
        g_time_val_to_iso8601 (castPtr ptr) >>= readUTFString


newtype GDateDay = GDateDay (CUChar)
{-# LINE 127 "./System/Glib/GDateTime.chs" #-}
    deriving (Eq, Ord)
instance Bounded GDateDay where
    minBound = GDateDay 1
    maxBound = GDateDay 31

data GDateMonth = GDateBadMonth
                | GDateJanuary
                | GDateFebruary
                | GDateMarch
                | GDateApril
                | GDateMay
                | GDateJune
                | GDateJuly
                | GDateAugust
                | GDateSeptember
                | GDateOctober
                | GDateNovember
                | GDateDecember
                deriving (Eq,Ord)
instance Enum GDateMonth where
  fromEnum GDateBadMonth = 0
  fromEnum GDateJanuary = 1
  fromEnum GDateFebruary = 2
  fromEnum GDateMarch = 3
  fromEnum GDateApril = 4
  fromEnum GDateMay = 5
  fromEnum GDateJune = 6
  fromEnum GDateJuly = 7
  fromEnum GDateAugust = 8
  fromEnum GDateSeptember = 9
  fromEnum GDateOctober = 10
  fromEnum GDateNovember = 11
  fromEnum GDateDecember = 12

  toEnum 0 = GDateBadMonth
  toEnum 1 = GDateJanuary
  toEnum 2 = GDateFebruary
  toEnum 3 = GDateMarch
  toEnum 4 = GDateApril
  toEnum 5 = GDateMay
  toEnum 6 = GDateJune
  toEnum 7 = GDateJuly
  toEnum 8 = GDateAugust
  toEnum 9 = GDateSeptember
  toEnum 10 = GDateOctober
  toEnum 11 = GDateNovember
  toEnum 12 = GDateDecember
  toEnum unmatched = error ("GDateMonth.toEnum: Cannot match " ++ show unmatched)

  succ GDateBadMonth = GDateJanuary
  succ GDateJanuary = GDateFebruary
  succ GDateFebruary = GDateMarch
  succ GDateMarch = GDateApril
  succ GDateApril = GDateMay
  succ GDateMay = GDateJune
  succ GDateJune = GDateJuly
  succ GDateJuly = GDateAugust
  succ GDateAugust = GDateSeptember
  succ GDateSeptember = GDateOctober
  succ GDateOctober = GDateNovember
  succ GDateNovember = GDateDecember
  succ _ = undefined

  pred GDateJanuary = GDateBadMonth
  pred GDateFebruary = GDateJanuary
  pred GDateMarch = GDateFebruary
  pred GDateApril = GDateMarch
  pred GDateMay = GDateApril
  pred GDateJune = GDateMay
  pred GDateJuly = GDateJune
  pred GDateAugust = GDateJuly
  pred GDateSeptember = GDateAugust
  pred GDateOctober = GDateSeptember
  pred GDateNovember = GDateOctober
  pred GDateDecember = GDateNovember
  pred _ = undefined

  enumFromTo x y | fromEnum x == fromEnum y = [ y ]
                 | otherwise = x : enumFromTo (succ x) y
  enumFrom x = enumFromTo x GDateDecember
  enumFromThen _ _ =     error "Enum GDateMonth: enumFromThen not implemented"
  enumFromThenTo _ _ _ =     error "Enum GDateMonth: enumFromThenTo not implemented"

{-# LINE 133 "./System/Glib/GDateTime.chs" #-}
instance Bounded GDateMonth where
    minBound = GDateJanuary
    maxBound = GDateDecember

newtype GDateYear = GDateYear (CUShort)
{-# LINE 138 "./System/Glib/GDateTime.chs" #-}
    deriving (Eq, Ord)
instance Bounded GDateYear where
    minBound = GDateYear 1
    maxBound = GDateYear (maxBound :: (CUShort))

type GDateJulianDay = (CUInt)
{-# LINE 144 "./System/Glib/GDateTime.chs" #-}
newtype GDate = GDate { gDateJulianDay :: GDateJulianDay }
    deriving (Eq)
instance Storable GDate where
    sizeOf _ = 5
{-# LINE 148 "./System/Glib/GDateTime.chs" #-}
    alignment _ = alignment (undefined :: CString)
    peek =
        (liftM (GDate . fromIntegral)) . g_date_get_julian . castPtr
    poke ptr val =
        g_date_set_julian (castPtr ptr) $ gDateJulianDay val

data GDateWeekday = GDateBadWeekday
                  | GDateMonday
                  | GDateTuesday
                  | GDateWednesday
                  | GDateThursday
                  | GDateFriday
                  | GDateSaturday
                  | GDateSunday
                  deriving (Eq,Ord)
instance Enum GDateWeekday where
  fromEnum GDateBadWeekday = 0
  fromEnum GDateMonday = 1
  fromEnum GDateTuesday = 2
  fromEnum GDateWednesday = 3
  fromEnum GDateThursday = 4
  fromEnum GDateFriday = 5
  fromEnum GDateSaturday = 6
  fromEnum GDateSunday = 7

  toEnum 0 = GDateBadWeekday
  toEnum 1 = GDateMonday
  toEnum 2 = GDateTuesday
  toEnum 3 = GDateWednesday
  toEnum 4 = GDateThursday
  toEnum 5 = GDateFriday
  toEnum 6 = GDateSaturday
  toEnum 7 = GDateSunday
  toEnum unmatched = error ("GDateWeekday.toEnum: Cannot match " ++ show unmatched)

  succ GDateBadWeekday = GDateMonday
  succ GDateMonday = GDateTuesday
  succ GDateTuesday = GDateWednesday
  succ GDateWednesday = GDateThursday
  succ GDateThursday = GDateFriday
  succ GDateFriday = GDateSaturday
  succ GDateSaturday = GDateSunday
  succ _ = undefined

  pred GDateMonday = GDateBadWeekday
  pred GDateTuesday = GDateMonday
  pred GDateWednesday = GDateTuesday
  pred GDateThursday = GDateWednesday
  pred GDateFriday = GDateThursday
  pred GDateSaturday = GDateFriday
  pred GDateSunday = GDateSaturday
  pred _ = undefined

  enumFromTo x y | fromEnum x == fromEnum y = [ y ]
                 | otherwise = x : enumFromTo (succ x) y
  enumFrom x = enumFromTo x GDateSunday
  enumFromThen _ _ =     error "Enum GDateWeekday: enumFromThen not implemented"
  enumFromThenTo _ _ _ =     error "Enum GDateWeekday: enumFromThenTo not implemented"

{-# LINE 155 "./System/Glib/GDateTime.chs" #-}
instance Bounded GDateWeekday where
    minBound = GDateMonday
    maxBound = GDateSunday

gDateValidJulian :: GDateJulianDay
                 -> Bool
gDateValidJulian =
    toBool . g_date_valid_julian
{-# LINE 163 "./System/Glib/GDateTime.chs" #-}

gDateValidDMY :: GDateDay
              -> GDateMonth
              -> GDateYear
              -> Bool
gDateValidDMY (GDateDay day) month (GDateYear year) =
    toBool $ g_date_valid_dmy day
                                             (fromIntegral $ fromEnum month)
                                             year

gDateNewJulian :: GDateJulianDay
               -> Maybe GDate
gDateNewJulian julian =
    if gDateValidJulian julian
        then Just $ GDate julian
        else Nothing

gDateNewDMY :: GDateDay
            -> GDateMonth
            -> GDateYear
            -> Maybe GDate
gDateNewDMY day month year =
    if gDateValidDMY day month year
        then Just $ unsafePerformIO $ alloca $ \ptr ->
            do let GDateDay day' = day
                   GDateYear year' = year
               g_date_set_dmy (castPtr ptr)
                                         day'
                                         (fromIntegral $ fromEnum month)
                                         year'
               peek ptr
        else Nothing

gDateSetDay :: GDate
            -> GDateDay
            -> Maybe GDate
gDateSetDay date (GDateDay day) =
    unsafePerformIO $ with date $ \ptr ->
        do g_date_set_day (castPtr ptr) day
           valid <- liftM toBool $ g_date_valid $ castPtr ptr
           if valid
               then liftM Just $ peek ptr
               else return Nothing

gDateSetMonth :: GDate
              -> GDateMonth
              -> Maybe GDate
gDateSetMonth date month =
    unsafePerformIO $ with date $ \ptr ->
        do g_date_set_month (castPtr ptr) $ fromIntegral $ fromEnum month
           valid <- liftM toBool $ g_date_valid $ castPtr ptr
           if valid
               then liftM Just $ peek ptr
               else return Nothing

gDateSetYear :: GDate
             -> GDateYear
             -> Maybe GDate
gDateSetYear date (GDateYear year) =
    unsafePerformIO $ with date $ \ptr ->
        do g_date_set_year (castPtr ptr) year
           valid <- liftM toBool $ g_date_valid $ castPtr ptr
           if valid
               then liftM Just $ peek ptr
               else return Nothing


gDateNewTimeVal :: GTimeVal
                -> GDate
gDateNewTimeVal timeVal =
    unsafePerformIO $ alloca $ \ptr ->
        with timeVal $ \timeValPtr ->
        do g_date_set_time_val (castPtr ptr) $ castPtr timeValPtr
           peek ptr


gDateParse :: GlibString string
           => string
           -> IO (Maybe GDate)
gDateParse str =
    alloca $ \ptr ->
        do withUTFString str $ g_date_set_parse $ castPtr ptr
           valid <- liftM toBool $ g_date_valid $ castPtr ptr
           if valid
               then liftM Just $ peek ptr
               else return Nothing

gDateAddDays :: GDate
             -> Word
             -> GDate
gDateAddDays date nDays =
    unsafePerformIO $ with date $ \ptr ->
        do g_date_add_days (castPtr ptr) $ fromIntegral nDays
           peek ptr

gDateSubtractDays :: GDate
                  -> Word
                  -> GDate
gDateSubtractDays date nDays =
    unsafePerformIO $ with date $ \ptr ->
        do g_date_subtract_days (castPtr ptr) $ fromIntegral nDays
           peek ptr

gDateAddMonths :: GDate
               -> Word
               -> GDate
gDateAddMonths date nMonths =
    unsafePerformIO $ with date $ \ptr ->
        do g_date_add_months (castPtr ptr) $ fromIntegral nMonths
           peek ptr

gDateSubtractMonths :: GDate
                    -> Word
                    -> GDate
gDateSubtractMonths date nMonths =
    unsafePerformIO $ with date $ \ptr ->
        do g_date_subtract_months (castPtr ptr) $ fromIntegral nMonths
           peek ptr

gDateAddYears :: GDate
              -> Word
              -> GDate
gDateAddYears date nYears =
    unsafePerformIO $ with date $ \ptr ->
        do g_date_add_years (castPtr ptr) $ fromIntegral nYears
           peek ptr

gDateSubtractYears :: GDate
                   -> Word
                   -> GDate
gDateSubtractYears date nYears =
    unsafePerformIO $ with date $ \ptr ->
        do g_date_subtract_years (castPtr ptr) $ fromIntegral nYears
           peek ptr

gDateDaysBetween :: GDate
                 -> GDate
                 -> Int
gDateDaysBetween date1 date2 =
    fromIntegral $ unsafePerformIO $ with date1 $ \ptr1 ->
        with date2 $ \ptr2 ->
            g_date_days_between (castPtr ptr1) $ castPtr ptr2

gDateCompare :: GDate
             -> GDate
             -> Ordering
gDateCompare date1 date2 =
    let result = fromIntegral $ unsafePerformIO $ with date1 $ \ptr1 ->
                     with date2 $ \ptr2 ->
                         g_date_compare (castPtr ptr1) $ castPtr ptr2
        ordering | result < 0 = LT
                 | result > 0 = GT
                 | otherwise = EQ
    in ordering

instance Ord GDate where
    compare = gDateCompare

gDateClamp :: GDate
           -> GDate
           -> GDate
           -> GDate
gDateClamp date minDate maxDate =
    unsafePerformIO $ with date $ \ptr ->
        with minDate $ \minPtr ->
            with maxDate $ \maxPtr ->
                do g_date_clamp (castPtr ptr) (castPtr minPtr) $ castPtr maxPtr
                   peek ptr

gDateDay :: GDate
         -> GDateDay
gDateDay date =
    GDateDay $ unsafePerformIO $ with date $ g_date_get_day . castPtr

gDateMonth :: GDate
           -> GDateMonth
gDateMonth date =
    toEnum $ fromIntegral $ unsafePerformIO $ with date $ g_date_get_month . castPtr

gDateYear :: GDate
          -> GDateYear
gDateYear date =
    GDateYear $ unsafePerformIO $ with date $ g_date_get_year . castPtr

gDateWeekday :: GDate
             -> GDateWeekday
gDateWeekday date =
    toEnum $ fromIntegral $ unsafePerformIO $ with date $ g_date_get_weekday . castPtr

foreign import ccall safe "g_get_current_time"
  g_get_current_time :: ((Ptr ()) -> (IO ()))

foreign import ccall safe "g_usleep"
  g_usleep :: (CULong -> (IO ()))

foreign import ccall safe "g_time_val_add"
  g_time_val_add :: ((Ptr ()) -> (CLong -> (IO ())))

foreign import ccall safe "g_time_val_from_iso8601"
  g_time_val_from_iso8601 :: ((Ptr CChar) -> ((Ptr ()) -> (IO CInt)))

foreign import ccall safe "g_time_val_to_iso8601"
  g_time_val_to_iso8601 :: ((Ptr ()) -> (IO (Ptr CChar)))

foreign import ccall safe "g_date_get_julian"
  g_date_get_julian :: ((Ptr ()) -> (IO CUInt))

foreign import ccall safe "g_date_set_julian"
  g_date_set_julian :: ((Ptr ()) -> (CUInt -> (IO ())))

foreign import ccall safe "g_date_valid_julian"
  g_date_valid_julian :: (CUInt -> CInt)

foreign import ccall safe "g_date_valid_dmy"
  g_date_valid_dmy :: (CUChar -> (CInt -> (CUShort -> CInt)))

foreign import ccall safe "g_date_set_dmy"
  g_date_set_dmy :: ((Ptr ()) -> (CUChar -> (CInt -> (CUShort -> (IO ())))))

foreign import ccall safe "g_date_set_day"
  g_date_set_day :: ((Ptr ()) -> (CUChar -> (IO ())))

foreign import ccall safe "g_date_valid"
  g_date_valid :: ((Ptr ()) -> (IO CInt))

foreign import ccall safe "g_date_set_month"
  g_date_set_month :: ((Ptr ()) -> (CInt -> (IO ())))

foreign import ccall safe "g_date_set_year"
  g_date_set_year :: ((Ptr ()) -> (CUShort -> (IO ())))

foreign import ccall safe "g_date_set_time_val"
  g_date_set_time_val :: ((Ptr ()) -> ((Ptr ()) -> (IO ())))

foreign import ccall safe "g_date_set_parse"
  g_date_set_parse :: ((Ptr ()) -> ((Ptr CChar) -> (IO ())))

foreign import ccall safe "g_date_add_days"
  g_date_add_days :: ((Ptr ()) -> (CUInt -> (IO ())))

foreign import ccall safe "g_date_subtract_days"
  g_date_subtract_days :: ((Ptr ()) -> (CUInt -> (IO ())))

foreign import ccall safe "g_date_add_months"
  g_date_add_months :: ((Ptr ()) -> (CUInt -> (IO ())))

foreign import ccall safe "g_date_subtract_months"
  g_date_subtract_months :: ((Ptr ()) -> (CUInt -> (IO ())))

foreign import ccall safe "g_date_add_years"
  g_date_add_years :: ((Ptr ()) -> (CUInt -> (IO ())))

foreign import ccall safe "g_date_subtract_years"
  g_date_subtract_years :: ((Ptr ()) -> (CUInt -> (IO ())))

foreign import ccall safe "g_date_days_between"
  g_date_days_between :: ((Ptr ()) -> ((Ptr ()) -> (IO CInt)))

foreign import ccall safe "g_date_compare"
  g_date_compare :: ((Ptr ()) -> ((Ptr ()) -> (IO CInt)))

foreign import ccall safe "g_date_clamp"
  g_date_clamp :: ((Ptr ()) -> ((Ptr ()) -> ((Ptr ()) -> (IO ()))))

foreign import ccall safe "g_date_get_day"
  g_date_get_day :: ((Ptr ()) -> (IO CUChar))

foreign import ccall safe "g_date_get_month"
  g_date_get_month :: ((Ptr ()) -> (IO CInt))

foreign import ccall safe "g_date_get_year"
  g_date_get_year :: ((Ptr ()) -> (IO CUShort))

foreign import ccall safe "g_date_get_weekday"
  g_date_get_weekday :: ((Ptr ()) -> (IO CInt))