diff options
| -rw-r--r-- | Application.hs | 52 | ||||
| -rw-r--r-- | Auth/Proxied.hs | 4 | ||||
| -rw-r--r-- | Foundation.hs | 66 | ||||
| -rw-r--r-- | Handler/Category.hs | 1 | ||||
| -rw-r--r-- | Handler/Home.hs | 28 | ||||
| -rw-r--r-- | Handler/User.hs | 16 | ||||
| -rw-r--r-- | Import.hs | 41 | ||||
| -rw-r--r-- | Model.hs | 4 | ||||
| -rw-r--r-- | Settings.hs | 30 | ||||
| -rw-r--r-- | config/models | 6 | ||||
| -rw-r--r-- | config/routes | 4 | ||||
| -rw-r--r-- | config/settings.yml | 3 | ||||
| -rw-r--r-- | dist/build/autogen/Paths_sflctimekeeper.hs | 4 | ||||
| -rw-r--r-- | sflctimekeeper.cabal | 52 | ||||
| -rw-r--r-- | templates/homepage.hamlet | 43 | ||||
| -rw-r--r-- | templates/homepage.julius | 2 | ||||
| -rw-r--r-- | templates/userpage.hamlet | 22 |
17 files changed, 204 insertions, 174 deletions
diff --git a/Application.hs b/Application.hs index e7d9049..dfd717d 100644 --- a/Application.hs +++ b/Application.hs @@ -11,46 +11,66 @@ import Yesod.Auth import Yesod.Default.Config import Yesod.Default.Main import Yesod.Default.Handlers -import Yesod.Logger (Logger, logBS, toProduction) -import Network.Wai.Middleware.RequestLogger (logCallback, logCallbackDev) +import Network.Wai.Middleware.RequestLogger import qualified Database.Persist.Store import Database.Persist.GenericSql (runMigration) import Network.HTTP.Conduit (newManager, def) +import Control.Monad.Logger (runLoggingT) +import System.IO (stdout) +import System.Log.FastLogger (mkLogger) -- Import all relevant handler modules here. -- Don't forget to add new modules to your cabal file! import Handler.Home +import Handler.Category +import Handler.Employment import Handler.User --- This line actually creates our YesodSite instance. It is the second half --- of the call to mkYesodData which occurs in Foundation.hs. Please see --- the comments there for more details. +-- This line actually creates our YesodDispatch instance. It is the second half +-- of the call to mkYesodData which occurs in Foundation.hs. Please see the +-- comments there for more details. mkYesodDispatch "App" resourcesApp -- This function allocates resources (such as a database connection pool), -- performs initialization and creates a WAI application. This is also the -- place to put your migrate statements to have automatic database -- migrations handled by Yesod. -makeApplication :: AppConfig DefaultEnv Extra -> Logger -> IO Application -makeApplication conf logger = do - foundation <- makeFoundation conf setLogger +makeApplication :: AppConfig DefaultEnv Extra -> IO Application +makeApplication conf = do + foundation <- makeFoundation conf + + -- Initialize the logging middleware + logWare <- mkRequestLogger def + { outputFormat = + if development + then Detailed True + else Apache FromSocket + , destination = Logger $ appLogger foundation + } + + -- Create the WAI application and apply middlewares app <- toWaiAppPlain foundation return $ logWare app - where - setLogger = if development then logger else toProduction logger - logWare = if development then logCallbackDev (logBS setLogger) - else logCallback (logBS setLogger) -makeFoundation :: AppConfig DefaultEnv Extra -> Logger -> IO App -makeFoundation conf setLogger = do +-- | Loads up any necessary settings, creates your foundation datatype, and +-- performs some initialization. +makeFoundation :: AppConfig DefaultEnv Extra -> IO App +makeFoundation conf = do manager <- newManager def s <- staticSite dbconf <- withYamlEnvironment "config/sqlite.yml" (appEnv conf) Database.Persist.Store.loadConfig >>= Database.Persist.Store.applyEnv p <- Database.Persist.Store.createPoolConfig (dbconf :: Settings.PersistConfig) - Database.Persist.Store.runPool dbconf (runMigration migrateAll) p - return $ App conf setLogger s p manager dbconf + logger <- mkLogger True stdout + let foundation = App conf s p manager dbconf logger + + -- Perform database migration using our application's logging settings. + runLoggingT + (Database.Persist.Store.runPool dbconf (runMigration migrateAll) p) + (messageLoggerSource foundation logger) + + return foundation -- for yesod devel getApplicationDev :: IO (Int, Application) diff --git a/Auth/Proxied.hs b/Auth/Proxied.hs index 684a3a1..9e15de3 100644 --- a/Auth/Proxied.hs +++ b/Auth/Proxied.hs @@ -32,6 +32,6 @@ authProxied = login authToMaster = let url = authToMaster (PluginR "proxied" []) in toWidget [hamlet| - Your new identifier is: # - <a href="@{url}">Zoinkz + Your are now authenticated for # + <a href="@{url}">here |] diff --git a/Foundation.hs b/Foundation.hs index 194fe14..15034a1 100644 --- a/Foundation.hs +++ b/Foundation.hs @@ -1,16 +1,4 @@ -module Foundation - ( App (..) - , Route (..) - , AppMessage (..) - , resourcesApp - , Handler - , Widget - , Form - , maybeAuth - , requireAuth - , module Settings - , module Model - ) where +module Foundation where import Prelude import Yesod @@ -19,18 +7,19 @@ import Yesod.Auth import Auth.Proxied (authProxied) import Yesod.Default.Config import Yesod.Default.Util (addStaticContentExternal) -import Yesod.Form.Jquery (YesodJquery) -import Yesod.Logger (Logger, logMsg, formatLogText) +import Yesod.Form.Jquery (YesodJquery(..)) import Network.HTTP.Conduit (Manager) import qualified Settings +import Settings.Development (development) import qualified Database.Persist.Store -import Settings.StaticFiles import Database.Persist.GenericSql import Settings (widgetFile, Extra (..)) +import Settings.StaticFiles import Model import Text.Jasmine (minifym) import Web.ClientSession (getKey) import Text.Hamlet (hamletFile) +import System.Log.FastLogger (Logger) -- | The site argument for your application. This can be a good place to -- keep settings and values requiring initialization before your application @@ -38,11 +27,11 @@ import Text.Hamlet (hamletFile) -- access to the data present here. data App = App { settings :: AppConfig DefaultEnv Extra - , getLogger :: Logger , getStatic :: Static -- ^ Settings for static file serving. , connPool :: Database.Persist.Store.PersistConfigPool Settings.PersistConfig -- ^ Database connection pool. , httpManager :: Manager , persistConfig :: Settings.PersistConfig + , appLogger :: Logger } -- Set up i18n messages. See the message folder. @@ -80,7 +69,9 @@ instance Yesod App where -- default session idle timeout is 120 minutes makeSessionBackend _ = do key <- getKey "config/client_session_key.aes" - return . Just $ clientSessionBackend key 120 + let timeout = 120 * 60 -- 120 minutes + (getCachedDate, _closeDateCache) <- clientSessionDateCacher timeout + return . Just $ clientSessionBackend2 key getCachedDate defaultLayout widget = do master <- getYesod @@ -107,20 +98,34 @@ instance Yesod App where -- The page to be redirected to when authentication is required. authRoute _ = Just $ AuthR LoginR - messageLogger y loc level msg = - formatLogText (getLogger y) loc level msg >>= logMsg (getLogger y) - -- This function creates static content files in the static folder -- and names them based on a hash of their content. This allows -- expiration dates to be set far in the future without worry of -- users receiving stale content. - addStaticContent = addStaticContentExternal minifym base64md5 Settings.staticDir (StaticR . flip StaticRoute []) + addStaticContent = + addStaticContentExternal minifym genFileName Settings.staticDir (StaticR . flip StaticRoute []) + where + -- Generate a unique filename based on the content itself + genFileName lbs + | development = "autogen-" ++ base64md5 lbs + | otherwise = base64md5 lbs -- Place Javascript at bottom of the body tag so the rest of the page loads first jsLoader _ = BottomOfBody + -- What messages should be logged. The following includes all messages when + -- in development, and warnings and errors in production. + shouldLog _ _source level = + development || level == LevelWarn || level == LevelError + + getLogger = return . appLogger + isAuthorized (UserR u) True = isUser u isAuthorized (UserR u) False = isUserOrAdmin u + isAuthorized (CategoryR _) True = isAdmin + isAuthorized (CategoryR _) False = return Authorized + isAuthorized (EmploymentR e) True = isAdmin + isAuthorized (EmploymentR _) False = return Authorized isAuthorized _ _ = return Authorized isUser :: UserId -> GHandler s App AuthResult @@ -137,6 +142,13 @@ isUserOrAdmin t = do Nothing -> AuthenticationRequired Just (Entity u v) -> if t == u || userIsAdmin v then Authorized else Unauthorized "You must be an admin" +isAdmin :: GHandler s App AuthResult +isAdmin = do + ma <- maybeAuth + return $ case ma of + Nothing -> AuthenticationRequired + Just (Entity u v) -> if userIsAdmin v then Authorized else Unauthorized "You must be an admin" + -- How to run database actions. instance YesodPersist App where type YesodPersistBackend App = SqlPersist @@ -171,6 +183,10 @@ instance YesodAuth App where instance RenderMessage App FormMessage where renderMessage _ _ = defaultFormMessage +-- | Get the 'Extra' value, used to hold data from the settings.yml file. +getExtra :: Handler Extra +getExtra = fmap (appExtra . settings) getYesod + -- Note: previous versions of the scaffolding included a deliver function to -- send emails. Unfortunately, there are too many different options for us to -- give a reasonable default. Instead, the information is available on the @@ -178,4 +194,8 @@ instance RenderMessage App FormMessage where -- -- https://github.com/yesodweb/yesod/wiki/Sending-email -instance YesodJquery App -- FIXME: go static +instance YesodJquery App where + urlJqueryJs _ = Left (StaticR js_jquery_js) + urlJqueryUiJs _ = Left (StaticR jquery_ui_jquery_ui_js) + urlJqueryUiCss _ = Left (StaticR cupertino_jquery_ui_css) + urlJqueryUiDateTimePicker _ = Left (StaticR js_jquery_ui_datetimepicker_js) diff --git a/Handler/Category.hs b/Handler/Category.hs index 62928a2..6a2c6df 100644 --- a/Handler/Category.hs +++ b/Handler/Category.hs @@ -2,7 +2,6 @@ module Handler.Category where import Import -import Data.Maybe (fromMaybe) import qualified Data.Text as T getCategoryR :: TimeCategoryId -> Handler RepHtml diff --git a/Handler/Home.hs b/Handler/Home.hs index 3444a5b..34078d5 100644 --- a/Handler/Home.hs +++ b/Handler/Home.hs @@ -3,37 +3,11 @@ module Handler.Home where import Import --- This is a handler function for the GET request method on the HomeR --- resource pattern. All of your resource patterns are defined in --- config/routes --- --- The majority of the code you will write in Yesod lives in these handler --- functions. You can spread them across multiple files if you are so --- inclined, or create a single monolithic file. getHomeR :: Handler RepHtml getHomeR = do - (formWidget, formEnctype) <- generateFormPost sampleForm - let submission = Nothing :: Maybe (FileInfo, Text) - handlerName = "getHomeR" :: Text + people <- runDB $ selectList [] [] defaultLayout $ do aDomId <- lift newIdent setTitle "Welcome To Yesod!" $(widgetFile "homepage") -postHomeR :: Handler RepHtml -postHomeR = do - ((result, formWidget), formEnctype) <- runFormPost sampleForm - let handlerName = "postHomeR" :: Text - submission = case result of - FormSuccess res -> Just res - _ -> Nothing - - defaultLayout $ do - aDomId <- lift newIdent - setTitle "Welcome To Yesod!" - $(widgetFile "homepage") - -sampleForm :: Form (FileInfo, Text) -sampleForm = renderDivs $ (,) - <$> fileAFormReq "Choose a file" - <*> areq textField "What's on the file?" Nothing diff --git a/Handler/User.hs b/Handler/User.hs index 499ba20..e89b365 100644 --- a/Handler/User.hs +++ b/Handler/User.hs @@ -6,6 +6,7 @@ import Data.Maybe (fromMaybe) import qualified Data.Text as T import Data.Text.Read (decimal) import Data.Time.Clock (getCurrentTime, UTCTime, utctDay) +import Yesod.Auth (maybeAuth) import Yesod.Form.Jquery (jqueryDayField, def) getUserR :: UserId -> Handler RepHtml @@ -13,7 +14,7 @@ getUserR cid = do user <- runDB $ get404 cid ma <- maybeAuth let username = userIdent user - let isUser = Just user == fmap entityVal ma + let isThisUser = Just user == fmap entityVal ma (pageNumber, pages) <- pagePosition cid let doPrev = pageNumber > 1 let doNext = pageNumber < pages @@ -23,6 +24,7 @@ getUserR cid = do entries <- runDB $ getEntriesForPage cid pageNumber cats' <- runDB $ selectList [TimeCategoryDisabled ==. False] [] let cats = map (\x -> ((timeCategoryName . entityVal) x, entityKey x)) cats' + employments <- runDB $ selectList [EmploymentUser ==. cid] [Asc EmploymentStartDate] (formWidget, formEnctype) <- generateFormPost (timeEntryForm cid cats) defaultLayout $ do aDomId <- lift newIdent @@ -34,7 +36,7 @@ postUserR cid = do user <- runDB $ get404 cid ma <- maybeAuth let username = userIdent user - let isUser = Just user == fmap entityVal ma + let isThisUser = Just user == fmap entityVal ma (pageNumber, pages) <- pagePosition cid let doPrev = pageNumber > 1 let doNext = pageNumber < pages @@ -43,6 +45,7 @@ postUserR cid = do let pageNavWidget = $(widgetFile "pagenav") cats' <- runDB $ selectList [TimeCategoryDisabled ==. False] [] let cats = map (\x -> ((timeCategoryName . entityVal) x, entityKey x)) cats' + employments <- runDB $ selectList [EmploymentUser ==. cid] [Asc EmploymentStartDate] ((result, formWidget), formEnctype) <- runFormPost (timeEntryForm cid cats) _ <- case result of FormSuccess res -> (runDB $ insert res) >> return () @@ -60,6 +63,7 @@ timeEntryAForm ct cats uid = TimeEntry <*> areq (selectFieldList cats) "category" Nothing <*> areq (jqueryDayField def) "day" (Just (utctDay ct)) <*> areq doubleField "hours" Nothing + <*> areq textField "note" Nothing <*> pure ct timeEntryForm :: UserId -> [(Text,TimeCategoryId)] -> Html -> MForm App App (FormResult TimeEntry, Widget) @@ -67,14 +71,14 @@ timeEntryForm u c h = do ct <- liftIO getCurrentTime renderDivs (timeEntryAForm ct c u) h -getEntriesForPage :: UserId -> Int -> YesodDB App App [(Text, Text, Text)] +getEntriesForPage :: UserId -> Int -> YesodDB App App [(TimeCategoryId, TimeCategory, Text, Text, Text)] getEntriesForPage uid pageNumber = do entries <- selectList [TimeEntryUser ==. uid] [Desc TimeEntryTimestamp, LimitTo 25, OffsetBy ((pageNumber - 1) * 25)] - mapM (\(Entity _ e) -> cat (timeEntryCategory e) >>= \x -> return (x, hours e, day e)) entries + mapM (\(Entity _ e) -> cat (timeEntryCategory e) >>= \x -> return (timeEntryCategory e, x, hours e, day e, timeEntryNote e)) entries where - cat :: TimeCategoryId -> YesodDB App App Text + cat :: TimeCategoryId -> YesodDB App App TimeCategory cat y = do x <- getJust y - return $ timeCategoryName x + return x day :: TimeEntry -> Text day = T.pack . show . timeEntryDay hours :: TimeEntry -> Text @@ -1,27 +1,28 @@ module Import - ( module Prelude - , module Yesod - , module Foundation - , module Settings.StaticFiles - , module Settings.Development - , module Data.Monoid - , module Control.Applicative - , Text -#if __GLASGOW_HASKELL__ < 704 - , (<>) -#endif + ( module Import ) where -import Prelude hiding (writeFile, readFile, head, tail, init, last) -import Yesod hiding (Route(..)) -import Foundation -import Data.Monoid (Monoid (mappend, mempty, mconcat)) -import Control.Applicative ((<$>), (<*>), pure) -import Data.Text (Text) -import Settings.StaticFiles -import Settings.Development +import Prelude as Import hiding (head, init, last, + readFile, tail, writeFile) +import Yesod as Import hiding (Route (..)) + +import Control.Applicative as Import (pure, (<$>), (<*>)) +import Data.Text as Import (Text) + +import Foundation as Import +import Model as Import +import Settings as Import +import Settings.Development as Import +import Settings.StaticFiles as Import + +#if __GLASGOW_HASKELL__ >= 704 +import Data.Monoid as Import + (Monoid (mappend, mempty, mconcat), + (<>)) +#else +import Data.Monoid as Import + (Monoid (mappend, mempty, mconcat)) -#if __GLASGOW_HASKELL__ < 704 infixr 5 <> (<>) :: Monoid m => m -> m -> m (<>) = mappend @@ -1,3 +1,5 @@ +{-# LANGUAGE TemplateHaskell, KindSignatures, TypeFamilies, FlexibleContexts, GADTs #-} + module Model where import Prelude @@ -7,5 +9,5 @@ import Database.Persist.Quasi import Data.Time.Calendar (Day) import Data.Time.Clock (UTCTime) -share [mkPersist sqlSettings, mkMigrate "migrateAll"] +share [mkPersist sqlOnlySettings, mkMigrate "migrateAll"] $(persistFileWith lowerCaseSettings "config/models") diff --git a/Settings.hs b/Settings.hs index f9f7075..bd1e0ab 100644 --- a/Settings.hs +++ b/Settings.hs @@ -3,25 +3,20 @@ -- In addition, you can configure a number of different aspects of Yesod -- by overriding methods in the Yesod typeclass. That instance is -- declared in the Foundation.hs file. -module Settings - ( widgetFile - , PersistConfig - , staticRoot - , staticDir - , Extra (..) - , parseExtra - ) where +module Settings where import Prelude import Text.Shakespeare.Text (st) import Language.Haskell.TH.Syntax import Database.Persist.Sqlite (SqliteConf) import Yesod.Default.Config -import qualified Yesod.Default.Util +import Yesod.Default.Util import Data.Text (Text) import Data.Yaml import Control.Applicative import Settings.Development +import Data.Default (def) +import Text.Hamlet -- | Which Persistent backend this site is using. type PersistConfig = SqliteConf @@ -49,13 +44,26 @@ staticDir = "static" staticRoot :: AppConfig DefaultEnv x -> Text staticRoot conf = [st|#{appRoot conf}/static|] +-- | Settings for 'widgetFile', such as which template languages to support and +-- default Hamlet settings. +-- +-- For more information on modifying behavior, see: +-- +-- https://github.com/yesodweb/yesod/wiki/Overriding-widgetFile +widgetFileSettings :: WidgetFileSettings +widgetFileSettings = def + { wfsHamletSettings = defaultHamletSettings + { hamletNewlines = AlwaysNewlines + } + } -- The rest of this file contains settings which rarely need changing by a -- user. widgetFile :: String -> Q Exp -widgetFile = if development then Yesod.Default.Util.widgetFileReload - else Yesod.Default.Util.widgetFileNoReload +widgetFile = (if development then widgetFileReload + else widgetFileNoReload) + widgetFileSettings data Extra = Extra { extraCopyright :: Text diff --git a/config/models b/config/models index 172af23..1bfa1c0 100644 --- a/config/models +++ b/config/models @@ -3,11 +3,17 @@ User isAdmin Bool default=False UniqueUser ident deriving Show Eq +Employment + user UserId + startDate Day + endDate Day Maybe + commitment Double TimeEntry user UserId category TimeCategoryId day Day hours Double + note Text timestamp UTCTime deriving Show Eq TimeCategory diff --git a/config/routes b/config/routes index a83a59f..a71d15d 100644 --- a/config/routes +++ b/config/routes @@ -4,5 +4,7 @@ /favicon.ico FaviconR GET /robots.txt RobotsR GET -/ HomeR GET POST +/ HomeR GET /user/#UserId UserR GET POST +/category/#TimeCategoryId CategoryR GET POST +/employment/#EmploymentId EmploymentR GET POST diff --git a/config/settings.yml b/config/settings.yml index 70828ae..686c9fc 100644 --- a/config/settings.yml +++ b/config/settings.yml @@ -2,7 +2,8 @@ Default: &defaults host: "*4" # any IPv4 host port: 3000 approot: "http://burrell.hq.sflc.info:80" - copyright: Copyright (C) 2012 Clint Adams + copyright: sflctimekeeper pre-release + #Copyright (C) 2012-2013 Clint Adams #analytics: UA-YOURCODE Development: diff --git a/dist/build/autogen/Paths_sflctimekeeper.hs b/dist/build/autogen/Paths_sflctimekeeper.hs index 76e952e..e33a371 100644 --- a/dist/build/autogen/Paths_sflctimekeeper.hs +++ b/dist/build/autogen/Paths_sflctimekeeper.hs @@ -7,6 +7,8 @@ module Paths_sflctimekeeper ( import qualified Control.Exception as Exception import Data.Version (Version(..)) import System.Environment (getEnv) +import Prelude + catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a catchIO = Exception.catch @@ -16,7 +18,7 @@ version = Version {versionBranch = [0,0,0], versionTags = []} bindir, libdir, datadir, libexecdir :: FilePath bindir = "/home/clint/.cabal/bin" -libdir = "/home/clint/.cabal/lib/sflctimekeeper-0.0.0/ghc-7.4.1" +libdir = "/home/clint/.cabal/lib/sflctimekeeper-0.0.0/ghc-7.6.3" datadir = "/home/clint/.cabal/share/sflctimekeeper-0.0.0" libexecdir = "/home/clint/.cabal/libexec" diff --git a/sflctimekeeper.cabal b/sflctimekeeper.cabal index 1548421..f3dd83a 100644 --- a/sflctimekeeper.cabal +++ b/sflctimekeeper.cabal @@ -30,7 +30,10 @@ library Settings.Development Handler.Home Handler.User + Handler.Category + Handler.Employment Auth.Proxied + PTO if flag(dev) || flag(library-only) cpp-options: -DDEVELOPMENT @@ -52,35 +55,40 @@ library NoMonomorphismRestriction build-depends: base >= 4 && < 5 - , yesod >= 1.0 && < 1.1 - , yesod-core >= 1.0 && < 1.1 - , yesod-auth >= 1.0 && < 1.1 - , yesod-static >= 1.0 && < 1.1 - , yesod-default >= 1.0 && < 1.1 - , yesod-form >= 1.0 && < 1.1 - , yesod-test >= 0.2 && < 0.3 - , clientsession >= 0.7.3 && < 0.8 - , bytestring >= 0.9 && < 0.10 + -- , yesod-platform >= 1.1 && < 1.2 + , yesod >= 1.1.5 && < 1.2 + , yesod-core >= 1.1.7 && < 1.2 + , yesod-auth >= 1.1 && < 1.2 + , yesod-static >= 1.1 && < 1.2 + , yesod-default >= 1.1 && < 1.2 + , yesod-form >= 1.1 && < 1.3 + , clientsession >= 0.8 && < 0.10 + , bytestring >= 0.9 && < 0.11 , text >= 0.11 && < 0.12 - , persistent >= 0.9 && < 0.10 - , persistent-sqlite >= 0.9 && < 0.10 + , persistent >= 1.1 && < 1.2 + , persistent-sqlite >= 1.1 && < 1.2 + , persistent-template >= 1.1.1 && < 1.2 , template-haskell - , hamlet >= 1.0 && < 1.1 + , hamlet >= 1.1 && < 1.2 , shakespeare-css >= 1.0 && < 1.1 - , shakespeare-js >= 1.0 && < 1.1 + , shakespeare-js >= 1.0.2 && < 1.2 , shakespeare-text >= 1.0 && < 1.1 , hjsmin >= 0.1 && < 0.2 , monad-control >= 0.3 && < 0.4 - , wai-extra >= 1.2 && < 1.3 - , yaml >= 0.7 && < 0.8 - , http-conduit >= 1.4 && < 1.5 - , directory >= 1.1 && < 1.2 - , warp >= 1.2 && < 1.3 + , wai-extra >= 1.3 && < 1.4 + , yaml >= 0.8 && < 0.9 + , http-conduit >= 1.8 && < 1.10 + , directory >= 1.1 && < 1.3 + , warp >= 1.3 && < 1.4 + , data-default + , aeson + , conduit >= 1.0 + , monad-logger >= 0.3 + , fast-logger >= 0.3 + , base64-bytestring + , case-insensitive , time , wai - , case-insensitive - , http-types - , base64-bytestring executable sflctimekeeper if flag(library-only) @@ -112,7 +120,7 @@ test-suite test build-depends: base , sflctimekeeper - , yesod-test + , yesod-test >= 0.3 && < 0.4 , yesod-default , yesod-core , time diff --git a/templates/homepage.hamlet b/templates/homepage.hamlet index c40be5c..e383365 100644 --- a/templates/homepage.hamlet +++ b/templates/homepage.hamlet @@ -1,38 +1,7 @@ -<h1>_{MsgHello} +<h1>_{MsgTimekeeping} -<ol> - <li>Now that you have a working project you should use the # - \<a href="http://www.yesodweb.com/book/">Yesod book</a> to learn more. # - You can also use this scaffolded site to explore some basic concepts. - - <li> This page was generated by the #{handlerName} handler in # - \<em>Handler/Root.hs</em>. - - <li> The #{handlerName} handler is set to generate your site's home screen in Routes file # - <em>config/routes - - <li> The HTML you are seeing now is actually composed by a number of <em>widgets</em>, # - most of them are brought together by the <em>defaultLayout</em> function which # - is defined in the <em>Foundation.hs</em> module, and used by <em>#{handlerName}</em>. # - All the files for templates and wigdets are in <em>templates</em>. - - <li> - A Widget's Html, Css and Javascript are separated in three files with the # - \<em>.hamlet</em>, <em>.lucius</em> and <em>.julius</em> extensions. - - <li ##{aDomId}>If you had javascript enabled then you wouldn't be seeing this. - - <li #form> - This is an example trivial Form. Read the # - \<a href="http://www.yesodweb.com/book/forms">Forms chapter</a> # - on the yesod book to learn more about them. - $maybe (info,con) <- submission - <div .message> - Your file's type was <em>#{fileContentType info}</em>. You say it has: <em>#{con}</em> - <form method=post action=@{HomeR}#form enctype=#{formEnctype}> - ^{formWidget} - <input type="submit" value="Send it!"> - - <li> And last but not least, Testing. In <em>tests/main.hs</em> you will find a # - test suite that performs tests on this page. # - You can run your tests by doing: <pre>yesod test</pre> +<ul> + $forall Entity key person <- people + <li> + <a href=@{UserR key}> + #{userIdent person} diff --git a/templates/homepage.julius b/templates/homepage.julius index efae799..22920d4 100644 --- a/templates/homepage.julius +++ b/templates/homepage.julius @@ -1 +1 @@ -document.getElementById("#{aDomId}").innerHTML = "This text was added by the Javascript part of the homepage widget."; +document.getElementById(#{toJSON aDomId}).innerHTML = "This text was added by the Javascript part of the homepage widget."; diff --git a/templates/userpage.hamlet b/templates/userpage.hamlet index 27353d0..4205d2c 100644 --- a/templates/userpage.hamlet +++ b/templates/userpage.hamlet @@ -1,21 +1,35 @@ <h1>#{username} -$if isUser +$forall Entity _ emp <- employments + <p>From # + <strong> + #{show (employmentStartDate emp)} + $maybe enddate <- employmentEndDate emp + \ until # + <strong> + #{show enddate} + +$if isThisUser <p> <form method=post action=@{UserR cid}#form enctype=#{formEnctype}> ^{formWidget} <input type="submit" value="Submit time entry"> $else + <table> <tr> <th>Category <th>Hours <th>Date - $forall (a,b,c) <- entries + <th>Note + $forall (a,b,c,d,e) <- entries <tr .timeentry> - <td>#{a} - <td>#{b} + <td> + <a href=@{CategoryR a}> + #{timeCategoryName b} <td>#{c} + <td>#{d} + <td>#{e} ^{pageNavWidget} |