polysemy-video 0.1.2.0 → 0.2.0.0

raw patch · 3 files changed

+89/−67 lines, 3 filesdep +path-formattingdep +simple-media-timestampdep +simple-media-timestamp-formattingdep −path-utilsdep ~formattingdep ~pathdep ~polysemyPVP ok

version bump matches the API change (PVP)

Dependencies added: path-formatting, simple-media-timestamp, simple-media-timestamp-formatting

Dependencies removed: path-utils

Dependency ranges changed: formatting, path, polysemy, text, turtle

API changes (from Hackage documentation)

Files

• ChangeLog.md +6/−0
• polysemy-video.cabal +10/−8
• src/Polysemy/Video.hs +73/−59

@@ -1,5 +1,11 @@ # Changelog for polysemy-video +## v0.2.0.0++* Use `Time` from +  [simple-media-timestamp](https://hackage.haskell.org/package/simple-media-timestamp).+* Rename interpreter functions.+ ## v0.1.1.0  * Support both `Abs` and `Rel`.

@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.34.2.+-- This file has been generated from package.yaml by hpack version 0.34.4. -- -- see: https://github.com/sol/hpack  name:           polysemy-video-version:        0.1.2.0+version:        0.2.0.0 description:    Experimental video processing DSL for polysemy. category:       video polysemy author:         Daniel Firth@@ -32,10 +32,12 @@   ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints   build-depends:       base >=4.7 && <5-    , formatting-    , path-    , path-utils-    , polysemy-    , text-    , turtle+    , formatting >=7.0.0 && <7.2+    , path >=0.7 && <0.10+    , path-formatting >=0.1.0.0 && <0.2+    , polysemy >=1.3.0.0 && <1.7+    , simple-media-timestamp ==0.2.*+    , simple-media-timestamp-formatting ==0.1.*+    , text >=1.0 && <1.3+    , turtle >=1.0 && <1.6   default-language: Haskell2010

@@ -1,71 +1,66 @@-{- |-   Module    : Polysemy.Video-   License   : MIT-   Stability : experimental--Experimental Video processing DSL for Polysemy.--}-{-# LANGUAGE DataKinds           #-}-{-# LANGUAGE FlexibleContexts    #-}-{-# LANGUAGE GADTs               #-}-{-# LANGUAGE LambdaCase          #-}-{-# LANGUAGE OverloadedStrings   #-}-{-# LANGUAGE PolyKinds           #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TemplateHaskell     #-}-{-# LANGUAGE TypeOperators       #-}-module Polysemy.Video where--import           Control.Monad.IO.Class-import           Data.Text              (Text)-import qualified Data.Text              as T-import           Formatting-import           Path-import           Path.Utils-import           Polysemy-import qualified Turtle                 as S+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeOperators #-} --- | Timestamp data type.-data Time = Time-  { hour    :: Int-  , minutes :: Int-  , seconds :: Int-  , frame   :: Int-  } deriving (Eq, Ord, Show)+-- |+--   Module    : Polysemy.Video+--   License   : MIT+--   Stability : experimental+--+-- Experimental Video processing DSL for Polysemy.+module Polysemy.Video+  ( ClipProcess (..),+    extractAudio,+    extractClips,+    extractFrames,+    runFFMpegCli,+    traceFFMpegArgs,+    ignoreClipProcess,+  )+where --- | Interval of two timestamps.-data Range = Range-  { from :: Time-  , to   :: Time-  } deriving (Eq, Ord, Show)+import Control.Monad.IO.Class+import Data.Text (Text)+import Formatting+import Media.Timestamp+import Media.Timestamp.Formatting+import Path+import Path.Formatting+import Polysemy+import Polysemy.Trace+import qualified Turtle as S --- |+-- | Effect for disecting a video file.+--+-- @since 0.1.1.0 data ClipProcess m a where-  ExtractAudio  :: Path b File -> [(Range, Path b' File)] -> ClipProcess m ()-  ExtractClips  :: Path b File -> [(Range, Path b' File)] -> ClipProcess m ()-  ExtractFrames :: Path b File -> [(Time, Path b' File)]  -> ClipProcess m ()+  ExtractAudio :: Path b File -> [(Range, Path b' File)] -> ClipProcess m ()+  ExtractClips :: Path b File -> [(Range, Path b' File)] -> ClipProcess m ()+  ExtractFrames :: Path b File -> [(Time, Path b' File)] -> ClipProcess m ()  makeSem ''ClipProcess --- | Format a Timestamp to ffmpeg's format 00:00:00.000.-timeFF :: Time -> Text-timeFF (Time h m s f) = sformat (int % ":" % int % ":" % int % "." % int) h m s f- -- | "-ss <x>" where x is a timestamp. seekFF :: Time -> [Text]-seekFF t = ["-ss", timeFF t]+seekFF t = ["-ss", sformat timef t]  -- | "-ss <x> -to <y> <output>". rangeFF :: Range -> Path b File -> [Text]-rangeFF (Range f t) x = seekFF f ++ ["-to", timeFF t, toFilePathText x]+rangeFF (Range f t) x = seekFF f ++ ["-to", sformat timef t, sformat pathf x]  -- | "-ss <x> -vframes 1 <output>" frameFF :: Time -> Path b File -> [Text]-frameFF t x = seekFF t ++ ["-vframes", "1", toFilePathText x]+frameFF t x = seekFF t ++ ["-vframes", "1", sformat pathf x]  -- | "-i <output>" inputFF :: Path b File -> [Text]-inputFF x = ["-i", toFilePathText x]+inputFF x = ["-i", sformat pathf x]  -- | "ffmpeg -y" followed by some arguments. runffmpeg :: MonadIO m => [Text] -> m ()@@ -76,15 +71,34 @@ mktreeFP = S.mktree . S.decodeString . toFilePath  -- | Interpret `ClipProcess` by running it against ffmpeg on the command line.-interpretFFMpegCli :: Member (Embed IO) effs => Sem (ClipProcess ': effs) a -> Sem effs a-interpretFFMpegCli = interpret $ \case-  ExtractAudio  x ts -> mapM_ mktreeFP (parent . snd <$> ts) >> runffmpeg (inputFF x <> (uncurry rangeFF =<< ts))-  ExtractClips  x ts -> mapM_ mktreeFP (parent . snd <$> ts) >> runffmpeg (inputFF x <> (uncurry rangeFF =<< ts))+--+-- @since 0.2.0.0+runFFMpegCli :: Member (Embed IO) effs => Sem (ClipProcess ': effs) a -> Sem effs a+runFFMpegCli = interpret $ \case+  ExtractAudio x ts -> mapM_ mktreeFP (parent . snd <$> ts) >> runffmpeg (inputFF x <> (uncurry rangeFF =<< ts))+  ExtractClips x ts -> mapM_ mktreeFP (parent . snd <$> ts) >> runffmpeg (inputFF x <> (uncurry rangeFF =<< ts))   ExtractFrames x ts -> mapM_ mktreeFP (parent . snd <$> ts) >> runffmpeg (inputFF x <> (uncurry frameFF =<< ts)) --- | Interpret `ClipProcess` by printing out the command it would have run to the terminal.-interpretFFMpegNoop :: Member (Embed IO) effs => Sem (ClipProcess ': effs) a -> Sem effs a-interpretFFMpegNoop = interpret $ \case-  ExtractAudio x ts  -> embed $ print $ T.unwords $ inputFF x <> (uncurry rangeFF =<< ts)-  ExtractClips x ts  -> embed $ print $ T.unwords $ inputFF x <> (uncurry rangeFF =<< ts)-  ExtractFrames x ts -> embed $ print $ T.unwords $ inputFF x <> (uncurry frameFF =<< ts)+-- | Trace `ClipProcess` by printing out the arguments it would pass to ffmpeg.+--+-- @since 0.2.0.0+traceFFMpegArgs :: Members '[ClipProcess, Trace] r => Sem r a -> Sem r a+traceFFMpegArgs = intercept $ \case+  ExtractAudio x ts -> do+    trace $ show $ inputFF x <> (uncurry rangeFF =<< ts)+    extractAudio x ts+  ExtractClips x ts -> do+    trace $ show $ inputFF x <> (uncurry rangeFF =<< ts)+    extractClips x ts+  ExtractFrames x ts -> do+    trace $ show $ inputFF x <> (uncurry frameFF =<< ts)+    extractFrames x ts++-- | Noop the `ClipProcess` effect.+--+-- @since 0.2.0.0+ignoreClipProcess :: Sem (ClipProcess ': r) a -> Sem r a+ignoreClipProcess = interpret $ \case+  ExtractAudio _ _ -> pure ()+  ExtractClips _ _ -> pure ()+  ExtractFrames _ _ -> pure ()