Colonnade for Sheet Files

This commit is contained in:
SJost 2018-05-04 11:13:39 +02:00
parent 1218f93944
commit 26c5ba5183
2 changed files with 46 additions and 22 deletions

View File

@ -1,5 +1,6 @@
{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
@ -176,17 +177,50 @@ getSheetShowR tid csh shn = do
entSheet <- runDB $ fetchSheet tid csh shn entSheet <- runDB $ fetchSheet tid csh shn
let sheet = entityVal entSheet let sheet = entityVal entSheet
sid = entityKey entSheet sid = entityKey entSheet
-- -- without Colonnade
fileNameTypes <- runDB $ E.select $ E.from $ -- fileNameTypes <- runDB $ E.select $ E.from $
\(sheet `E.InnerJoin` sheetFile `E.InnerJoin` file) -> do -- \(sheet `E.InnerJoin` sheetFile `E.InnerJoin` file) -> do
-- Restrict to consistent rows that correspond to each other -- -- Restrict to consistent rows that correspond to each other
E.on (file E.^. FileId E.==. sheetFile E.^. SheetFileFile) -- E.on (file E.^. FileId E.==. sheetFile E.^. SheetFileFile)
E.on (sheetFile E.^. SheetFileSheet E.==. sheet E.^. SheetId) -- E.on (sheetFile E.^. SheetFileSheet E.==. sheet E.^. SheetId)
-- filter to requested file -- -- filter to requested file
E.where_ (sheet E.^. SheetId E.==. E.val sid ) -- E.where_ (sheet E.^. SheetId E.==. E.val sid )
-- return desired columns -- -- return desired columns
return $ (file E.^. FileTitle, file E.^. FileModified, sheetFile E.^. SheetFileType) -- return $ (file E.^. FileTitle, file E.^. FileModified, sheetFile E.^. SheetFileType)
let fileLinks = map (\(E.Value fName, E.Value modified, E.Value fType) -> (CSheetR tid csh (SheetFileR shn fType fName),modified)) fileNameTypes -- let fileLinks = map (\(E.Value fName, E.Value modified, E.Value fType) -> (CSheetR tid csh (SheetFileR shn fType fName),modified)) fileNameTypes
-- with Colonnade
let fileData (sheet `E.InnerJoin` sheetFile `E.InnerJoin` file) = do
-- Restrict to consistent rows that correspond to each other
E.on (file E.^. FileId E.==. sheetFile E.^. SheetFileFile)
E.on (sheetFile E.^. SheetFileSheet E.==. sheet E.^. SheetId)
-- filter to requested file
E.where_ $ sheet E.^. SheetId E.==. E.val sid
E.&&. E.not_ (E.isNothing $ file E.^. FileContent)
-- return desired columns
return $ (file E.^. FileTitle, file E.^. FileModified, sheetFile E.^. SheetFileType)
let colonnadeFiles = mconcat
[ sortable (Just "type") "Typ" $ \(_,_, E.Value ftype) -> textCell $ toPathPiece ftype
, sortable (Just "path") "Dateiname" $ anchorCell (\(E.Value fName,_,E.Value fType) -> CSheetR tid csh (SheetFileR shn fType fName))
(\(E.Value fName,_,_) -> str2widget fName)
, sortable (Just "time") "Modifikation" $ \(_,E.Value modified,_) -> stringCell $ formatTimeGerWDT modified
]
fileTable <- dbTable def $ DBTable
{ dbtSQLQuery = fileData
, dbtColonnade = colonnadeFiles
, dbtAttrs = tableDefault
, dbtIdent = "files" :: Text
, dbtSorting = [ ( "type"
, SortColumn $ \(sheet `E.InnerJoin` sheetFile `E.InnerJoin` file) -> sheetFile E.^. SheetFileType
)
, ( "path"
, SortColumn $ \(sheet `E.InnerJoin` sheetFile `E.InnerJoin` file) -> file E.^. FileTitle
)
, ( "time"
, SortColumn $ \(sheet `E.InnerJoin` sheetFile `E.InnerJoin` file) -> file E.^. FileModified
)
]
}
defaultLayout $ do defaultLayout $ do
setTitle $ toHtml $ T.append "Übung " $ sheetName sheet setTitle $ toHtml $ T.append "Übung " $ sheetName sheet
$(widgetFile "sheetShow") $(widgetFile "sheetShow")

View File

@ -25,16 +25,6 @@
<div .row> <div .row>
<div .col-lg-12> <div .col-lg-12>
<h2>Dateien <h2>Dateien
<ul> ^{fileTable}
$forall (fileLink,modified) <- fileLinks
<li>
$case fileLink
$of CourseR _ _ (SheetR (SheetFileR _ typ name))
#{toPathPiece typ}
<a href=@{fileLink}>#{name}
#{formatTimeGerWDT modified}
$of other
<a href=@{fileLink}>@{fileLink}
#{formatTimeGerWDT modified}
<hr> <hr>