CalendarUtils.hs

{-
 *  Programmer:	Piotr Borek
 *  E-mail:     piotrborek@op.pl
 *  Copyright 2015 Piotr Borek
 *
 *  Distributed under the terms of the GPL (GNU Public License)
 *
 *  This program is free software; you can redistribute it and/or modify
 *  it under the terms of the GNU General Public License as published by
 *  the Free Software Foundation; either version 2 of the License, or
 *  (at your option) any later version.
 *
 *  This program 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 General Public License for more details.
 *
 *  You should have received a copy of the GNU General Public License
 *  along with this program; if not, write to the Free Software
 *  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
-}

module Coin.UI.Utils.CalendarUtils (
    Days (..),
    Months (..),
    succ',
    pred',
    intToDay,
    intToMonth,
    calendarGetDate,
    calendarGetInfo,
    calendarDateToInt,
    calendarIntToDate,
    calendarShow
) where

import Data.Bits
import Data.Time
import Data.Time.Calendar.WeekDate

import Coin.Locale.Translate

data Days = Monday
          | Tuesday
          | Wednesday
          | Thursday
          | Friday
          | Saturday
          | Sunday
          deriving (Eq, Ord, Enum, Bounded)

data Months = January
            | February
            | March
            | April
            | May
            | June
            | July
            | August
            | September
            | October
            | November
            | December
            deriving (Eq, Ord, Enum, Bounded)

instance Show Days where
    show Monday    = __"Mo"
    show Tuesday   = __"Tu"
    show Wednesday = __"We"
    show Thursday  = __"Th"
    show Friday    = __"Fr"
    show Saturday  = __"Sa"
    show Sunday    = __"Su"

instance Show Months where
    show January   = __"January"
    show February  = __"February"
    show March     = __"March"
    show April     = __"April"
    show May       = __"May"
    show June      = __"June"
    show July      = __"July"
    show August    = __"August"
    show September = __"September"
    show October   = __"October"
    show November  = __"November"
    show December  = __"December"

succ' :: (Eq a, Enum a, Bounded a) => a -> a
succ' x
    | x == maxBound = minBound
    | otherwise     = succ x

pred' :: (Eq a, Enum a, Bounded a) => a -> a
pred' x
    | x == minBound = maxBound
    | otherwise     = pred x

intToDay :: Int -> Days
intToDay x
    | x == 0    = Monday
    | x == 1    = Tuesday
    | x == 2    = Wednesday
    | x == 3    = Thursday
    | x == 4    = Friday
    | x == 5    = Saturday
    | x == 6    = Sunday
    | otherwise = undefined

intToMonth :: Int -> Months
intToMonth x
    | x ==  1   = January
    | x ==  2   = February
    | x ==  3   = March
    | x ==  4   = April
    | x ==  5   = May
    | x ==  6   = June
    | x ==  7   = July
    | x ==  8   = August
    | x ==  9   = September
    | x == 10   = October
    | x == 11   = November
    | x == 12   = December
    | otherwise = undefined

calendarGetDate :: IO (Integer, Int, Int, Int, Int)
calendarGetDate = do
    c <- getCurrentTime
    let (year, month, day) = toGregorian $ utctDay c
    let numberOfDays = gregorianMonthLength year month
    let (_, _, firstDay) = toWeekDate $ fromGregorian year month 1
    return (year, month, day, numberOfDays, firstDay)

calendarGetInfo :: Integer -> Int -> IO (Int, Int)
calendarGetInfo year month = do
    let numberOfDays = gregorianMonthLength year month
    let (_, _, firstDay) = toWeekDate $ fromGregorian year month 1
    return (firstDay, numberOfDays)

calendarDateToInt :: (Integer, Int, Int) -> Int
calendarDateToInt (year, month, day) = (day .&. 0x1F) + (shiftL (month .&. 0xF) 5) + (shiftL (fromInteger year) 9)

calendarIntToDate :: Int -> (Integer, Int, Int)
calendarIntToDate date = (toInteger $ shiftR date 9, (shiftR date 5) .&. 0xF, date .&. 0x1F)

calendarShow :: Int -> String
calendarShow date = let (year, month, day) = calendarIntToDate date
                    in show year ++ "-" ++ show' month ++ "-" ++ show' day
  where
    show' x | length (show x) == 0 = "00"
            | length (show x) == 1 = "0" ++ show x
            | otherwise            = show x