chore(problem): towards admin problem filtering

src/Handler/Admin.hs

@@ -9,8 +9,9 @@ module Handler.Admin
 import Import
 
 -- import Data.Either
-import qualified Data.Set as Set
+import qualified Data.Set  as Set
-import qualified Data.Map as Map
+import qualified Data.Map  as Map
+import qualified Data.Text as Text
 -- import qualified Data.Text.Lazy.Encoding as LBS
 
 -- import qualified Control.Monad.Catch as Catch
@@ -326,7 +327,7 @@ mkProblemLogTable = over _1 postprocess <$> dbTable validator DBTable{..}
                     EL.on (solver E.?. UserId E.==. problem E.^. ProblemLogSolver)
                     return (problem, solver, usr)
     dbtRowKey = queryProblem >>> (E.^. ProblemLogId)
-    dbtProj = dbtProjId
+    dbtProj = dbtProjFilteredPostId
     dbtColonnade = formColonnade $ mconcat
       [ dbSelect (applying _2) id $ return . view (resultProblem . _entityKey)
       , sortable (Just "time")    (i18nCell MsgAdminProblemCreated) $ \(   view $ resultProblem . _entityVal . _problemLogTime   -> t) ->           dateTimeCell t
@@ -349,9 +350,15 @@ mkProblemLogTable = over _1 postprocess <$> dbTable validator DBTable{..}
     dbtFilter = mconcat
       [ single ("user"    , FilterColumn . E.mkContainsFilterWithCommaPlus Just $ views (to queryUser)   (E.?. UserDisplayName))
       , single ("solver"  , FilterColumn . E.mkContainsFilterWithCommaPlus Just $ views (to querySolver) (E.?. UserDisplayName))
-      , single ("problem" , FilterColumn . E.mkContainsFilter  $ views (to queryProblem) ((E.->>. "problem").(E.^. ProblemLogInfo)))
+      -- , single ("problem" , FilterColumn . E.mkContainsFilter  $ views (to queryProblem) ((E.->>. "problem").(E.^. ProblemLogInfo))) -- not stored in plaintext!
       , single ("company" , FilterColumn . E.mkContainsFilter  $ views (to queryProblem) ((E.->>. "company").(E.^. ProblemLogInfo)))
       , single ("solved"  , FilterColumn . E.mkExactFilterLast $ views (to queryProblem) (E.isJust . (E.^. ProblemLogSolved)))
+      , single ("problem" , mkFilterProjectedPost $ \(getLast -> criterion) dbr ->
+          ifNothingM criterion True $ \(crit::Text) -> do
+            let problem = dbr ^. resultProblem . _entityVal . _problemLogAdminProblem
+            protxt <- adminProblem2Text problem
+            return $ crit `Text.isInfixOf` protxt
+        )
       ]
     dbtFilterUI mPrev = mconcat
       [ prismAForm (singletonFilter "user"    . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField)                        (fslI MsgAdminProblemUser   & setTooltip MsgTableFilterCommaPlus)

src/Handler/Utils.hs

@@ -181,6 +181,27 @@ adminProblemCell AdminProblemNewlyUnsupervised{adminProblemCompanyNew}
 adminProblemCell AdminProblemUnknown{adminProblemText}
   = textCell $ "Problem: " <> adminProblemText
 
+adminProblem2Text :: AdminProblem -> DB Text
+adminProblem2Text adprob = do
+  mr <- getMessageRender
+  case adprob of
+    AdminProblemNewCompany{}
+      -> return $ mr MsgAdminProblemNewCompany
+    AdminProblemSupervisorNewCompany{adminProblemSupervisorReroute} -- , adminProblemCompanyNew} -- TODO
+      -> return $ mr (MsgAdminProblemSupervisorNewCompany adminProblemSupervisorReroute) -- TODO <> companyIdCell adminProblemCompanyNew
+    AdminProblemSupervisorLeftCompany{adminProblemSupervisorReroute}
+      -> return $ mr (MsgAdminProblemSupervisorLeftCompany adminProblemSupervisorReroute)
+    AdminProblemCompanySuperiorChange{adminProblemUserOld=Nothing}
+      -> return $ mr MsgAdminProblemCompanySuperiorChange
+    -- TODO AdminProblemCompanySuperiorChange{adminProblemUserOld=Just uid}
+    --   = i18nCell MsgAdminProblemCompanySuperiorChange <> spacerCell <> i18nCell MsgAdminProblemCompanySuperiorPrevious <> anchorCellM (AdminUserR <$> encrypt uid) (userIdWidget uid)
+    AdminProblemNewlyUnsupervised{} -- TODO adminProblemCompanyNew}
+      -> mr MsgAdminProblemNewlyUnsupervised -- TODO <> companyIdCell adminProblemCompanyNew
+    AdminProblemUnknown{adminProblemText}
+      -> return $ "Problem: " <> adminProblemText
+    _ -> return "TODO -- CONTINUE HERE"
+
+
 company2msg :: CompanyId -> SomeMessage UniWorX
 company2msg = text2message . ciOriginal . unCompanyKey