1 {-# LANGUAGE OverloadedStrings, RecordWildCards #-} 2 module Databrary.View.Party 3 ( htmlPartyViewLink 4 , htmlPartyView 5 , htmlPartyEdit 6 , htmlPartySearch 7 , htmlPartyAdmin 8 , htmlPartyDelete 9 ) where 10 11 import Control.Monad (when, forM_, void) 12 import qualified Data.ByteString.Char8 as BSC 13 import Data.Maybe (fromMaybe) 14 import Data.Monoid ((<>)) 15 import Network.HTTP.Types.QueryLike (QueryLike(..)) 16 import qualified Text.Blaze.Html5 as H 17 import qualified Text.Blaze.Html5.Attributes as HA 18 19 import Databrary.Has (view) 20 import Databrary.Model.Permission 21 import Databrary.Model.Party 22 import Databrary.Model.ORCID 23 import Databrary.Store.Temp 24 import Databrary.Action.Types 25 import Databrary.Action 26 import Databrary.Controller.Paths 27 import Databrary.View.Html 28 import Databrary.View.Template 29 import Databrary.View.Form 30 import Databrary.View.Paginate 31 32 import {-# SOURCE #-} Databrary.Controller.Angular 33 import {-# SOURCE #-} Databrary.Controller.Party 34 import {-# SOURCE #-} Databrary.Controller.Volume 35 import {-# SOURCE #-} Databrary.Controller.Register 36 37 htmlPartyViewLink :: QueryLike q => PartyRow -> q -> H.Html 38 htmlPartyViewLink p q = 39 H.a H.! actionLink viewParty (HTML, TargetParty $ partyId p) q 40 $ H.text $ partyName p 41 42 htmlPartyView :: Party -> RequestContext -> H.Html 43 htmlPartyView p@Party{ partyRow = pr@PartyRow{..}, ..} req = htmlTemplate req Nothing $ \js -> do 44 H.div H.! H.customAttribute "typeof" "person" $ do 45 H.h1 H.! H.customAttribute "property" "name" $ H.text $ partyName pr 46 when (partyPermission >= PermissionEDIT) $ 47 H.p $ 48 H.a H.! actionLink viewPartyEdit (TargetParty partyId) js $ "edit" 49 H.img 50 H.! HA.src (builderValue $ actionURL Nothing viewAvatar partyId []) 51 H.dl $ do 52 forM_ partyAffiliation $ \a -> do 53 H.dt "affiliation" 54 H.dd H.! H.customAttribute "property" "affiliation" $ H.text a 55 forM_ partyURL $ \u -> do 56 let us = show u 57 H.dt "url" 58 H.dd H.! H.customAttribute "property" "url" $ H.a H.! HA.href (H.stringValue us) $ H.string us 59 forM_ (partyEmail p) $ \e -> do 60 H.dt "email" 61 H.dd H.! H.customAttribute "property" "email" $ H.a H.! HA.href (byteStringValue $ "mailto:" <> e) $ byteStringHtml e 62 forM_ partyORCID $ \o -> do 63 H.dt "orcid" 64 H.dd H.! H.customAttribute "property" "sameAs" $ H.a H.! HA.href (H.stringValue $ show $ orcidURL o) $ H.string $ show o 65 H.a H.! actionLink queryVolumes HTML (toQuery js <> [("party", Just $ BSC.pack $ show partyId)]) $ "volumes" 66 return () 67 68 htmlPartyForm :: Maybe Party -> FormHtml TempFile 69 htmlPartyForm t = do 70 field "prename" $ inputText $ partyPreName . partyRow =<< t 71 field "sortname" $ inputText $ partySortName . partyRow <$> t 72 field "affiliation" $ inputText $ partyAffiliation . partyRow =<< t 73 field "url" $ inputText $ show <$> (partyURL . partyRow =<< t) 74 75 htmlPartyEdit :: Maybe Party -> RequestContext -> FormHtml TempFile 76 htmlPartyEdit t = maybe 77 (htmlForm "Create party" createParty HTML) 78 (\p -> htmlForm 79 ("Edit " <> partyName (partyRow p)) 80 postParty (HTML, TargetParty $ partyId $ partyRow p)) 81 t 82 (htmlPartyForm t) 83 (const mempty) 84 85 htmlPartyList :: JSOpt -> [Party] -> H.Html 86 htmlPartyList js pl = H.ul $ forM_ pl $ \p -> H.li $ do 87 H.h2 $ htmlPartyViewLink (partyRow p) js 88 mapM_ H.text $ partyAffiliation $ partyRow p 89 90 htmlPartySearchForm :: PartyFilter -> FormHtml f 91 htmlPartySearchForm pf = do 92 field "query" $ inputText $ partyFilterQuery pf 93 field "authorization" $ inputEnum False $ partyFilterAuthorization pf 94 field "institution" $ inputCheckbox $ fromMaybe False $ partyFilterInstitution pf 95 96 htmlPartySearch :: PartyFilter -> [Party] -> RequestContext -> FormHtml f 97 htmlPartySearch pf pl req = htmlForm "Search users" queryParties HTML 98 (htmlPartySearchForm pf) 99 (\js -> htmlPaginate (htmlPartyList js) (partyFilterPaginate pf) pl (view req)) 100 req 101 102 htmlPartyAdmin :: PartyFilter -> [Party] -> RequestContext -> FormHtml f 103 htmlPartyAdmin pf pl req = htmlForm "party admin" adminParties () 104 (htmlPartySearchForm pf) 105 (\js -> htmlPaginate 106 (\pl' -> H.table $ do 107 H.thead $ 108 H.tr $ do 109 H.th "id" 110 H.th "name" 111 H.th "email" 112 H.th "affiliation" 113 H.th "act" 114 H.tbody $ 115 forM_ pl' $ \Party{ partyRow = pr@PartyRow{..}, ..} -> H.tr $ do 116 H.td $ H.a H.! actionLink viewParty (HTML, TargetParty partyId) js 117 $ H.string $ show partyId 118 H.td $ H.text $ partyName pr 119 H.td $ mapM_ (byteStringHtml . accountEmail) partyAccount 120 H.td $ mapM_ H.text partyAffiliation 121 H.td $ do 122 actionForm resendInvestigator partyId js 123 $ H.input H.! HA.type_ "submit" H.! HA.value "agreement" 124 H.a H.! actionLink viewPartyDelete partyId js 125 $ "delete" 126 ) 127 (partyFilterPaginate pf) pl (view req)) 128 req 129 130 htmlPartyDelete :: Party -> RequestContext -> FormHtml f 131 htmlPartyDelete Party{ partyRow = pr@PartyRow{..}, ..} = htmlForm ("delete " <> partyName pr) 132 deleteParty partyId 133 (return ()) 134 (void . htmlPartyViewLink pr)