More Time Utilities (13/365)

Suppose you want to add one second to the current date. One approach is to convert it to unix-time (seconds from epoch), add 1, and then convert it back. The cost of converting is a little too high if we frequently perfom this wrapping and unwrapping (technically we could catch unwrap . wrap using rules and fuse it to id). Furthermore, this method doesn’t necessarily help if we want to perform more complex tasks like the following: given a date range pick out the sub-ranges that match mondays. For this purpose, the original representation of year, month, and day is more helpful.

I have written some utilities to make these tasks simpler. Today, I will introduce the date-time representation and then provide a way to tick the date-time forward by one second or to tick it back by one second and then in the next post present a matching DSL.

> import Text.Printf
> import Data.Time.Calendar          (fromGregorianValid)
> import Data.Time.Calendar.WeekDate (toWeekDate)
> import Control.Monad               (guard, when)
> 
> data DT = DT
>   {
>     year  :: {-# UNPACK #-} !Int
>   , month :: {-# UNPACK #-} !Int
>   , day   :: {-# UNPACK #-} !Int
>   , dow   :: {-# UNPACK #-} !Int
>   , tod   :: {-# UNPACK #-} !Int
>   }

Some instances

> instance Eq DT where
>   dt == dt' = tod dt == tod dt' &&
>               day dt == day dt' &&
>               month dt == month dt' &&
>               year dt == year dt'
> 
> instance Ord DT where
>   compare dt dt' =
>     compare (year dt,month dt,day dt,tod dt)
>             (year dt',month dt',day dt',tod dt')
> 
> instance Show DT where
>   show dt = printf "%d-%02d-%02d %02d:%02d:%02d"
>                    (year dt) (month dt) (day dt)
>                    (tod dt `div` 3600) (((tod dt-s) `div` 60) `mod` 60) s
>     where s = tod dt `mod` 60

For constructing it

> toDT :: Int -> Int -> Int -> Int -> Int -> Int -> Either String DT
> toDT year month day hour min sec = do
>   dayObj <- maybe (Left "Invalid Year/Month/Day") return $ fromGregorianValid (fromIntegral year) month day
>   when (0 > hour || hour > 23) $ Left "Invalid Hour"
>   when (0 > min  || min  > 59) $ Left "Invalid Minute"
>   when (0 > sec  || sec  > 59) $ Left "Invalid Second"
>   let (_,_,dow) = toWeekDate dayObj
>   return $ DT year month day (dow-1) (hour*3600 + min*60 + sec)

So far we have

ghci> toDT 2016 08 02 11 32 21
  Right 2016-08-02 11:32:21

ghci> toDT 2016 06 31 11 32 21
  Left "Invalid Year/Month/Day"

ghci> toDT 2016 08 02 11 32 21 > toDT 2016 08 02 11 32 19
  True

Finally, the ability to tick and untick the date-time.

> tick :: DT -> DT
> tick = tickTOD
>   where tickTOD (dt@DT{tod=s}) =
>           let dt' = if s < secsInDay-1
>                     then dt{ tod = s+1 }
>                     else dt{ tod = 0 }
>           in if s==(secsInDay-1) then tickDay dt' else dt'
> 
>         tickDay (dt@DT{day=d,dow=dayOfWeek,month=m,year=y}) =
>           let dt' = dt{ dow = if dayOfWeek < 6 then dayOfWeek+1 else 0
>                       , day = day'}
>               day' = if d < 27
>                      then d+1
>                      else if d == numDays y m
>                           then 1
>                           else d+1
>           in if day'==1 then tickMonth dt' else dt'
> 
>         tickMonth (dt@DT{month=m}) =
>           let dt' = dt{ month = if m < 12 then m+1 else 1}
>           in if m==12 then tickYear dt' else dt'
> 
>         tickYear (dt@DT{year=y}) = dt{year = y+1}
> 
> 
> untick :: DT -> DT
> untick = untickTOD
>   where untickTOD (dt@DT{tod=s}) =
>           let dt' = if s == 0
>                     then dt{ tod = secsInDay-1 }
>                     else dt{ tod = s-1 }
>           in if s==0 then untickDay dt' else dt'
> 
>         untickDay (dt@DT{day=d,dow=dayOfWeek,month=m,year=y}) =
>           let dt' = dt{ dow = if dayOfWeek == 0 then 6 else dayOfWeek-1
>                       , day = day'}
>               day' = if d == 1
>                      then if m==1 then numDays (y-1) 12 else numDays y (m-1)
>                      else d - 1
>           in if d==1 then untickMonth dt' else dt'
> 
>         untickMonth (dt@DT{month=m}) =
>           let dt' = dt{ month = if m == 1 then 12 else m-1}
>           in if m==1 then untickYear dt' else dt'
>         untickYear (dt@DT{year=y}) = dt{year = y-1}
> 
> numDays :: Int -> Int -> Int
> numDays y m
>   | m == 2 = if (mod y 4 == 0) && ((mod y 400 == 0) || not (mod y 100 == 0))
>              then 29
>              else 28
>   | m == 1 || m == 3 || m == 5 || m == 7 || m == 8 || m == 10 || m == 12 = 31
>   | otherwise = 30
> 
> secsInDay :: Int
> secsInDay = 86400

Examples

ghci> let Right d = toDT 2016 08 02 11 32 21
ghci> mapM_ (print . head) $ take 10 $ iterate (drop 10000) $ iterate tick d
  2016-08-02 11:32:21
  2016-08-02 14:19:01
  2016-08-02 17:05:41
  2016-08-02 19:52:21
  2016-08-02 22:39:01
  2016-08-03 01:25:41
  2016-08-03 04:12:21
  2016-08-03 06:59:01
  2016-08-03 09:45:41
  2016-08-03 12:32:21

ghci> 
ghci> let Right d = toDT 2016 08 03 12 32 21
ghci> mapM_ (print . head) $ take 10 $ iterate (drop 10000) $ iterate untick d
  2016-08-03 12:32:21
  2016-08-03 09:45:41
  2016-08-03 06:59:01
  2016-08-03 04:12:21
  2016-08-03 01:25:41
  2016-08-02 22:39:01
  2016-08-02 19:52:21
  2016-08-02 17:05:41
  2016-08-02 14:19:01
  2016-08-02 11:32:21
Advertisements
This entry was posted in Uncategorized and tagged , . Bookmark the permalink.

One Response to More Time Utilities (13/365)

  1. Pingback: More Time Utilities (14/365) | Latent observations

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s