Colonnade for Sheet Files
This commit is contained in:
parent
1218f93944
commit
26c5ba5183
@ -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")
|
||||||
|
|||||||
@ -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>
|
||||||
|
|
||||||
|
|||||||
Reference in New Issue
Block a user