1 {-# LANGUAGE OverloadedStrings, RecordWildCards #-}
    2 module 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 Has (view)
   11 import Model.Transcode
   12 import Model.Asset
   13 import Model.Party
   14 import Action
   15 import Controller.Paths
   16 import View.Html
   17 import View.Template
   18 
   19 import Controller.Asset
   20 import Controller.Party
   21 import {-# SOURCE #-} Controller.Transcode
   22 
   23 htmlTranscodes :: [Transcode] -> RequestContext -> H.Html
   24 htmlTranscodes tl req = htmlTemplate req (Just "transcodes") $ \js ->
   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