3. Dates and Times

-- you can use haskell-98 standard module:
import Time

date = fmap show getClockTime   -- "Wed Apr 25 19:43:29 CEST 2007"
localtime = getClockTime >>= toCalendarTime
-- => CalendarTime {ctYear = 2007, ctMonth = April, ctDay = 25, ctHour = 19, ctMin = 46, ctSec = 41, ctPicosec = 214805000000, ctWDay = Wednesday, ctYDay = 114, ctTZName = "CEST", ctTZ = 7200, ctIsDST = True}

utc_time = fmap toUTCTime getClockTime
-- => CalendarTime {ctYear = 2007, ctMonth = April, ctDay = 25, ctHour = 17, ctMin = 47, ctSec = 59, ctPicosec = 325921000000, ctWDay = Wednesday, ctYDay = 114, ctTZName = "UTC", ctTZ = 0, ctIsDST = False}

t = do tm <- localtime
       putStrLn $ "Today is day " ++ show (ctYDay tm) ++ " of the current year"
-- => Today is day 114 of the current year


-- or you can use new "time library":
import Data.Time

date = getCurrentTime
-- "2008-04-18 14:11:22.476894 UTC"

t = do today <- fmap utctDay getCurrentTime      
       let (year, _, _) = toGregorian today
       let days = diffDays today (fromGregorian year 0 0)
       putStrLn $ "Today is day " ++ show days ++ " of the current year"
-- => Today is day 108 of the current year

import Data.Time
import System.Locale (defaultTimeLocale)

t = do tm <- getCurrentTime
       let (year, month, day) = toGregorian (utctDay tm)
       printf "The current date is %04d %02d %02d\n" year month day

t2 = do tm <- getCurrentTime
        return $ "The current date is " ++ show (utctDay tm)
-- The current date is 2008-04-18

t3 = fmap (formatTime defaultTimeLocale "%Y-%m-%d") getCurrentTime
-- => 2008-04-18

import Data.Time
import Data.Time.Clock.POSIX

-- !! epoch is not the "base" value in Data.Time, so do not use it unless you !!
-- !! really need it !!

-- if you want epoch, use:
t = getPOSIXTime                -- 1208529250.856017s

-- if you want to get epoch from a time, use:
t2 = fmap utcTimeToPOSIXSeconds getCurrentTime -- 1208529250.856017s

import System.Time
import Data.Time
import Data.Time.Clock.POSIX

epoch = 111111
t1 = posixSecondsToUTCTime epoch      -- 1970-01-02 06:51:51 UTC
t2 = timeToTimeOfDay (utctDayTime t1) -- 06:51:51

import Data.Time

ten_seconds_before = addUTCTime (-10)
t = do now <- getCurrentTime
       return (now, ten_seconds_before now)
-- (2008-04-18 14:48:33.075113 UTC,
--  2008-04-18 14:48:23.075113 UTC)

-- ten_seconds_before can also be written:
ten_seconds_before (UTCTime day time) = UTCTime day (time - 10)
ten_seconds_before t = t { utctDayTime = utctDayTime t - 10 }


birth_date = fromGregorian 1973 1 18
t  = "Nat was 55 days old on: " ++ show (addDays 55 birth_date)
-- Nat was 55 days old on: 1973-03-14

import Data.Time
import Data.Time.Clock.POSIX

bree = UTCTime (fromGregorian 1981 6 16) (timeOfDayToTime $ TimeOfDay 4 35 25) -- 1981-06-16 04:35:25 UTC
nat  = UTCTime (fromGregorian 1973 1 18) (timeOfDayToTime $ TimeOfDay 3 45 50) -- 1973-01-18 03:45:50 UTC
-- or simpler:
bree' = read "1981-06-16 04:35:25" :: UTCTime
nat'  = read "1973-01-18 03:45:50" :: UTCTime

difference = diffUTCTime bree nat / posixDayLength
t = "There were " ++ (show $ round difference) ++ " days between Nat and Bree"
-- There were 3071 days between Nat and Bree

toFloat n = realToFrac n :: Float
t2 = printf "There were %.2f days between Nat and Bree" (toFloat difference) :: String
-- There were 3071.03 days between Nat and Bree

import Data.Time
import Data.Time.Calendar.MonthDay
import Data.Time.Calendar.OrdinalDate
import Locale

(year, month, day) = (1981, 6, 16)

t = do printf "%d/%d/%d was a %s\n" year month day week_day_name
       printf "%d/%d/%d was day %d of the week %d\n" year month day week_day week
       printf "%d/%d/%d was day %d of month %d\n" year month day month_day month_
       printf "%d/%d/%d was day %d of year %d\n" year month day year_day year_
    where date = (fromGregorian year month day)
          (week, week_day) = sundayStartWeek date
          (_, month_, month_day) = toGregorian date
          (year_, year_day) = toOrdinalDate date
          (week_day_name, _) = wDays defaultTimeLocale !! week_day
-- 1981/6/16 was a Tuesday
-- 1981/6/16 was day 2 of the week 24
-- 1981/6/16 was day 16 of month 6
-- 1981/6/16 was day 167 of year 1981

import Data.Time
import Data.Time.Format
import Data.Time.Clock.POSIX
import Locale

day :: Day
day = readTime defaultTimeLocale "%F" "1998-06-03"

-- calculate epoch seconds at midnight on that day in UTC
epoch = utcTimeToPOSIXSeconds (UTCTime day 0)
-- 896832000s

-- readTime can return a UTCTime:
epoch_ = utcTimeToPOSIXSeconds (readTime defaultTimeLocale "%F" "1998-06-03")

-- it seems readTime is not flexible, 
-- for example "%d/%m/%Y" can't handle 16/6/1981, only 16/06/1981
--
-- here is an alternative solution, using regexp
import Data.Time
import Data.Time.Clock.POSIX
import Text.Regex

day = fromGregorian (read year) (read month) (read day)
      where Just [year, month, day] = matchRegex (mkRegex "(.*)-(.*)-(.*)") "1998-06-03"
-- 1998-06-03

-- formatTime from Data.Time.Format allow powerful time formatting:
import Data.Time
import Data.Time.Format
import Locale

t = do now <- getCurrentTime
       return $ formatTime defaultTimeLocale "The date is %A (%a) %d/%m/%Y" now
-- "The date is Tuesday (Tue) 28/10/2008"

-- getCurrentTime/UTCTime has a precision of 1 picosecond, full precision is used by default
import Data.Time
import System.Posix.Unistd

t = do t1 <- getCurrentTime
       usleep 100000 -- 100ms
       t2 <- getCurrentTime
       return (diffUTCTime t2 t1)
-- 0.111262s

-- short sleeps:
t = do usleep 3100000

-- for even more precision, nanosleep is available

-- download the following standalone program
module Main where

import Data.Char (toLower)
import Data.Fixed (divMod')
import Data.List (intersperse, isInfixOf, foldl')
import System.Environment (getArgs)

import qualified Codec.MIME.Parse       as MIME
import qualified Data.Time.Clock        as CLOCK
import qualified Data.Time.Format       as TIME
import qualified System.Locale          as LOCALE
import qualified Text.Regex.PCRE.String as PCRE

data ServerHeader = ServerHeader {
      receivedFrom :: String
    , receivedBy   :: String
    , receivedAt   :: CLOCK.UTCTime
    } deriving (Show)

serverHeaderRegex :: IO PCRE.Regex
serverHeaderRegex = do
  let pattern = "from (.*) by (.*) with (.*); (.*)"
  compres <- PCRE.compile PCRE.compBlank PCRE.execBlank pattern
  case compres of
    Left (offset, string)
        -> error $
           "Regex pattern error" ++
           " at offset " ++ show offset ++
           " for string: " ++ string
    Right regex
        -> return regex

parseTime :: String -> CLOCK.UTCTime
parseTime time = case parseres of
                   Just utctime -> utctime
                   Nothing -> error $ "Invalid data format: " ++ time
                 where parseres = TIME.parseTime
                                  LOCALE.defaultTimeLocale
                                  "%a, %e %b %Y %X %z (%Z)"
                                  time
                                  :: Maybe CLOCK.UTCTime

parseServerHeader :: String -> IO ServerHeader
parseServerHeader input = do
  let header = concat $ intersperse " " $ words input
      headerWithFrom  = if "from" `isInfixOf` header
                        then header
                        else "from - " ++ header
  regex <- serverHeaderRegex
  execres <- PCRE.regexec regex headerWithFrom
  case execres of
    Left err -> error $ "regexec WrapError " ++ show err ++ "for: " ++ input
    Right Nothing -> error $ "Invalid server header: " ++ headerWithFrom
    Right (Just (_, _, _, [from, by, _, time]))
        -> return $ ServerHeader from by (parseTime time)

parseServerHeaders :: String -> IO [ServerHeader]
parseServerHeaders contents = do
  mapM (parseServerHeader . snd) $ reverse $ filter match headers
  where match   = (== "received") . (map toLower) . fst
        headers = fst $ MIME.parseHeaders contents

prettifyTimeDiff :: (Real a) => a -> String
prettifyTimeDiff diff =
  concat $ intersperse " " $ map (\(n,t) -> show n ++ t)
         $ if null diffs then [(0,"s")] else diffs
  where merge (tot,acc) (sec,typ) = let (sec',tot') = divMod' tot sec
                                    in (tot',(sec',typ):acc)
        metrics = [(86400,"d"),(3600,"h"),(60,"m"),(1,"s")]
        diffs = filter ((/= 0) . fst) $ reverse $ snd $ foldl' merge (diff,[]) metrics

printServerHeaders :: String -> IO ()
printServerHeaders contents = do
  headers <- parseServerHeaders contents
  mapM_ printHeader (zip headers $ (head headers) : headers)
  where printHeader (c,p) = do
          putStrLn $ "after " ++ (prettifyTimeDiff $ CLOCK.diffUTCTime (receivedAt c) (receivedAt p))
          putStrLn $ " from " ++ (receivedFrom c)
          putStrLn $ "   by " ++ (receivedBy c)
          putStrLn $ "   at " ++ (show $ receivedAt c)

main :: IO ()
main = do
  args <- getArgs
  case args of
    []         -> getContents >>= printServerHeaders
    [pathname] -> readFile pathname >>= printServerHeaders
    _          -> error "Arguments: [<PATHNAME>]"