glib-0.11.0: System/Glib/GDateTime.chs
{-# LANGUAGE CPP #-}
-- -*-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,
#if GLIB_CHECK_VERSION(2,12,0)
gTimeValFromISO8601,
gTimeValToISO8601,
#endif
GDate(..),
GDateDay,
GDateMonth,
GDateYear,
GDateJulianDay,
GDateWeekday,
gDateValidJulian,
gDateValidDMY,
gDateNewJulian,
gDateNewDMY,
gDateSetDay,
gDateSetMonth,
gDateSetYear,
#if GLIB_CHECK_VERSION(2,10,0)
gDateNewTimeVal,
#endif
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 = {# type glong #}
data GTimeVal = GTimeVal { gTimeValSec :: GTimeValPart
, gTimeValUSec :: GTimeValPart }
deriving (Eq, Ord)
instance Storable GTimeVal where
sizeOf _ = {# sizeof GTimeVal #}
alignment _ = alignment (undefined :: CString)
peek ptr =
do sec <- {# get GTimeVal->tv_sec #} ptr
uSec <- {# get GTimeVal->tv_usec #} ptr
return $ GTimeVal sec uSec
poke ptr (GTimeVal sec uSec) =
do {# set GTimeVal->tv_sec #} ptr sec
{# set GTimeVal->tv_usec #} ptr uSec
gGetCurrentTime :: IO GTimeVal
gGetCurrentTime =
alloca $ \ptr ->
do {# call g_get_current_time #} $ castPtr ptr
peek ptr
gUSleep :: GTimeValPart
-> IO ()
gUSleep microseconds =
{# call g_usleep #} $ fromIntegral microseconds
gTimeValAdd :: GTimeVal
-> GTimeValPart
-> GTimeVal
gTimeValAdd time microseconds =
unsafePerformIO $ with time $ \ptr ->
do {# call g_time_val_add #} (castPtr ptr) microseconds
peek ptr
#if GLIB_CHECK_VERSION(2,12,0)
gTimeValFromISO8601 :: String
-> Maybe GTimeVal
gTimeValFromISO8601 isoDate =
unsafePerformIO $ withUTFString isoDate $ \cISODate ->
alloca $ \ptr ->
do success <- liftM toBool $ {# call g_time_val_from_iso8601 #} cISODate $ castPtr ptr
if success
then liftM Just $ peek ptr
else return Nothing
gTimeValToISO8601 :: GTimeVal
-> String
gTimeValToISO8601 time =
unsafePerformIO $ with time $ \ptr ->
{# call g_time_val_to_iso8601 #} (castPtr ptr) >>= readUTFString
#endif
newtype GDateDay = GDateDay {# type GDateDay #}
deriving (Eq, Ord)
instance Bounded GDateDay where
minBound = GDateDay 1
maxBound = GDateDay 31
{# enum GDateMonth {underscoreToCase} deriving (Eq, Ord) #}
instance Bounded GDateMonth where
minBound = GDateJanuary
maxBound = GDateDecember
newtype GDateYear = GDateYear {# type GDateYear #}
deriving (Eq, Ord)
instance Bounded GDateYear where
minBound = GDateYear 1
maxBound = GDateYear (maxBound :: {# type guint16 #})
type GDateJulianDay = {# type guint32 #}
newtype GDate = GDate { gDateJulianDay :: GDateJulianDay }
deriving (Eq)
instance Storable GDate where
sizeOf _ = {# sizeof GDate #}
alignment _ = alignment (undefined :: CString)
peek =
(liftM (GDate . fromIntegral)) . {# call g_date_get_julian #} . castPtr
poke ptr val =
{# call g_date_set_julian #} (castPtr ptr) $ gDateJulianDay val
{# enum GDateWeekday {underscoreToCase} deriving (Eq, Ord) #}
instance Bounded GDateWeekday where
minBound = GDateMonday
maxBound = GDateSunday
gDateValidJulian :: GDateJulianDay
-> Bool
gDateValidJulian =
toBool . {# call fun g_date_valid_julian #}
gDateValidDMY :: GDateDay
-> GDateMonth
-> GDateYear
-> Bool
gDateValidDMY (GDateDay day) month (GDateYear year) =
toBool $ {# call fun 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
{# call 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 {# call g_date_set_day #} (castPtr ptr) day
valid <- liftM toBool $ {# call 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 {# call g_date_set_month #} (castPtr ptr) $ fromIntegral $ fromEnum month
valid <- liftM toBool $ {# call 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 {# call g_date_set_year #} (castPtr ptr) year
valid <- liftM toBool $ {# call g_date_valid #} $ castPtr ptr
if valid
then liftM Just $ peek ptr
else return Nothing
#if GLIB_CHECK_VERSION(2,10,0)
gDateNewTimeVal :: GTimeVal
-> GDate
gDateNewTimeVal timeVal =
unsafePerformIO $ alloca $ \ptr ->
with timeVal $ \timeValPtr ->
do {# call g_date_set_time_val #} (castPtr ptr) $ castPtr timeValPtr
peek ptr
#endif
gDateParse :: String
-> IO (Maybe GDate)
gDateParse str =
alloca $ \ptr ->
do withUTFString str $ {# call g_date_set_parse #} $ castPtr ptr
valid <- liftM toBool $ {# call 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 {# call g_date_add_days #} (castPtr ptr) $ fromIntegral nDays
peek ptr
gDateSubtractDays :: GDate
-> Word
-> GDate
gDateSubtractDays date nDays =
unsafePerformIO $ with date $ \ptr ->
do {# call g_date_subtract_days #} (castPtr ptr) $ fromIntegral nDays
peek ptr
gDateAddMonths :: GDate
-> Word
-> GDate
gDateAddMonths date nMonths =
unsafePerformIO $ with date $ \ptr ->
do {# call g_date_add_months #} (castPtr ptr) $ fromIntegral nMonths
peek ptr
gDateSubtractMonths :: GDate
-> Word
-> GDate
gDateSubtractMonths date nMonths =
unsafePerformIO $ with date $ \ptr ->
do {# call g_date_subtract_months #} (castPtr ptr) $ fromIntegral nMonths
peek ptr
gDateAddYears :: GDate
-> Word
-> GDate
gDateAddYears date nYears =
unsafePerformIO $ with date $ \ptr ->
do {# call g_date_add_years #} (castPtr ptr) $ fromIntegral nYears
peek ptr
gDateSubtractYears :: GDate
-> Word
-> GDate
gDateSubtractYears date nYears =
unsafePerformIO $ with date $ \ptr ->
do {# call 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 ->
{# call 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 ->
{# call 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 {# call g_date_clamp #} (castPtr ptr) (castPtr minPtr) $ castPtr maxPtr
peek ptr
gDateDay :: GDate
-> GDateDay
gDateDay date =
GDateDay $ unsafePerformIO $ with date $ {# call g_date_get_day #} . castPtr
gDateMonth :: GDate
-> GDateMonth
gDateMonth date =
toEnum $ fromIntegral $ unsafePerformIO $ with date $ {# call g_date_get_month #} . castPtr
gDateYear :: GDate
-> GDateYear
gDateYear date =
GDateYear $ unsafePerformIO $ with date $ {# call g_date_get_year #} . castPtr
gDateWeekday :: GDate
-> GDateWeekday
gDateWeekday date =
toEnum $ fromIntegral $ unsafePerformIO $ with date $ {# call g_date_get_weekday #} . castPtr