From b442c48cbaa1a1cfae4e42aa03bc41e33f2710f9 Mon Sep 17 00:00:00 2001 From: Clint Adams Date: Thu, 5 Feb 2015 11:34:26 -0500 Subject: newer yesod stuff --- Handler/Category.hs | 4 ++-- Handler/Employment.hs | 4 ++-- Handler/Home.hs | 2 +- Handler/Vacation.hs | 2 +- devel.hs | 17 ++++++++++++----- sflctimekeeper.cabal | 1 + 6 files changed, 19 insertions(+), 11 deletions(-) diff --git a/Handler/Category.hs b/Handler/Category.hs index 73d9128..d4d4803 100644 --- a/Handler/Category.hs +++ b/Handler/Category.hs @@ -4,7 +4,7 @@ module Handler.Category where import Import import qualified Data.Text as T -getCategoryR :: TimeCategoryId -> Handler RepHtml +getCategoryR :: TimeCategoryId -> Handler Html getCategoryR tcid = do cat <- runDB $ get404 tcid (formWidget, formEnctype) <- generateFormPost (timeCategoryForm cat) @@ -13,7 +13,7 @@ getCategoryR tcid = do (setTitle . toHtml) ("Time category " `T.append` timeCategoryName cat) $(widgetFile "categorypage") -postCategoryR :: TimeCategoryId -> Handler RepHtml +postCategoryR :: TimeCategoryId -> Handler Html postCategoryR tcid = do cat <- runDB $ get404 tcid ((result, formWidget), formEnctype) <- runFormPost (timeCategoryForm cat) diff --git a/Handler/Employment.hs b/Handler/Employment.hs index ce31dd1..55057a9 100644 --- a/Handler/Employment.hs +++ b/Handler/Employment.hs @@ -5,7 +5,7 @@ import Import import qualified Data.Text as T import Yesod.Form.Jquery (jqueryDayField, def) -getEmploymentR :: EmploymentId -> Handler RepHtml +getEmploymentR :: EmploymentId -> Handler Html getEmploymentR eid = do emp <- runDB $ get404 eid user <- runDB $ get404 (employmentUser emp) @@ -16,7 +16,7 @@ getEmploymentR eid = do (setTitle . toHtml) ("Employment span for " `T.append` username) $(widgetFile "employmentpage") -postEmploymentR :: EmploymentId -> Handler RepHtml +postEmploymentR :: EmploymentId -> Handler Html postEmploymentR eid = do emp <- runDB $ get404 eid user <- runDB $ get404 (employmentUser emp) diff --git a/Handler/Home.hs b/Handler/Home.hs index 247e55e..7fed6dd 100644 --- a/Handler/Home.hs +++ b/Handler/Home.hs @@ -3,7 +3,7 @@ module Handler.Home where import Import -getHomeR :: Handler RepHtml +getHomeR :: Handler Html getHomeR = do people <- runDB $ selectList [] [] defaultLayout $ do diff --git a/Handler/Vacation.hs b/Handler/Vacation.hs index b9e1217..18a96cb 100644 --- a/Handler/Vacation.hs +++ b/Handler/Vacation.hs @@ -9,7 +9,7 @@ import Data.Time.Clock (getCurrentTime, UTCTime, utctDay) import Yesod.Auth (maybeAuth) import PTO -getVacationR :: UserId -> Handler RepHtml +getVacationR :: UserId -> Handler Html getVacationR cid = do user <- runDB $ get404 cid ma <- maybeAuth diff --git a/devel.hs b/devel.hs index 0181215..baf3531 100644 --- a/devel.hs +++ b/devel.hs @@ -1,25 +1,32 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE PackageImports #-} import "sflctimekeeper" Application (getApplicationDev) import Network.Wai.Handler.Warp - (runSettings, defaultSettings, settingsPort) + (runSettings, defaultSettings, setPort) import Control.Concurrent (forkIO) import System.Directory (doesFileExist, removeFile) import System.Exit (exitSuccess) import Control.Concurrent (threadDelay) +#ifndef mingw32_HOST_OS +import System.Posix.Signals (installHandler, sigINT, Handler(Catch)) +#endif + main :: IO () main = do +#ifndef mingw32_HOST_OS + _ <- installHandler sigINT (Catch $ return ()) Nothing +#endif + putStrLn "Starting devel application" (port, app) <- getApplicationDev - forkIO $ runSettings defaultSettings - { settingsPort = port - } app + forkIO $ runSettings (setPort port defaultSettings) app loop loop :: IO () loop = do threadDelay 100000 - e <- doesFileExist "dist/devel-terminate" + e <- doesFileExist "yesod-devel/devel-terminate" if e then terminateDevel else loop terminateDevel :: IO () diff --git a/sflctimekeeper.cabal b/sflctimekeeper.cabal index 98661b4..46d443a 100644 --- a/sflctimekeeper.cabal +++ b/sflctimekeeper.cabal @@ -94,6 +94,7 @@ library , case-insensitive , time , transformers + , unix executable sflctimekeeper if flag(library-only) -- cgit v1.2.1