movie-monad-0.0.5.0: src/VideoInfo.hs

{-
  Movie Monad
  (C) 2017 David Lettier
  lettier.com
-}

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

module VideoInfo where

import System.Exit
import Text.Read
import Data.Maybe
import Data.Text
import Data.IORef

import qualified Records as R
import Uri
import Utils

getRawVideoInfo :: Prelude.String -> IO (Maybe Prelude.String)
getRawVideoInfo uri = do
  (code, out, _) <- safeRunProcessGetOutput "gst-discoverer-1.0" [uri, "-v"]
  if code == System.Exit.ExitSuccess
    then return (Just out)
    else return Nothing

processRawVideoInfo :: Maybe Prelude.String -> Prelude.String -> Maybe R.VideoInfo
processRawVideoInfo Nothing _ = Nothing
processRawVideoInfo (Just str) uri = do
  let text      = Data.Text.toLower $ Data.Text.pack str
  let textLines = Data.Text.lines text
  let videoInfo =
        R.VideoInfo
          { R.uri          = uri
          , R.isLocalFile  = hasFileUriScheme uri
          , R.isVideo      = "video: video/" `Data.Text.isInfixOf` text
          , R.isSeekable   = "yes" == getField seekableField textLines
          , R.videoWidth   = getDimension R.videoWidth  widthField textLines
          , R.videoHeight  = getDimension R.videoHeight heightField textLines
          }
  Just videoInfo
  where
    widthField    :: Data.Text.Text
    widthField    = "width: "
    heightField   :: Data.Text.Text
    heightField   = "height: "
    seekableField :: Data.Text.Text
    seekableField = "seekable: "
    getDimension :: (R.VideoInfo -> Int) -> Data.Text.Text -> [Data.Text.Text] -> Int
    getDimension f field lines' =
      fromMaybe
        (f R.defaultVideoInfo)
        (readMaybe (Data.Text.unpack $ getField field lines') :: Maybe Int)
    getField :: Data.Text.Text -> [Data.Text.Text] -> Data.Text.Text
    getField field =
      Prelude.foldl
        (\ acc l ->
          if not $ Data.Text.null acc
            then acc
            else
              if field `Data.Text.isInfixOf` l
                then Data.Text.replace field "" $ Data.Text.strip l
                else ""
        )
      ""
getVideoInfo :: IORef R.VideoInfo -> Prelude.String -> IO (Maybe R.VideoInfo)
getVideoInfo videoInfoRef filePathName = do
  videoInfo <- readIORef videoInfoRef
  uri       <- addUriSchemeIfNone filePathName
  if R.uri videoInfo == uri
    then return $ Just videoInfo
    else do
      rawVideoInfo <- getRawVideoInfo uri
      case processRawVideoInfo rawVideoInfo uri of
        (Just videoInfo') -> return $ Just videoInfo'
        _ -> return Nothing

saveVideoInfo :: IORef R.VideoInfo -> R.VideoInfo -> IO ()
saveVideoInfo = atomicWriteIORef