{-# OPTIONS_GHC -Wno-type-defaults #-}
module Cut.CutVideo
( extract
, Interval(..)
, Silent
, Sound
, combine
, combineOutput
, combineDir
)
where
import Control.Lens
import Control.Monad
import Control.Monad.Catch
import Cut.Analyze
import Cut.Shell
import Cut.Options
import Data.Foldable
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Text.Lens
import Shelly hiding (FilePath, shelly)
import Text.Printf (printf)
toFileName :: ListenCutOptions -> FilePath -> Interval Sound -> FilePath
toFileName :: ListenCutOptions -> FilePath -> Interval Sound -> FilePath
toFileName options :: ListenCutOptions
options tmp :: FilePath
tmp inter :: Interval Sound
inter = FilePath
tmp
FilePath -> FilePath -> FilePath
forall filepath1 filepath2.
(ToFilePath filepath1, ToFilePath filepath2) =>
filepath1 -> filepath2 -> FilePath
</> ListenCutOptions -> FilePath
forall a. ListenCutOptionsT a -> FilePath
getOutFileName ListenCutOptions
options
FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> "-"
FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
fname
FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> ".mkv"
where
fname :: FilePath
fname = FilePath -> Integer -> FilePath
forall r. PrintfType r => FilePath -> r
printf "%010d" (Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Double -> Integer) -> Double -> Integer
forall a b. (a -> b) -> a -> b
$ Interval Sound -> Double
forall e. Interval e -> Double
interval_start Interval Sound
inter Double -> Double -> Double
forall a. Num a => a -> a -> a
* 100 :: Integer)
toArgs :: ListenCutOptions -> FilePath -> Interval Sound -> (Interval Sound, [Text])
toArgs :: ListenCutOptions
-> FilePath -> Interval Sound -> (Interval Sound, [Text])
toArgs options :: ListenCutOptions
options tmp :: FilePath
tmp inter :: Interval Sound
inter =
( Interval Sound
inter
,
["-y", "-ss", Text
start, "-t", Text
duration, "-i", ListenCutOptions
options ListenCutOptions -> Getting Text ListenCutOptions Text -> Text
forall s a. s -> Getting a s a -> a
^. (FileIO FilePath -> Const Text (FileIO FilePath))
-> ListenCutOptions -> Const Text ListenCutOptions
forall a b.
Lens
(ListenCutOptionsT a) (ListenCutOptionsT b) (FileIO a) (FileIO b)
lc_fileio ((FileIO FilePath -> Const Text (FileIO FilePath))
-> ListenCutOptions -> Const Text ListenCutOptions)
-> ((Text -> Const Text Text)
-> FileIO FilePath -> Const Text (FileIO FilePath))
-> Getting Text ListenCutOptions Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Const Text FilePath)
-> FileIO FilePath -> Const Text (FileIO FilePath)
forall a b. Lens (FileIO a) (FileIO b) a b
in_file ((FilePath -> Const Text FilePath)
-> FileIO FilePath -> Const Text (FileIO FilePath))
-> ((Text -> Const Text Text) -> FilePath -> Const Text FilePath)
-> (Text -> Const Text Text)
-> FileIO FilePath
-> Const Text (FileIO FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const Text Text) -> FilePath -> Const Text FilePath
forall t. IsText t => Iso' FilePath t
packed]
[Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> ListenCutOptions -> [Text]
forall a. ListenCutOptionsT a -> [Text]
specifyTracks ListenCutOptions
options
[Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [ FilePath -> Text
Text.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ ListenCutOptions -> FilePath -> Interval Sound -> FilePath
toFileName ListenCutOptions
options FilePath
tmp Interval Sound
inter
]
)
where
start :: Text
start = Double -> Text
floatToText (Double -> Text) -> Double -> Text
forall a b. (a -> b) -> a -> b
$ Interval Sound -> Double
forall e. Interval e -> Double
interval_start Interval Sound
inter
duration :: Text
duration = Double -> Text
floatToText (Double -> Text) -> Double -> Text
forall a b. (a -> b) -> a -> b
$ Interval Sound -> Double
forall e. Interval e -> Double
interval_duration Interval Sound
inter
extractDir :: FilePath
= "extract"
extract :: ListenCutOptions -> FilePath -> [Interval Sound] -> IO ()
options :: ListenCutOptions
options tempDir :: FilePath
tempDir intervals :: [Interval Sound]
intervals = do
Sh () -> IO ()
forall (m :: * -> *) a. MonadIO m => Sh a -> m a
shelly (Sh () -> IO ()) -> Sh () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Sh ()
mkdir_p FilePath
exdir
((Interval Sound, [Text]) -> IO ())
-> [(Interval Sound, [Text])] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_
(\(inter :: Interval Sound
inter, args :: [Text]
args) -> IO [Text] -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO [Text] -> IO ()) -> IO [Text] -> IO ()
forall a b. (a -> b) -> a -> b
$ IO [Text] -> (SomeException -> IO [Text]) -> IO [Text]
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch (Sh [Text] -> IO [Text]
forall (m :: * -> *) a. MonadIO m => Sh a -> m a
shelly (Sh [Text] -> IO [Text]) -> Sh [Text] -> IO [Text]
forall a b. (a -> b) -> a -> b
$ [Text] -> Sh [Text]
ffmpeg' [Text]
args) ((SomeException -> IO [Text]) -> IO [Text])
-> (SomeException -> IO [Text]) -> IO [Text]
forall a b. (a -> b) -> a -> b
$ \exec :: SomeException
exec -> do
IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
((FilePath, SomeException, [Text], Interval Sound) -> IO ()
forall a. Show a => a -> IO ()
print ("expection during edit: ", SomeException
exec :: SomeException, [Text]
args, Interval Sound
inter)
)
[Text] -> IO [Text]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ["expection"]
)
([(Interval Sound, [Text])] -> IO ())
-> [(Interval Sound, [Text])] -> IO ()
forall a b. (a -> b) -> a -> b
$ ListenCutOptions
-> FilePath -> Interval Sound -> (Interval Sound, [Text])
toArgs ListenCutOptions
options FilePath
exdir (Interval Sound -> (Interval Sound, [Text]))
-> [Interval Sound] -> [(Interval Sound, [Text])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Interval Sound]
intervals
IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
putStrLn "finished extracting"
where
exdir :: FilePath
exdir = FilePath
tempDir FilePath -> FilePath -> FilePath
forall filepath1 filepath2.
(ToFilePath filepath1, ToFilePath filepath2) =>
filepath1 -> filepath2 -> FilePath
</> FilePath
extractDir
combineOutput :: FilePath
combineOutput :: FilePath
combineOutput = "combined-output.mkv"
combine :: FilePath -> Sh ()
combine :: FilePath -> Sh ()
combine tempDir :: FilePath
tempDir = do
[Text]
output' <- [Text] -> Sh [Text]
ffmpeg' [Text]
args
IO () -> Sh ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Sh ()) -> IO () -> Sh ()
forall a b. (a -> b) -> a -> b
$ (FilePath, [Text]) -> IO ()
forall a. Show a => a -> IO ()
print ("output", [Text]
output')
where
args :: [Text]
args =
[ "-y"
, "-f"
, "concat"
, "-safe"
, "0"
, "-i"
, FilePath -> Text
Text.pack (FilePath
tempDir FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> "/input.txt")
, "-c"
, "copy"
, FilePath -> Text
Text.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ FilePath
tempDir FilePath -> FilePath -> FilePath
forall filepath1 filepath2.
(ToFilePath filepath1, ToFilePath filepath2) =>
filepath1 -> filepath2 -> FilePath
</> FilePath
combineOutput
]
combineDir :: ListenCutOptions -> FilePath -> [Interval Sound] -> Sh ()
combineDir :: ListenCutOptions -> FilePath -> [Interval Sound] -> Sh ()
combineDir options :: ListenCutOptions
options tempDir :: FilePath
tempDir intervals :: [Interval Sound]
intervals = do
IO () -> Sh ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Sh ()) -> IO () -> Sh ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
putStrLn "start combining the dir"
let paths :: Text
paths = [Text] -> Text
Text.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Text -> Text -> Text) -> Text -> Text -> Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
(<>) "'" (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ("file '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
res
FilePath -> Text -> Sh ()
writefile (Text -> FilePath
fromText (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
Text.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ FilePath
tempDir FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> "/input.txt") Text
paths
FilePath -> Sh ()
combine FilePath
tempDir
where
res :: [Text]
res = FilePath -> Text
Text.pack (FilePath -> Text)
-> (Interval Sound -> FilePath) -> Interval Sound -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListenCutOptions -> FilePath -> Interval Sound -> FilePath
toFileName ListenCutOptions
options FilePath
exdir (Interval Sound -> Text) -> [Interval Sound] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Interval Sound]
intervals
exdir :: FilePath
exdir = if Bool
hasWorkDir then FilePath
extractDir else FilePath
tempDir FilePath -> FilePath -> FilePath
forall filepath1 filepath2.
(ToFilePath filepath1, ToFilePath filepath2) =>
filepath1 -> filepath2 -> FilePath
</> FilePath
extractDir
hasWorkDir :: Bool
hasWorkDir :: Bool
hasWorkDir = Getting Any ListenCutOptions FilePath -> ListenCutOptions -> Bool
forall s a. Getting Any s a -> s -> Bool
has ((FileIO FilePath -> Const Any (FileIO FilePath))
-> ListenCutOptions -> Const Any ListenCutOptions
forall a b.
Lens
(ListenCutOptionsT a) (ListenCutOptionsT b) (FileIO a) (FileIO b)
lc_fileio ((FileIO FilePath -> Const Any (FileIO FilePath))
-> ListenCutOptions -> Const Any ListenCutOptions)
-> ((FilePath -> Const Any FilePath)
-> FileIO FilePath -> Const Any (FileIO FilePath))
-> Getting Any ListenCutOptions FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe FilePath -> Const Any (Maybe FilePath))
-> FileIO FilePath -> Const Any (FileIO FilePath)
forall a. Lens' (FileIO a) (Maybe FilePath)
work_dir ((Maybe FilePath -> Const Any (Maybe FilePath))
-> FileIO FilePath -> Const Any (FileIO FilePath))
-> ((FilePath -> Const Any FilePath)
-> Maybe FilePath -> Const Any (Maybe FilePath))
-> (FilePath -> Const Any FilePath)
-> FileIO FilePath
-> Const Any (FileIO FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Const Any FilePath)
-> Maybe FilePath -> Const Any (Maybe FilePath)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just) ListenCutOptions
options