diff options
Diffstat (limited to 'Handler/Vacation.hs')
-rw-r--r-- | Handler/Vacation.hs | 42 |
1 files changed, 42 insertions, 0 deletions
diff --git a/Handler/Vacation.hs b/Handler/Vacation.hs new file mode 100644 index 0000000..b9e1217 --- /dev/null +++ b/Handler/Vacation.hs @@ -0,0 +1,42 @@ +{-# LANGUAGE TupleSections, OverloadedStrings #-} +module Handler.Vacation where + +import Import hiding (get) +import Control.Monad (when, guard) +import Control.Monad.Trans.RWS.Lazy (ask, tell, get, put, execRWST) +import qualified Data.Text as T +import Data.Time.Clock (getCurrentTime, UTCTime, utctDay) +import Yesod.Auth (maybeAuth) +import PTO + +getVacationR :: UserId -> Handler RepHtml +getVacationR cid = do + user <- runDB $ get404 cid + ma <- maybeAuth + today <- fmap utctDay (liftIO getCurrentTime) + [e'] <- runDB $ fmap (map entityVal) (selectList [EmploymentUser ==. cid] []) + let twoyear = twoYearsFrom $ employmentStartDate e' + username = userIdent user + (currentyear, currentmonth) = monthOf today + months = [2005 .. currentyear] >>= \ x -> [1 .. 12] >>= \ y -> guard ((x, y) < (currentyear, currentmonth)) >> return (x, y) + (_, transacts') <- execRWST' (cid, twoyear) 0 $ mapM anotherMonth months + let transacts = reverse $ map (fmap fromRational) transacts' + defaultLayout $ do + aDomId <- newIdent + (setTitle . toHtml) ("Vacation report for " `T.append` username) + $(widgetFile "vacationpage") + where + execRWST' = flip . flip execRWST + +-- anotherMonth :: UserId -> (Integer,Int) -> WriterT [Change] +anotherMonth (y,m) = do + currentval <- get + (u, twoyear) <- ask + (plus, minus) <- lift . runDB $ monthlyTransactions u (y,m) + when (plus > 0) (add plus) + when (minus > 0) (subtract (toRational minus)) + when ((snd . monthOf) twoyear == m) kneecap + where + add x = get >>= \o -> tell [(show y ++ "-" ++ show m ++ ": adding " ++ show (fromRational x) ++ " hours", o + x)] >> put (o + x) + subtract x = get >>= \o -> tell [(show y ++ "-" ++ show m ++ ": subtracting " ++ show (fromRational x) ++ " hours", o - x)] >> put (o - x) + kneecap = get >>= \o -> when (o > 160) (tell [(show y ++ "-" ++ show m ++ ": over anniversary max, subtracting " ++ show (fromRational o - 160) ++ " hours", 160)] >> put 160) |