JSON for showTerms

src/Common.hs

@@ -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" 

src/Handler/Term.hs

@@ -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 
+  selectRep $ do
-        -- TODO Edit-Links only $if isAdmin, otherwise breadcrumb navigation
+    provideRep $ return $ toJSON terms
-        [ headed "Kürzel" $ (\t -> let tn = termName t in
+    provideRep $ do
-            [whamlet| <a href=@{EditTermExistR tn}>#{termToText tn}|] )        
+      let colonnadeTerms = mconcat 
-        , headed "Beginn Vorlesungen" $ fromString.formatTimeGerWD.termLectureStart
+            -- TODO Edit-Links only $if isAdmin, otherwise breadcrumb navigation
-        , headed "Ende Vorlesungen"   $ fromString.formatTimeGerWD.termLectureEnd
+            [ headed "Kürzel" $ (\t -> let tn = termName t in
-        , headed "Aktiv"  (\t -> if termActive t then tickmark else "")
+                [whamlet| <a href=@{EditTermExistR tn}>#{termToText tn}|] )        
---         , Colonnade.bool (Headed "Aktiv") termActive (const tickmark) (const "")
+            , headed "Beginn Vorlesungen" $ fromString.formatTimeGerWD.termLectureStart
-        , headed "Semesteranfang" $ fromString.formatTimeGerWD.termStart
+            , headed "Ende Vorlesungen"   $ fromString.formatTimeGerWD.termLectureEnd
-        , headed "Semesterende"   $ fromString.formatTimeGerWD.termEnd
+            , headed "Aktiv"  (\t -> if termActive t then tickmark else "")
-        , headed "Feiertage im Semester" $ 
+    --         , Colonnade.bool (Headed "Aktiv") termActive (const tickmark) (const "")
-        fromString.(intercalate ", ").(map formatTimeGerWD).termHolidays
+            , headed "Semesteranfang" $ fromString.formatTimeGerWD.termStart
-        ]  
+            , headed "Semesterende"   $ fromString.formatTimeGerWD.termEnd
-  defaultLayout $ do
+            , headed "Feiertage im Semester" $ 
-    setTitle "Freigeschaltete Semester"            
+            fromString.(intercalate ", ").(map formatTimeGerWD).termHolidays
-    encodeHeadedWidgetTable tableDefault colonnadeTerms (map entityVal terms)
+            ]  
+      defaultLayout $ do
+        setTitle "Freigeschaltete Semester"            
+        encodeHeadedWidgetTable tableDefault colonnadeTerms (map entityVal terms)
 
     
 getNewTermR :: Handler Html

src/Handler/Utils/Table.hs

@@ -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)
+  
+  
+