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