1 {-# LANGUAGE OverloadedStrings, RecordWildCards #-} 2 module 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 Has (view) 20 import Model.Permission 21 import Model.Party 22 import Model.ORCID 23 import Store.Temp 24 import Action.Types 25 import Action 26 import Controller.Paths 27 import View.Html 28 import View.Template 29 import View.Form 30 import View.Paginate 31 32 import {-# SOURCE #-} Controller.Angular 33 import {-# SOURCE #-} Controller.Party 34 import {-# SOURCE #-} Controller.Volume 35 import {-# SOURCE #-} 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 -> 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)