{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}

module Handler.Admin.StudyFeatures
  ( getAdminFeaturesR, postAdminFeaturesR
  ) where

import Import
import Handler.Utils

import qualified Data.Text as Text

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

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

import qualified Handler.Utils.TermCandidates as Candidates


data ButtonAdminStudyTermsNames
  = BtnNameCandidatesInfer
  | BtnNameCandidatesDeleteConflicts
  | BtnNameCandidatesDeleteAll
  deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable)
instance Universe ButtonAdminStudyTermsNames
instance Finite ButtonAdminStudyTermsNames

nullaryPathPiece ''ButtonAdminStudyTermsNames $ camelToPathPiece' 1
embedRenderMessage ''UniWorX ''ButtonAdminStudyTermsNames id

instance Button UniWorX ButtonAdminStudyTermsNames where
  btnClasses BtnNameCandidatesInfer           = [BCIsButton, BCPrimary]
  btnClasses BtnNameCandidatesDeleteConflicts = [BCIsButton, BCDanger]
  btnClasses BtnNameCandidatesDeleteAll       = [BCIsButton, BCDanger]

data ButtonAdminStudyTermsParents
  = BtnParentCandidatesInfer
  | BtnParentCandidatesDeleteAll
  deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable)
instance Universe ButtonAdminStudyTermsParents
instance Finite ButtonAdminStudyTermsParents

nullaryPathPiece ''ButtonAdminStudyTermsParents $ camelToPathPiece' 1
embedRenderMessage ''UniWorX ''ButtonAdminStudyTermsParents id

instance Button UniWorX ButtonAdminStudyTermsParents where
  btnClasses BtnParentCandidatesInfer     = [BCIsButton, BCPrimary]
  btnClasses BtnParentCandidatesDeleteAll = [BCIsButton, BCDanger]
  
data ButtonAdminStudyTermsStandalone
  = BtnStandaloneCandidatesDeleteRedundant
  | BtnStandaloneCandidatesDeleteAll
  deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable)
instance Universe ButtonAdminStudyTermsStandalone
instance Finite ButtonAdminStudyTermsStandalone

nullaryPathPiece ''ButtonAdminStudyTermsStandalone $ camelToPathPiece' 1
embedRenderMessage ''UniWorX ''ButtonAdminStudyTermsStandalone id

instance Button UniWorX ButtonAdminStudyTermsStandalone where
  btnClasses BtnStandaloneCandidatesDeleteRedundant = [BCIsButton, BCPrimary]
  btnClasses BtnStandaloneCandidatesDeleteAll       = [BCIsButton, BCDanger]

  
{-# ANN postAdminFeaturesR ("HLint: ignore Redundant void" :: String) #-}
getAdminFeaturesR, postAdminFeaturesR :: Handler Html
getAdminFeaturesR = postAdminFeaturesR
postAdminFeaturesR = do
    uid <- requireAuthId
    ((nameBtnResult, nameBtnWdgt), nameBtnEnctype) <- runFormPost $ identifyForm ("infer-names-button" :: Text) buttonForm
    let nameBtnForm = wrapForm nameBtnWdgt def
          { formAction = Just $ SomeRoute AdminFeaturesR
          , formEncoding = nameBtnEnctype
          , formSubmit = FormNoSubmit
          }
    infNameConflicts <- case nameBtnResult of
      FormSuccess BtnNameCandidatesInfer -> do
        (infConflicts, infAmbiguous, infRedundantNames, infAccepted) <- Candidates.inferNamesHandler
        unless (null infAmbiguous) . addMessageI Info . MsgAmbiguousNameCandidatesRemoved $ length infAmbiguous
        unless (null infRedundantNames) . addMessageI Info . MsgRedundantNameCandidatesRemoved $ length infRedundantNames
        unless (null infConflicts) $ do
          let badKeys = map entityKey infConflicts
          setSessionJson SessionConflictingStudyTerms badKeys
          addMessageI Warning MsgStudyFeatureConflict

        let newKeys = map fst infAccepted
        setSessionJson SessionNewStudyTerms newKeys

        if  | null infAccepted
              -> addMessageI Info      MsgNoNameCandidatesInferred
            | otherwise
               -> addMessageI Success . MsgNameCandidatesInferred $ length infAccepted
        redirect AdminFeaturesR
      FormSuccess BtnNameCandidatesDeleteConflicts -> do
        runDB $ do
          confs <- Candidates.nameConflicts
          incis <- Candidates.getNameIncidencesFor $ map entityKey confs
          deleteWhere [StudyTermNameCandidateIncidence <-. (E.unValue <$> incis)]
          addMessageI Success $ MsgIncidencesDeleted $ length incis
        redirect AdminFeaturesR
      FormSuccess BtnNameCandidatesDeleteAll -> do
        runDB $ do
          deleteWhere ([] :: [Filter StudyTermNameCandidate])
          addMessageI Success MsgAllNameIncidencesDeleted
        redirect AdminFeaturesR
      _other -> runDB Candidates.nameConflicts

    ((parentsBtnResult, parentsBtnWdgt), parentsBtnEnctype) <- runFormPost $ identifyForm ("infer-parents-button" :: Text) buttonForm
    let parentsBtnForm = wrapForm parentsBtnWdgt def
          { formAction = Just $ SomeRoute AdminFeaturesR
          , formEncoding = parentsBtnEnctype
          , formSubmit = FormNoSubmit
          }
    formResult parentsBtnResult $ \case
      BtnParentCandidatesInfer -> do
        (infRedundantParents, infAccepted) <- Candidates.inferParentsHandler
        unless (null infRedundantParents) . addMessageI Info . MsgRedundantParentCandidatesRemoved $ length infRedundantParents

        let newKeys = map (studySubTermsChild . entityVal) infAccepted
        setSessionJson SessionNewStudyTerms newKeys

        if  | null infAccepted
              -> addMessageI Info      MsgNoParentCandidatesInferred
            | otherwise
               -> addMessageI Success . MsgParentCandidatesInferred $ length infAccepted
        redirect AdminFeaturesR
      BtnParentCandidatesDeleteAll -> do
        runDB $ do
          deleteWhere ([] :: [Filter StudySubTermParentCandidate])
          addMessageI Success MsgAllParentIncidencesDeleted
        redirect AdminFeaturesR

    ((standaloneBtnResult, standaloneBtnWdgt), standaloneBtnEnctype) <- runFormPost $ identifyForm ("infer-standalone-button" :: Text) buttonForm
    let standaloneBtnForm = wrapForm standaloneBtnWdgt def
          { formAction = Just $ SomeRoute AdminFeaturesR
          , formEncoding = standaloneBtnEnctype
          , formSubmit = FormNoSubmit
          }
    formResult standaloneBtnResult $ \case
      BtnStandaloneCandidatesDeleteRedundant -> do
        infRedundantStandalone <- runDB Candidates.removeRedundantStandalone
        unless (null infRedundantStandalone) . addMessageI Info . MsgRedundantStandaloneCandidatesRemoved $ length infRedundantStandalone
        redirect AdminFeaturesR
      BtnStandaloneCandidatesDeleteAll -> do
        runDB $ do
          deleteWhere ([] :: [Filter StudyTermStandaloneCandidate])
          addMessageI Success MsgAllStandaloneIncidencesDeleted
        redirect AdminFeaturesR
  

    newStudyTermKeys <- fromMaybe [] <$> lookupSessionJson SessionNewStudyTerms
    badStudyTermKeys <- lookupSessionJson SessionConflictingStudyTerms
    (   (degreeResult,degreeTable)
      , (studyTermsResult,studytermsTable)
      , ((), candidateTable)
      , userSchools
      , ((), parentCandidateTable)
      , (standaloneResult, standaloneCandidateTable)) <- runDB $ do
      schools <- E.select . E.from $ \school -> do
        E.where_ . E.exists . E.from $ \schoolFunction ->
          E.where_ $ schoolFunction E.^. UserFunctionSchool   E.==. school E.^. SchoolId
               E.&&. schoolFunction E.^. UserFunctionUser     E.==. E.val uid
               E.&&. schoolFunction E.^. UserFunctionFunction E.==. E.val SchoolAdmin
        return school
      (,,,,,)
        <$> mkDegreeTable
        <*> mkStudytermsTable (Set.fromList newStudyTermKeys)
                              (Set.fromList $ fromMaybe (map entityKey infNameConflicts) badStudyTermKeys)
                              (Set.fromList schools)
        <*> mkCandidateTable
        <*> pure schools
        <*> mkParentCandidateTable
        <*> mkStandaloneCandidateTable

    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
      redirect $ AdminFeaturesR :#: ("admin-studydegrees-table-wrapper" :: Text)

    let standaloneResult' :: FormResult (Map (Key StudyTermStandaloneCandidate) (Maybe StudyDegreeId, Maybe StudyFieldType))
        standaloneResult' = standaloneResult <&> getDBFormResult
          (\row -> ( row ^? _dbrOutput . _2 . _Just . _entityVal . _studyTermsDefaultDegree . _Just
                   , row ^? _dbrOutput . _2 . _Just . _entityVal . _studyTermsDefaultType . _Just
          ))
    formResult standaloneResult' $ \res -> do
      updated <- runDB . iforM res $ \candidateId (mDegree, mType) -> do
        StudyTermStandaloneCandidate{..} <- getJust candidateId
        let termsId = StudyTermsKey' studyTermStandaloneCandidateKey
        updated <- case (,) <$> mDegree <*> mType of
          Nothing -> return Nothing
          Just (degree, typ) -> do
            ifM (existsKey termsId)
              ( update termsId
                  [ StudyTermsDefaultDegree =. Just degree
                  , StudyTermsDefaultType =. Just typ
                  ]
              )
              ( insert_ $ StudyTerms studyTermStandaloneCandidateKey Nothing Nothing (Just degree) (Just typ)
              )
            return $ Just termsId
        infRedundantStandalone <- Candidates.removeRedundantStandalone
        unless (null infRedundantStandalone) . addMessageI Info . MsgRedundantStandaloneCandidatesRemoved $ length infRedundantStandalone
        return updated
      
      let newKeys = catMaybes $ Map.elems updated
      unless (null newKeys) $ do
        setSessionJson SessionNewStudyTerms newKeys

        redirect $ AdminFeaturesR :#: ("admin-studyterms-table-wrapper" :: Text)


    let studyTermsResult' :: FormResult (Map StudyTermsId (Maybe Text, Maybe Text, Set SchoolId, Set StudyTermsId, Maybe StudyDegreeId, Maybe StudyFieldType))
        studyTermsResult' = studyTermsResult <&> getDBFormResult
          (\row -> ( row ^? _dbrOutput . _1 . _entityVal . _studyTermsName . _Just
                   , row ^? _dbrOutput . _1 . _entityVal . _studyTermsShorthand . _Just
                   , row ^. _dbrOutput . _3
                   , row ^. _dbrOutput . _2 . to (Set.map entityKey)
                   , row ^? _dbrOutput . _1 . _entityVal . _studyTermsDefaultDegree . _Just
                   , row ^? _dbrOutput . _1 . _entityVal . _studyTermsDefaultType . _Just
          ))
        updateStudyTerms studyTermsKey (name,short,schools,parents,degree,sType) = do
          degreeExists <- fmap (fromMaybe False) . for degree $ fmap (is _Just) . get
          update studyTermsKey [StudyTermsName =. name, StudyTermsShorthand =. short, StudyTermsDefaultDegree =. guard degreeExists *> degree, StudyTermsDefaultType =. sType]

          forM_ schools $ \ssh -> void . insertUnique $ SchoolTerms ssh studyTermsKey
          deleteWhere [SchoolTermsTerms ==. studyTermsKey, SchoolTermsSchool /<-. Set.toList schools, SchoolTermsSchool <-. toListOf (folded . _entityKey) userSchools]

          forM_ parents $ void . insertUnique . StudySubTerms studyTermsKey
          deleteWhere [StudySubTermsChild ==. studyTermsKey, StudySubTermsParent /<-. Set.toList parents]
    formResult studyTermsResult' $ \res -> do
      void . runDB $ Map.traverseWithKey updateStudyTerms res
      addMessageI Success MsgStudyTermsChangeSuccess
      redirect $ AdminFeaturesR :#: ("admin-studyterms-table-wrapper" :: Text)

    siteLayoutMsg MsgAdminFeaturesHeading $ do
      setTitleI MsgAdminFeaturesHeading
      $(widgetFile "adminFeatures")
  where
    textInputCell :: Ord i
                  => Lens' a (Maybe Text)
                  -> Getter (DBRow r) (Maybe Text)
                  -> Getter (DBRow r) i
                  -> DBRow r 
                  -> DBCell (MForm (HandlerFor UniWorX)) (FormResult (DBFormResult i a (DBRow r)))
    textInputCell lensRes lensDefault lensIndex = formCell id (return . view lensIndex)
      (\row _mkUnique -> bimap (fmap $ set lensRes . assertM (not . Text.null)) fvInput
        <$> mopt (textField & cfStrip) "" (Just $ row ^. lensDefault)
      )
  
    checkboxCell :: Ord i
                 => Lens' a Bool
                 -> Getter (DBRow r) Bool
                 -> Getter (DBRow r) i
                 -> DBRow r 
                 -> DBCell (MForm (HandlerFor UniWorX)) (FormResult (DBFormResult i a (DBRow r))) 
    checkboxCell lensRes lensDefault lensIndex = formCell id (return . view lensIndex)
      ( \row _mkUnique -> bimap (fmap $ set lensRes) fvInput
        <$> mpopt checkBoxField "" (Just $ row ^. lensDefault)
      )

    -- termKeyCell :: Ord i
    --             => Lens' a (Maybe StudyTermsId)
    --             -> Getter (DBRow r) (Maybe StudyTermsId)
    --             -> Getter (DBRow r) i
    --             -> DBRow r
    --             -> DBCell (MForm (HandlerFor UniWorX)) (FormResult (DBFormResult i a (DBRow r)))
    -- termKeyCell lensRes lensDefault lensIndex = formCell id (return . view lensIndex)
    --   ( \row _mkUnique -> (\(res, fieldView) -> (set lensRes <$> res, fvInput fieldView))
    --     <$> mopt (intField & isoField (from _StudyTermsId)) "" (Just $ row ^. lensDefault)
    --   )

    parentsCell :: Ord i
                => Lens' a (Set StudyTermsId)
                -> Getter (DBRow r) (Set StudyTermsId)
                -> Getter (DBRow r) i
                -> DBRow r
                -> DBCell (MForm (HandlerFor UniWorX)) (FormResult (DBFormResult i a (DBRow r)))
    parentsCell lensRes lensDefault lensIndex = formCell id (return . view lensIndex)
      ( \row mkUnique -> bimap (fmap $ set lensRes . Set.fromList) fvInput
        <$> massInputList
              (intField & isoField (from _StudyTermsId))
              (const "")
              (Just . SomeRoute . (AdminFeaturesR :#:))
              (mkUnique ("parents" :: Text))
              ""
              False
              (Just . Set.toList $ row ^. lensDefault)
              mempty
      )

    degreeCell :: Ord i
               => Lens' a (Maybe StudyDegreeId)
               -> Getter (DBRow r) (Maybe StudyDegreeId)
               -> Getter (DBRow r) i
               -> DBRow r
               -> DBCell (MForm (HandlerFor UniWorX)) (FormResult (DBFormResult i a (DBRow r)))
    degreeCell lensRes lensDefault lensIndex = formCell id (return . view lensIndex)
      ( \row _mkUnique -> bimap (fmap $ set lensRes) fvInput
        <$> mopt degreeField "" (Just $ row ^. lensDefault)
      )
  
    fieldTypeCell :: Ord i
                  => Lens' a (Maybe StudyFieldType)
                  -> Getter (DBRow r) (Maybe StudyFieldType)
                  -> Getter (DBRow r) i
                  -> DBRow r
                  -> DBCell (MForm (HandlerFor UniWorX)) (FormResult (DBFormResult i a (DBRow r)))
    fieldTypeCell lensRes lensDefault lensIndex = formCell id (return . view lensIndex)
      ( \row _mkUnique -> bimap (fmap $ set lensRes) fvInput
        <$> mopt (selectField optionsFinite) "" (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) (_dbrOutput . _entityKey))
            , sortable (Just "short") (i18nCell MsgDegreeShort) (textInputCell _2 (_dbrOutput . _entityVal . _studyDegreeShorthand) (_dbrOutput . _entityKey))
            , 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"]
                        & defaultPagesize PagesizeAll
                        & defaultSorting [SortAscBy "key"]
          dbtCsvEncode  = noCsvEncode
          dbtCsvDecode  = Nothing
      in dbTable psValidator DBTable{..}

    mkStudytermsTable :: Set StudyTermsId -> Set StudyTermsId -> Set (Entity School) -> DB (FormResult (DBFormResult StudyTermsId (Maybe Text, Maybe Text, Set SchoolId, Set StudyTermsId, Maybe StudyDegreeId, Maybe StudyFieldType) (DBRow (Entity StudyTerms, Set (Entity StudyTerms), Set SchoolId))), Widget)
    mkStudytermsTable newKeys badKeys schools =
      let dbtIdent      = "admin-studyterms" :: Text
          dbtStyle      = def
          dbtSQLQuery   :: E.SqlExpr (Entity StudyTerms) -> E.SqlQuery (E.SqlExpr (Entity StudyTerms))
          dbtSQLQuery = return
          dbtRowKey = (E.^. StudyTermsKey)
          dbtProj field@(view _dbrOutput -> Entity fId _) = do
            fieldSchools <- fmap (setOf $ folded . _Value) . lift . E.select . E.from $ \school -> do
              E.where_ . E.exists . E.from $ \schoolTerms ->
                E.where_ $ schoolTerms E.^. SchoolTermsSchool E.==. school E.^. SchoolId
                     E.&&. schoolTerms E.^. SchoolTermsTerms  E.==. E.val fId 
              E.where_ $ school E.^. SchoolShorthand `E.in_` E.valList (toListOf (folded . _entityKey . _SchoolId) schools)
              return $ school E.^. SchoolId
            fieldParents <- fmap (setOf folded) . lift . E.select . E.from $ \terms -> do
              E.where_ . E.exists . E.from $ \subTerms ->
                E.where_ $ subTerms E.^. StudySubTermsChild E.==. E.val fId
                     E.&&. subTerms E.^. StudySubTermsParent E.==. terms E.^. StudyTermsId
              return terms
            return $ field & _dbrOutput %~ (, fieldParents, fieldSchools)
          dbtColonnade  = formColonnade $ mconcat
            [ sortable (Just "key")   (i18nCell MsgGenericKey)         (maybe mempty numCell . preview (_dbrOutput . _1 . _entityVal . _studyTermsKey))
            , sortable Nothing (i18nCell MsgStudySubTermsParentKey) (parentsCell _4 (_dbrOutput . _2 . to (Set.map entityKey)) _dbrKey')
            , sortable (Just "isnew") (i18nCell MsgGenericIsNew)       (isNewCell . flip Set.member newKeys . view (_dbrOutput . _1 . _entityKey))
            , sortable (Just "isbad") (i18nCell MsgGenericHasConflict) (isBadCell . flip Set.member badKeys . view (_dbrOutput . _1 . _entityKey))
            , sortable (Just "name")  (i18nCell MsgStudyTermsName)     (textInputCell _1 (_dbrOutput . _1 . _entityVal . _studyTermsName) _dbrKey')
            , sortable (Just "short") (i18nCell MsgStudyTermsShort)    (textInputCell _2 (_dbrOutput . _1 . _entityVal . _studyTermsShorthand) _dbrKey')
            , sortable (Just "degree") (i18nCell MsgStudyTermsDefaultDegree)    (degreeCell _5 (_dbrOutput . _1 . _entityVal . _studyTermsDefaultDegree) _dbrKey')
            , sortable (Just "field-type") (i18nCell MsgStudyTermsDefaultFieldType)    (fieldTypeCell _6 (_dbrOutput . _1 . _entityVal . _studyTermsDefaultType) _dbrKey')
            , flip foldMap schools $ \(Entity ssh School{schoolName}) ->
                sortable Nothing (cell $ toWidget schoolName) (checkboxCell (_3 . at ssh . _Maybe) (_dbrOutput . _3 . at ssh . _Maybe) _dbrKey')
            , dbRow
            ]
          dbtSorting    = Map.fromList
            [ ("key"   , SortColumn $ queryField >>> (E.^. StudyTermsKey))
            -- , ("parent", SortColumn $ \t -> querySubField t E.?. StudySubTermsParent)
            , ("isnew" , SortColumn $ queryField >>> (E.^. StudyTermsKey) >>> (`E.in_` E.valList (unStudyTermsKey <$> Set.toList newKeys))
              )
            , ("isbad" , SortColumn $ queryField >>> (E.^. StudyTermsKey) >>> (`E.in_` E.valList (unStudyTermsKey <$> Set.toList badKeys))
              )
            , ("name"  , SortColumn $ queryField >>> (E.^. StudyTermsName))
            , ("short" , SortColumn $ queryField >>> (E.^. StudyTermsShorthand))
            , ("degree" , SortColumn $ queryField >>> (E.^. StudyTermsDefaultDegree))
            , ("field-type" , SortColumn $ queryField >>> (E.^. StudyTermsDefaultType))
            ]
          dbtFilter     = mempty
          dbtFilterUI   = mempty
          dbtParams     = def { dbParamsFormAction = Just . SomeRoute $ AdminFeaturesR :#: ("admin-studyterms-table-wrapper" :: Text)
                              }
          psValidator   = def
                        & defaultPagesize PagesizeAll
                        & defaultSorting [SortAscBy "isnew", SortAscBy "isbad", SortAscBy "key"]
          dbtCsvEncode  = noCsvEncode
          dbtCsvDecode  = Nothing

          queryField = id
          _dbrKey' :: Getter (DBRow (Entity StudyTerms, _, _)) StudyTermsId
          _dbrKey' = _dbrOutput . _1 . _entityKey
      in dbTable psValidator DBTable{..}

    mkCandidateTable =
      let dbtIdent      = "admin-termcandidate" :: Text
          dbtStyle      = def { dbsFilterLayout = defaultDBSFilterLayout }
          dbtSQLQuery   :: E.SqlExpr (Entity StudyTermNameCandidate) -> E.SqlQuery ( E.SqlExpr (Entity StudyTermNameCandidate))
          dbtSQLQuery   = return
          dbtRowKey     = (E.^. StudyTermNameCandidateId)
          dbtProj       = return
          dbtColonnade  = dbColonnade $ mconcat
            [ dbRow
            , sortable (Just "key")       (i18nCell MsgStudyTermsKey)           (numCell  . view (_dbrOutput . _entityVal . _studyTermNameCandidateKey))
            , sortable (Just "name")      (i18nCell MsgStudyTermsName)          (textCell . view (_dbrOutput . _entityVal . _studyTermNameCandidateName))
            , sortable (Just "incidence") (i18nCell MsgStudyCandidateIncidence) (pathPieceCell . view (_dbrOutput . _entityVal . _studyTermNameCandidateIncidence))
            ]
          dbtSorting    = Map.fromList
            [ ("key"      , SortColumn (E.^. StudyTermNameCandidateKey))
            , ("name"     , SortColumn (E.^. StudyTermNameCandidateName))
            , ("incidence", SortColumn (E.^. StudyTermNameCandidateIncidence))
            ]
          dbtFilter     = Map.fromList
            [ ("key",       FilterColumn $ mkExactFilter    (E.^. StudyTermNameCandidateKey))
            , ("name",      FilterColumn $ mkContainsFilter (E.^. StudyTermNameCandidateName))
            , ("incidence", FilterColumn $ mkExactFilter    (E.^. StudyTermNameCandidateIncidence)) -- contains filter desired, but impossible here
            ]
          dbtFilterUI mPrev = mconcat
            [ prismAForm (singletonFilter "key" . maybePrism _PathPiece) mPrev $ aopt (intField :: Field _ Int) (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{..}

    mkParentCandidateTable =
      let dbtIdent      = "admin-termparentcandidate" :: Text
          dbtStyle      = def
          dbtSQLQuery   ::                   E.SqlExpr (Entity StudySubTermParentCandidate)
                           `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity StudyTerms))
                           `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity StudyTerms))
                        -> E.SqlQuery ( E.SqlExpr (Entity StudySubTermParentCandidate)
                                      , E.SqlExpr (Maybe (Entity StudyTerms))
                                      , E.SqlExpr (Maybe (Entity StudyTerms))
                                      )
          dbtSQLQuery (candidate `E.LeftOuterJoin` parent `E.LeftOuterJoin` child) = do
            E.on $ child E.?. StudyTermsKey E.==. E.just (candidate E.^. StudySubTermParentCandidateKey)
            E.on $ parent E.?. StudyTermsKey E.==. E.just (candidate E.^. StudySubTermParentCandidateParent)
            return (candidate, parent, child)
          dbtRowKey = queryCandidate >>> (E.^. StudySubTermParentCandidateId)
          dbtProj       = return
          dbtColonnade  = dbColonnade $ mconcat
            [ dbRow
            , sortable (Just "child") (i18nCell MsgStudySubTermsChildKey)   (numCell . view (_dbrOutput . _1 . _entityVal . _studySubTermParentCandidateKey))
            , sortable (Just "child-name") (i18nCell MsgStudySubTermsChildName)  (maybe mempty i18nCell . preview (_dbrOutput . _3 . _Just . _entityVal . _studyTermsName . _Just))
            , sortable (Just "parent") (i18nCell MsgStudySubTermsParentKey)  (numCell . view (_dbrOutput . _1 . _entityVal . _studySubTermParentCandidateParent))
            , sortable (Just "parent-name") (i18nCell MsgStudySubTermsParentName) (maybe mempty i18nCell . preview (_dbrOutput . _2 . _Just . _entityVal . _studyTermsName . _Just))
            , sortable (Just "incidence") (i18nCell MsgStudyCandidateIncidence) (pathPieceCell . view (_dbrOutput . _1 . _entityVal . _studySubTermParentCandidateIncidence))
            ]
          dbtSorting    = Map.fromList
            [ ("child"    , SortColumn $ queryCandidate >>> (E.^. StudySubTermParentCandidateKey))
            , ("child-name", SortColumn $ queryChild >>> (E.?. StudyTermsName) >>> E.joinV)
            , ("parent"   , SortColumn $ queryCandidate >>> (E.^. StudySubTermParentCandidateParent))
            , ("parent-name", SortColumn $ queryParent >>> (E.?. StudyTermsName) >>> E.joinV)
            , ("incidence", SortColumn $ queryCandidate >>> (E.^. StudySubTermParentCandidateIncidence))
            ]
          dbtFilter     = mempty
          dbtFilterUI   = mempty
          dbtParams     = def
          psValidator   = def
                        & defaultSorting [SortAscBy "child", SortAscBy "incidence", SortAscBy "parent"]
          dbtCsvEncode  = noCsvEncode
          dbtCsvDecode  = Nothing

          queryCandidate (c `E.LeftOuterJoin` _ `E.LeftOuterJoin` _) = c
          queryParent (_ `E.LeftOuterJoin` p `E.LeftOuterJoin` _) = p
          queryChild (_ `E.LeftOuterJoin` _ `E.LeftOuterJoin` c) = c
      in dbTable psValidator DBTable{..}

    mkStandaloneCandidateTable :: DB (FormResult (DBFormResult StudyTermStandaloneCandidateId (Maybe StudyDegreeId, Maybe StudyFieldType) (DBRow (Entity StudyTermStandaloneCandidate, Maybe (Entity StudyTerms)))), Widget)
    mkStandaloneCandidateTable =
      let dbtIdent      = "admin-termstandalonecandidate" :: Text
          dbtStyle      = def
          dbtSQLQuery   ::                   E.SqlExpr (Entity StudyTermStandaloneCandidate)
                           `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity StudyTerms))
                        -> E.SqlQuery ( E.SqlExpr (Entity StudyTermStandaloneCandidate)
                                      , E.SqlExpr (Maybe (Entity StudyTerms))
                                      )
          dbtSQLQuery (candidate `E.LeftOuterJoin` sterm) = do
            E.on $ sterm E.?. StudyTermsKey E.==. E.just (candidate E.^. StudyTermStandaloneCandidateKey)
            return (candidate, sterm)
          dbtRowKey = queryCandidate >>> (E.^. StudyTermStandaloneCandidateId)
          dbtProj       = return
          dbtColonnade  = formColonnade $ mconcat
            [ dbRow
            , sortable (Just "key") (i18nCell MsgStudyTermsKey) (numCell . view (_dbrOutput . _1 . _entityVal . _studyTermStandaloneCandidateKey))
            , sortable (Just "name") (i18nCell MsgStudyTermsName) (maybe mempty i18nCell . preview (_dbrOutput . _2 . _Just . _entityVal . _studyTermsName . _Just))
            , sortable (Just "incidence") (i18nCell MsgStudyCandidateIncidence) (pathPieceCell . view (_dbrOutput . _1 . _entityVal . _studyTermStandaloneCandidateIncidence))
            , sortable Nothing (i18nCell MsgStudyTermsDefaultDegree) (degreeCell _1 (pre $ _dbrOutput . _2 . _Just . _studyTermsDefaultDegree . _Just) _dbrKey')
            , sortable Nothing (i18nCell MsgStudyTermsDefaultFieldType) (fieldTypeCell _2 (pre $ _dbrOutput . _2 . _Just . _studyTermsDefaultType . _Just) _dbrKey')
            ]
          dbtSorting    = Map.fromList
            [ ("key"      , SortColumn $ queryCandidate >>> (E.^. StudyTermStandaloneCandidateKey))
            , ("name"     , SortColumn $ queryTerm      >>> (E.?. StudyTermsName) >>> E.joinV)
            , ("incidence", SortColumn $ queryCandidate >>> (E.^. StudyTermStandaloneCandidateIncidence))
            ]
          dbtFilter     = mempty
          dbtFilterUI   = mempty
          dbtParams     = def { dbParamsFormAction = Just . SomeRoute $ AdminFeaturesR :#: ("admin-studyterms-table-wrapper" :: Text)
                              }
          psValidator   = def
                        & defaultSorting [SortAscBy "key", SortAscBy "incidence"]
          dbtCsvEncode  = noCsvEncode
          dbtCsvDecode  = Nothing

          queryCandidate (c `E.LeftOuterJoin` _) = c
          queryTerm (_ `E.LeftOuterJoin` t) = t
          _dbrKey' :: Getter (DBRow (Entity StudyTermStandaloneCandidate, _)) StudyTermStandaloneCandidateId
          _dbrKey' = _dbrOutput . _1 . _entityKey
      in dbTable psValidator DBTable{..}