TermTable properly realised with Colonnade now. Additional dependencies were required.

This commit is contained in:
SJost 2017-10-08 19:57:08 +02:00
parent 99edd912dc
commit 930a478ee3
6 changed files with 58 additions and 106 deletions

View File

@ -50,6 +50,9 @@ dependencies:
- base64-bytestring - base64-bytestring
- memory - memory
- http-api-data - http-api-data
- colonnade >=1.1.1
- yesod-colonnade >=1.1.0
- blaze-markup
# The library contains all of our application code. The executable # The library contains all of our application code. The executable
# defined below is just a thin wrapper. # defined below is just a thin wrapper.

View File

@ -8,46 +8,34 @@
module Handler.Term where module Handler.Term where
import Import import Import
import Handler.Utils import Handler.Utils
import qualified Data.Text as T import qualified Data.Text as T
-- import Data.Maybe
import Yesod.Form.Bootstrap3 import Yesod.Form.Bootstrap3
-- import Text.Julius (RawJS (..))
import Colonnade
import Yesod.Colonnade
getShowTermsR :: Handler Html getShowTermsR :: Handler Html
getShowTermsR = do getShowTermsR = do
terms <- runDB $ selectList [] [Desc TermStart] terms <- runDB $ selectList [] [Desc TermStart]
let colonnadeTerms = mconcat
-- TODO Edit-Links only $if isAdmin, otherwise breadcrumb navigation
[ headed "Kürzel" $ (\t -> let tn = termName t in
[whamlet| <a href=@{EditTermExistR tn}>#{termToText tn}|] )
, headed "Beginn Vorlesungen" $ fromString.formatTimeGerWD.termLectureStart
, headed "Ende Vorlesungen" $ fromString.formatTimeGerWD.termLectureEnd
, headed "Aktiv" (\t -> if termActive t then tickmark else "")
, headed "Semesteranfang" $ fromString.formatTimeGerWD.termStart
, headed "Semesterende" $ fromString.formatTimeGerWD.termEnd
, headed "Feiertage im Semester" $
fromString.(intercalate ", ").(map formatTimeGerWD).termHolidays
]
defaultLayout $ do defaultLayout $ do
setTitle "Freigeschaltete Semester" setTitle "Freigeschaltete Semester"
-- TODO: provide common utility function for formatting Times encodeHeadedWidgetTable tableDefault colonnadeTerms (map entityVal terms)
-- TODO: turn into proper table
-- TODO Edit-Links only $if isAdmin, otherwise breadcrumb navigation
[whamlet|
<h2>
Liste der freigeschalteten Semester:
$if null terms
<p> Es wurden noch kein Semester freigeschaltetet.
$else
<ul>
$forall Entity _ term <- terms
<li>
<a href=@{EditTermExistR $ termName term}>
#{termToText $ termName term}
#{formatTimeGerWD $ termStart term}
bis #{formatTimeGerWD $ termEnd term}.
<h4>
Vorlesungszeit:
#{formatTimeGerWD $ termLectureStart term}
bis #{formatTimeGerWD $ termLectureEnd term}.
$if termActive term
(Semester ist aktiv)
$with holidays <- termHolidays term
$if not (null holidays)
Feiertage im Semester: #{show holidays}
|]
getNewTermR :: Handler Html getNewTermR :: Handler Html
@ -71,12 +59,14 @@ getEditTermExistR tid = do
getEditTermMaybeR :: Maybe Term -> Handler Html getEditTermMaybeR :: Maybe Term -> Handler Html
getEditTermMaybeR mbTerm= do getEditTermMaybeR mbTerm= do
aid <- requireAuthId aid <- requireAuthId
-- TODO: verify Admin
(formWidget, formEnctype) <- generateFormPost $ newTermForm mbTerm (formWidget, formEnctype) <- generateFormPost $ newTermForm mbTerm
wdgtTermForm formWidget formEnctype wdgtTermForm formWidget formEnctype
postEditTermR :: Handler Html postEditTermR :: Handler Html
postEditTermR = do postEditTermR = do
aid <- requireAuthId aid <- requireAuthId
-- TODO: verify Admin
((result, formWidget), formEnctype) <- runFormPost $ newTermForm Nothing ((result, formWidget), formEnctype) <- runFormPost $ newTermForm Nothing
action <- lookupPostParam "formaction" action <- lookupPostParam "formaction"
case (result,action) of case (result,action) of

View File

@ -1,11 +1,17 @@
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE OverloadedStrings #-}
module Handler.Utils module Handler.Utils
( module Handler.Utils ( module Handler.Utils
) where ) where
import Import.NoFoundation
import Handler.Utils.DateTime as Handler.Utils import Handler.Utils.DateTime as Handler.Utils
import Handler.Utils.Term as Handler.Utils import Handler.Utils.Term as Handler.Utils
import Handler.Utils.Bootstrap3 as Handler.Utils import Handler.Utils.Bootstrap3 as Handler.Utils
import Handler.Utils.Form as Handler.Utils import Handler.Utils.Form as Handler.Utils
import Handler.Utils.Table as Handler.Utils
tickmark :: IsString a => a
tickmark = fromString ""

View File

@ -1,10 +1,8 @@
module Handler.Utils.DateTime where module Handler.Utils.DateTime where
import Data.Time import Data.Time
germanTimeLocale :: TimeLocale
germanTimeLocale :: TimeLocale
germanTimeLocale = TimeLocale germanTimeLocale = TimeLocale
{ wDays = [("Montag" ,"Mo") { wDays = [("Montag" ,"Mo")
,("Dienstag" ,"Di") ,("Dienstag" ,"Di")
@ -36,8 +34,8 @@ germanTimeLocale = TimeLocale
} }
formatTimeGer :: FormatTime t => String -> t -> String formatTimeGer :: FormatTime t => String -> t -> String
formatTimeGer = formatTime germanTimeLocale formatTimeGer = formatTime germanTimeLocale
formatTimeGerDTlong :: FormatTime t => t -> String formatTimeGerDTlong :: FormatTime t => t -> String
formatTimeGerDTlong = formatTimeGer "%A, %e. %B %Y, %k:%M:%S" formatTimeGerDTlong = formatTimeGer "%A, %e. %B %Y, %k:%M:%S"
@ -52,6 +50,6 @@ formatTimeGerWD = formatTimeGer "%a %e.%m.%y"
formatTimeGerD :: FormatTime t => t -> String formatTimeGerD :: FormatTime t => t -> String
formatTimeGerD = formatTimeGer $ dateFmt germanTimeLocale formatTimeGerD = formatTimeGer $ dateFmt germanTimeLocale
formatTimeGerT :: FormatTime t => t -> String formatTimeGerT :: FormatTime t => t -> String
formatTimeGerT = formatTimeGer $ timeFmt germanTimeLocale formatTimeGerT = formatTimeGer $ timeFmt germanTimeLocale

View File

@ -0,0 +1,14 @@
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
module Handler.Utils.Table where
-- General Utilities for Tables
-- import Import hiding ((<>))
import Data.Monoid ((<>))
import Text.Blaze as B
-- Table design
tableDefault :: Attribute
tableDefault = customAttribute "class" "table table-striped"

View File

@ -1,71 +1,12 @@
# This file was automatically generated by 'stack init'
#
# Some commonly used options have been documented as comments in this file.
# For advanced use and comprehensive documentation of the format, please see:
# https://docs.haskellstack.org/en/stable/yaml_configuration/
# Resolver to choose a 'specific' stackage snapshot or a compiler version.
# A snapshot resolver dictates the compiler version and the set of packages
# to be used for project dependencies. For example:
#
# resolver: lts-3.5
# resolver: nightly-2015-09-21
# resolver: ghc-7.10.2
# resolver: ghcjs-0.1.0_ghc-7.10.2
# resolver:
# name: custom-snapshot
# location: "./custom-snapshot.yaml"
resolver: lts-9.3
# User packages to be built.
# Various formats can be used as shown in the example below.
#
# packages:
# - some-directory
# - https://example.com/foo/bar/baz-0.0.2.tar.gz
# - location:
# git: https://github.com/commercialhaskell/stack.git
# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a
# extra-dep: true
# subdirs:
# - auto-update
# - wai
#
# A package marked 'extra-dep: true' will only be built if demanded by a
# non-dependency (i.e. a user package), and its test suites and benchmarks
# will not be run. This is useful for tweaking upstream packages.
packages:
- .
# Dependency packages to be pulled from upstream that are not in the resolver
# (e.g., acme-missiles-0.3)
extra-deps: []
# Override default flag values for local packages and extra-deps
flags: {} flags: {}
# Extra package databases containing global packages
extra-package-dbs: []
# Control whether we use the GHC we find on the path
# system-ghc: true
#
# Require a specific version of stack, using version ranges
# require-stack-version: -any # Default
# require-stack-version: ">=1.5"
#
# Override the architecture used by stack, especially useful on Windows
# arch: i386
# arch: x86_64
#
# Extra directories used by stack for building
# extra-include-dirs: [/path/to/dir]
# extra-lib-dirs: [/path/to/dir]
#
# Allow a newer minor version of GHC than the snapshot specifies
# compiler-check: newer-minor
nix: nix:
packages: [] packages: []
shell-file: ./stack.nix
pure: false pure: false
shell-file: ./stack.nix
extra-package-dbs: []
packages:
- .
extra-deps:
- colonnade-1.1.1
- yesod-colonnade-1.1.0
resolver: lts-9.3