{-# OPTIONS_GHC -Wno-type-defaults #-}

module Cut.CutVideo
  ( extract
  , Interval(..)
  , Silent
  , Sound
  , combine
  , combineOutput
  , extractDir
  )
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)
import           Text.Printf         (printf)

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
  , -- keep ter interval for debugging
    ["-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
tmp
         Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "/"
         Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
Text.pack (ListenCutOptions -> FilePath
forall a. ListenCutOptionsT a -> FilePath
getOutFileName ListenCutOptions
options)
         Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "-"
         Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fname
         Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ".mkv"
       ]
  )
 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
  fname :: Text
fname    = FilePath -> Text
Text.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ 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)

extractDir :: FilePath
extractDir :: FilePath
extractDir = "/extract"

extract :: ListenCutOptions -> FilePath -> [Interval Sound] -> IO ()
extract :: ListenCutOptions -> FilePath -> [Interval Sound] -> IO ()
extract 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 "finish extracting"

  where
    exdir :: FilePath
exdir = FilePath
tempDir FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> 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 -- https://stackoverflow.com/questions/7333232/how-to-concatenate-two-mp4-files-using-ffmpeg
  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 a. Semigroup a => a -> a -> a
<> "/" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
combineOutput
    ]