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)