chore(firm): add firm-all filters and code cleaning

messages/uniworx/utils/table_column/de-de-formal.msg

@@ -75,6 +75,7 @@ TableExamOfficeLabelStatus: Label-Farbe
 TableExamOfficeLabelPriority: Label-Priorität
 TableQualifications: Qualifikationen
 TableCompany: Firma
+TableCompanyFilter: Firma oder Nummer
 TableCompanyShort: Firmenkürzel
 TableCompanies: Firmen
 TableCompanyNo: Firmennummer

messages/uniworx/utils/table_column/en-eu.msg

@@ -75,6 +75,7 @@ TableExamOfficeLabelStatus: Label colour
 TableExamOfficeLabelPriority: Label priority
 TableQualifications: Qualifications
 TableCompany: Company
+TableCompanyFilter: Company/Nr
 TableCompanyShort: Company shorthand
 TableCompanies: Companies
 TableCompanyNo: Company number

routes

@@ -113,7 +113,7 @@
 /for/#CryptoUUIDUser/user         ForProfileR       GET POST    !supervisor !self
 /for/#CryptoUUIDUser/user/profile ForProfileDataR   GET         !supervisor !self
 
-/firm                           FirmAllR            GET
+/firm                           FirmAllR            GET POST
 /firm/#CompanyShorthand         FirmR               GET POST
 /firm/#CompanyShorthand/users   FirmUsersR          GET POST
 /firm/#CompanyShorthand/supers  FirmSupersR         GET POST

src/Database/Esqueleto/Utils.hs

@@ -46,6 +46,7 @@ module Database.Esqueleto.Utils
   , subSelectCountDistinct
   , selectCountRows, selectCountDistinct
   , selectMaybe
+  , num2text
   , day, day', dayMaybe, interval, diffDays, diffTimes
   , exprLift
   , explicitUnsafeCoerceSqlExprValue
@@ -656,10 +657,14 @@ selectCountDistinct q = do
 selectMaybe :: (E.SqlSelect a r, MonadIO m) => E.SqlQuery a -> E.SqlReadT m (Maybe r)
 selectMaybe = fmap listToMaybe . E.select . (<* E.limit 1)
 
+-- | cast numeric type to text, which is safe and allows for an inefficient but safe comparison of numbers stored as text and numbers
+num2text :: Num n => E.SqlExpr (E.Value n) -> E.SqlExpr (E.Value Text)
+num2text = E.unsafeSqlCastAs "text"
 
 day :: E.SqlExpr (E.Value UTCTime) -> E.SqlExpr (E.Value Day)
 day = E.unsafeSqlCastAs "date"
 
+-- | cast text to day, truly unsafe
 day' :: E.SqlExpr (E.Value Text) -> E.SqlExpr (E.Value Day)
 day' = E.unsafeSqlCastAs "date"
 

src/Handler/Firm.hs

@@ -19,11 +19,11 @@ import Import
 -- import Jobs
 import Handler.Utils
 
--- import qualified Data.Set as Set
+import qualified Data.Set as Set
 import qualified Data.Map as Map
 -- import qualified Data.Csv as Csv
 -- import qualified Data.Text as T
--- import qualified Data.CaseInsensitive as CI
+import qualified Data.CaseInsensitive as CI
 -- import qualified Data.Conduit.List as C
 -- import Database.Persist.Sql (updateWhereCount)
 import           Database.Esqueleto.Experimental ((:&)(..))
@@ -35,8 +35,8 @@ import Database.Esqueleto.Utils.TH
 
 
 -- avoids repetition of local definitions
--- single :: (k,a) -> Map k a
+single :: (k,a) -> Map k a
--- single = uncurry Map.singleton
+single = uncurry Map.singleton
 
 
 getFirmR,  postFirmR :: CompanyShorthand -> Handler Html
@@ -106,6 +106,10 @@ data FirmAllActionData = FirmAllActNotifyData
                    | FirmAllActResetSupervisionData
   deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
 
+-- just in case for future extensions
+type AllCompanyTableExpr = E.SqlExpr (Entity Company)
+queryCompany :: AllCompanyTableExpr -> E.SqlExpr (Entity Company)
+queryCompany = id
 
 type AllCompanyTableData = DBRow (Entity Company, E.Value Word64, E.Value Word64, E.Value Word64, E.Value Word64, E.Value Word64, E.Value Word64)
 resultAllCompanyEntity          :: Lens' AllCompanyTableData (Entity Company)
@@ -184,14 +188,7 @@ firmCountActiveReroutes' cmpy = E.subSelectCount $ do
       E.&&.  usrSuper E.^. UserSupervisorRerouteNotifications
 
 
-mkFirmAllTable ::
+mkFirmAllTable :: Bool -> UserId -> DB (FormResult (FirmAllActionData, Set CompanyId), Widget)
-  -- ( Functor h, ToSortable h
-  -- , AsCornice h p FirmAllActionData
-  --     (DBCell (MForm Handler)
-  --       (FormResult (First FirmAllActionData, DBFormResult CompanyId Bool FirmAllActionData))
-  --     ) cols
-  -- ) =>
-  Bool -> UserId -> DB (FormResult (FirmAllActionData, Set CompanyId), Widget)
 mkFirmAllTable isAdmin uid = do
   -- now <- liftIO getCurrentTime
   let
@@ -214,48 +211,14 @@ mkFirmAllTable isAdmin uid = do
         dbtProj = dbtProjId
         dbtColonnade = formColonnade $
           mconcat
-          [ -- if not isAdmin then mempty else -- guardOnM idAdmin $
+          [ if not isAdmin then mempty else -- guardOnM idAdmin $
-            {- hole :: (x -> f x) -> r -> f r
-            (FormResult
-                (DBFormResult (Key Company) Bool (DBRow (Entity Company, E.Value Word64, E.Value Word64, E.Value Word64, E.Value Word64, E.Value Word64, E.Value Word64))
-                )
-            -> f (FormResult
-                      (DBFormResult
-                         (Key Company)
-                         Bool
-                         (DBRow
-                            (Entity Company, E.Value Word64, E.Value Word64, E.Value Word64,
-                             E.Value Word64, E.Value Word64, E.Value Word64)))))
-             -> FormResult
-                  (First FirmAllActionData,
-                   DBFormResult CompanyId Bool FirmAllActionData)
-             -> f (FormResult
-                     (First FirmAllActionData,
-                      DBFormResult CompanyId Bool FirmAllActionData))
-                      
-              -------
-              
-                  (    (FormResult (DBFormResult (Key Company) Bool AllCompanyTableData))
-                  -> f (FormResult (DBFormResult (Key Company) Bool AllCompanyTableData))
-                  )
-                  ->   (FormResult (First FirmAllActionData, DBFormResult CompanyId Bool FirmAllActionData))
-                  -> f (FormResult (First FirmAllActionData, DBFormResult CompanyId Bool FirmAllActionData))
-                      
-              ------
-                Lens' (FormResult (DBFormResult (Key Company) Bool AllCompanyTableData)) 
-                      (FormResult (First FirmAllActionData, DBFormResult CompanyId Bool FirmAllActionData))
-              ------
-                Lens' (FormResult                           (Map (Key Company) (AllCompanyTableData,Bool -> Bool)))
-                      (FormResult (First FirmAllActionData, (Map (CompanyId)   (FirmAllActionData  ,Bool -> Bool))))
-              -- applying bringt uns unter das FormResult
-            -}
             dbSelect (applying _2) id (return . view (resultAllCompanyEntity . _entityKey))
-          , sortable (Just "name")        (i18nCell MsgTableCompany) $ \(view resultAllCompany -> firm) ->
+          , sortable (Just "name")          (i18nCell MsgTableCompany)                 $ \(view resultAllCompany -> firm) ->
               anchorCell (FirmR $ companyShorthand firm) . toWgt $ companyName firm
-          , sortable (Just "short")       (i18nCell MsgTableCompanyShort) $ \(view resultAllCompany -> firm) ->
+          , sortable (Just "short")         (i18nCell MsgTableCompanyShort)            $ \(view resultAllCompany -> firm) ->
               let fsh = companyShorthand firm
               in  anchorCell (FirmR fsh) $ toWgt fsh
-          , sortable (Just "avsnr")       (i18nCell MsgTableCompanyNo) $ \(view resultAllCompany -> firm) ->
+          , sortable (Just "avsnr")         (i18nCell MsgTableCompanyNo)               $ \(view resultAllCompany -> firm) ->
               anchorCell (FirmR $ companyShorthand firm) $ toWgt $ companyAvsId firm
           , sortable (Just "users")         (i18nCell MsgTableCompanyNrUsers)          $ \(view resultAllCompanyUsers           -> nr) -> wgtCell $ word2widget nr
           , sortable (Just "supervisors")   (i18nCell MsgTableCompanyNrSupersDefault)  $ \(view resultAllCompanySupervisors     -> nr) -> wgtCell $ word2widget nr
@@ -276,10 +239,21 @@ mkFirmAllTable isAdmin uid = do
           , singletonMap "reroute-all"  $ SortColumn firmCountActiveReroutes'
           ]
         dbtFilter = mconcat
-          [
+          [ single $ fltrCompanyNameNr queryCompany
+          , single ("is-supervisor", FilterColumn . E.mkExistsFilter $ \row (criterion :: Text) -> do              
+              (usr :& usrCmp) <- E.from $ E.table @User
+                `E.innerJoin` E.table @UserCompany
+                `E.on` (\(usr :& usrCmp) -> usr E.^. UserId E.==. usrCmp E.^. UserCompanyUser)              
+              E.where_ $ usrCmp E.^. UserCompanyCompany E.==. queryCompany row E.^. CompanyId
+                E.&&. (  (usr E.^. UserDisplayName  `E.hasInfix` E.val criterion)
+                  E.||.  (usr E.^. UserDisplayEmail `E.hasInfix` E.val (CI.mk criterion))
+                  E.||.  (usr E.^. UserSurname      `E.hasInfix` E.val criterion)
+                )
+            )
           ]
-        dbtFilterUI = mconcat
+        dbtFilterUI mPrev = mconcat        
-          [
+          [ fltrCompanyNameNrUI mPrev
+          , prismAForm (singletonFilter "is-supervisor") mPrev $ aopt textField (fslI MsgTableSupervisor)
           ]
         dbtStyle =  def -- { dbsFilterLayout = defaultDBSFilterLayout }
         acts :: Map FirmAllAction (AForm Handler FirmAllActionData)
@@ -293,8 +267,7 @@ mkFirmAllTable isAdmin uid = do
           , dbParamsFormAttrs  = []
           , dbParamsFormSubmit = FormSubmit
           , dbParamsFormAdditional
-              = renderAForm FormStandard
+              = renderAForm FormStandard $ (, mempty) . First . Just
-                    $  (, mempty) . First . Just
                   <$> multiActionA acts (fslI MsgTableAction) Nothing
           , dbParamsFormEvaluate = liftHandler . runFormPost
           , dbParamsFormResult   = id
@@ -313,7 +286,7 @@ mkFirmAllTable isAdmin uid = do
         let cmpSet = Map.keysSet . Map.filter id $ getDBFormResult (const False) cmpMap
         return (act, cmpSet)
 
-    -- resultDBTableValidator :: PSValidator (MForm Handler) (FormResult (First FirmAllActionData, DBFormResult CompanyId Bool FirmAllActionData)) -- This type signature is not optional!
+    -- resultDBTableValidator :: PSValidator (MForm Handler) (FormResult (First FirmAllActionData, DBFormResult CompanyId Bool FirmAllActionData))
     resultDBTableValidator = def
       & defaultSorting  [SortAscBy "short"]
   over _1 postprocess <$> dbTable resultDBTableValidator resultDBTable

src/Handler/Qualification.hs

@@ -504,8 +504,7 @@ mkQualificationTable isAdmin (Entity qid quali) acts cols psValidator = do
       , dbParamsFormAttrs  = []
       , dbParamsFormSubmit = FormSubmit
       , dbParamsFormAdditional
-          = renderAForm FormStandard
+          = renderAForm FormStandard $ (, mempty) . First . Just
-                $  (, mempty) . First . Just
               <$> multiActionA acts (fslI MsgTableAction) Nothing
       , dbParamsFormEvaluate = liftHandler . runFormPost
       , dbParamsFormResult   = id

src/Handler/Utils/Table/Columns.hs

@@ -753,6 +753,25 @@ sortUserCompany queryUser = ( "user-company"
                 return (comp E.^. CompanyName)
             ))
 
+-- | Search companies by name, shorthand oder AVS nr
+fltrCompanyNameNr :: (IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bool)), IsString d)
+   => (a -> E.SqlExpr (Entity Company))
+   -> (d, FilterColumn t fs)
+fltrCompanyNameNr query = ( "company-name-number", FilterColumn $ anyFilter
+    [ mkContainsFilterWithCommaPlus CI.mk $ query >>> (E.^. CompanyName)
+    , mkContainsFilterWithCommaPlus CI.mk $ query >>> (E.^. CompanyShorthand)
+    , mkContainsFilterWithCommaPlus id    $ query >>> (E.num2text . (E.^. CompanyAvsId))
+    ]
+  )
+
+
+fltrCompanyNameNrUI :: Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text])
+fltrCompanyNameNrUI = fltrCompanyNameNrHdrUI MsgTableCompanyFilter
+
+fltrCompanyNameNrHdrUI :: (RenderMessage UniWorX msg) => msg -> Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text])
+fltrCompanyNameNrHdrUI msg mPrev =
+  prismAForm (singletonFilter "company-name-number") mPrev $ aopt textField (fslI msg & setTooltip MsgTableFilterCommaPlus)
+
 
 ----------------------------
 -- Colonnade manipulation --