fix(avs): steps towards #164
- link avs nr to status on profile page - link companies on profile page - swap icons for isAutomatic - improve jsonWidget number display for integers and small floats
This commit is contained in:
parent
6acfd849ae
commit
aa1d230e49
@ -605,10 +605,8 @@ makeProfileData usrEnt@(Entity uid User{..}) = do
|
|||||||
E.on $ usrComp E.^. UserCompanyCompany E.==. comp E.^. CompanyId
|
E.on $ usrComp E.^. UserCompanyCompany E.==. comp E.^. CompanyId
|
||||||
E.where_ $ usrComp E.^. UserCompanyUser E.==. E.val uid
|
E.where_ $ usrComp E.^. UserCompanyUser E.==. E.val uid
|
||||||
E.orderBy [E.asc (comp E.^. CompanyName)] -- E.desc (usrComp E.^. UserCompanySupervisor),
|
E.orderBy [E.asc (comp E.^. CompanyName)] -- E.desc (usrComp E.^. UserCompanySupervisor),
|
||||||
return (comp E.^. CompanyName, usrComp E.^. UserCompanySupervisor)
|
return (comp E.^. CompanyShorthand, comp E.^. CompanyName, usrComp E.^. UserCompanySupervisor)
|
||||||
let companies = intersperse (text2markup ", ") $
|
let companies = intersperse (text2widget ", ") $ companyWidget . $(E.unValueN 3) <$> companies'
|
||||||
(\(E.Value cmpName, E.Value cmpSpr) -> text2markup (CI.original cmpName) <> bool mempty icnSuper cmpSpr) <$> companies'
|
|
||||||
icnSuper = text2markup " " <> icon IconSupervisor
|
|
||||||
supervisors' <- E.select $ E.from $ \(spvr `E.InnerJoin` usrSpvr) -> do
|
supervisors' <- E.select $ E.from $ \(spvr `E.InnerJoin` usrSpvr) -> do
|
||||||
E.on $ spvr E.^. UserSupervisorSupervisor E.==. usrSpvr E.^. UserId
|
E.on $ spvr E.^. UserSupervisorSupervisor E.==. usrSpvr E.^. UserId
|
||||||
E.where_ $ spvr E.^. UserSupervisorUser E.==. E.val uid
|
E.where_ $ spvr E.^. UserSupervisorUser E.==. E.val uid
|
||||||
|
|||||||
@ -356,10 +356,11 @@ courseCell Course{..} = anchorCell link name `mappend` desc
|
|||||||
^{modal "Beschreibung" (Right $ toWidget descr)}
|
^{modal "Beschreibung" (Right $ toWidget descr)}
|
||||||
|]
|
|]
|
||||||
|
|
||||||
|
-- also see Handler.Utils.Widgets.companyWidget
|
||||||
companyCell :: IsDBTable m a => CompanyShorthand -> CompanyName -> Bool -> DBCell m a
|
companyCell :: IsDBTable m a => CompanyShorthand -> CompanyName -> Bool -> DBCell m a
|
||||||
companyCell csh cname isSupervisor = anchorCell link name
|
companyCell csh cname isSupervisor = anchorCell curl name
|
||||||
where
|
where
|
||||||
link = FirmUsersR csh
|
curl = FirmUsersR csh
|
||||||
corg = ciOriginal cname
|
corg = ciOriginal cname
|
||||||
name
|
name
|
||||||
| isSupervisor = text2markup (corg <> " ") <> icon IconSupervisor
|
| isSupervisor = text2markup (corg <> " ") <> icon IconSupervisor
|
||||||
|
|||||||
@ -14,6 +14,7 @@ import Handler.Utils.DateTime
|
|||||||
|
|
||||||
import qualified Data.Char as Char
|
import qualified Data.Char as Char
|
||||||
import qualified Data.HashMap.Strict as Aeson -- ON UPDATE replace with: import qualified Data.Aeson.KeyMap as Aeson
|
import qualified Data.HashMap.Strict as Aeson -- ON UPDATE replace with: import qualified Data.Aeson.KeyMap as Aeson
|
||||||
|
import Data.Scientific
|
||||||
|
|
||||||
---------
|
---------
|
||||||
-- Simple utilities for consistent display
|
-- Simple utilities for consistent display
|
||||||
@ -131,6 +132,16 @@ modalAccess wdgtNo wdgtYes writeAccess route = do
|
|||||||
then modal wdgtYes (Left $ SomeRoute route)
|
then modal wdgtYes (Left $ SomeRoute route)
|
||||||
else wdgtNo
|
else wdgtNo
|
||||||
|
|
||||||
|
-- also see Handler.Utils.Table.Cells.companyCell
|
||||||
|
companyWidget :: (CompanyShorthand, CompanyName, Bool) -> Widget
|
||||||
|
companyWidget (csh, cname, isSupervisor) = simpleLink (toWgt name) curl
|
||||||
|
where
|
||||||
|
curl = FirmUsersR csh
|
||||||
|
corg = ciOriginal cname
|
||||||
|
name
|
||||||
|
| isSupervisor = text2markup (corg <> " ") <> icon IconSupervisor
|
||||||
|
| otherwise = text2markup corg
|
||||||
|
|
||||||
----------
|
----------
|
||||||
-- HEAT --
|
-- HEAT --
|
||||||
----------
|
----------
|
||||||
@ -253,7 +264,9 @@ jsonWidget x = jsonWidgetAux $ toJSON x
|
|||||||
jsonWidgetAux Null = [whamlet|Null|]
|
jsonWidgetAux Null = [whamlet|Null|]
|
||||||
jsonWidgetAux (Bool b) = toWidget $ boolSymbol b
|
jsonWidgetAux (Bool b) = toWidget $ boolSymbol b
|
||||||
jsonWidgetAux (String s) = [whamlet|#{s}|]
|
jsonWidgetAux (String s) = [whamlet|#{s}|]
|
||||||
jsonWidgetAux (Number n) = [whamlet|#{show n}|]
|
jsonWidgetAux (Number n)
|
||||||
|
| isInteger n = [whamlet|#{formatScientific Fixed (Just 0) n}|]
|
||||||
|
| otherwise = [whamlet|#{formatScientific Generic Nothing n}|]
|
||||||
jsonWidgetAux (Array l)
|
jsonWidgetAux (Array l)
|
||||||
| 1 >= length l = foldMap jsonWidgetAux l -- empty arrays don't show
|
| 1 >= length l = foldMap jsonWidgetAux l -- empty arrays don't show
|
||||||
| otherwise =
|
| otherwise =
|
||||||
|
|||||||
@ -102,7 +102,7 @@ mkAvsQuery _ _ _ = AvsQuery
|
|||||||
AvsQueryPerson{avsPersonQueryCardNo=Just (AvsCardNo "00006666"), avsPersonQueryVersionNo=Just "4"} -> AvsResponsePerson $ sumpfi1 <> sumpfi2 <> sumpfi3
|
AvsQueryPerson{avsPersonQueryCardNo=Just (AvsCardNo "00006666"), avsPersonQueryVersionNo=Just "4"} -> AvsResponsePerson $ sumpfi1 <> sumpfi2 <> sumpfi3
|
||||||
AvsQueryPerson{avsPersonQueryCardNo=Just (AvsCardNo "00007777"), avsPersonQueryVersionNo=Just "4"} -> AvsResponsePerson $ sumpfi1 <> sumpfi2 <> sumpfi3
|
AvsQueryPerson{avsPersonQueryCardNo=Just (AvsCardNo "00007777"), avsPersonQueryVersionNo=Just "4"} -> AvsResponsePerson $ sumpfi1 <> sumpfi2 <> sumpfi3
|
||||||
AvsQueryPerson{avsPersonQueryCardNo=Just (AvsCardNo "00008888"), avsPersonQueryVersionNo=Just "4"} -> AvsResponsePerson $ sumpfi1 <> sumpfi2 <> sumpfi3
|
AvsQueryPerson{avsPersonQueryCardNo=Just (AvsCardNo "00008888"), avsPersonQueryVersionNo=Just "4"} -> AvsResponsePerson $ sumpfi1 <> sumpfi2 <> sumpfi3
|
||||||
_ -> AvsResponsePerson mempty
|
_ -> AvsResponsePerson steffen
|
||||||
|
|
||||||
fakeStatus :: AvsQueryStatus -> AvsResponseStatus
|
fakeStatus :: AvsQueryStatus -> AvsResponseStatus
|
||||||
fakeStatus (AvsQueryStatus (Set.toList -> (api:_))) = AvsResponseStatus $ Set.singleton $ AvsStatusPerson api $ Set.fromList
|
fakeStatus (AvsQueryStatus (Set.toList -> (api:_))) = AvsResponseStatus $ Set.singleton $ AvsStatusPerson api $ Set.fromList
|
||||||
|
|||||||
@ -118,7 +118,7 @@ data Icon
|
|||||||
| IconCompany
|
| IconCompany
|
||||||
| IconEdit
|
| IconEdit
|
||||||
| IconUserEdit
|
| IconUserEdit
|
||||||
| IconMagic -- indicates automatic updates
|
-- | IconMagic -- indicates automatic updates
|
||||||
|
|
||||||
deriving (Eq, Ord, Enum, Bounded, Show, Read, Generic)
|
deriving (Eq, Ord, Enum, Bounded, Show, Read, Generic)
|
||||||
deriving anyclass (Universe, Finite, NFData)
|
deriving anyclass (Universe, Finite, NFData)
|
||||||
@ -215,7 +215,7 @@ iconText = \case
|
|||||||
IconCompany -> "building"
|
IconCompany -> "building"
|
||||||
IconEdit -> "edit"
|
IconEdit -> "edit"
|
||||||
IconUserEdit -> "user-edit"
|
IconUserEdit -> "user-edit"
|
||||||
IconMagic -> "wand-magic"
|
-- IconMagic -> "wand-magic"
|
||||||
|
|
||||||
nullaryPathPiece ''Icon $ camelToPathPiece' 1
|
nullaryPathPiece ''Icon $ camelToPathPiece' 1
|
||||||
deriveLift ''Icon
|
deriveLift ''Icon
|
||||||
@ -298,10 +298,10 @@ isNew :: Bool -> Markup
|
|||||||
isNew True = icon IconNew
|
isNew True = icon IconNew
|
||||||
isNew False = mempty
|
isNew False = mempty
|
||||||
|
|
||||||
-- ^ Maybe display an icon that denotes that something™ is automagically updated or derived
|
-- ^ Maybe display an icon that denotes that something™ is NOT automagically updated or derived, but had been edited
|
||||||
isAutomatic :: Bool -> Markup
|
isAutomatic :: Bool -> Markup
|
||||||
isAutomatic True = icon IconMagic
|
isAutomatic True = mempty -- icon IconMagic
|
||||||
isAutomatic False = mempty
|
isAutomatic False = icon IconLocked -- IconEdit
|
||||||
|
|
||||||
boolSymbol :: Bool -> Markup
|
boolSymbol :: Bool -> Markup
|
||||||
boolSymbol True = icon IconOK
|
boolSymbol True = icon IconOK
|
||||||
|
|||||||
@ -37,7 +37,7 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
|
|||||||
<dt .deflist__dt>
|
<dt .deflist__dt>
|
||||||
_{MsgTableMatrikelNr}
|
_{MsgTableMatrikelNr}
|
||||||
<dd .deflist__dd>
|
<dd .deflist__dd>
|
||||||
#{matnr}
|
^{modalAccess (text2widget matnr) (text2widget matnr) False (AdminAvsUserR cID)}
|
||||||
$maybe sex <- userSex
|
$maybe sex <- userSex
|
||||||
<dt .deflist__dt>
|
<dt .deflist__dt>
|
||||||
_{MsgTableSex}
|
_{MsgTableSex}
|
||||||
@ -58,8 +58,8 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
|
|||||||
<dt .deflist__dt>
|
<dt .deflist__dt>
|
||||||
_{MsgAdminUserPostAddress}
|
_{MsgAdminUserPostAddress}
|
||||||
<dd .deflist__dd>
|
<dd .deflist__dd>
|
||||||
#{isAutomatic postalAutomatic} #
|
#{addr} #
|
||||||
#{addr}
|
#{isAutomatic postalAutomatic}
|
||||||
$if (not postalAutomatic)
|
$if (not postalAutomatic)
|
||||||
$maybe postUpdate <- userPostLastUpdate
|
$maybe postUpdate <- userPostLastUpdate
|
||||||
<dt .deflist__dt>
|
<dt .deflist__dt>
|
||||||
@ -70,8 +70,8 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
|
|||||||
_{MsgUserDisplayEmail}
|
_{MsgUserDisplayEmail}
|
||||||
<dd .deflist__dd .email>
|
<dd .deflist__dd .email>
|
||||||
$maybe primaryEmail <- actualDisplayEmail
|
$maybe primaryEmail <- actualDisplayEmail
|
||||||
#{isAutomatic emailAutomatic} #
|
#{mailtoHtml primaryEmail} #
|
||||||
#{mailtoHtml primaryEmail}
|
#{isAutomatic emailAutomatic}
|
||||||
$nothing
|
$nothing
|
||||||
^{messageTooltip tooltipInvalidEmail} #
|
^{messageTooltip tooltipInvalidEmail} #
|
||||||
#{mailtoHtml userDisplayEmail}
|
#{mailtoHtml userDisplayEmail}
|
||||||
@ -113,7 +113,7 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
|
|||||||
<dt .deflist__dt>
|
<dt .deflist__dt>
|
||||||
_{MsgCompany}
|
_{MsgCompany}
|
||||||
<dd .deflist__dd>
|
<dd .deflist__dd>
|
||||||
^{toWgt (mconcat companies)}
|
^{mconcat companies}
|
||||||
$if numSupervisors > 0
|
$if numSupervisors > 0
|
||||||
<dt .deflist__dt>_{MsgProfileSupervisor}
|
<dt .deflist__dt>_{MsgProfileSupervisor}
|
||||||
$if numSupervisors > 3
|
$if numSupervisors > 3
|
||||||
|
|||||||
Reference in New Issue
Block a user