{- * 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