1 {-# LANGUAGE OverloadedStrings, RecordWildCards #-} 2 module Databrary.View.Volume 3 ( 4 htmlVolumeViewLink 5 {- 6 , htmlVolumeView 7 , htmlVolumeEdit 8 , htmlVolumeLinksEdit 9 , htmlVolumeSearch 10 -} 11 ) where 12 13 -- import Control.Monad (when, forM_) 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.Action 21 -- import Databrary.Model.Permission 22 import Databrary.Model.Volume 23 -- import Databrary.Model.Citation 24 -- import Databrary.Model.Tag 25 -- import Databrary.HTTP.Form.View 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 36 htmlVolumeViewLink :: QueryLike q => VolumeRow -> q -> H.Html 37 htmlVolumeViewLink v q = 38 H.a H.! actionLink viewVolume (HTML, volumeId v) q 39 $ H.text $ volumeName v 40 41 {- 42 htmlVolumeView :: Volume -> [Tag] -> RequestContext -> H.Html 43 htmlVolumeView v t req = htmlTemplate req Nothing $ \js -> do 44 H.div H.! H.customAttribute "typeof" "dataset" $ do 45 H.h1 H.! H.customAttribute "property" "name" $ H.text $ volumeName $ volumeRow v 46 when (view v >= PermissionEDIT) $ 47 H.p $ 48 H.a H.! actionLink viewVolumeEdit (volumeId $ volumeRow v) js $ "edit" 49 H.img 50 H.! HA.src (builderValue $ actionURL Nothing thumbVolume (volumeId $ volumeRow v) []) 51 H.dl $ do 52 forM_ (getVolumeAlias v) $ \a -> do 53 H.dt "alias" 54 H.dd H.! H.customAttribute "property" "alternateName" $ H.text a 55 forM_ (volumeOwners v) $ \(p, n) -> do 56 H.dt "owner" 57 H.dd H.! H.customAttribute "property" "creator" $ H.a H.! actionLink viewParty (HTML, TargetParty p) js $ H.text n 58 forM_ (volumeBody $ volumeRow v) $ \b -> do 59 H.dt "body" 60 H.dd H.! H.customAttribute "property" "description" $ H.text b -- format 61 forM_ (volumeDOI $ volumeRow v) $ \d -> do 62 H.dt "doi" 63 H.dd H.! H.customAttribute "property" "alternateName" $ byteStringHtml d 64 H.dt "keywords" 65 H.dd $ H.ul H.! HA.class_ "comma" H.! H.customAttribute "property" "keywords" $ do 66 forM_ t $ \n -> do 67 H.li $ byteStringHtml $ tagNameBS $ tagName n 68 69 htmlVolumeForm :: Maybe Volume -> Maybe Citation -> FormHtml f 70 htmlVolumeForm vol cite = do 71 field "name" $ inputText $ volumeName . volumeRow <$> vol 72 field "alias" $ inputText $ volumeAlias . volumeRow =<< vol 73 field "body" $ inputTextarea $ volumeBody . volumeRow =<< vol 74 "citation" .:> do 75 field "head" $ inputText $ citationHead <$> cite 76 field "url" $ inputText $ fmap show $ citationURL =<< cite 77 field "year" $ inputText $ fmap show $ citationYear =<< cite 78 79 htmlVolumeEdit :: Maybe (Volume, Maybe Citation) -> RequestContext -> FormHtml f 80 htmlVolumeEdit Nothing = htmlForm "Create volume" createVolume HTML (htmlVolumeForm Nothing Nothing) (const mempty) 81 htmlVolumeEdit (Just (v, cite)) = htmlForm ("Edit " <> volumeName (volumeRow v)) postVolume (HTML, volumeId $ volumeRow v) (htmlVolumeForm (Just v) cite) (const mempty) 82 83 htmlVolumeLinksEdit :: Volume -> [Citation] -> RequestContext -> FormHtml f 84 htmlVolumeLinksEdit vol links = htmlForm "Edit volume links" postVolumeLinks (HTML, volumeId $ volumeRow vol) 85 (withSubFormsViews links $ \link -> do 86 field "head" $ inputText $ citationHead <$> link 87 field "url" $ inputText $ fmap show $ citationURL =<< link) 88 (const mempty) 89 90 htmlVolumeList :: JSOpt -> [Volume] -> H.Html 91 htmlVolumeList js vl = H.ul 92 H.! HA.class_ "flat" 93 $ forM_ vl $ \v -> H.li 94 $ H.article 95 H.! HA.class_ "volume-list-result cf" 96 $ do 97 H.h1 98 $ htmlVolumeViewLink (volumeRow v) js 99 H.ul 100 H.! HA.class_ "flat semicolon" 101 $ forM_ (volumeOwners v) $ \(p, o) -> H.li $ do 102 H.a H.! actionLink viewParty (HTML, TargetParty p) js 103 $ H.text o 104 mapM_ (H.p . H.text) $ volumeBody $ volumeRow v 105 106 htmlVolumeSearch :: VolumeFilter -> [Volume] -> RequestContext -> FormHtml f 107 htmlVolumeSearch VolumeFilter{..} vl req = htmlForm "Volume search" queryVolumes HTML 108 (field "query" $ inputText volumeFilterQuery) 109 (\js -> htmlPaginate (htmlVolumeList js) volumeFilterPaginate vl (view req)) 110 req 111 -}