1 {-# LANGUAGE OverloadedStrings, RecordWildCards #-}
    2 module Databrary.View.Transcode
    3   ( htmlTranscodes
    4   ) where
    5 
    6 import Control.Monad (when, forM_)
    7 import qualified Text.Blaze.Html5 as H
    8 import qualified Text.Blaze.Html5.Attributes as HA
    9 
   10 -- import Databrary.Has (view)
   11 import Databrary.Model.Transcode
   12 import Databrary.Model.Asset
   13 import Databrary.Model.Party
   14 import Databrary.Action
   15 import Databrary.Controller.Paths
   16 import Databrary.View.Html
   17 import Databrary.View.Template
   18 
   19 import Databrary.Controller.Asset
   20 import Databrary.Controller.Party
   21 import {-# SOURCE #-} Databrary.Controller.Transcode
   22 
   23 htmlTranscodes :: [Transcode] -> RequestContext -> H.Html
   24 htmlTranscodes tl req = htmlTemplate req (Just "transcodes") $ \js -> do
   25   H.table $ do
   26     H.thead $ H.tr $
   27       mapM_ H.th
   28         [ "action"
   29         , "id"
   30         , "time"
   31         , "owner"
   32         , "source"
   33         , "segment"
   34         , "options"
   35         , "pid"
   36         , "log"
   37         ]
   38     H.tbody $
   39       forM_ tl $ \t@Transcode{..} -> H.tr $ do
   40         H.td $ actionForm postTranscode (transcodeId t) js $ do
   41           let act a = H.input H.! HA.type_ "submit" H.! HA.name "action" H.! HA.value (H.stringValue $ show a)
   42           maybe (do
   43             act TranscodeStart
   44             act TranscodeFail)
   45             (\p -> when (p >= 0) $ act TranscodeStop)
   46             transcodeProcess
   47         H.td $ H.a H.! actionLink viewAsset (HTML, assetId $ assetRow $ transcodeAsset t) js $
   48           H.string $ show $ assetId $ assetRow $ transcodeAsset t
   49         H.td $ foldMap (H.string . show) transcodeStart
   50         H.td $ do
   51           let p = (partyRow . accountParty . siteAccount) transcodeOwner
   52           H.a H.! actionLink viewParty (HTML, TargetParty (partyId p)) js $
   53             H.text $ partyName p
   54         H.td $ H.a H.! actionLink viewAsset (HTML, assetId $ assetRow $ transcodeOrig t) js $
   55           maybe (H.string $ show $ assetId $ assetRow $ transcodeOrig t) H.text (assetName $ assetRow $ transcodeOrig t)
   56         H.td $ H.string $ show transcodeSegment
   57         H.td $ mapM_ ((>>) " " . H.string) transcodeOptions
   58         H.td $ foldMap (H.string . show) transcodeProcess
   59         H.td $ foldMap (H.pre . byteStringHtml) transcodeLog