diff --git a/app/exe.hs b/app/exe.hs --- a/app/exe.hs +++ b/app/exe.hs @@ -1,6 +1,6 @@ module Main where -import qualified Cut.Lib as Lib +import qualified Cut.Crap as Lib main :: IO () main = Lib.entryPoint diff --git a/cut-the-crap.cabal b/cut-the-crap.cabal --- a/cut-the-crap.cabal +++ b/cut-the-crap.cabal @@ -1,13 +1,13 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.33.0. +-- This file has been generated from package.yaml by hpack version 0.34.2. -- -- see: https://github.com/sol/hpack -- --- hash: 1250d94c516268de8b0a4c1ee8c7600bca2b27ba1ff011c15e836402301f160f +-- hash: 08b09429fe51925e641cb423204fc08004d168fc0e79a7dbc750ea69c9e350d4 name: cut-the-crap -version: 1.2.0 +version: 1.3.0 synopsis: Cuts out uninteresting parts of videos by detecting silences. description: Cut the crap is an automatic video editing program for streamers. It can cut out uninteresting parts by detecting silences. This was inspired by [jumpcutter](https://github.com/carykh/jumpcutter), where this program can get better quality results by using an (optional) dedicated microphone track. This prevents cutting of [quieter consonants](https://youtu.be/DQ8orIurGxw?t=675) for example. Using ffmpeg more efficiently also produces faster results and is less error prone. category: video @@ -24,11 +24,10 @@ library exposed-modules: Cut.Analyze + Cut.Crap Cut.CutVideo Cut.Ffmpeg - Cut.Lib Cut.Options - Cut.SplitVideo other-modules: Paths_cut_the_crap hs-source-dirs: @@ -79,11 +78,10 @@ Test.MatchLineSpec Test.TestSpec Cut.Analyze + Cut.Crap Cut.CutVideo Cut.Ffmpeg - Cut.Lib Cut.Options - Cut.SplitVideo Paths_cut_the_crap hs-source-dirs: test diff --git a/src/Cut/Crap.hs b/src/Cut/Crap.hs new file mode 100644 --- /dev/null +++ b/src/Cut/Crap.hs @@ -0,0 +1,126 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeOperators #-} +{-# OPTIONS_GHC -w #-} + +module Cut.Crap + ( entryPoint + , combineDir + , runCrap + , runEdit + ) +where + +import Control.Lens +import Control.Monad +import Control.Monad.Catch +import Control.Monad.IO.Class +import Control.Monad.IO.Unlift +import Cut.Analyze +import Cut.CutVideo +import Cut.Ffmpeg +import Cut.Options +import Data.Bifunctor +import Data.Either +import qualified Data.Text as Text +import qualified Data.Text.IO as Text +import Data.Text.Lens +import Options.Applicative +import Shelly hiding (FilePath) +import System.IO.Temp +import Text.Regex.TDFA hiding (empty, extract) + +entryPoint :: (MonadMask m, MonadUnliftIO m) => m () +entryPoint = runCrap =<< liftIO readSettings + +runCrap :: (MonadMask m, MonadUnliftIO m) => Options -> m () +runCrap options = do + liftIO $ putStr "started with options: " + liftIO $ print options + + -- first figure out what's up in the vid + parsed <- detect options + + -- then do stuff to it + case parsed of + [] -> + liftIO + $ putStr + "\n\nNo silence in input video detected. There is nothing to be cut so exiting.\n\n" + _ -> case options ^. work_dir of + Nothing -> + withTempDirectory "/tmp" "streamedit" $ liftIO . runEdit options parsed + Just x -> liftIO $ runEdit options parsed x + +runEdit :: Options -> [Interval Sound] -> FilePath -> IO () +runEdit options parsed tempDir = do + extract options tempDir parsed + shelly $ combineDir options tempDir + getMusic options tempDir + +combineDir :: Options -> FilePath -> Sh () +combineDir options tempDir = do + res <- lsT $ fromText $ Text.pack (tempDir <> extractDir) + let paths = Text.unlines $ flip (<>) "'" . ("file '" <>) <$> res + writefile (fromText $ Text.pack $ tempDir <> "/input.txt") paths + combine tempDir + +readSettings :: IO Options +readSettings = customExecParser (prefs showHelpOnError) $ info + (parseRecord <**> helper) + (fullDesc <> Options.Applicative.header "Cut the crap" <> progDesc + "Automated video extracting, can cut out silences" + ) + +musicFile :: FilePath +musicFile = "music.mp3" + +withMusicFile :: FilePath +withMusicFile = "combined.mkv" + +getMusic :: Options -> FilePath -> IO () +getMusic opt' tempDir = do + res <- case opt' ^. music_track of + Nothing -> pure $ Text.pack combinedFile + Just x -> do + shelly $ extractMusicTrack x (opt' ^. in_file) tempDir + shelly $ mergeMusicAndVideo tempDir + pure $ Text.pack (tempDir <> "/" <> withMusicFile) + putStrLn "done get music" + shelly $ cp (fromText res) (opt' ^. out_file . packed . to fromText) + pure () + where combinedFile = tempDir <> "/" <> combineOutput + +extractMusicTrack :: Int -> FilePath -> FilePath -> Sh () +extractMusicTrack musicTrack inputFile tempDir = void $ ffmpeg args + where -- https://stackoverflow.com/questions/7333232/how-to-concatenate-two-mp4-files-using-ffmpeg + args = + [ "-i" + , Text.pack inputFile + , "-map" + , "0:" <> Text.pack (show musicTrack) + , Text.pack (tempDir <> "/" <> musicFile) + ] + +mergeMusicAndVideo :: FilePath -> Sh () +mergeMusicAndVideo tempDir = void $ ffmpeg args + where -- https://stackoverflow.com/questions/7333232/how-to-concatenate-two-mp4-files-using-ffmpeg + args = + [ "-i" + , Text.pack $ tempDir <> "/" <> combineOutput + , "-i" + , Text.pack $ tempDir <> "/" <> musicFile + , "-filter_complex" + , "[0:a][1:a]amerge=inputs=2[a]" + , "-map" + , "0:v" + , "-map" + , "[a]" + , "-c:v" + , "copy" + , "-c:a" + , "mp3" + , "-ac" + , "2" + , "-shortest" + , Text.pack (tempDir <> "/" <> withMusicFile) + ] diff --git a/src/Cut/CutVideo.hs b/src/Cut/CutVideo.hs --- a/src/Cut/CutVideo.hs +++ b/src/Cut/CutVideo.hs @@ -7,6 +7,7 @@ , Sound , combine , combineOutput + , extractDir ) where @@ -17,11 +18,11 @@ import Cut.Ffmpeg import Cut.Options import Data.Foldable -import Data.Text ( Text ) -import qualified Data.Text as Text +import Data.Text (Text) +import qualified Data.Text as Text import Data.Text.Lens -import Shelly hiding ( FilePath ) -import Text.Printf ( printf ) +import Shelly hiding (FilePath) +import Text.Printf (printf) specifyTracks :: Options -> [Text] specifyTracks options = @@ -39,9 +40,7 @@ <> specifyTracks options <> [ Text.pack tmp <> "/" - <> options - ^. out_file - . packed + <> Text.pack (getOutFileName options) <> "-" <> fname <> ".mkv" @@ -52,8 +51,12 @@ duration = floatToText $ interval_duration inter fname = Text.pack $ printf "%010d" (truncate $ interval_start inter * 100 :: Integer) +extractDir :: FilePath +extractDir = "/extract" + extract :: Options -> FilePath -> [Interval Sound] -> IO () extract options tempDir intervals = do + shelly $ mkdir_p exdir traverse_ (\(inter, args) -> void $ catch (shelly $ ffmpeg args) $ \exec -> do liftIO @@ -61,9 +64,11 @@ ) pure ["expection"] ) - $ toArgs options tempDir - <$> intervals + $ toArgs options exdir <$> intervals liftIO $ putStrLn "finish extracting" + + where + exdir = tempDir <> extractDir combineOutput :: FilePath combineOutput = "combined-output.mkv" diff --git a/src/Cut/Lib.hs b/src/Cut/Lib.hs deleted file mode 100644 --- a/src/Cut/Lib.hs +++ /dev/null @@ -1,122 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE TypeOperators #-} -{-# OPTIONS_GHC -w #-} - -module Cut.Lib - ( entryPoint - , combineDir - ) -where - -import Control.Lens -import Control.Monad -import Control.Monad.Catch -import Control.Monad.IO.Class -import Control.Monad.IO.Unlift -import Cut.Analyze -import Cut.CutVideo -import Cut.Ffmpeg -import Cut.Options -import Cut.SplitVideo -import Data.Bifunctor -import Data.Either -import qualified Data.Text as Text -import qualified Data.Text.IO as Text -import Data.Text.Lens -import Options.Applicative -import Shelly hiding ( FilePath ) -import System.IO.Temp -import Text.Regex.TDFA hiding ( empty - , extract - ) - -entryPoint :: (MonadMask m, MonadUnliftIO m) => m () -entryPoint = do - options <- liftIO readSettings - liftIO $ putStr "started with options: " - liftIO $ print options - - parsed <- detect options - case parsed of - [] -> - liftIO - $ putStr - "\n\nNo silence in input video detected. There is nothing to be cut so exiting.\n\n" - _ -> case options ^. work_dir of - Nothing -> - withTempDirectory "/tmp" "streamedit" $ liftIO . runEdit options parsed - Just x -> liftIO $ runEdit options parsed x - -runEdit :: Options -> [Interval Sound] -> FilePath -> IO () -runEdit options parsed tempDir = do - extract options tempDir parsed - shelly $ combineDir options tempDir - getMusic options tempDir - -combineDir :: Options -> FilePath -> Sh () -combineDir options tempDir = do - res <- lsT $ fromText $ Text.pack tempDir - let paths = Text.unlines $ flip (<>) "'" . ("file '" <>) <$> res - writefile (fromText $ Text.pack $ tempDir <> "/input.txt") paths - combine tempDir - -readSettings :: IO Options -readSettings = customExecParser (prefs showHelpOnError) $ info - (parseRecord <**> helper) - (fullDesc <> Options.Applicative.header "Cut the crap" <> progDesc - "Automated video extracting, can cut out silences" - ) - -musicFile :: FilePath -musicFile = "music.mp3" - -withMusicFile :: FilePath -withMusicFile = "combined.mkv" - -getMusic :: Options -> FilePath -> IO () -getMusic opt' tempDir = do - res <- case opt' ^. music_track of - Nothing -> pure $ Text.pack combinedFile - Just x -> do - shelly $ extractMusicTrack x (opt' ^. in_file) tempDir - shelly $ mergeMusicAndVideo tempDir - pure $ Text.pack (tempDir <> "/" <> withMusicFile) - putStrLn "done get music" - shelly $ cp (fromText res) (opt' ^. out_file . packed . to fromText) - pure () - where combinedFile = tempDir <> "/" <> combineOutput - -extractMusicTrack :: Int -> FilePath -> FilePath -> Sh () -extractMusicTrack musicTrack inputFile tempDir = void $ ffmpeg args - where -- https://stackoverflow.com/questions/7333232/how-to-concatenate-two-mp4-files-using-ffmpeg - args = - [ "-i" - , Text.pack inputFile - , "-map" - , "0:" <> Text.pack (show musicTrack) - , Text.pack (tempDir <> "/" <> musicFile) - ] - -mergeMusicAndVideo :: FilePath -> Sh () -mergeMusicAndVideo tempDir = void $ ffmpeg args - where -- https://stackoverflow.com/questions/7333232/how-to-concatenate-two-mp4-files-using-ffmpeg - args = - [ "-i" - , Text.pack $ tempDir <> "/" <> combineOutput - , "-i" - , Text.pack $ tempDir <> "/" <> musicFile - , "-filter_complex" - , "[0:a][1:a]amerge=inputs=2[a]" - , "-map" - , "0:v" - , "-map" - , "[a]" - , "-c:v" - , "copy" - , "-c:a" - , "mp3" - , "-ac" - , "2" - , "-shortest" - , Text.pack (tempDir <> "/" <> withMusicFile) - ] diff --git a/src/Cut/Options.hs b/src/Cut/Options.hs --- a/src/Cut/Options.hs +++ b/src/Cut/Options.hs @@ -16,14 +16,11 @@ , cut_noise , work_dir , simpleOptions + , getOutFileName ) where -import Control.Lens ( (#) - , Lens' - , _Just - , non - ) +import Control.Lens (Lens', non, view, ( # ), _Just) import Data.Generics.Product.Fields import GHC.Generics import Options.Applicative @@ -41,17 +38,20 @@ , workDir = Nothing } +getOutFileName :: Options -> FilePath +getOutFileName = reverse . takeWhile ((/=) '/') . reverse . view out_file + data Options = Options - { inFile :: FilePath - , outFile :: FilePath - , segmentSize :: Maybe Int + { inFile :: FilePath + , outFile :: FilePath + , segmentSize :: Maybe Int , silentTreshold :: Maybe Double , silentDuration :: Maybe Double - , detectMargin :: Maybe Double - , voiceTrack :: Maybe Int - , musicTrack :: Maybe Int - , cutNoise :: Bool - , workDir :: Maybe FilePath + , detectMargin :: Maybe Double + , voiceTrack :: Maybe Int + , musicTrack :: Maybe Int + , cutNoise :: Bool + , workDir :: Maybe FilePath } deriving (Show, Generic) in_file :: Lens' Options FilePath diff --git a/src/Cut/SplitVideo.hs b/src/Cut/SplitVideo.hs deleted file mode 100644 --- a/src/Cut/SplitVideo.hs +++ /dev/null @@ -1,32 +0,0 @@ -module Cut.SplitVideo - ( split - ) -where - -import Control.Lens -import Control.Monad -import Cut.Ffmpeg -import Cut.Options -import Data.Text.Lens -import Shelly hiding ( FilePath ) - --- | Splits a video into segments -split :: FilePath -> Options -> Sh () -split tmp opt' = do - cp (fromText (tmp ^. packed)) - (fromText (opt' ^. out_file . packed <> "-full.mp4")) - void $ ffmpeg - [ "-i" - , tmp ^. packed - , "-c" - , "copy" - , "-map" - , "0" - , "-segment_time" - , "00:" <> (opt' ^. seg_size . to show . packed) <> ":00" - , "-f" - , "segment" - , "-reset_timestamps" - , "1" - , opt' ^. out_file . packed <> "%03d.mp4" - ]