diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg
index 1595dc8d9..340c9fa16 100644
--- a/messages/uniworx/de.msg
+++ b/messages/uniworx/de.msg
@@ -72,6 +72,8 @@ CourseSecretTip: Anmeldung zum Kurs erfordert Eingabe des Passworts, sofern gese
CourseRegisterFromTip: Ohne Datum ist keine Anmeldung möglich
CourseRegisterToTip: Anmeldung darf auch ohne Begrenzung möglich sein
CourseDeregisterUntilTip: Abmeldung darf auch ohne Begrenzung möglich sein
+CourseFilterSearch: Volltext-Suche
+CourseFilterRegistered: Registriert
NoSuchTerm tid@TermId: Semester #{display tid} gibt es nicht.
NoSuchSchool ssh@SchoolId: Institut #{display ssh} gibt es nicht.
@@ -233,6 +235,7 @@ CorrUpload: Korrekturen hochladen
CorrSetCorrector: Korrektor zuweisen
CorrAutoSetCorrector: Korrekturen verteilen
NatField xyz@Text: #{xyz} muss eine natürliche Zahl sein!
+JSONFieldDecodeFailure aesonFailure@String: Konnte JSON nicht parsen: #{aesonFailure}
SubmissionsAlreadyAssigned num@Int64: #{display num} Abgaben waren bereits einem Korrektor zugeteilt und wurden nicht verändert:
SubmissionsAssignUnauthorized num@Int64: #{display num} Abgaben können momentan nicht einem Korrektor zugeteilt werden (z.B. weil die Abgabe noch offen ist):
diff --git a/src/Data/CaseInsensitive/Instances.hs b/src/Data/CaseInsensitive/Instances.hs
index 7dc9123e8..c9e7f0c5d 100644
--- a/src/Data/CaseInsensitive/Instances.hs
+++ b/src/Data/CaseInsensitive/Instances.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Data.CaseInsensitive.Instances
@@ -20,6 +21,8 @@ import Language.Haskell.TH.Syntax (Lift(..))
import Data.Aeson (ToJSON(..), FromJSON(..), ToJSONKey(..), FromJSONKey(..), ToJSONKeyFunction(..))
+import qualified Database.Esqueleto as E
+
instance PersistField (CI Text) where
toPersistValue ciText = PersistDbSpecific . Text.encodeUtf8 $ CI.original ciText
@@ -37,6 +40,8 @@ instance PersistFieldSql (CI Text) where
instance PersistFieldSql (CI String) where
sqlType _ = SqlOther "citext"
+instance (E.SqlString a, PersistField (CI a)) => E.SqlString (CI a)
+
instance ToJSON a => ToJSON (CI a) where
toJSON = toJSON . CI.original
diff --git a/src/Data/Monoid/Instances.hs b/src/Data/Monoid/Instances.hs
new file mode 100644
index 000000000..44909d53f
--- /dev/null
+++ b/src/Data/Monoid/Instances.hs
@@ -0,0 +1,19 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module Data.Monoid.Instances
+ (
+ ) where
+
+import ClassyPrelude
+import Data.Monoid
+
+type instance Element (Dual a) = a
+instance MonoPointed (Dual a)
+type instance Element (Sum a) = a
+instance MonoPointed (Sum a)
+type instance Element (Product a) = a
+instance MonoPointed (Product a)
+type instance Element (First a) = a
+instance MonoPointed (First a)
+type instance Element (Last a) = a
+instance MonoPointed (Last a)
diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs
index 803ef4bae..b77167ca8 100644
--- a/src/Handler/Corrections.hs
+++ b/src/Handler/Corrections.hs
@@ -277,6 +277,7 @@ makeCorrectionsTable whereClause dbtColonnade psValidator dbtProj' = do
E.||. (if Nothing `Set.member` emails then E.isNothing (corrector E.?. UserEmail) else E.val False)
)
]
+ , dbtFilterUI = mempty
, dbtStyle = def
, dbtIdent = "corrections" :: Text
}
diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs
index e843ade32..d34542f87 100644
--- a/src/Handler/Course.hs
+++ b/src/Handler/Course.hs
@@ -12,6 +12,8 @@ import qualified Data.Text as T
import Data.Function ((&))
-- import Yesod.Form.Bootstrap3
+import Data.Monoid (Last(..))
+
import Data.Maybe
import qualified Data.Set as Set
import qualified Data.Map as Map
@@ -161,13 +163,27 @@ makeCourseTable whereClause colChoices psValidator = do
| Set.null criterias -> E.val True :: E.SqlExpr (E.Value Bool)
| otherwise -> school E.^. SchoolShorthand `E.in_` E.valList (Set.toList criterias)
)
+ , ( "registered", FilterColumn $ \tExpr criterion -> case getLast (criterion :: Last Bool) of
+ Nothing -> E.val True :: E.SqlExpr (E.Value Bool)
+ Just needle -> course2Registered muid tExpr E.==. E.val needle
+ )
+ , ( "search", FilterColumn $ \(course `E.InnerJoin` _school :: CourseTableExpr) criterion -> case getLast (criterion :: Last Text) of
+ Nothing -> E.val True :: E.SqlExpr (E.Value Bool)
+ Just needle -> (E.castString (course E.^. CourseName) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%))
+ E.||. (E.castString (course E.^. CourseShorthand) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%))
+ E.||. (E.castString (course E.^. CourseDescription) `E.ilike` (E.%) E.++. E.val needle E.++. (E.%))
+ )
]
+ , dbtFilterUI = mconcat
+ [ Map.singleton "search" . maybeToList <$> aopt textField (fslI MsgCourseFilterSearch) Nothing
+ , Map.singleton "registered" . fmap toPathPiece . maybeToList <$> aopt boolField (fslI MsgCourseFilterRegistered) Nothing
+ ]
, dbtStyle = def
, dbtIdent = "courses" :: Text
}
getCourseListR :: Handler Html
-getCourseListR = do -- TODO: Suchfunktion für Kurse und Kürzel!!!
+getCourseListR = do
muid <- maybeAuthId
let colonnade = widgetColonnade $ mconcat
[ colCourseDescr
@@ -182,7 +198,6 @@ getCourseListR = do -- TODO: Suchfunktion für Kurse und Kürzel!!!
coursesTable <- runDB $ makeCourseTable whereClause colonnade validator
defaultLayout $ do
setTitleI MsgCourseListTitle
- [whamlet|TODO: Such-/Filterfunktion hier einbauen|] -- TODO
$(widgetFile "courses")
getTermCurrentR :: Handler Html
diff --git a/src/Handler/Home.hs b/src/Handler/Home.hs
index 911827e00..f5bd47c51 100644
--- a/src/Handler/Home.hs
+++ b/src/Handler/Home.hs
@@ -97,6 +97,7 @@ homeAnonymous = do
| otherwise -> course E.^. CourseTerm `E.in_` E.valList (Set.toList tids)
)
] -}
+ , dbtFilterUI = mempty
, dbtStyle = def
, dbtIdent = "upcomingdeadlines" :: Text
}
@@ -198,6 +199,7 @@ homeUser uid = do
| otherwise -> course E.^. CourseTerm `E.in_` E.valList (Set.toList tids)
)
] -}
+ , dbtFilterUI = mempty
, dbtStyle = def { dbsEmptyStyle = DBESNoHeading, dbsEmptyMessage = MsgNoUpcomingSheetDeadlines }
, dbtIdent = "upcomingdeadlines" :: Text
}
diff --git a/src/Handler/Profile.hs b/src/Handler/Profile.hs
index dab2a6b83..410f6862a 100644
--- a/src/Handler/Profile.hs
+++ b/src/Handler/Profile.hs
@@ -273,6 +273,7 @@ mkOwnedCoursesTable =
, ( "term", FilterColumn $ withType $ \(crse `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseTerm )
, ( "school", FilterColumn $ withType $ \(crse `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseSchool )
]
+ dbtFilterUI = mempty
in \uid -> let dbtSQLQuery = dbtSQLQuery' uid in (_1 %~ getAny) <$> dbTableWidget validator DBTable{..}
@@ -319,6 +320,7 @@ mkEnrolledCoursesTable =
, ( "school", FilterColumn $ withType $ \(crse `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseSchool)
-- , ( "time" , FilterColumn $ \(_ `E.InnerJoin` part :: CourseTableData) -> emptyOrIn $ part E.^. CourseParticipantRegistration )
]
+ , dbtFilterUI = mempty
, dbtStyle = def
}
@@ -396,6 +398,7 @@ mkSubmissionTable =
, ( "term", FilterColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseTerm )
, ( "school", FilterColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseSchool )
]
+ dbtFilterUI = mempty
in \uid -> let dbtSQLQuery = dbtSQLQuery' uid
dbtSorting = dbtSorting' uid
in dbTableWidget' validator DBTable{..}
@@ -465,6 +468,7 @@ mkSubmissionGroupTable =
, ( "term", FilterColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseTerm )
, ( "school", FilterColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseSchool )
]
+ dbtFilterUI = mempty
in \uid -> let dbtSQLQuery = dbtSQLQuery' uid
in dbTableWidget' validator DBTable{..}
@@ -538,6 +542,7 @@ mkCorrectionsTable =
, ( "school", FilterColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseSchool )
, ( "course", FilterColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseShorthand)
]
+ dbtFilterUI = mempty
in \uid -> let dbtSQLQuery = dbtSQLQuery' uid
in dbTableWidget' validator DBTable{..}
diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs
index 6728e11a2..f8b4b8f51 100644
--- a/src/Handler/Sheet.hs
+++ b/src/Handler/Sheet.hs
@@ -225,8 +225,8 @@ getSheetListR tid ssh csh = do
-- (submission E.?. SubmissionRatingPoints) E./. (sheet E.^. SheetType)
-- )
]
- , dbtFilter = Map.fromList
- []
+ , dbtFilter = mempty
+ , dbtFilterUI = mempty
, dbtStyle = def
, dbtIdent = "sheets" :: Text
}
@@ -294,7 +294,8 @@ getSShowR tid ssh csh shn = do
, dbtProj = \DBRow{ dbrOutput = dbrOutput@(E.Value fName, _, E.Value fType) }
-> dbrOutput <$ guardM (lift $ (== Authorized) <$> evalAccessDB (CSheetR tid ssh csh shn $ SFileR fType fName) False)
, dbtStyle = def
- , dbtFilter = Map.empty
+ , dbtFilter = mempty
+ , dbtFilterUI = mempty
, dbtIdent = "files" :: Text
, dbtSorting = Map.fromList
[ ( "type"
diff --git a/src/Handler/Submission.hs b/src/Handler/Submission.hs
index cc645a929..7129dfeeb 100644
--- a/src/Handler/Submission.hs
+++ b/src/Handler/Submission.hs
@@ -310,7 +310,8 @@ submissionHelper tid ssh csh shn (SubmissionMode mcid) = do
, SortColumn $ \((_sf1 `E.InnerJoin` f1) `E.FullOuterJoin` (_sf2 `E.InnerJoin` f2)) -> (E.unsafeSqlFunction "GREATEST" ([f1 E.?. FileModified, f2 E.?. FileModified] :: [E.SqlExpr (E.Value (Maybe UTCTime))]) :: E.SqlExpr (E.Value (Maybe UTCTime)))
)
]
- , dbtFilter = Map.empty
+ , dbtFilter = mempty
+ , dbtFilterUI = mempty
}
mFileTable <- traverse (runDB . dbTableWidget' def) . fmap smid2ArchiveTable $ (,) <$> msmid <*> mcid
diff --git a/src/Handler/SystemMessage.hs b/src/Handler/SystemMessage.hs
index 0bde9b1c8..a71104eff 100644
--- a/src/Handler/SystemMessage.hs
+++ b/src/Handler/SystemMessage.hs
@@ -178,12 +178,9 @@ postMessageListR = do
{ dbtSQLQuery
, dbtColonnade
, dbtProj
- , dbtSorting = Map.fromList
- [ -- TODO: from, to, authenticated, severity
- ]
- , dbtFilter = Map.fromList
- [
- ]
+ , dbtSorting = mempty -- TODO: from, to, authenticated, severity
+ , dbtFilter = mempty
+ , dbtFilterUI = mempty
, dbtStyle = def
, dbtIdent = "messages" :: Text
}
diff --git a/src/Handler/Term.hs b/src/Handler/Term.hs
index 41262bd44..0b1e67100 100644
--- a/src/Handler/Term.hs
+++ b/src/Handler/Term.hs
@@ -126,6 +126,7 @@ getTermShowR = do
E.&&. course E.^. CourseShorthand `E.in_` E.valList cshs
)
]
+ , dbtFilterUI = mempty
, dbtStyle = def
, dbtIdent = "terms" :: Text
}
diff --git a/src/Handler/Users.hs b/src/Handler/Users.hs
index ec3924508..d3a9a1d50 100644
--- a/src/Handler/Users.hs
+++ b/src/Handler/Users.hs
@@ -85,6 +85,7 @@ getUsersR = do
)
]
, dbtFilter = mempty
+ , dbtFilterUI = mempty
, dbtStyle = def
, dbtIdent = "users" :: Text
}
diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs
index cc16635d7..906aa48fc 100644
--- a/src/Handler/Utils/Form.hs
+++ b/src/Handler/Utils/Form.hs
@@ -45,6 +45,9 @@ import Text.Read (readMaybe)
import Utils.Lens
+import Data.Aeson (eitherDecodeStrict')
+import Data.Aeson.Text (encodeToLazyText)
+
----------------------------
-- Buttons (new version ) --
----------------------------
@@ -455,6 +458,27 @@ langField :: Bool -- ^ Only allow values from `appLanguages`
langField False = checkBool (all ((&&) <$> not . null <*> T.all Char.isAlpha) . T.splitOn "-") MsgInvalidLangFormat $ textField & addDatalist (return $ toList appLanguages)
langField True = selectField . optionsPairs . map (MsgLanguage &&& id) $ toList appLanguages
+jsonField :: ( ToJSON a, FromJSON a
+ , MonadHandler m
+ , RenderMessage (HandlerSite m) UniWorXMessage
+ , RenderMessage (HandlerSite m) FormMessage
+ )
+ => Bool {-^ Hidden? -}
+ -> Field m a
+jsonField hide = Field{..}
+ where
+ inputType :: Text
+ inputType
+ | hide = "hidden"
+ | otherwise = "text"
+ fieldParse [v] [] = return . second Just . first (SomeMessage . MsgJSONFieldDecodeFailure) . eitherDecodeStrict' $ encodeUtf8 v
+ fieldParse [] [] = return $ Right Nothing
+ fieldParse _ _ = return . Left $ SomeMessage MsgValueRequired
+ fieldView theId name attrs val isReq = liftWidgetT [whamlet|
+
+ |]
+ fieldEnctype = UrlEncoded
+
funcForm :: forall k v m.
( Finite k, Ord k
diff --git a/src/Handler/Utils/Table/Pagination.hs b/src/Handler/Utils/Table/Pagination.hs
index 808ad04af..170d52bbd 100644
--- a/src/Handler/Utils/Table/Pagination.hs
+++ b/src/Handler/Utils/Table/Pagination.hs
@@ -25,6 +25,7 @@ module Handler.Utils.Table.Pagination
) where
import Handler.Utils.Table.Pagination.Types
+import Handler.Utils.Form
import Utils
import Utils.Lens.TH
@@ -228,6 +229,11 @@ data DBStyle = DBStyle
{ dbsEmptyStyle :: DBEmptyStyle
, dbsEmptyMessage :: UniWorXMessage
, dbsAttrs :: [(Text, Text)]
+ , dbsLayoutFilter :: Widget -- ^ Filter UI
+ -> Enctype
+ -> Text -- ^ Filter action (target uri)
+ -> Widget -- ^ Table
+ -> Widget
}
instance Default DBStyle where
@@ -235,8 +241,12 @@ instance Default DBStyle where
{ dbsEmptyStyle = def
, dbsEmptyMessage = MsgNoTableContent
, dbsAttrs = [ ("class", "table table--striped table--hover table--sortable") ]
+ , dbsLayoutFilter = \filterWgdt filterEnctype filterAction scrolltable -> $(widgetFile "table/layout-filter-default")
}
+type FilterKey = CI Text
+type SortingKey = CI Text
+
data DBTable m x = forall a r r' h i t.
( ToSortable h, Functor h
, E.SqlSelect a r
@@ -246,8 +256,9 @@ data DBTable m x = forall a r r' h i t.
{ dbtSQLQuery :: t -> E.SqlQuery a
, dbtProj :: DBRow r -> MaybeT (ReaderT SqlBackend (HandlerT UniWorX IO)) r'
, dbtColonnade :: Colonnade h r' (DBCell m x)
- , dbtSorting :: Map (CI Text) (SortColumn t)
- , dbtFilter :: Map (CI Text) (FilterColumn t)
+ , dbtSorting :: Map SortingKey (SortColumn t)
+ , dbtFilter :: Map FilterKey (FilterColumn t)
+ , dbtFilterUI :: AForm (ReaderT SqlBackend (HandlerT UniWorX IO)) (Map FilterKey [Text])
, dbtStyle :: DBStyle
, dbtIdent :: i
}
@@ -379,18 +390,31 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
, fieldEnctype = UrlEncoded
}
- piResult <- lift . runInputGetResult $ PaginationInput
+ piPrevious <- fmap (maybe FormMissing FormSuccess) . runMaybeT $ MaybeT . return . decodeStrict' . encodeUtf8 =<< MaybeT (lookupPostParam $ wIdent "pagination")
+
+ piInput <- lift . runInputGetResult $ PaginationInput
<$> iopt (multiSelectField $ return sortingOptions) (wIdent "sorting")
<*> (assertM' (not . Map.null) . Map.mapMaybe (assertM $ not . null) <$> Map.traverseWithKey (\k _ -> iopt multiTextField . wIdent $ CI.foldedCase k) dbtFilter)
<*> iopt intField (wIdent "pagesize")
<*> iopt intField (wIdent "page")
- piPrevious <- fmap (maybe FormMissing FormSuccess) . runMaybeT $ MaybeT . return . decodeStrict' . encodeUtf8 =<< MaybeT (lookupPostParam $ wIdent "pagination")
+ let filterPi
+ | FormSuccess PaginationInput{..} <- piPrevious <|> piInput
+ = def{ piSorting, piLimit }
+ | otherwise
+ = def
+
+ ((filterRes, filterWdgt), filterEnc) <- runFormGet . renderAForm FormDBTableFilter $ (,)
+ <$> areq (jsonField True) "" (Just filterPi)
+ <*> dbtFilterUI
+
+ let
+ piResult = piPrevious <|> (\(prev, fSettings) -> prev & _piFilter .~ Just fSettings) <$> filterRes <|> piInput
psShortcircuit <- (== Just dbtIdent') <$> lookupCustomHeader HeaderDBTableShortcircuit
let
- (errs, PaginationSettings{..}) = case piPrevious <|> piResult of
+ (errs, PaginationSettings{..}) = case piResult of
FormSuccess pi
| not (piIsUnset pi)
-> runPSValidator dbtable $ Just pi
@@ -398,7 +422,7 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
-> first (map SomeMessage errs' <>) $ runPSValidator dbtable Nothing
_ -> runPSValidator dbtable Nothing
paginationInput
- | FormSuccess pi <- piPrevious <|> piResult
+ | FormSuccess pi <- piResult
, not $ piIsUnset pi
= pi
| otherwise
@@ -419,18 +443,23 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
rows <- mapMaybeM dbtProj . map (\(dbrIndex, (E.Value dbrCount, dbrOutput)) -> DBRow{..}) $ zip [succ (psPage * psLimit)..] rows'
+ getParams <- liftHandlerT $ queryToQueryText . Wai.queryString . reqWaiRequest <$> getRequest
+
let
rowCount
| (E.Value n, _):_ <- rows' = n
| otherwise = 0
+ tblLink f = decodeUtf8 . toStrict . Builder.toLazyByteString . renderQueryText True $ f getParams
+
+ filterAction = tblLink
+ $ setParam (wIdent "page") Nothing
+ . Map.foldrWithKey (\k _ f -> setParam (wIdent $ CI.foldedCase k) Nothing . f) id dbtFilter
+
table' :: WriterT x m Widget
table' = do
- getParams <- liftHandlerT $ queryToQueryText . Wai.queryString . reqWaiRequest <$> getRequest
let
- tblLink f = decodeUtf8 . Builder.toLazyByteString . renderQueryText True $ f getParams
-
genHeaders SortableP{..} = forM (toSortable . oneColonnadeHead <$> getColonnade dbtColonnade) $ \Sortable{..} -> do
widget <- sortableContent ^. cellContents
let
@@ -456,7 +485,7 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
return $(widgetFile "table/layout")
- bool (dbHandler dbtable paginationInput $ \table -> $(widgetFile "table/layout-wrapper")) (sendResponse <=< tblLayout <=< dbWidget dbtable paginationInput) psShortcircuit <=< runDBTable . fmap swap $ runWriterT table'
+ bool (dbHandler dbtable paginationInput $ (\table -> $(widgetFile "table/layout-wrapper")) . dbsLayoutFilter filterWdgt filterEnc filterAction) (sendResponse <=< tblLayout . dbsLayoutFilter filterWdgt filterEnc filterAction <=< dbWidget dbtable paginationInput) psShortcircuit <=< runDBTable . fmap swap $ runWriterT table'
where
tblLayout :: forall m'. (MonadHandler m', HandlerSite m' ~ UniWorX) => Widget -> m' Html
tblLayout tbl' = do
@@ -464,7 +493,7 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
withUrlRenderer $(hamletFile "templates/table/layout-standalone.hamlet")
setParam :: Text -> Maybe Text -> QueryText -> QueryText
- setParam key v qt = (key, v) : [ i | i@(key', _) <- qt, key' /= key ]
+ setParam key v qt = maybe id (\v' -> (:) (key, Just v')) v [ i | i@(key', _) <- qt, key' /= key ]
dbTableWidget :: Monoid x => PSValidator (HandlerT UniWorX IO) x -> DBTable (HandlerT UniWorX IO) x
-> DB (DBResult (HandlerT UniWorX IO) x)
diff --git a/src/Import/NoFoundation.hs b/src/Import/NoFoundation.hs
index 3bd7ebc45..a832df0db 100644
--- a/src/Import/NoFoundation.hs
+++ b/src/Import/NoFoundation.hs
@@ -41,6 +41,7 @@ import Data.Hashable as Import
import Data.List.NonEmpty as Import (NonEmpty(..))
import Data.Text.Encoding.Error as Import(UnicodeException(..))
import Data.Semigroup as Import (Semigroup)
+import Data.Monoid.Instances as Import ()
import Control.Monad.Morph as Import (MFunctor(..))
diff --git a/src/Utils/Form.hs b/src/Utils/Form.hs
index 5450e0f40..c754bf227 100644
--- a/src/Utils/Form.hs
+++ b/src/Utils/Form.hs
@@ -28,7 +28,7 @@ import Utils.Message
-------------------
-- | Use this type to pass information to the form template
-data FormLayout = FormStandard
+data FormLayout = FormStandard | FormDBTableFilter
renderAForm :: Monad m => FormLayout -> FormRender m a
renderAForm formLayout aform fragment = do
diff --git a/templates/table/layout-filter-default.hamlet b/templates/table/layout-filter-default.hamlet
new file mode 100644
index 000000000..9291c30fb
--- /dev/null
+++ b/templates/table/layout-filter-default.hamlet
@@ -0,0 +1,6 @@
+$newline never
+