1 {-# LANGUAGE OverloadedStrings, RecordWildCards, ScopedTypeVariables #-}
    2 module Databrary.View.Zip
    3   ( htmlVolumeDescription
    4   ) where
    5 
    6 import Control.Monad (void, unless, forM_)
    7 import qualified Data.ByteString.Builder as BSB
    8 import qualified Data.ByteString.Char8 as BSC
    9 import Data.Char (toLower)
   10 import Data.Maybe (fromMaybe)
   11 import Data.Monoid ((<>))
   12 import Data.String (fromString)
   13 import Data.Time.Format (formatTime, defaultTimeLocale)
   14 import System.FilePath ((<.>))
   15 import System.Posix.FilePath ((</>))
   16 import qualified Text.Blaze.Html5 as H
   17 import qualified Text.Blaze.Html5.Attributes as HA
   18 import qualified Text.Blaze.Html4.Strict.Attributes as H4A
   19 
   20 import Databrary.Ops
   21 import Databrary.Has (view)
   22 import Databrary.Service.Messages
   23 import Databrary.Store.Filename
   24 import Databrary.Model.Time
   25 import Databrary.Model.Enum
   26 import Databrary.Model.Release.Types
   27 import Databrary.Model.Id.Types
   28 import Databrary.Model.Party
   29 import Databrary.Model.Volume.Types
   30 import Databrary.Model.Container
   31 import Databrary.Model.Segment
   32 import Databrary.Model.Slot.Types
   33 import Databrary.Model.Citation.Types
   34 import Databrary.Model.Funding.Types
   35 import Databrary.Model.RecordSlot.Types
   36 import Databrary.Model.Record.Types
   37 import Databrary.Model.Category.Types
   38 import Databrary.Model.Measure
   39 import Databrary.Model.Metric.Types
   40 import Databrary.Model.Asset.Types
   41 import Databrary.Model.AssetSlot.Types
   42 import Databrary.Model.Format
   43 import Databrary.Action
   44 import Databrary.Controller.Paths
   45 import Databrary.Controller.Volume
   46 import Databrary.Controller.Party
   47 import Databrary.Controller.Container
   48 import Databrary.Controller.Asset
   49 import Databrary.Controller.Web
   50 import Databrary.Controller.IdSet
   51 import Databrary.View.Html
   52 
   53 -- import {-# SOURCE #-} Databrary.Controller.Zip
   54 
   55 htmlVolumeDescription :: Bool -> Volume -> [Citation] -> [Funding] -> [RecordSlot] -> IdSet Container -> [[AssetSlot]] -> [[AssetSlot]] -> RequestContext -> H.Html
   56 htmlVolumeDescription inzip Volume{ volumeRow = VolumeRow{..}, ..} cite fund glob cs atl abl req = H.docTypeHtml $ do
   57   H.head $ do
   58     H.meta H.! HA.httpEquiv "content-type" H.! HA.content "text/html;charset=utf-8"
   59     H.title $ do
   60       void "Databrary Volume "
   61       H.toMarkup (unId volumeId)
   62   H.body $ do
   63     H.p $ do
   64       H.em "Databrary"
   65       void " Volume "
   66       H.toMarkup (unId volumeId)
   67       forM_ volumeDOI $ \doi -> do
   68         void " DOI "
   69         byteStringHtml doi
   70     H.h1 $
   71       H.a H.! HA.href (maybe (link viewVolume (HTML, volumeId)) (byteStringValue . ("http://doi.org/" <>)) volumeDOI) $
   72         H.text volumeName
   73     H.ul $ forM_ volumeOwners $ \(i, n) ->
   74       H.li $
   75         H.a H.! HA.href (link viewParty (HTML, TargetParty i)) $
   76           H.text n
   77     H.h2 "Volume description"
   78     mapM_ (H.p . H.text) volumeBody
   79     unless (null fund) $ do
   80       H.h3 "Funded by"
   81       H.dl $ forM_ fund $ \Funding{..} -> do
   82         H.dt $ H.text $ funderName fundingFunder
   83         mapM_ (H.dd . H.text) fundingAwards
   84     unless (null cite) $ do
   85       H.h3 "Related works"
   86       H.ul $ forM_ cite $ \Citation{..} -> H.li $
   87         maybe id (\u -> H.a H.! HA.href (H.toValue u)) citationURL $ do
   88           H.text citationHead
   89           forM_ citationYear $ \y ->
   90             " (" >> H.toMarkup (fromIntegral y :: Int) >> ")"
   91     unless (null glob) $ do
   92       H.h3 "Descriptors"
   93       forM_ glob $ \RecordSlot{ slotRecord = r, recordSlot = s } -> do
   94         H.h3 $ H.text $ categoryName $ recordCategory $ recordRow r
   95         H.dl $ do
   96           unless (segmentFull $ slotSegment s) $ do
   97             H.dt "segment"
   98             H.dd $ H.string $ show $ slotSegment s
   99           forM_ (getRecordMeasures r) $ \m -> do
  100             H.dt $ H.text $ metricName $ measureMetric m
  101             H.dd $ byteStringHtml $ measureDatum m
  102     H.h2 "Package information"
  103     H.dl $ do
  104       H.dt "Created"
  105       H.dd $ H.string $ formatTime defaultTimeLocale "%d %b %Y" volumeCreation
  106 --      if inzip
  107 --      then do
  108       do
  109         H.dt "Downloaded"
  110         H.dd $ do
  111           H.string $ formatTime defaultTimeLocale "%a, %d %b %Y %H:%M:%S %Z" (view req :: Timestamp)
  112           void " by "
  113           H.a H.! HA.href (link viewParty (HTML, TargetParty $ view req)) $
  114             H.text $ partyName $ partyRow $ view req
  115 --      else do
  116 --        H.dt $ H.a H.! actionLink (zipVolume True) volumeId (idSetQuery cs) $
  117 --          void "Download Original"
  118     unless (idSetIsFull cs) $ H.p $ msg "download.zip.partial"
  119     H.p $ do
  120       msg "download.warning"
  121       void " For more information and terms of use see the "
  122       H.a H.! HA.href "http://databrary.org/access/policies/agreement.html"
  123         $ "Databrary Access Agreement"
  124       void "."
  125     H.h2 "Contents"
  126     H.h3 "Legend of release levels"
  127     H.dl $ forM_ pgEnumValues $ \(_ :: Release, n) -> do
  128       H.dt $ H.string n
  129       H.dd $ do
  130         H.img H.! HA.src (link webFile (Just $ staticPath ["icons", "release", BSC.pack $ map toLower n <.> "svg"]))
  131         msg (fromString $ "release." ++ n ++ ".title")
  132         void ": "
  133         msg (fromString $ "release." ++ n ++ ".description")
  134     H.h3 "Materials"
  135     atable atl
  136     H.h3 "Sessions"
  137     atable abl
  138   where
  139   link r a = builderValue $ actionURL (inzip `thenUse` (view req)) r a []
  140   msg m = H.text $ getMessage m $ view req
  141   atable acl = H.table H.! H4A.border "1" $ do
  142     H.thead $ H.tr $ do
  143       H.th "directory"
  144       H.th "container"
  145       H.th "file"
  146       H.th "description"
  147       H.th "release"
  148       H.th "size"
  149       H.th "duration"
  150       H.th "sha1 checksum"
  151     H.tbody $ abody acl
  152   abody [] = mempty
  153   abody (~(AssetSlot{ assetSlot = Nothing }:_):_) = mempty
  154   -- FIXME, probably don't want lazy patterns since all this beautiful code
  155   -- never evaluates.
  156   abody (~(a@AssetSlot{ assetSlot = Just Slot{ slotContainer = c } }:l):al) = do
  157     H.tr $ do
  158       H.td H.! rs $ H.a !? (inzip `thenUse` (HA.href (byteStringValue fn))) $
  159         byteStringHtml dn
  160       H.td H.! rs $ H.a H.! HA.href (link viewContainer (HTML, (Just volumeId, containerId $ containerRow c))) $ do
  161         mapM_ H.string $ formatContainerDate c
  162         mapM_ H.text $ containerName $ containerRow c
  163       arow fn a
  164       mapM_ (H.tr . arow fn) l
  165     abody al
  166     where
  167     rs = HA.rowspan $ H.toValue $ succ $ length l
  168     dn = makeFilename $ containerDownloadName c
  169     fn
  170       | containerTop (containerRow c) = dn
  171       | otherwise = "sessions" </> dn
  172   arow bf as@AssetSlot{ slotAsset = Asset{ assetRow = a } } = do
  173     H.td $ H.a !? (inzip `thenUse` (HA.href (byteStringValue $ bf </> fn))) $
  174       byteStringHtml fn
  175     H.td $ H.a H.! HA.href (link viewAsset (HTML, assetId a)) $
  176       H.text $ fromMaybe (formatName $ assetFormat a) $ assetName a
  177     H.td $ H.string $ show (getAssetSlotRelease as :: Release)
  178     H.td $ maybe mempty H.toMarkup $ assetSize a
  179     H.td $ maybe mempty (H.string . show) $ assetDuration a
  180     H.td $ maybe mempty (lazyByteStringHtml . BSB.toLazyByteString . BSB.byteStringHex) $ assetSHA1 a
  181     where
  182     fn = last $ BSC.split '-' $ makeFilename (assetDownloadName True False a) `addFormatExtension` assetFormat a