Transcode.hs

module Hoovie.Transcode where

import Data.Maybe
import System.Process
import Data.Enumerator
import Blaze.ByteString.Builder
import Debug.Trace

import qualified Data.ByteString    as B
import qualified Control.Exception  as Exc
import qualified System.IO          as IO
import qualified GHC.IO.Exception   as E

-- mencoder -ss 0 '/home/peter/movies/[UsaBit.com] - The.Pirates.Band.of.Misfits.2012.DVDRip.XviD-PTpOWeR/The.Pirates.Band.of.Misfits.2012.DVDRip.XviD-PTpOWeR.avi' -msglevel statusline=2 -oac lavc -of mpeg -mpegopts format=mpeg2:muxrate=500000:vbuf_size=1194:abuf_size=64 -ovc lavc -channels 6 -lavdopts debug=0:threads=4 -lavcopts autoaspect=1:vcodec=mpeg2video:acodec=ac3:abitrate=448:threads=4:keyint=5:vqscale=1:vqmin=2:vrc_maxrate=54000:vrc_buf_size=1835 -font /usr/share/fonts/truetype/ttf-dejavu/DejaVuSans.ttf -subfont-text-scale 3 -subfont-outline 1 -subfont-blur 1 -subpos 98 -fontconfig -sid 100 -ofps 24000/1001 -sub '/home/peter/movies/[UsaBit.com] - The.Pirates.Band.of.Misfits.2012.DVDRip.XviD-PTpOWeR/The.Pirates.Band.of.Misfits.2012.DVDRip.XviD-PTpOWeR.srt' -lavdopts fast -mc 0 -noskip -af lavcresample=48000 -srate 48000 -o movie.avi

transcode :: (Maybe Double, Maybe Double)
          -> FilePath
          -> Enumerator Builder IO b
transcode range filename step = do
    trace ("transcode: " ++ show range) (return ())
    (_, hOut, _, encoder) <- tryIO $ createProcess ((ffmpeg range filename) { std_out = CreatePipe, create_group = True })
    case hOut of
        Nothing -> do
            Iteratee $ Exc.throw (E.IOError Nothing E.IllegalOperation "" "could not start transcoding" Nothing (Just filename))
        Just h  -> do
            let iter = streamFromHandle h step
            Iteratee $ Exc.finally (Exc.catch (runIteratee iter) (\err -> trace (show (err :: Exc.IOException)) (Exc.throwIO err))) (IO.hClose h >> interruptProcessGroupOf encoder)

simpleCat :: String -> CreateProcess
simpleCat filename = proc "cat" [filename]

ffmpeg :: (Maybe Double, Maybe Double) -> String -> CreateProcess
ffmpeg (start, stop) filename = 
    let startArg = case start of
                    Just pos -> ["-ss", show pos]
                    Nothing  -> []
        stopArg = case stop of
                    Just pos -> ["-t", show $ max (1 :: Int) (floor $ pos - (fromMaybe 0.0 start))]
                    Nothing  -> []
    in proc "avconv" $
        startArg ++
        [ "-i", filename
        , "-target", "ntsc-vcd"
        , "-loglevel", "quiet" ] ++
        stopArg ++
        [ "pipe:1" ]

mencoder :: String -> CreateProcess
mencoder filename =
    proc "mencoder" [
        "-ss", "0", 
        filename,
        "-msglevel", "all=-1", --"statusline=2", 
        "-oac", "lavc", 
        "-of", "mpeg", 
        "-mpegopts", "format=mpeg2:muxrate=500000:vbuf_size=1194:abuf_size=64", 
        "-ovc", "lavc", 
        "-channels", "6", 
        "-lavdopts", "debug=0:threads=4", 
        "-lavcopts", "autoaspect=1:vcodec=mpeg2video:acodec=ac3:abitrate=448:threads=4:keyint=5:vqscale=1:vqmin=2:vrc_maxrate=54000:vrc_buf_size=1835", 
        "-sid", "100", 
        "-ofps", "24000/1001", 
        "-lavdopts", "fast", 
        "-mc", "0", 
        "-noskip", 
        "-af", "lavcresample=48000", 
        "-srate", "48000", 
        "-o", "/dev/stdout"]

streamFromHandle :: IO.Handle
       -> Enumerator Builder IO b
streamFromHandle h = checkContinue0 $ \loop k -> do
    -- bytes <- tryIO (getBytes h 4096)
    bytes <- tryIO $ Exc.catch (B.hGet h 4096) (\err -> trace (show (err :: Exc.IOException)) (Exc.throwIO err))
    if B.null bytes
        then trace "No data left!!!" $ continue k
        else k (Chunks [fromByteString bytes]) >>== loop