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

-- | Extract sounded parts, and combine again
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)

-- | convert a sounded interval into a filename where we write the temporary extracted file in
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
  , -- 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 -> 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
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 "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 -- 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 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
    -- for relative dirs ffmpeg doesn't accept prepending of tempdir
    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