{-# LANGUAGE TupleSections, OverloadedStrings #-}
module Handler.Vacation where

import Import hiding (get)
import Control.Monad (when)
import Control.Monad.Trans.RWS.Lazy (RWST, ask, tell, get, put, execRWST)
import qualified Data.Text as T
import Data.Time (UTCTime, fromGregorian, getCurrentTime, utctDay)
import Yesod.Auth (maybeAuth)
import qualified Data.Map as Map
import Text.Printf (printf)
import PTO

type Month = (Integer, Int)

fmtHours :: Rational -> String
fmtHours r = printf "%.2f" d
    where d = fromRational r :: Double

getAnniversaryMax :: [Employment] -> Month -> Maybe Rational
getAnniversaryMax es (y, m) =
    case capOverride of
      Just 0.0 -> Nothing
      Just v   -> Just (toRational v)
      Nothing  -> Just 160.0
  where
    empMap = Map.fromList [(employmentStartDate e, e) | e <- es]
    today = fromGregorian y m 0

    todaysEmp :: Maybe Employment
    todaysEmp =
      Map.lookupLE today empMap >>=
	\(_, emp) ->
	  case employmentEndDate emp of
 	    Just end
	      | end < today -> Nothing 
	    _               -> Just emp
    
    capOverride :: Maybe Double
    capOverride = todaysEmp >>= employmentPtoMaxRollover

getVacationR :: UserId -> Handler Html
getVacationR cid = do
    user <- runDB $ get404 cid
    ma <- maybeAuth
    today <- fmap utctDay (liftIO getCurrentTime)
    employments <- runDB $ fmap (map entityVal) (selectList [EmploymentUser ==. cid] [])
    let username = userIdent user
        current@(currentyear, currentmonth) = monthOf today
	months = takeWhile (< current) [(y, m) | y <- [2005..], m <- [1..12]]
    (_, transacts') <- execRWST' (cid, employments) 0 $ mapM anotherMonth months
    let transacts = reverse $ transacts' :: [(String, Rational)]
    defaultLayout $ do
        aDomId <- newIdent
        (setTitle . toHtml) ("Vacation report for " `T.append` username)
        $(widgetFile "vacationpage")
    where
        execRWST' = flip .  flip execRWST

anotherMonth :: Month -> RWST (UserId, [Employment]) [(String, Rational)] Rational Handler ()
anotherMonth (y,m) = do
    (u, employments@(e:_)) <- ask
    (plus, minus) <- lift . runDB $ monthlyTransactions u (y,m)
    when (plus > 0) (add plus)
    when (minus > 0) (subtract (toRational minus))
    let twoyear = twoYearsFrom $ employmentStartDate e
        ptoMax = getAnniversaryMax employments (y,m)
    when ((snd . monthOf) twoyear == m) $
         maybe (return ()) kneecap ptoMax
    where
        add x = get >>= \o -> tell [(show y ++ "-" ++ show m ++ ": adding " ++ fmtHours x ++ " hours", o + x)] >> put (o + x)
        subtract x = get >>= \o -> tell [(show y ++ "-" ++ show m ++ ": subtracting " ++ fmtHours x ++ " hours", o - x)] >> put (o - x)
	kneecap cap = get >>= \o -> when (o > cap) (tell [(show y ++ "-" ++ show m ++ ": over anniversary max, subtracting " ++ fmtHours (o - cap) ++ " hours", cap)] >> put cap)