Dawn of the nth Day

today.hs

module Main where

import System( getArgs )
import Data.Char
import Control.Exception (bracket_)
import qualified UI.HSCurses.Curses as Curses
import qualified UI.HSCurses.CursesHelper as CursesH
import Data.Time.Clock
import Data.Time.Calendar

start = do
  args <- getArgs
  hremain <- hoursremain
  dsin <- daysin
  let tday = days (fromIntegral dsin) 1
  Curses.initScr
  Curses.keypad Curses.stdScr True
  Curses.echo False
  Curses.nl False
  Curses.cBreak True
  hasColors <- Curses.hasColors
  if hasColors
    then do
      Curses.startColor
      Curses.initPair (Curses.Pair 1) (CursesH.white) (CursesH.black)
      return ()
    else
      return ()
  Curses.wclear Curses.stdScr
  (sizeY, sizeX) <- Curses.scrSize
  Curses.wMove Curses.stdScr ((sizeY `div` 2)-1) ((sizeX `div` 2) - (length((tday)!!0) `div` 2 ))
  Curses.wAddStr Curses.stdScr ((tday)!!0)
  Curses.attrOn (Curses.setBold Curses.attr0 True)
  Curses.wMove Curses.stdScr ((sizeY `div` 2)) ((sizeX `div` 2) - (length((tday)!!1) `div` 2 ))
  Curses.wAddStr Curses.stdScr ((tday)!!1)
  Curses.attrOff (Curses.setBold Curses.attr0 True)
  Curses.wMove Curses.stdScr ((sizeY `div` 2)+1) ((sizeX `div` 2) - (length(hremain) `div` 2 ))
  Curses.wAddStr Curses.stdScr (hremain)
  Curses.wMove Curses.stdScr (sizeY-1) ((sizeX `div` 2) - (length(continue) `div` 2 ))
  Curses.wAddStr Curses.stdScr continue
  return ()

loop num = do
  c <- Curses.getch
  Curses.attrSet Curses.attr0 (Curses.Pair 1)
  if Curses.decodeKey c == Curses.KeyChar 'q'
    then return()
    else loop (num + 1)

end = do
  Curses.endWin
  return ()

main = do
  bracket_ start end (loop 0)

firstday = (2011,9,1) --set this to the first day of internship

lastday = (2011,9,30) --set this to the last day of internship

boobday :: IO (Integer, Int, Int)
boobday = getCurrentTime >>= return . toGregorian . utctDay

monthdays month year = gregorianMonthLength year month

daysin :: IO (Int)
daysin = do
    bd <- boobday
    return $ diffdays firstday bd

hoursleft :: IO (Int)
hoursleft = do
    bd <- boobday
    return $ diffhours bd lastday

hoursremain :: IO (String)
hoursremain = do
    hl <- hoursleft
    return $ '-':(show hl)++" Hours Remain-"

daysleft :: IO (Int)
daysleft = do
    bd <- boobday
    return $ diffdays bd lastday

diffdays (x,y,z) (x',y',z') = foldr (+) 0 [ monthdays m x | m<-[y..y'-1] ] + (z'-z) +1

diffhours a b = 24*(diffdays a b)

days :: Integer -> Integer -> [String]
days x y = "Dawn of":("The "++lcap(concat(daystring(show x)))):("-"++show (24*(y-x)+24)++" Hours Remain-"):[]

lcap :: String -> String
lcap x = toUpper(head x):tail x

continue :: String
continue = "Press Q to continue."

daystring :: String -> [String]
daystring [] = []
daystring x | ((length x == 4) && (tail x == "000"))                   = dig(head x):"-thousandth day":[]
            | ((length x == 4) && (head (tail x) == '0'))              = dig(head x):"-thousand-and-":daystring(tail(tail x))
            | (length x == 4)                                          = dig(head x):"-thousand, ":daystring(tail x)
            | ((length x == 3) && (tail x == "00"))                    = dig(head x):"-hundredth day":[]
            | (length x == 3)                                          = dig(head x):"-hundred-and-":daystring(tail x)
            | ((length x == 2) && (head x == '0'))                     = daystring(tail x)
            | ((length x == 2) && (head x /= '1') && (tail x /= "0") ) = dig2(head x):daystring(tail x)
            | ((length x == 2) && (head x /= '1'))                     = x0(x):"Day":[]
            | (length x == 2)                                          = teen(x):"Day":[]
            | (length x == 1)                                          = dig1(x):"Day":[]

dig :: Char -> String
dig x = ["one","two","three","four","five","six","seven","eight","nine"] !! (digitToInt(x)-1)

x0 :: String -> String
x0 x = ["twentieth ","thirtieth ","fourtieth ","fiftieth ","sixtieth ","seventieth ","eightieth ","ninetieth "] !! round((read(x)/10)-2)

dig2 :: Char -> String
dig2 x = ["twenty-","thirty-","fourty-","fifty-","sixty-","seventy-","eighty-","ninety-"] !! (digitToInt(x)-2)

teen :: String -> String
teen x = ["tenth ","eleventh ","twelfth ","thirteenth ","fourteenth ","fifteenth ","sixteenth ","seventeenth ","eighteenth ","nineteenth "] !!(read(x)-10)

dig1 :: String  -> String
dig1 x = ["first ","second ","third ","fourth ","fifth ","sixth ","seventh ","eighth ","ninth "] !! (read(x)-1)