{-# LANGUAGE DataKinds     #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | This is where it all started
module Cut.Crap
  ( entryPoint
  , combineDir
  , makeSrt
  , runListenCut
  , runEdit
  , runGenSubs
  )
where

import           Cut.Shell
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.Options
import           Cut.SpeechRecognition
import           Data.Foldable                (fold, foldl', traverse_)
import           Data.Generics.Product.Fields
import           Data.Maybe
import           Data.Text                    (Text)
import qualified Data.Text                    as Text
import qualified Data.Text.IO                 as T
import           Data.Text.Lens
import           Data.Time
import           GHC.Generics                 hiding (to)
import           Options.Applicative
import           Shelly                       hiding (FilePath)
import           System.IO.Temp
import Cut.Download

-- | reads settings from terminal and runs whatever command was
--   given in program options
entryPoint :: MonadMask m => MonadUnliftIO m => m ()
entryPoint :: m ()
entryPoint = do
  ProgramOptions InputSource
result <- IO (ProgramOptions InputSource) -> m (ProgramOptions InputSource)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (ProgramOptions InputSource)
readSettings
  case  ProgramOptions InputSource
result of
    ListenCut cut :: ListenCutOptionsT InputSource
cut -> ListenCutOptionsT InputSource
-> (ListenCutOptionsT FilePath -> m ()) -> m ()
forall (m :: * -> *) a.
(MonadMask m, MonadIO m) =>
ListenCutOptionsT InputSource
-> (ListenCutOptionsT FilePath -> m a) -> m a
downloadCutifNeccisary ListenCutOptionsT InputSource
cut ((ListenCutOptionsT FilePath -> m ()) -> m ())
-> (ListenCutOptionsT FilePath -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ m [Interval Sound] -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m [Interval Sound] -> m ())
-> (ListenCutOptionsT FilePath -> m [Interval Sound])
-> ListenCutOptionsT FilePath
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListenCutOptionsT FilePath -> m [Interval Sound]
forall (m :: * -> *).
(MonadMask m, MonadUnliftIO m) =>
ListenCutOptionsT FilePath -> m [Interval Sound]
runListenCut
    GenerateSubtitles x :: FileIO InputSource
x -> FileIO InputSource -> (FileIO FilePath -> m ()) -> m ()
forall (m :: * -> *) a.
(MonadMask m, MonadIO m) =>
FileIO InputSource -> (FileIO FilePath -> m a) -> m a
downloadIfNeccisary FileIO InputSource
x FileIO FilePath -> m ()
forall (m :: * -> *). MonadIO m => FileIO FilePath -> m ()
runGenSubs

runGenSubs :: MonadIO m => FileIO FilePath -> m ()
runGenSubs :: FileIO FilePath -> m ()
runGenSubs options :: FileIO FilePath
options = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ FileIO FilePath -> (FilePath -> IO ()) -> IO ()
withTempDir FileIO FilePath
options ((FilePath -> IO ()) -> IO ()) -> (FilePath -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \tmp :: FilePath
tmp -> do
    ListenCutOptionsT InputSource
-> (ListenCutOptionsT FilePath -> IO ()) -> IO ()
forall (m :: * -> *) a.
(MonadMask m, MonadIO m) =>
ListenCutOptionsT InputSource
-> (ListenCutOptionsT FilePath -> m a) -> m a
downloadCutifNeccisary ListenCutOptionsT InputSource
simpleOptions ((ListenCutOptionsT FilePath -> IO ()) -> IO ())
-> (ListenCutOptionsT FilePath -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \betterOptions :: ListenCutOptionsT FilePath
betterOptions -> do
      Either ResultCode [WordFrame]
result <- Sh (Either ResultCode [WordFrame])
-> IO (Either ResultCode [WordFrame])
forall (m :: * -> *) a. MonadIO m => Sh a -> m a
shelly (Sh (Either ResultCode [WordFrame])
 -> IO (Either ResultCode [WordFrame]))
-> Sh (Either ResultCode [WordFrame])
-> IO (Either ResultCode [WordFrame])
forall a b. (a -> b) -> a -> b
$ ListenCutOptionsT FilePath
-> FilePath -> FilePath -> Sh (Either ResultCode [WordFrame])
detectSpeech (ASetter
  (ListenCutOptionsT FilePath) (ListenCutOptionsT FilePath) Int Int
-> Int -> ListenCutOptionsT FilePath -> ListenCutOptionsT FilePath
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  (ListenCutOptionsT FilePath) (ListenCutOptionsT FilePath) Int Int
forall a. Lens' (ListenCutOptionsT a) Int
voice_track 1 ListenCutOptionsT FilePath
betterOptions) FilePath
tmp (FilePath -> Sh (Either ResultCode [WordFrame]))
-> FilePath -> Sh (Either ResultCode [WordFrame])
forall a b. (a -> b) -> a -> b
$ FileIO FilePath
options FileIO FilePath
-> Getting FilePath (FileIO FilePath) FilePath -> FilePath
forall s a. s -> Getting a s a -> a
^. Getting FilePath (FileIO FilePath) FilePath
forall a b. Lens (FileIO a) (FileIO b) a b
in_file
      Either ResultCode [WordFrame] -> IO ()
forall a. Show a => a -> IO ()
print Either ResultCode [WordFrame]
result
      ([WordFrame] -> IO ()) -> Either ResultCode [WordFrame] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (FilePath -> Text -> IO ()
T.writeFile (FileIO FilePath
options FileIO FilePath
-> Getting FilePath (FileIO FilePath) FilePath -> FilePath
forall s a. s -> Getting a s a -> a
^. Getting FilePath (FileIO FilePath) FilePath
forall a. Lens' (FileIO a) FilePath
out_file) (Text -> IO ()) -> ([WordFrame] -> Text) -> [WordFrame] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [WordFrame] -> Text
makeSrt) Either ResultCode [WordFrame]
result

-- | Runs cut-the-crap with provided `ListenCutOptions`
runListenCut :: MonadMask m => MonadUnliftIO m => ListenCutOptions -> m [Interval Sound]
runListenCut :: ListenCutOptionsT FilePath -> m [Interval Sound]
runListenCut options :: ListenCutOptionsT FilePath
options = do
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
putStr "started with options: "
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ListenCutOptionsT FilePath -> IO ()
forall a. Show a => a -> IO ()
print ListenCutOptionsT FilePath
options

  -- first figure out what's up in the vid
  [Interval Sound]
parsed <- ListenCutOptionsT FilePath -> m [Interval Sound]
forall (m :: * -> *).
(MonadMask m, MonadUnliftIO m) =>
ListenCutOptionsT FilePath -> m [Interval Sound]
detectSoundInterval ListenCutOptionsT FilePath
options

  -- then do stuff to it
  [Interval Sound]
parsed [Interval Sound] -> m () -> m [Interval Sound]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ case [Interval Sound]
parsed of
    [] ->
      IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
        (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
putStr
            "\n\nNo silence in input video detected. There is nothing to be cut so exiting.\n\n"
    _ -> IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ FileIO FilePath -> (FilePath -> IO ()) -> IO ()
withTempDir (ListenCutOptionsT FilePath
options ListenCutOptionsT FilePath
-> Getting
     (FileIO FilePath) (ListenCutOptionsT FilePath) (FileIO FilePath)
-> FileIO FilePath
forall s a. s -> Getting a s a -> a
^. Getting
  (FileIO FilePath) (ListenCutOptionsT FilePath) (FileIO FilePath)
forall a b.
Lens
  (ListenCutOptionsT a) (ListenCutOptionsT b) (FileIO a) (FileIO b)
lc_fileio) ((FilePath -> IO ()) -> IO ()) -> (FilePath -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ ListenCutOptionsT FilePath -> [Interval Sound] -> FilePath -> IO ()
runEdit ListenCutOptionsT FilePath
options [Interval Sound]
parsed

withTempDir :: FileIO FilePath -> (FilePath -> IO ()) -> IO ()
withTempDir :: FileIO FilePath -> (FilePath -> IO ()) -> IO ()
withTempDir filioOpts :: FileIO FilePath
filioOpts fun :: FilePath -> IO ()
fun =
  IO () -> (FilePath -> IO ()) -> Maybe FilePath -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath -> FilePath -> (FilePath -> IO ()) -> IO ()
forall (m :: * -> *) a.
(MonadMask m, MonadIO m) =>
FilePath -> FilePath -> (FilePath -> m a) -> m a
withTempDirectory "/tmp" "streamedit" FilePath -> IO ()
fun) FilePath -> IO ()
fun (Maybe FilePath -> IO ()) -> Maybe FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FileIO FilePath
filioOpts FileIO FilePath
-> Getting (Maybe FilePath) (FileIO FilePath) (Maybe FilePath)
-> Maybe FilePath
forall s a. s -> Getting a s a -> a
^. Getting (Maybe FilePath) (FileIO FilePath) (Maybe FilePath)
forall a. Lens' (FileIO a) (Maybe FilePath)
work_dir

-- | Run editing on video from options with preprovided detections
--   normally aquired throug `detect`
runEdit :: ListenCutOptions -> [Interval Sound] -> FilePath -> IO ()
runEdit :: ListenCutOptionsT FilePath -> [Interval Sound] -> FilePath -> IO ()
runEdit options :: ListenCutOptionsT FilePath
options parsed :: [Interval Sound]
parsed tempDir :: FilePath
tempDir = do
  ListenCutOptionsT FilePath -> FilePath -> [Interval Sound] -> IO ()
extract ListenCutOptionsT FilePath
options FilePath
tempDir [Interval Sound]
parsed
  Sh () -> IO ()
forall (m :: * -> *) a. MonadIO m => Sh a -> m a
shelly (Sh () -> IO ()) -> Sh () -> IO ()
forall a b. (a -> b) -> a -> b
$ ListenCutOptionsT FilePath -> FilePath -> Sh ()
combineDir ListenCutOptionsT FilePath
options FilePath
tempDir
  ListenCutOptionsT FilePath -> FilePath -> IO ()
getMusic ListenCutOptionsT FilePath
options FilePath
tempDir

combineDir :: ListenCutOptions -> FilePath -> Sh ()
combineDir :: ListenCutOptionsT FilePath -> FilePath -> Sh ()
combineDir _ tempDir :: FilePath
tempDir = do
  [Text]
res <- FilePath -> Sh [Text]
lsT (FilePath -> Sh [Text]) -> FilePath -> Sh [Text]
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
fromText (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
Text.pack (FilePath
tempDir FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
extractDir)
  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

readSettings :: IO (ProgramOptions InputSource)
readSettings :: IO (ProgramOptions InputSource)
readSettings = ParserPrefs
-> ParserInfo (ProgramOptions InputSource)
-> IO (ProgramOptions InputSource)
forall a. ParserPrefs -> ParserInfo a -> IO a
customExecParser (PrefsMod -> ParserPrefs
prefs PrefsMod
showHelpOnError) (ParserInfo (ProgramOptions InputSource)
 -> IO (ProgramOptions InputSource))
-> ParserInfo (ProgramOptions InputSource)
-> IO (ProgramOptions InputSource)
forall a b. (a -> b) -> a -> b
$ Parser (ProgramOptions InputSource)
-> InfoMod (ProgramOptions InputSource)
-> ParserInfo (ProgramOptions InputSource)
forall a. Parser a -> InfoMod a -> ParserInfo a
info
  (Parser (ProgramOptions InputSource)
parseProgram Parser (ProgramOptions InputSource)
-> Parser
     (ProgramOptions InputSource -> ProgramOptions InputSource)
-> Parser (ProgramOptions InputSource)
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (ProgramOptions InputSource -> ProgramOptions InputSource)
forall a. Parser (a -> a)
helper)
  (InfoMod (ProgramOptions InputSource)
forall a. InfoMod a
fullDesc InfoMod (ProgramOptions InputSource)
-> InfoMod (ProgramOptions InputSource)
-> InfoMod (ProgramOptions InputSource)
forall a. Semigroup a => a -> a -> a
<> FilePath -> InfoMod (ProgramOptions InputSource)
forall a. FilePath -> InfoMod a
header "Cut the crap" InfoMod (ProgramOptions InputSource)
-> InfoMod (ProgramOptions InputSource)
-> InfoMod (ProgramOptions InputSource)
forall a. Semigroup a => a -> a -> a
<> FilePath -> InfoMod (ProgramOptions InputSource)
forall a. FilePath -> InfoMod a
progDesc
    "Automated video extracting, can cut out silences"
  )

musicFile :: FilePath
musicFile :: FilePath
musicFile = "music.mp3"

withMusicFile :: FilePath
withMusicFile :: FilePath
withMusicFile = "combined.mkv"

getMusic :: ListenCutOptions -> FilePath -> IO ()
getMusic :: ListenCutOptionsT FilePath -> FilePath -> IO ()
getMusic opt' :: ListenCutOptionsT FilePath
opt' tempDir :: FilePath
tempDir = do
  Text
res <- case ListenCutOptionsT FilePath
opt' ListenCutOptionsT FilePath
-> Getting (Maybe Int) (ListenCutOptionsT FilePath) (Maybe Int)
-> Maybe Int
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Int) (ListenCutOptionsT FilePath) (Maybe Int)
forall a. Lens' (ListenCutOptionsT a) (Maybe Int)
music_track of
    Nothing -> Text -> IO Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> IO Text) -> Text -> IO Text
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
Text.pack FilePath
combinedFile
    Just x :: Int
x  -> do
      Sh () -> IO ()
forall (m :: * -> *) a. MonadIO m => Sh a -> m a
shelly (Sh () -> IO ()) -> Sh () -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> FilePath -> FilePath -> Sh ()
extractMusicTrack Int
x (ListenCutOptionsT FilePath
opt' ListenCutOptionsT FilePath
-> Getting FilePath (ListenCutOptionsT FilePath) FilePath
-> FilePath
forall s a. s -> Getting a s a -> a
^. (FileIO FilePath -> Const FilePath (FileIO FilePath))
-> ListenCutOptionsT FilePath
-> Const FilePath (ListenCutOptionsT FilePath)
forall a b.
Lens
  (ListenCutOptionsT a) (ListenCutOptionsT b) (FileIO a) (FileIO b)
lc_fileio ((FileIO FilePath -> Const FilePath (FileIO FilePath))
 -> ListenCutOptionsT FilePath
 -> Const FilePath (ListenCutOptionsT FilePath))
-> Getting FilePath (FileIO FilePath) FilePath
-> Getting FilePath (ListenCutOptionsT FilePath) FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting FilePath (FileIO FilePath) FilePath
forall a b. Lens (FileIO a) (FileIO b) a b
in_file) FilePath
tempDir
      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 ()
mergeMusicAndVideo FilePath
tempDir
      Text -> IO Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> IO Text) -> Text -> IO Text
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
Text.pack (FilePath
tempDir FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> "/" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
withMusicFile)
  FilePath -> IO ()
putStrLn "done get music"
  Sh () -> IO ()
forall (m :: * -> *) a. MonadIO m => Sh a -> m a
shelly (Sh () -> IO ()) -> Sh () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> Sh ()
cp (Text -> FilePath
fromText Text
res) (ListenCutOptionsT FilePath
opt' ListenCutOptionsT FilePath
-> Getting FilePath (ListenCutOptionsT FilePath) FilePath
-> FilePath
forall s a. s -> Getting a s a -> a
^. (FileIO FilePath -> Const FilePath (FileIO FilePath))
-> ListenCutOptionsT FilePath
-> Const FilePath (ListenCutOptionsT FilePath)
forall a b.
Lens
  (ListenCutOptionsT a) (ListenCutOptionsT b) (FileIO a) (FileIO b)
lc_fileio ((FileIO FilePath -> Const FilePath (FileIO FilePath))
 -> ListenCutOptionsT FilePath
 -> Const FilePath (ListenCutOptionsT FilePath))
-> Getting FilePath (FileIO FilePath) FilePath
-> Getting FilePath (ListenCutOptionsT FilePath) FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting FilePath (FileIO FilePath) FilePath
forall a. Lens' (FileIO a) FilePath
out_file Getting FilePath (FileIO FilePath) FilePath
-> ((FilePath -> Const FilePath FilePath)
    -> FilePath -> Const FilePath FilePath)
-> Getting FilePath (FileIO FilePath) FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const FilePath Text)
-> FilePath -> Const FilePath FilePath
forall t. IsText t => Iso' FilePath t
packed ((Text -> Const FilePath Text)
 -> FilePath -> Const FilePath FilePath)
-> ((FilePath -> Const FilePath FilePath)
    -> Text -> Const FilePath Text)
-> (FilePath -> Const FilePath FilePath)
-> FilePath
-> Const FilePath FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> FilePath)
-> (FilePath -> Const FilePath FilePath)
-> Text
-> Const FilePath Text
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Text -> FilePath
fromText)
  () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  where combinedFile :: FilePath
combinedFile = FilePath
tempDir FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> "/" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
combineOutput

extractMusicTrack :: Int -> FilePath -> FilePath -> Sh ()
extractMusicTrack :: Int -> FilePath -> FilePath -> Sh ()
extractMusicTrack musicTrack :: Int
musicTrack inputFile :: FilePath
inputFile tempDir :: FilePath
tempDir = Sh [Text] -> Sh ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sh [Text] -> Sh ()) -> Sh [Text] -> Sh ()
forall a b. (a -> b) -> a -> b
$ FilePath -> [Text] -> Sh [Text]
ffmpeg FilePath
inputFile [Text]
args
 where -- https://stackoverflow.com/questions/7333232/how-to-concatenate-two-mp4-files-using-ffmpeg
  args :: [Text]
args =
    [ "-map"
    , "0:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
Text.pack (Int -> FilePath
forall a. Show a => a -> FilePath
show Int
musicTrack)
    , FilePath -> Text
Text.pack (FilePath
tempDir FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> "/" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
musicFile)
    ]

mergeMusicAndVideo :: FilePath -> Sh ()
mergeMusicAndVideo :: FilePath -> Sh ()
mergeMusicAndVideo tempDir :: FilePath
tempDir = Sh [Text] -> Sh ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sh [Text] -> Sh ()) -> Sh [Text] -> Sh ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Sh [Text]
ffmpeg' [Text]
args
 where -- https://stackoverflow.com/questions/7333232/how-to-concatenate-two-mp4-files-using-ffmpeg
  args :: [Text]
args =
    [ "-i"
    , 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
    , "-i"
    , 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
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"
    , FilePath -> Text
Text.pack (FilePath
tempDir FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> "/" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
withMusicFile)
    ]


data SrtDisplay = SrtDisplay
  { SrtDisplay -> DiffTime
_srt_from     :: DiffTime
  , SrtDisplay -> DiffTime
_srt_to       :: DiffTime
  , SrtDisplay -> Text
_srt_words    :: Text
  , SrtDisplay -> Int
_srt_position :: Int
  } deriving (Int -> SrtDisplay -> FilePath -> FilePath
[SrtDisplay] -> FilePath -> FilePath
SrtDisplay -> FilePath
(Int -> SrtDisplay -> FilePath -> FilePath)
-> (SrtDisplay -> FilePath)
-> ([SrtDisplay] -> FilePath -> FilePath)
-> Show SrtDisplay
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [SrtDisplay] -> FilePath -> FilePath
$cshowList :: [SrtDisplay] -> FilePath -> FilePath
show :: SrtDisplay -> FilePath
$cshow :: SrtDisplay -> FilePath
showsPrec :: Int -> SrtDisplay -> FilePath -> FilePath
$cshowsPrec :: Int -> SrtDisplay -> FilePath -> FilePath
Show, SrtDisplay -> SrtDisplay -> Bool
(SrtDisplay -> SrtDisplay -> Bool)
-> (SrtDisplay -> SrtDisplay -> Bool) -> Eq SrtDisplay
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SrtDisplay -> SrtDisplay -> Bool
$c/= :: SrtDisplay -> SrtDisplay -> Bool
== :: SrtDisplay -> SrtDisplay -> Bool
$c== :: SrtDisplay -> SrtDisplay -> Bool
Eq, (forall x. SrtDisplay -> Rep SrtDisplay x)
-> (forall x. Rep SrtDisplay x -> SrtDisplay) -> Generic SrtDisplay
forall x. Rep SrtDisplay x -> SrtDisplay
forall x. SrtDisplay -> Rep SrtDisplay x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SrtDisplay x -> SrtDisplay
$cfrom :: forall x. SrtDisplay -> Rep SrtDisplay x
Generic)

instance Semigroup SrtDisplay where
  <> :: SrtDisplay -> SrtDisplay -> SrtDisplay
(<>) a :: SrtDisplay
a b :: SrtDisplay
b = SrtDisplay :: DiffTime -> DiffTime -> Text -> Int -> SrtDisplay
SrtDisplay{
    _srt_from :: DiffTime
_srt_from = SrtDisplay
a SrtDisplay -> Getting DiffTime SrtDisplay DiffTime -> DiffTime
forall s a. s -> Getting a s a -> a
^. Getting DiffTime SrtDisplay DiffTime
Lens' SrtDisplay DiffTime
srt_from,
    _srt_to :: DiffTime
_srt_to = SrtDisplay
b SrtDisplay -> Getting DiffTime SrtDisplay DiffTime -> DiffTime
forall s a. s -> Getting a s a -> a
^. Getting DiffTime SrtDisplay DiffTime
Lens' SrtDisplay DiffTime
srt_to,
    _srt_words :: Text
_srt_words = SrtDisplay
a SrtDisplay -> Getting Text SrtDisplay Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text SrtDisplay Text
Lens' SrtDisplay Text
srt_words Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SrtDisplay
b SrtDisplay -> Getting Text SrtDisplay Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text SrtDisplay Text
Lens' SrtDisplay Text
srt_words,
    _srt_position :: Int
_srt_position = SrtDisplay
a SrtDisplay -> Getting Int SrtDisplay Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int SrtDisplay Int
Lens' SrtDisplay Int
srt_position
    }
instance Monoid SrtDisplay where
  mempty :: SrtDisplay
mempty = SrtDisplay :: DiffTime -> DiffTime -> Text -> Int -> SrtDisplay
SrtDisplay{
    _srt_from :: DiffTime
_srt_from = 0,
    _srt_to :: DiffTime
_srt_to = 0,
    _srt_words :: Text
_srt_words = Text
forall a. Monoid a => a
mempty,
    _srt_position :: Int
_srt_position = 0
    }

srt_from :: Lens' SrtDisplay DiffTime
srt_from :: (DiffTime -> f DiffTime) -> SrtDisplay -> f SrtDisplay
srt_from = forall s t a b. HasField "_srt_from" s t a b => Lens s t a b
forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"_srt_from"
srt_to :: Lens' SrtDisplay DiffTime
srt_to :: (DiffTime -> f DiffTime) -> SrtDisplay -> f SrtDisplay
srt_to = forall s t a b. HasField "_srt_to" s t a b => Lens s t a b
forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"_srt_to"
srt_words :: Lens' SrtDisplay Text
srt_words :: (Text -> f Text) -> SrtDisplay -> f SrtDisplay
srt_words = forall s t a b. HasField "_srt_words" s t a b => Lens s t a b
forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"_srt_words"
srt_position :: Lens' SrtDisplay Int
srt_position :: (Int -> f Int) -> SrtDisplay -> f SrtDisplay
srt_position = forall s t a b. HasField "_srt_position" s t a b => Lens s t a b
forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"_srt_position"

makeSrt :: [WordFrame] -> Text.Text
makeSrt :: [WordFrame] -> Text
makeSrt frames :: [WordFrame]
frames = [Text] -> Text
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ ([SrtDisplay] -> Text) -> [[SrtDisplay]] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SrtDisplay -> Text
formatSrt (SrtDisplay -> Text)
-> ([SrtDisplay] -> SrtDisplay) -> [SrtDisplay] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SrtDisplay -> SrtDisplay -> SrtDisplay)
-> SrtDisplay -> [SrtDisplay] -> SrtDisplay
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' SrtDisplay -> SrtDisplay -> SrtDisplay
forall a. Semigroup a => a -> a -> a
(<>) SrtDisplay
forall a. Monoid a => a
mempty) ([[SrtDisplay]] -> [Text]) -> [[SrtDisplay]] -> [Text]
forall a b. (a -> b) -> a -> b
$ [SrtDisplay] -> [[SrtDisplay]]
groupBySentence ([SrtDisplay] -> [[SrtDisplay]]) -> [SrtDisplay] -> [[SrtDisplay]]
forall a b. (a -> b) -> a -> b
$ (Int -> WordFrame -> SrtDisplay) -> [WordFrame] -> [SrtDisplay]
forall i (f :: * -> *) a b.
FunctorWithIndex i f =>
(i -> a -> b) -> f a -> f b
imap (FrameOffset -> Int -> WordFrame -> SrtDisplay
toSrtDisplay FrameOffset
off) [WordFrame]
frames
  where off :: FrameOffset
off = FrameOffset -> Maybe FrameOffset -> FrameOffset
forall a. a -> Maybe a -> a
fromMaybe FrameOffset
noOffset (Maybe FrameOffset -> FrameOffset)
-> Maybe FrameOffset -> FrameOffset
forall a b. (a -> b) -> a -> b
$ [WordFrame]
frames [WordFrame]
-> Getting (First FrameOffset) [WordFrame] FrameOffset
-> Maybe FrameOffset
forall s a. s -> Getting (First a) s a -> Maybe a
^? Index [WordFrame] -> Traversal' [WordFrame] (IxValue [WordFrame])
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix 0 ((WordFrame -> Const (First FrameOffset) WordFrame)
 -> [WordFrame] -> Const (First FrameOffset) [WordFrame])
-> ((FrameOffset -> Const (First FrameOffset) FrameOffset)
    -> WordFrame -> Const (First FrameOffset) WordFrame)
-> Getting (First FrameOffset) [WordFrame] FrameOffset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FrameOffset -> Const (First FrameOffset) FrameOffset)
-> WordFrame -> Const (First FrameOffset) WordFrame
Lens' WordFrame FrameOffset
frame_from

groupBySentence :: [SrtDisplay] -> [[SrtDisplay]]
groupBySentence :: [SrtDisplay] -> [[SrtDisplay]]
groupBySentence = ([SrtDisplay], [[SrtDisplay]]) -> [[SrtDisplay]]
forall a b. (a, b) -> b
snd (([SrtDisplay], [[SrtDisplay]]) -> [[SrtDisplay]])
-> ([SrtDisplay] -> ([SrtDisplay], [[SrtDisplay]]))
-> [SrtDisplay]
-> [[SrtDisplay]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([SrtDisplay], [[SrtDisplay]])
 -> SrtDisplay -> ([SrtDisplay], [[SrtDisplay]]))
-> ([SrtDisplay], [[SrtDisplay]])
-> [SrtDisplay]
-> ([SrtDisplay], [[SrtDisplay]])
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ([SrtDisplay], [[SrtDisplay]])
-> SrtDisplay -> ([SrtDisplay], [[SrtDisplay]])
innerFold ([], []) -- face

innerFold :: ([SrtDisplay], [[SrtDisplay]]) -> SrtDisplay ->  ([SrtDisplay], [[SrtDisplay]])
innerFold :: ([SrtDisplay], [[SrtDisplay]])
-> SrtDisplay -> ([SrtDisplay], [[SrtDisplay]])
innerFold (prev :: [SrtDisplay]
prev, res :: [[SrtDisplay]]
res) x :: SrtDisplay
x = if SrtDisplay
x SrtDisplay -> Getting Text SrtDisplay Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text SrtDisplay Text
Lens' SrtDisplay Text
srt_words Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "<sil>" then ([], [SrtDisplay]
prev [SrtDisplay] -> [[SrtDisplay]] -> [[SrtDisplay]]
forall a. a -> [a] -> [a]
: [[SrtDisplay]]
res) else
  (SrtDisplay
x SrtDisplay -> [SrtDisplay] -> [SrtDisplay]
forall a. a -> [a] -> [a]
: [SrtDisplay]
prev, [[SrtDisplay]]
res)


toSrtDisplay :: FrameOffset -> Int -> WordFrame -> SrtDisplay
toSrtDisplay :: FrameOffset -> Int -> WordFrame -> SrtDisplay
toSrtDisplay firstOffset :: FrameOffset
firstOffset ix' :: Int
ix' frame :: WordFrame
frame = SrtDisplay :: DiffTime -> DiffTime -> Text -> Int -> SrtDisplay
SrtDisplay
  { _srt_from :: DiffTime
_srt_from     = WordFrame
frame WordFrame -> Getting DiffTime WordFrame DiffTime -> DiffTime
forall s a. s -> Getting a s a -> a
^. (FrameOffset -> Const DiffTime FrameOffset)
-> WordFrame -> Const DiffTime WordFrame
Lens' WordFrame FrameOffset
frame_from ((FrameOffset -> Const DiffTime FrameOffset)
 -> WordFrame -> Const DiffTime WordFrame)
-> ((DiffTime -> Const DiffTime DiffTime)
    -> FrameOffset -> Const DiffTime FrameOffset)
-> Getting DiffTime WordFrame DiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FrameOffset -> DiffTime)
-> (DiffTime -> Const DiffTime DiffTime)
-> FrameOffset
-> Const DiffTime FrameOffset
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (FrameOffset -> FrameOffset -> DiffTime
toDiffTime FrameOffset
firstOffset)
  , _srt_to :: DiffTime
_srt_to       = WordFrame
frame WordFrame -> Getting DiffTime WordFrame DiffTime -> DiffTime
forall s a. s -> Getting a s a -> a
^. (FrameOffset -> Const DiffTime FrameOffset)
-> WordFrame -> Const DiffTime WordFrame
Lens' WordFrame FrameOffset
frame_to ((FrameOffset -> Const DiffTime FrameOffset)
 -> WordFrame -> Const DiffTime WordFrame)
-> ((DiffTime -> Const DiffTime DiffTime)
    -> FrameOffset -> Const DiffTime FrameOffset)
-> Getting DiffTime WordFrame DiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FrameOffset -> DiffTime)
-> (DiffTime -> Const DiffTime DiffTime)
-> FrameOffset
-> Const DiffTime FrameOffset
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (FrameOffset -> FrameOffset -> DiffTime
toDiffTime FrameOffset
firstOffset)
  , _srt_words :: Text
_srt_words    = WordFrame
frame WordFrame -> Getting Text WordFrame Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text WordFrame Text
Lens' WordFrame Text
frame_word
  , _srt_position :: Int
_srt_position = Int
ix'
  }


-- | wikipedia explains the srt format pretty well: https://en.wikipedia.org/wiki/SubRip
--  in escence :
-- [A numeric counter identifying each sequential subtitle]
-- [The time that the subtitle should appear on the screen] --–> [d the time it should disappear]
-- [Subtitle text itself on one or more lines]
-- [A blank line containing no text, indicating the end of this subtitle]
formatSrt :: SrtDisplay -> Text.Text
formatSrt :: SrtDisplay -> Text
formatSrt sentence :: SrtDisplay
sentence = [Text] -> Text
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
  [ SrtDisplay
sentence SrtDisplay -> Getting Text SrtDisplay Text -> Text
forall s a. s -> Getting a s a -> a
^. (Int -> Const Text Int) -> SrtDisplay -> Const Text SrtDisplay
Lens' SrtDisplay Int
srt_position ((Int -> Const Text Int) -> SrtDisplay -> Const Text SrtDisplay)
-> ((Text -> Const Text Text) -> Int -> Const Text Int)
-> Getting Text SrtDisplay Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> FilePath) -> Optic' (->) (Const Text) Int FilePath
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Int -> FilePath
forall a. Show a => a -> FilePath
show Optic' (->) (Const Text) Int FilePath
-> ((Text -> Const Text Text) -> FilePath -> Const Text FilePath)
-> (Text -> Const Text Text)
-> Int
-> Const Text Int
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
  , "\n"
  , FilePath -> Text
Text.pack
  (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$  TimeLocale -> FilePath -> DiffTime -> FilePath
forall t. FormatTime t => TimeLocale -> FilePath -> t -> FilePath
formatTime TimeLocale
defaultTimeLocale "%0H:%0M:%0S,000"
  (DiffTime -> FilePath) -> DiffTime -> FilePath
forall a b. (a -> b) -> a -> b
$  SrtDisplay
sentence
  SrtDisplay -> Getting DiffTime SrtDisplay DiffTime -> DiffTime
forall s a. s -> Getting a s a -> a
^. Getting DiffTime SrtDisplay DiffTime
Lens' SrtDisplay DiffTime
srt_from
  , " --> "
  , FilePath -> Text
Text.pack
  (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$  TimeLocale -> FilePath -> DiffTime -> FilePath
forall t. FormatTime t => TimeLocale -> FilePath -> t -> FilePath
formatTime TimeLocale
defaultTimeLocale "%0H:%0M:%0S,000"
  (DiffTime -> FilePath) -> DiffTime -> FilePath
forall a b. (a -> b) -> a -> b
$  SrtDisplay
sentence
  SrtDisplay -> Getting DiffTime SrtDisplay DiffTime -> DiffTime
forall s a. s -> Getting a s a -> a
^. Getting DiffTime SrtDisplay DiffTime
Lens' SrtDisplay DiffTime
srt_to
  , "\n"
  , (SrtDisplay
sentence SrtDisplay -> Getting Text SrtDisplay Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text SrtDisplay Text
Lens' SrtDisplay Text
srt_words)
  , "\n"
  , "\n"
  ]