module Handler.Admin where

import Import
import Handler.Utils
import Jobs
import Data.Aeson.Encode.Pretty (encodePrettyToTextBuilder)

import Control.Monad.Trans.Except
import Control.Monad.Trans.Writer (mapWriterT)

-- import Data.Time
import Data.Char (isDigit)
import qualified Data.Text as Text
-- import Data.Function ((&))
-- import Yesod.Form.Bootstrap3

import qualified Data.Set as Set
import qualified Data.Map as Map

import Database.Persist.Sql (fromSqlKey)
import qualified Database.Esqueleto as E
import Database.Esqueleto.Utils (mkExactFilter, mkContainsFilter)

import Handler.Utils.Table.Cells
import qualified Handler.Utils.TermCandidates as Candidates

-- import Colonnade hiding (fromMaybe)
-- import Yesod.Colonnade

-- import qualified Data.UUID.Cryptographic as UUID


getAdminR :: Handler Html
getAdminR = -- do
   siteLayoutMsg MsgAdminHeading $ do
      setTitleI MsgAdminHeading
      [whamlet|
        This shall become the Administrators' overview page.
        Its current purpose is to provide links to some important admin functions
      |]

-- BEGIN - Buttons needed only here
data ButtonCreate = CreateMath | CreateInf  -- Dummy for Example
  deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable)
instance Universe ButtonCreate
instance Finite ButtonCreate

nullaryPathPiece ''ButtonCreate camelToPathPiece

instance Button UniWorX ButtonCreate where
  btnLabel CreateMath = [whamlet|Ma<i>thema</i>tik|]
  btnLabel CreateInf  = "Informatik"

  btnClasses CreateMath = [BCIsButton, BCInfo]
  btnClasses CreateInf  = [BCIsButton, BCPrimary]
-- END Button needed only here

emailTestForm :: AForm (HandlerT UniWorX IO) (Email, MailContext)
emailTestForm = (,)
            <$> areq emailField (fslI MsgMailTestFormEmail) Nothing
            <*> ( MailContext
                  <$> (MailLanguages <$> areq (reorderField appLanguagesOpts) (fslI MsgMailTestFormLanguages) Nothing)
                  <*> (toMailDateTimeFormat
                        <$> areq (selectField $ dateTimeFormatOptions SelFormatDateTime) (fslI MsgDateTimeFormat) Nothing
                        <*> areq (selectField $ dateTimeFormatOptions SelFormatDate) (fslI MsgDateFormat) Nothing
                        <*> areq (selectField $ dateTimeFormatOptions SelFormatTime) (fslI MsgTimeFormat) Nothing
                      )
                )
  where
    toMailDateTimeFormat dt d t = \case
      SelFormatDateTime -> dt
      SelFormatDate -> d
      SelFormatTime -> t

makeDemoForm :: Int -> Form (Int,Bool,Double)
makeDemoForm n = identifyForm ("adminTestForm" :: Text) $ \html -> do
    (result, widget) <- flip (renderAForm FormStandard) html $ (,,)
        <$> areq (minIntField n "Zahl") (fromString $ "Ganzzahl > " ++ show n) Nothing
        <*  aformSection MsgFormBehaviour
        <*> areq checkBoxField "Muss nächste Zahl größer sein?" (Just True)
        <*> areq doubleField "Fliesskommazahl" Nothing
        -- NO LONGER DESIRED IN AFORMS:
        -- <*  submitButton
    return $ case result of
      FormSuccess fsres
        | errorMsgs <- validateResult fsres
        , not $ null errorMsgs -> (FormFailure errorMsgs, widget)
      _otherwise -> (result, widget)
  where
    validateResult :: (Int,Bool,Double) -> [Text]
    validateResult (i,True,d) | fromIntegral i >= d = [tshow d <> " ist nicht größer als " <> tshow i, "Zweite Fehlermeldung", "Dritte Fehlermeldung"]
    validateResult _other = []


getAdminTestR, postAdminTestR :: Handler Html -- Demo Page. Referenzimplementierungen sollte hier gezeigt werden!
getAdminTestR = postAdminTestR
postAdminTestR = do
  ((btnResult, btnWdgt), btnEnctype) <- runFormPost $ identifyForm ("buttons" :: Text) (buttonForm :: Form ButtonCreate)
  let btnForm = wrapForm btnWdgt def
        { formAction = Just $ SomeRoute AdminTestR
        , formEncoding = btnEnctype
        , formSubmit = FormNoSubmit
        }
  case btnResult of
    (FormSuccess CreateInf)  -> addMessage Info "Informatik-Knopf gedrückt"
    (FormSuccess CreateMath) -> addMessage Warning "Knopf Mathematik erkannt"
    FormMissing -> return ()
    _other -> addMessage Warning "KEIN Knopf erkannt"

  ((emailResult, emailWidget), emailEnctype) <- runFormPost . identifyForm ("email" :: Text) $ renderAForm FormStandard emailTestForm
  formResultModal emailResult AdminTestR $ \(email, ls) -> do
    jId <- mapWriterT runDB $ do
      jId <- queueJob $ JobSendTestEmail email ls
      tell . pure $ Message Success [shamlet|Email-test gestartet (Job ##{tshow (fromSqlKey jId)})|] (Just IconEmail)
      return jId
    writeJobCtl $ JobCtlPerform jId
    addMessage Warning [shamlet|Inkorrekt ausgegebener Alert|] -- For testing alert handling when short circuiting; for proper (not fallback-solution) handling always use `tell` within `formResultModal`

  let emailWidget' = wrapForm emailWidget def
        { formAction = Just . SomeRoute $ AdminTestR
        , formEncoding = emailEnctype
        , formAttrs = [("uw-async-form", "")]
        }


  let demoFormAction (_i,_b,_d) = addMessage Info "All ok."
  ((demoResult, formWidget),formEnctype) <- runFormPost $ makeDemoForm 7
  formResult demoResult demoFormAction
  let showDemoResult = [whamlet|
          $maybe (i,b,d) <- formResult' demoResult
            Received values:
              <ul>
                <li>#{show i}
                <li>#{show b}
                <li>#{show d}
          $nothing
            No form values received, due to #
            $# Using formResult' above means that we usually to not distinguish the following two cases here, sind formResult does this already:
            $case demoResult
              $of FormSuccess _
                $# Already dealt with above, to showecase usage of formResult' as normally done.
                success, which should not happen here.
              $of FormMissing
                Form data missing, probably empty.
              $of FormFailure msgs
                <ul>
                  $forall m <- msgs
                    <li>#{m}
        |]


  {- The following demonstrates the use of @massInput@.

     @massInput@ takes as arguments:
       - A configuration struct describing how the Widget should behave (how is the space of sub-forms structured, how many dimensions does it have, which additions/deletions are permitted, what data do they need to operate and what should their effect on the overall shape be?)
       - Information on how the resulting field fits into the form as a whole (@FieldSettings@ and whether the @massInput@ should be marked required)
       - An initial value to pre-fill the field with

     @massInput@ then returns an @MForm@ structured for easy downstream consumption of the result
   -}
  let
    -- We define the fields of the configuration struct @MassInput@:

    -- | Make a form for adding a point/line/plane/hyperplane/... (in this case: cell)
    --
    -- This /needs/ to replace all occurrences of @mreq@ with @mpreq@ (no fields should be /actually/ required)
    mkAddForm :: ListPosition -- ^ Approximate position of the add-widget
              -> Natural -- ^ Dimension Index, outermost dimension ist 0 i.e. if dimension is 3 hyperplane-adders get passed 0, planes get passed 1, lines get 2, and points get 3
              -> (Text -> Text) -- ^ Nudge deterministic field ids so they're unique
              -> FieldView UniWorX -- ^ Submit-Button for this add-widget
              -> Maybe (Form (Map ListPosition Int -> FormResult (Map ListPosition Int))) -- ^ Nothing iff adding further cells in this position/dimension makes no sense; returns callback to determine index of new cells and data needed to initialize cells
    mkAddForm 0 0 nudge submitBtn = Just $ \csrf -> do
      (addRes, addView) <- mpreq textField ("" & addName (nudge "text")) Nothing -- Any old field; for demonstration
      let addRes' = fromMaybe 0 . readMay . Text.filter isDigit <$> addRes -- Do something semi-interesting on the result of the @textField@ to demonstrate that further processing can be done
          addRes'' = addRes' <&> \dat prev -> FormSuccess (Map.singleton (maybe 0 succ . fmap fst $ Map.lookupMax prev) dat) -- Construct the callback to determine new cell positions and data within @FormResult@ as required, nested @FormResult@ allows aborting the add depending on previous data
      return (addRes'', toWidget csrf >> fvInput addView >> fvInput submitBtn)
    mkAddForm _pos _dim _ _ = error "Dimension and Position is always 0 for our 1-dimensional form"

    -- | Make a single massInput-Cell
    --
    -- This /needs/ to use @nudge@ and deterministic field naming (this allows for correct value-shifting when cells are deleted)
    mkCellForm :: ListPosition -- ^ Position of this cell
               -> Int -- ^ Data needed to initialize the cell (see return of @mkAddForm@)
               -> Maybe Int -- ^ Initial cell result from Argument to `massInput`
               -> (Text -> Text) -- ^ Nudge deterministic field ids so they're unique
               -> Form Int
    mkCellForm _pos cData initial nudge csrf = do -- Extremely simple cell
      (intRes, intView) <- mreq intField ("" & addName (nudge "int")) $ initial <|> Just cData
      return (intRes, toWidget csrf >> fvInput intView)
    -- | How does the shape (`ListLength`) change if a certain cell is deleted?
    deleteCell :: Map ListPosition Int -- ^ Current shape, including initialisation data
               -> ListPosition -- ^ Coordinate to delete
               -> MaybeT (MForm (HandlerT UniWorX IO)) (Map ListPosition ListPosition) -- ^ Monadically compute a set of new positions and their associated old positions
    deleteCell = miDeleteList
    -- | Make a decision on whether an add widget should be allowed to further cells, given the current @liveliness@ (i.e. before performing the addition)
    allowAdd :: ListPosition -> Natural -> ListLength -> Bool
    allowAdd _ _ l = l < 7 -- Limit list length; much more complicated checks are possible (this could in principle be monadic, but @massInput@ is probably already complicated enough to cover just current (2019-03) usecases)
    -- | Where to send the user when they click a shape-changing button, given the id of the Wrapper of the `massInput`-`Widget`
    buttonAction :: PathPiece p => p -> Maybe (SomeRoute UniWorX)
    buttonAction frag = Just . SomeRoute $ AdminTestR :#: frag

  -- The actual call to @massInput@ is comparatively simple:

  ((miResult, fvInput -> miForm), miEnc) <- runFormPost . identifyForm ("massinput" :: Text) $ massInput (MassInput mkAddForm mkCellForm deleteCell allowAdd (\_ _ _ -> Set.empty) buttonAction defaultMiLayout ("massinput" :: Text)) "" True Nothing


  let locallyDefinedPageHeading = [whamlet|Admin TestPage for Uni2work|]
  siteLayout locallyDefinedPageHeading $ do
  -- defaultLayout $ do
    setTitle "Uni2work Admin Testpage"
    $(widgetFile "adminTest")

    [whamlet|<h2>Formular Demonstration|]
    wrapForm formWidget FormSettings
      { formMethod   = POST
      , formAction   = Just . SomeRoute $ AdminTestR :#: FIDAdminDemo
      , formEncoding = formEnctype
      , formAttrs    = []
      , formSubmit   = FormSubmit
      , formAnchor   = Just FIDAdminDemo
      }
    showDemoResult

    miIdent <- newIdent
    let miForm' = wrapForm miForm FormSettings
          { formMethod   = POST
          , formAction   = Just . SomeRoute $ AdminTestR :#: miIdent
          , formEncoding = miEnc
          , formAttrs    = []
          , formSubmit   = FormSubmit
          , formAnchor   = Just miIdent
          }
    [whamlet|
      <h2>Mass-Input
      ^{miForm'}
      $case miResult
        $of FormMissing
        $of FormFailure errs
          <ul>
            $forall err <- errs
              <li>#{err}
        $of FormSuccess res
          <p style="white-space:pre-wrap; font-family:monospace;">
            #{tshow res}
    |]


getAdminErrMsgR, postAdminErrMsgR :: Handler Html
getAdminErrMsgR = postAdminErrMsgR
postAdminErrMsgR = do
  ((ctResult, ctView), ctEncoding) <- runFormPost . renderAForm FormStandard $
        unTextarea <$> areq textareaField (fslpI MsgErrMsgCiphertext "Ciphertext") Nothing

  plaintext <- formResultMaybe ctResult $ exceptT (\err -> Nothing <$ addMessageI Error err) (return . Just) . (encodedSecretBoxOpen :: Text -> ExceptT EncodedSecretBoxException Handler Value)

  let ctView' = wrapForm ctView def{ formAction = Just . SomeRoute $ AdminErrMsgR, formEncoding = ctEncoding }
  defaultLayout
    [whamlet|
      $maybe t <- plaintext
        <pre style="white-space:pre-wrap; font-family:monospace">
          $case t
            $of String t'
              #{t'}
            $of t'
              #{encodePrettyToTextBuilder t'}

      ^{ctView'}
    |]


-- BEGIN - Buttons needed only for StudyTermCandidateManagement
data ButtonAdminStudyTerms
  = BtnCandidatesInfer
  | BtnCandidatesDeleteConflicts
  | BtnCandidatesDeleteAll
  deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable)
instance Universe ButtonAdminStudyTerms
instance Finite ButtonAdminStudyTerms

nullaryPathPiece ''ButtonAdminStudyTerms camelToPathPiece
embedRenderMessage ''UniWorX ''ButtonAdminStudyTerms id

instance Button UniWorX ButtonAdminStudyTerms where
  btnClasses BtnCandidatesInfer           = [BCIsButton, BCPrimary]
  btnClasses BtnCandidatesDeleteConflicts = [BCIsButton, BCDanger]
  btnClasses BtnCandidatesDeleteAll       = [BCIsButton, BCDanger]
-- END Button needed only here

getAdminFeaturesR, postAdminFeaturesR :: Handler Html
getAdminFeaturesR = postAdminFeaturesR
postAdminFeaturesR = do
    ((btnResult, btnWdgt), btnEnctype) <- runFormPost $ identifyForm ("infer-button" :: Text) (buttonForm :: Form ButtonAdminStudyTerms)
    let btnForm = wrapForm btnWdgt def
          { formAction = Just $ SomeRoute AdminFeaturesR
          , formEncoding = btnEnctype
          , formSubmit = FormNoSubmit
          }
    infConflicts <- case btnResult of
      FormSuccess BtnCandidatesInfer -> do
        (infConflicts, infAmbiguous, infRedundant, infAccepted) <- Candidates.inferHandler
        unless (null infAmbiguous) . addMessageI Info . MsgAmbiguousCandidatesRemoved $ length infAmbiguous
        unless (null infRedundant) . addMessageI Info . MsgRedundantCandidatesRemoved $ length infRedundant
        let newKeys = map (StudyTermsKey' . fst) infAccepted
        setSessionJson SessionNewStudyTerms newKeys
        if  | null infAccepted
              -> addMessageI Info      MsgNoCandidatesInferred
            | otherwise
               -> addMessageI Success . MsgCandidatesInferred $ length infAccepted
        return infConflicts
      FormSuccess BtnCandidatesDeleteConflicts -> runDB $ do
        confs <- Candidates.conflicts
        incis <- Candidates.getIncidencesFor (entityKey <$> confs)
        deleteWhere [StudyTermCandidateIncidence <-. (E.unValue <$> incis)]
        addMessageI Success $ MsgIncidencesDeleted $ length incis
        return []
      FormSuccess BtnCandidatesDeleteAll -> runDB $ do
        deleteWhere ([] :: [Filter StudyTermCandidate])
        addMessageI Success MsgAllIncidencesDeleted
        Candidates.conflicts
      _other -> runDB Candidates.conflicts

    newStudyTermKeys <- fromMaybe [] <$> lookupSessionJson SessionNewStudyTerms
    (   (degreeResult,degreeTable)
      , (studyTermsResult,studytermsTable)
      , ((), candidateTable)) <- runDB $ (,,)
      <$> mkDegreeTable
      <*> mkStudytermsTable (Set.fromList newStudyTermKeys)
                            (Set.fromList $ map entityKey infConflicts)
      <*> mkCandidateTable

    -- This needs to happen after calls to `dbTable` so they can short-circuit correctly
    unless (null infConflicts) $ addMessageI Warning MsgStudyFeatureConflict

    let degreeResult' :: FormResult (Map (Key StudyDegree) (Maybe Text, Maybe Text))
        degreeResult' = degreeResult <&> getDBFormResult
          (\row -> ( row ^. _dbrOutput . _entityVal . _studyDegreeName
                   , row ^. _dbrOutput . _entityVal . _studyDegreeShorthand
          ))
        updateDegree degreeKey (name,short) = update degreeKey [StudyDegreeName =. name, StudyDegreeShorthand =. short]
    formResult degreeResult' $ \res -> do
      void . runDB $ Map.traverseWithKey updateDegree res
      addMessageI Success MsgStudyDegreeChangeSuccess

    let studyTermsResult' :: FormResult (Map (Key StudyTerms) (Maybe Text, Maybe Text))
        studyTermsResult' = studyTermsResult <&> getDBFormResult
          (\row -> ( row ^. _dbrOutput . _entityVal . _studyTermsName
                   , row ^. _dbrOutput . _entityVal . _studyTermsShorthand
          ))
        updateStudyTerms studyTermsKey (name,short) = update studyTermsKey [StudyTermsName =. name, StudyTermsShorthand =. short]
    formResult studyTermsResult' $ \res -> do
      void . runDB $ Map.traverseWithKey updateStudyTerms res
      addMessageI Success MsgStudyTermsChangeSuccess

    siteLayoutMsg MsgAdminFeaturesHeading $ do
      setTitleI MsgAdminFeaturesHeading
      $(widgetFile "adminFeatures")
  where
    textInputCell lensRes lensDefault = formCell id (return . view (_dbrOutput . _entityKey))
      (\row _mkUnique -> (\(res,fieldView) -> (set lensRes . assertM (not . Text.null) <$> res, fvInput fieldView))
        <$> mopt textField "" (Just $ row ^. lensDefault)
      )


    mkDegreeTable :: DB (FormResult (DBFormResult (Key StudyDegree) (Maybe Text, Maybe Text) (DBRow (Entity StudyDegree))), Widget)
    mkDegreeTable =
      let dbtIdent      = "admin-studydegrees" :: Text
          dbtStyle      = def
          dbtSQLQuery   :: E.SqlExpr (Entity StudyDegree) -> E.SqlQuery ( E.SqlExpr (Entity StudyDegree))
          dbtSQLQuery   = return
          dbtRowKey     = (E.^. StudyDegreeKey)
          dbtProj       = return
          dbtColonnade  = formColonnade $ mconcat
            [ sortable (Just "key")   (i18nCell MsgGenericKey)  (numCell . view (_dbrOutput . _entityVal . _studyDegreeKey))
            , sortable (Just "name")  (i18nCell MsgDegreeName)  (textInputCell _1 (_dbrOutput . _entityVal . _studyDegreeName))
            , sortable (Just "short") (i18nCell MsgDegreeShort) (textInputCell _2 (_dbrOutput . _entityVal . _studyDegreeShorthand))
            , dbRow
            ]
          dbtSorting    = Map.fromList
            [ ("key"  , SortColumn (E.^. StudyDegreeKey))
            , ("name" , SortColumn (E.^. StudyDegreeName))
            , ("short", SortColumn (E.^. StudyDegreeShorthand))
            ]
          dbtFilter     = mempty
          dbtFilterUI   = mempty
          dbtParams     = def { dbParamsFormAction = Just . SomeRoute $ AdminFeaturesR :#: ("admin-studydegrees-table-wrapper" :: Text)
                              }
          psValidator   = def  -- & defaultSorting [SortAscBy "name", SortAscBy "short", SortAscBy "key"]
                        & defaultSorting [SortAscBy "key"]
          dbtCsvEncode  = noCsvEncode
          dbtCsvDecode  = Nothing
      in dbTable psValidator DBTable{..}

    mkStudytermsTable :: Set (Key StudyTerms) -> Set (Key StudyTerms) -> DB (FormResult (DBFormResult (Key StudyTerms) (Maybe Text, Maybe Text) (DBRow (Entity StudyTerms))), Widget)
    mkStudytermsTable newKeys badKeys =
      let dbtIdent      = "admin-studyterms" :: Text
          dbtStyle      = def
          dbtSQLQuery   :: E.SqlExpr (Entity StudyTerms) -> E.SqlQuery ( E.SqlExpr (Entity StudyTerms))
          dbtSQLQuery   = return
          dbtRowKey     = (E.^. StudyTermsKey)
          dbtProj       = return
          dbtColonnade  = formColonnade $ mconcat
            [ sortable (Just "key")   (i18nCell MsgGenericKey)         (numCell . view (_dbrOutput . _entityVal . _studyTermsKey))
            , sortable (Just "isnew") (i18nCell MsgGenericIsNew)       (isNewCell . flip Set.member newKeys . view (_dbrOutput . _entityKey))
            , sortable (Just "isbad") (i18nCell MsgGenericHasConflict) (isBadCell . flip Set.member badKeys . view (_dbrOutput . _entityKey))
            , sortable (Just "name")  (i18nCell MsgStudyTermsName)     (textInputCell _1 (_dbrOutput . _entityVal . _studyTermsName))
            , sortable (Just "short") (i18nCell MsgStudyTermsShort)    (textInputCell _2 (_dbrOutput . _entityVal . _studyTermsShorthand))
            , dbRow
            ]
          dbtSorting    = Map.fromList
            [ ("key"   , SortColumn (E.^. StudyTermsKey))
            , ("isnew" , SortColumn (\studyTerm -> studyTerm E.^. StudyTermsKey `E.in_` E.valList (unStudyTermsKey <$> Set.toList newKeys))) -- works only once
            -- Remember: sorting with E.in_ by StudyTermsId instead will produce esqueleto-error "unsafeSqlBinOp: non-id/composite keys not expected here"
            , ("isbad" , SortColumn (\studyTerm -> studyTerm E.^. StudyTermsKey `E.in_` E.valList (unStudyTermsKey <$> Set.toList badKeys)))
            , ("name"  , SortColumn (E.^. StudyTermsName))
            , ("short" , SortColumn (E.^. StudyTermsShorthand))
            ]
          dbtFilter     = mempty
          dbtFilterUI   = mempty
          dbtParams     = def { dbParamsFormAction = Just . SomeRoute $ AdminFeaturesR :#: ("admin-studyterms-table-wrapper" :: Text)
                              }
          psValidator   = def
                        -- & defaultSorting [SortAscBy "name", SortAscBy "short", SortAscBy "key"]
                        & defaultSorting [SortDescBy "isnew", SortDescBy "isbad", SortAscBy "key"]
          dbtCsvEncode  = noCsvEncode
          dbtCsvDecode  = Nothing
      in dbTable psValidator DBTable{..}

    mkCandidateTable =
      let dbtIdent      = "admin-termcandidate" :: Text
          dbtStyle      = def { dbsFilterLayout = defaultDBSFilterLayout }
          dbtSQLQuery   :: E.SqlExpr (Entity StudyTermCandidate) -> E.SqlQuery ( E.SqlExpr (Entity StudyTermCandidate))
          dbtSQLQuery   = return
          dbtRowKey     = (E.^. StudyTermCandidateId)
          dbtProj       = return
          dbtColonnade  = dbColonnade $ mconcat
            [ dbRow
            , sortable (Just "key")       (i18nCell MsgStudyTermsKey)           (numCell  . view (_dbrOutput . _entityVal . _studyTermCandidateKey))
            , sortable (Just "name")      (i18nCell MsgStudyTermsName)          (textCell . view (_dbrOutput . _entityVal . _studyTermCandidateName))
            , sortable (Just "incidence") (i18nCell MsgStudyCandidateIncidence) (pathPieceCell . view (_dbrOutput . _entityVal . _studyTermCandidateIncidence))
            ]
          dbtSorting    = Map.fromList
            [ ("key"      , SortColumn (E.^. StudyTermCandidateKey))
            , ("name"     , SortColumn (E.^. StudyTermCandidateName))
            , ("incidence", SortColumn (E.^. StudyTermCandidateIncidence))
            ]
          dbtFilter     = Map.fromList
            [ ("key",       FilterColumn $ mkExactFilter    (E.^. StudyTermCandidateKey))
            , ("name",      FilterColumn $ mkContainsFilter (E.^. StudyTermCandidateName))
            , ("incidence", FilterColumn $ mkExactFilter    (E.^. StudyTermCandidateIncidence)) -- contains filter desired, but impossible here
            ]
          dbtFilterUI mPrev = mconcat
            -- [ prismAForm (singletonFilter "key")       mPrev $ aopt intField            (fslI MsgStudyTermsKey) -- Typing problem exactFilter suffices here
            [ prismAForm (singletonFilter "key")       mPrev $ aopt textField (fslI MsgStudyTermsKey)
            , prismAForm (singletonFilter "name")      mPrev $ aopt textField (fslI MsgStudyTermsName)
            , prismAForm (singletonFilter "incidence") mPrev $ aopt textField (fslI MsgStudyCandidateIncidence)
            ]
          dbtParams     = def
          psValidator   = def & defaultSorting [SortAscBy "incidence", SortAscBy "key", SortAscBy "name"]
          dbtCsvEncode  = noCsvEncode
          dbtCsvDecode  = Nothing
      in dbTable psValidator DBTable{..}