如何用GStreamer与Haskell实现视频流无限循环播放？

问题场景 #

基于GstHelloWorld.hs教程修改代码，目标是实现按顺序循环播放多个视频，每12秒切换一次源文件路径，但编写切换逻辑时出现编译错误，核心问题是Gst.ClockCallback类型与实现不匹配，无法递归调用自定义函数。

编译错误信息 #

[1 of 2] Compiling Main [Source file changed]

D:\stack-projects\gtk-intro-twelve\app\Main.hs:152:9: error: [GHC-83865]
    * Couldn't match type: IO [Gst.ClockReturn]
                     with: GHC.Word.Word64 -> GHC.Ptr.Ptr () -> IO Bool
      Expected: [Data.Text.Internal.Text]
                -> GHC.Word.Word64 -> GHC.Ptr.Ptr () -> IO Bool
        Actual: [Data.Text.Internal.Text] -> IO [Gst.ClockReturn]
    * In the first argument of `(.)', namely `traverse go'
      In the expression: traverse go . cycle
      In an equation for `putStr2':
          putStr2
            = traverse go . cycle
            where
                go path
                  = do clock <- Gst.pipelineGetPipelineClock pipeline
                       ....
    |
152 |         traverse go . cycle  where
    |         ^^^^^^^^^^^

D:\stack-projects\gtk-intro-twelve\app\Main.hs:152:23: error: [GHC-83865]
    * Couldn't match type `[Data.Text.Internal.Text]' with `Gst.Clock'
      Expected: Gst.Clock -> [Data.Text.Internal.Text]
        Actual: [Data.Text.Internal.Text] -> [Data.Text.Internal.Text]
    * In the second argument of `(.)', namely `cycle'
      In the expression: traverse go . cycle
      In an equation for `putStr2':
          putStr2
            = traverse go . cycle
            where
                go path
                  = do clock <- Gst.pipelineGetPipelineClock pipeline
                       ....
    |
152 |         traverse go . cycle  where
    |                       ^^^^^

错误原因分析 #

1. 回调类型不匹配：Gst.ClockCallback的标准签名是Word64 -> Ptr () -> IO Bool，但你定义的putStr2函数类型为[Text] -> IO [Gst.ClockReturn]，完全不符合回调函数的要求。
2. 逻辑设计错误：traverse go . cycle的组合逻辑错误——cycle生成无限循环的路径列表，traverse go会将每个路径映射为IO动作，最终得到IO [Gst.ClockReturn]，这与回调需要的单次触发、返回布尔值的逻辑完全冲突。

正确实现方案 #

核心思路 #

• 用IORef维护当前播放的视频路径索引，实现循环切换
• 回调函数严格遵循Gst.ClockCallback类型，每次触发时切换视频源，再调度下一次切换
• 修改GStreamer管道的filesrc元素属性，重启管道状态加载新视频

代码示例 #

import Data.IORef
import Data.Text (Text, pack)
import qualified Gst
import System.Environment (getArgs)

main :: IO ()
main = do
  -- 读取命令行传入的视频路径
  args <- getArgs
  let videoPaths = map pack args
  if null videoPaths
    then putStrLn "请传入至少一个视频路径"
    else do
      -- 初始化GStreamer（参考原教程代码）
      Gst.init Nothing
      pipeline <- Gst.pipelineNew (pack "video-player")
      -- 构建管道元素（参考原教程，确保包含名为"filesrc"的元素）
      -- ... 原教程中的元素创建、链接代码 ...
      
      -- 初始化当前播放索引的IORef
      currentIndexRef <- newIORef 0
      -- 获取管道时钟，调度第一次12秒后的切换回调
      clock <- Gst.pipelineGetPipelineClock pipeline
      let twelveSeconds = 12 * Gst.SECOND
      clockID <- Gst.clockNewPeriodicClockID clock 0 twelveSeconds
      Gst.clockIDWaitAsync clockID (switchVideoCallback pipeline videoPaths currentIndexRef) nullPtr
      
      -- 启动管道播放
      Gst.elementSetState pipeline Gst.StatePlaying
      -- 等待播放结束（参考原教程代码）
      -- ... 原教程中的事件循环、清理代码 ...

-- 符合Gst.ClockCallback类型的切换函数
switchVideoCallback :: Gst.Pipeline -> [Text] -> IORef Int -> Gst.ClockCallback
switchVideoCallback pipeline paths indexRef _ _ = do
  currentIndex <- readIORef indexRef
  -- 计算下一个索引，实现循环
  let nextIndex = (currentIndex + 1) `mod` length paths
      nextPath = paths !! nextIndex
  writeIORef indexRef nextIndex
  
  -- 找到管道中的filesrc元素，切换视频路径
  maybeFilesrc <- Gst.binGetByName pipeline (pack "filesrc")
  case maybeFilesrc of
    Just filesrc -> do
      -- 设置filesrc的location属性为下一个视频路径
      Gst.objectSetPropertyString filesrc "location" nextPath
      -- 重启管道状态，加载新视频
      Gst.elementSetState pipeline Gst.StateReady
      Gst.elementSetState pipeline Gst.StatePlaying
    Nothing -> putStrLn "错误：未找到名为filesrc的管道元素"
  
  -- 返回True，让周期回调持续触发
  return True

启动命令 #

支持传入多个视频路径，循环切换：

stack exec gtk-intro-twelve-exe -- video1.avi video2.avi video3.avi

内容的提问来源于stack exchange，提问作者Ciuppo