JSON for showTerms

This commit is contained in:
SJost 2017-10-09 07:47:34 +02:00
parent 98c945b443
commit df1398f756
3 changed files with 50 additions and 19 deletions

View File

@ -1,4 +1,5 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
module Common where
-- Common Utility Functions
@ -23,3 +24,18 @@ projNI n i = lamE [pat] rhs
where pat = tupP (map varP xs)
rhs = varE (xs !! (i - 1))
xs = [ mkName $ "x" ++ show j | j <- [1..n] ]
---------------
-- Functions --
---------------
permuteFun :: [Int] -> ExpQ -- generic permutation of function arguments, i.e. $(permuteFun [2,1]) == flip
permuteFun perm = lamE pat rhs
where pat = map varP $ fn:xs
rhs = foldl appE (varE fn) $ map varE ps
-- rhs = appE (varE fn) (varE $ xs!!1)
ln = length perm
xs = [ mkName $ "x" ++ show j | j <- [1..ln] ]
ps = [ xs !! (j-1) | j <- perm ]
fn = mkName "fn"

View File

@ -18,25 +18,28 @@ import Colonnade
import Yesod.Colonnade
getShowTermsR :: Handler Html
getShowTermsR :: Handler TypedContent
getShowTermsR = do
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 "")
-- , Colonnade.bool (Headed "Aktiv") termActive (const tickmark) (const "")
, headed "Semesteranfang" $ fromString.formatTimeGerWD.termStart
, headed "Semesterende" $ fromString.formatTimeGerWD.termEnd
, headed "Feiertage im Semester" $
fromString.(intercalate ", ").(map formatTimeGerWD).termHolidays
]
defaultLayout $ do
setTitle "Freigeschaltete Semester"
encodeHeadedWidgetTable tableDefault colonnadeTerms (map entityVal terms)
selectRep $ do
provideRep $ return $ toJSON terms
provideRep $ do
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 "")
-- , Colonnade.bool (Headed "Aktiv") termActive (const tickmark) (const "")
, headed "Semesteranfang" $ fromString.formatTimeGerWD.termStart
, headed "Semesterende" $ fromString.formatTimeGerWD.termEnd
, headed "Feiertage im Semester" $
fromString.(intercalate ", ").(map formatTimeGerWD).termHolidays
]
defaultLayout $ do
setTitle "Freigeschaltete Semester"
encodeHeadedWidgetTable tableDefault colonnadeTerms (map entityVal terms)
getNewTermR :: Handler Html

View File

@ -18,8 +18,20 @@ import Yesod.Colonnade
tableDefault :: Attribute
tableDefault = customAttribute "class" "table table-striped table-hover"
-- Colonnade Tools
numberColonnade :: (IsString c) => Colonnade Headed Int c
numberColonnade = headed "Nr" (fromString.show)
pairColonnade :: (Functor h) => Colonnade h a c -> Colonnade h b c -> Colonnade h (a,b) c
pairColonnade a b = mconcat [ lmap fst a, lmap snd b]
-- modifiy tables
-- Table Modification
encodeHeadedWidgetTableNumbered :: Attribute -> Colonnade Headed a (WidgetT site IO ()) -> [a] -> WidgetT site IO ()
encodeHeadedWidgetTableNumbered attrs colo tdata =
encodeHeadedWidgetTable attrs (mconcat [headed "Nr" (fromString.show.fst), lmap snd colo]) (zip [1..] tdata)
encodeHeadedWidgetTable attrs (mconcat [numberCol, lmap snd colo]) (zip [1..] tdata)
where
numberCol = headed "Nr" (fromString.show.fst)