{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ScopedTypeVariables #-}
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
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
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
[Interval Sound]
parsed <- ListenCutOptionsT FilePath -> m [Interval Sound]
forall (m :: * -> *).
(MonadMask m, MonadUnliftIO m) =>
ListenCutOptionsT FilePath -> m [Interval Sound]
detectSoundInterval ListenCutOptionsT FilePath
options
[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
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 ()
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
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
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 ([], [])
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'
}
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"
]