{-# LANGUAGE DataKinds #-}

module Cut.Analyze
  ( detectSoundInterval
  , Interval(..)
  , Sound
  , Silent
  , getStart
  , getEnd
  , getDuration
  , takeOnlyLines
  , detectSpeech
  )
where

import           Control.Lens
import           Control.Monad
import           Control.Monad.Catch
import           Control.Monad.IO.Unlift
import           Cut.Shell
import           Cut.Options
import           Cut.SpeechRecognition
import           Data.Coerce
import           Data.Foldable
import           Data.Maybe
import           Data.Text               (Text)
import qualified Data.Text               as Text
import qualified Data.Text.IO            as Text
import           Data.Text.Lens
import           Shelly                  hiding (find, shelly)
import           Text.Regex.TDFA         hiding (empty)
import           GHC.Generics                 (Generic)

data Silent
data Sound

-- | I think we can only detect silence with ffmpeg, so we flip the
--  silent to sounded intervals, and :
-- if x indicates silence:
-- silence: xxx___xxx__xxxx____xxxxx__xx
-- sounded: ___xxx___xx____xxxx_____xx__
data Interval e =
  Interval
  { Interval e -> Double
interval_start       :: Double
  , Interval e -> Double
interval_end         :: Double
  , Interval e -> Double
interval_duration    :: Double
  , Interval e -> Text
interval_input_start :: Text
  , Interval e -> Text
interval_input_end   :: Text
  } deriving (Int -> Interval e -> ShowS
[Interval e] -> ShowS
Interval e -> String
(Int -> Interval e -> ShowS)
-> (Interval e -> String)
-> ([Interval e] -> ShowS)
-> Show (Interval e)
forall e. Int -> Interval e -> ShowS
forall e. [Interval e] -> ShowS
forall e. Interval e -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Interval e] -> ShowS
$cshowList :: forall e. [Interval e] -> ShowS
show :: Interval e -> String
$cshow :: forall e. Interval e -> String
showsPrec :: Int -> Interval e -> ShowS
$cshowsPrec :: forall e. Int -> Interval e -> ShowS
Show, (forall x. Interval e -> Rep (Interval e) x)
-> (forall x. Rep (Interval e) x -> Interval e)
-> Generic (Interval e)
forall x. Rep (Interval e) x -> Interval e
forall x. Interval e -> Rep (Interval e) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall e x. Rep (Interval e) x -> Interval e
forall e x. Interval e -> Rep (Interval e) x
$cto :: forall e x. Rep (Interval e) x -> Interval e
$cfrom :: forall e x. Interval e -> Rep (Interval e) x
Generic)

detectSoundInterval :: (MonadMask m, MonadUnliftIO m) => ListenCutOptions -> m [Interval Sound]
detectSoundInterval :: ListenCutOptions -> m [Interval Sound]
detectSoundInterval opts :: ListenCutOptions
opts = do
  [Text]
lines'' <- Sh [Text] -> m [Text]
forall (m :: * -> *) a. MonadIO m => Sh a -> m a
shelly (Sh [Text] -> m [Text]) -> Sh [Text] -> m [Text]
forall a b. (a -> b) -> a -> b
$ ListenCutOptions -> Sh [Text]
detectShell ListenCutOptions
opts
  let linesRes :: [Either Text Text]
linesRes = do
        Text
line <- [Text]
lines''
        if Text -> Bool
takeOnlyLines Text
line then Either Text Text -> [Either Text Text]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Text -> [Either Text Text])
-> Either Text Text -> [Either Text Text]
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Text
forall a b. b -> Either a b
Right Text
line else Either Text Text -> [Either Text Text]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Text -> [Either Text Text])
-> Either Text Text -> [Either Text Text]
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Text
forall a b. a -> Either a b
Left Text
line
      lines' :: [Text]
lines' = [Either Text Text]
linesRes [Either Text Text]
-> Getting (Endo [Text]) [Either Text Text] Text -> [Text]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. (Either Text Text -> Const (Endo [Text]) (Either Text Text))
-> [Either Text Text] -> Const (Endo [Text]) [Either Text Text]
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
traversed ((Either Text Text -> Const (Endo [Text]) (Either Text Text))
 -> [Either Text Text] -> Const (Endo [Text]) [Either Text Text])
-> ((Text -> Const (Endo [Text]) Text)
    -> Either Text Text -> Const (Endo [Text]) (Either Text Text))
-> Getting (Endo [Text]) [Either Text Text] Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (Endo [Text]) Text)
-> Either Text Text -> Const (Endo [Text]) (Either Text Text)
forall c a b. Prism (Either c a) (Either c b) a b
_Right

  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn "-----------------------------------------"
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn "-----------------actual lines-----------------"
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn "-----------------------------------------"
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
Text.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
Text.unlines [Text]
lines'

  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn "-----------------------------------------"
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn "-----------------filtered lines-----------------"
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn "-----------------------------------------"
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
Text.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
Text.unlines ([Either Text Text]
linesRes [Either Text Text]
-> Getting (Endo [Text]) [Either Text Text] Text -> [Text]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. (Either Text Text -> Const (Endo [Text]) (Either Text Text))
-> [Either Text Text] -> Const (Endo [Text]) [Either Text Text]
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
traversed ((Either Text Text -> Const (Endo [Text]) (Either Text Text))
 -> [Either Text Text] -> Const (Endo [Text]) [Either Text Text])
-> ((Text -> Const (Endo [Text]) Text)
    -> Either Text Text -> Const (Endo [Text]) (Either Text Text))
-> Getting (Endo [Text]) [Either Text Text] Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (Endo [Text]) Text)
-> Either Text Text -> Const (Endo [Text]) (Either Text Text)
forall a c b. Prism (Either a c) (Either b c) a b
_Left)

  let linedUp        :: [(Text, Text)]
      linedUp :: [(Text, Text)]
linedUp        = [Text] -> [(Text, Text)]
zipped [Text]
lines'
      parsed         :: [Interval Silent]
      parsed :: [Interval Silent]
parsed         = (Text, Text) -> Interval Silent
parse ((Text, Text) -> Interval Silent)
-> [(Text, Text)] -> [Interval Silent]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Text)]
linedUp
      fancyResult    :: [Interval Sound]
      fancyResult :: [Interval Sound]
fancyResult    = ListenCutOptions -> [Interval Silent] -> [Interval Sound]
detector ListenCutOptions
opts [Interval Silent]
parsed
      negativeResult :: Maybe (Interval Sound)
      negativeResult :: Maybe (Interval Sound)
negativeResult = (Interval Sound -> Bool)
-> [Interval Sound] -> Maybe (Interval Sound)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((0 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>) (Double -> Bool)
-> (Interval Sound -> Double) -> Interval Sound -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Interval Sound -> Double
forall e. Interval e -> Double
interval_duration) [Interval Sound]
fancyResult

  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn "-----------------------------------------"
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn "-----------------lined up-----------------"
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn "-----------------------------------------"
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ((Text, Text) -> IO ()) -> [(Text, Text)] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Text, Text) -> IO ()
forall a. Show a => a -> IO ()
print [(Text, Text)]
linedUp

  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn "-----------------------------------------"
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn "-----------------parsed-----------------"
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn "-----------------------------------------"
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ (Interval Silent -> IO ()) -> [Interval Silent] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Interval Silent -> IO ()
forall a. Show a => a -> IO ()
print [Interval Silent]
parsed

  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn "-----------------------------------------"
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn "-----------------sounds-----------------"
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn "-----------------------------------------"
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ (Interval Sound -> IO ()) -> [Interval Sound] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Interval Sound -> IO ()
forall a. Show a => a -> IO ()
print [Interval Sound]
fancyResult

  if Maybe (Interval Sound) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (Interval Sound)
negativeResult
    then do
      IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ (Interval Sound -> IO ()) -> [Interval Sound] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Interval Sound -> IO ()
forall a. Show a => a -> IO ()
print [Interval Sound]
fancyResult
      IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Maybe (Interval Sound) -> IO ()
forall a. Show a => a -> IO ()
print Maybe (Interval Sound)
negativeResult
      String -> m [Interval Sound]
forall a. HasCallStack => String -> a
error "Found negative durations"
    else [Interval Sound] -> m [Interval Sound]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Interval Sound]
fancyResult

  where
      detector       :: ListenCutOptions -> [Interval Silent] -> [Interval Sound]
      detector :: ListenCutOptions -> [Interval Silent] -> [Interval Sound]
detector       = if ListenCutOptions
opts ListenCutOptions -> Getting Bool ListenCutOptions Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool ListenCutOptions Bool
forall a. Lens' (ListenCutOptionsT a) Bool
cut_noise then ListenCutOptions -> [Interval Silent] -> [Interval Sound]
detectSilence else ListenCutOptions -> [Interval Silent] -> [Interval Sound]
detectSound

takeOnlyLines :: Text -> Bool
takeOnlyLines :: Text -> Bool
takeOnlyLines matchWith :: Text
matchWith = Bool
matches
 where
  silenceRegex :: String
  silenceRegex :: String
silenceRegex = ".*silencedetect.*"
  matches :: Bool
  matches :: Bool
matches = Text -> String
Text.unpack Text
matchWith String -> String -> Bool
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ String
silenceRegex

zipped :: [Text] -> [(Text, Text)]
zipped :: [Text] -> [(Text, Text)]
zipped []                 = [(Text, Text)]
forall a. Monoid a => a
mempty
zipped [_               ] = []
zipped (one :: Text
one : two :: Text
two : rem' :: [Text]
rem') = (Text
one, Text
two) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: [Text] -> [(Text, Text)]
zipped [Text]
rem'

detectSilence :: ListenCutOptions -> [Interval Silent] -> [Interval Sound]
detectSilence :: ListenCutOptions -> [Interval Silent] -> [Interval Sound]
detectSilence _ = [Interval Silent] -> [Interval Sound]
forall a b. Coercible a b => a -> b
coerce

-- TODO: we can't process videos that are longer then a week.
finalSound :: Interval Silent
finalSound :: Interval Silent
finalSound = Double -> Double -> Double -> Text -> Text -> Interval Silent
forall e. Double -> Double -> Double -> Text -> Text -> Interval e
Interval Double
week (Double
weekDouble -> Double -> Double
forall a. Num a => a -> a -> a
+1) 1 "" ""
  where
    week :: Double
week = Double
day Double -> Double -> Double
forall a. Num a => a -> a -> a
* 7
    day :: Double
day = 60Double -> Double -> Double
forall a. Num a => a -> a -> a
*60Double -> Double -> Double
forall a. Num a => a -> a -> a
*24

detectSound :: ListenCutOptions -> [Interval Silent] -> [Interval Sound]
detectSound :: ListenCutOptions -> [Interval Silent] -> [Interval Sound]
detectSound opts :: ListenCutOptions
opts silences :: [Interval Silent]
silences =
  [Interval Sound] -> [Interval Sound]
forall a. [a] -> [a]
reverse ([Interval Sound] -> [Interval Sound])
-> [Interval Sound] -> [Interval Sound]
forall a b. (a -> b) -> a -> b
$ (Interval Silent, [Interval Sound]) -> [Interval Sound]
forall a b. (a, b) -> b
snd ((Interval Silent, [Interval Sound]) -> [Interval Sound])
-> (Interval Silent, [Interval Sound]) -> [Interval Sound]
forall a b. (a -> b) -> a -> b
$ (Interval Silent, [Interval Sound])
-> Interval Silent -> (Interval Silent, [Interval Sound])
fun (Interval Silent, [Interval Sound])
soundedParts Interval Silent
finalSound
  where
    soundedParts :: (Interval Silent, [Interval Sound])
    soundedParts :: (Interval Silent, [Interval Sound])
soundedParts = ((Interval Silent, [Interval Sound])
 -> Interval Silent -> (Interval Silent, [Interval Sound]))
-> (Interval Silent, [Interval Sound])
-> [Interval Silent]
-> (Interval Silent, [Interval Sound])
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Interval Silent, [Interval Sound])
-> Interval Silent -> (Interval Silent, [Interval Sound])
fun (Double -> Double -> Double -> Text -> Text -> Interval Silent
forall e. Double -> Double -> Double -> Text -> Text -> Interval e
Interval 0 0 0 "" "", []) [Interval Silent]
silences

    fun :: (Interval Silent, [Interval Sound])
-> Interval Silent -> (Interval Silent, [Interval Sound])
fun = (Interval Silent
 -> (Interval Silent, [Interval Sound])
 -> (Interval Silent, [Interval Sound]))
-> (Interval Silent, [Interval Sound])
-> Interval Silent
-> (Interval Silent, [Interval Sound])
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Interval Silent
  -> (Interval Silent, [Interval Sound])
  -> (Interval Silent, [Interval Sound]))
 -> (Interval Silent, [Interval Sound])
 -> Interval Silent
 -> (Interval Silent, [Interval Sound]))
-> (Interval Silent
    -> (Interval Silent, [Interval Sound])
    -> (Interval Silent, [Interval Sound]))
-> (Interval Silent, [Interval Sound])
-> Interval Silent
-> (Interval Silent, [Interval Sound])
forall a b. (a -> b) -> a -> b
$ ListenCutOptions
-> Interval Silent
-> (Interval Silent, [Interval Sound])
-> (Interval Silent, [Interval Sound])
silentIntoSounded ListenCutOptions
opts


silentIntoSounded
  :: ListenCutOptions
  -> Interval Silent
  -> (Interval Silent, [Interval Sound])
  -> (Interval Silent, [Interval Sound])
silentIntoSounded :: ListenCutOptions
-> Interval Silent
-> (Interval Silent, [Interval Sound])
-> (Interval Silent, [Interval Sound])
silentIntoSounded opts :: ListenCutOptions
opts current :: Interval Silent
current prev :: (Interval Silent, [Interval Sound])
prev = (Interval Silent
current, Interval Sound
forall e. Interval e
soundedInterval Interval Sound -> [Interval Sound] -> [Interval Sound]
forall a. a -> [a] -> [a]
: (Interval Silent, [Interval Sound]) -> [Interval Sound]
forall a b. (a, b) -> b
snd (Interval Silent, [Interval Sound])
prev)
 where
  soundedInterval :: Interval e
soundedInterval = Interval :: forall e. Double -> Double -> Double -> Text -> Text -> Interval e
Interval
    { interval_start :: Double
interval_start       = Double
soundStart
    , interval_end :: Double
interval_end         = Double
soundEnd Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
margin
    , interval_duration :: Double
interval_duration    = (Double
soundEnd Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
soundStart) Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
margin
    , interval_input_start :: Text
interval_input_start =
      Interval Silent -> Text
forall e. Interval e -> Text
interval_input_start ((Interval Silent, [Interval Sound]) -> Interval Silent
forall a b. (a, b) -> a
fst (Interval Silent, [Interval Sound])
prev) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "," Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Interval Silent -> Text
forall e. Interval e -> Text
interval_input_end ((Interval Silent, [Interval Sound]) -> Interval Silent
forall a b. (a, b) -> a
fst (Interval Silent, [Interval Sound])
prev)
    , interval_input_end :: Text
interval_input_end   = Interval Silent -> Text
forall e. Interval e -> Text
interval_input_start Interval Silent
current
                             Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ","
                             Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Interval Silent -> Text
forall e. Interval e -> Text
interval_input_end Interval Silent
current
    }
  soundEnd :: Double
soundEnd   = Interval Silent -> Double
forall e. Interval e -> Double
interval_start Interval Silent
current
  soundStart :: Double
soundStart = Interval Silent -> Double
forall e. Interval e -> Double
interval_end (Interval Silent -> Double) -> Interval Silent -> Double
forall a b. (a -> b) -> a -> b
$ (Interval Silent, [Interval Sound]) -> Interval Silent
forall a b. (a, b) -> a
fst (Interval Silent, [Interval Sound])
prev

  margin :: Double
margin     = ListenCutOptions
opts ListenCutOptions
-> Getting Double ListenCutOptions Double -> Double
forall s a. s -> Getting a s a -> a
^. Getting Double ListenCutOptions Double
forall a. Lens' (ListenCutOptionsT a) Double
detect_margin


detectShell :: ListenCutOptions -> Sh [Text]
detectShell :: ListenCutOptions -> Sh [Text]
detectShell opt' :: ListenCutOptions
opt' = String -> [Text] -> Sh [Text]
ffmpeg (ListenCutOptions
opt' ListenCutOptions
-> Getting String ListenCutOptions String -> String
forall s a. s -> Getting a s a -> a
^. (FileIO String -> Const String (FileIO String))
-> ListenCutOptions -> Const String ListenCutOptions
forall a b.
Lens
  (ListenCutOptionsT a) (ListenCutOptionsT b) (FileIO a) (FileIO b)
lc_fileio ((FileIO String -> Const String (FileIO String))
 -> ListenCutOptions -> Const String ListenCutOptions)
-> ((String -> Const String String)
    -> FileIO String -> Const String (FileIO String))
-> Getting String ListenCutOptions String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Const String String)
-> FileIO String -> Const String (FileIO String)
forall a b. Lens (FileIO a) (FileIO b) a b
in_file ((String -> Const String String)
 -> FileIO String -> Const String (FileIO String))
-> ((String -> Const String String)
    -> String -> Const String String)
-> (String -> Const String String)
-> FileIO String
-> Const String (FileIO String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Const String String) -> String -> Const String String
forall t. IsText t => Iso' String t
packed)
  ["-map"
  , ListenCutOptions -> Text
forall a. ListenCutOptionsT a -> Text
voice_track_map ListenCutOptions
opt'
  , "-filter:a"
                 -- , "silencedetect=noise=-30dB:d=0.5"
  , "silencedetect=noise="
  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (ListenCutOptions
opt' ListenCutOptions -> Getting Text ListenCutOptions Text -> Text
forall s a. s -> Getting a s a -> a
^. (Double -> Const Text Double)
-> ListenCutOptions -> Const Text ListenCutOptions
forall a. Lens' (ListenCutOptionsT a) Double
silent_treshold ((Double -> Const Text Double)
 -> ListenCutOptions -> Const Text ListenCutOptions)
-> ((Text -> Const Text Text) -> Double -> Const Text Double)
-> Getting Text ListenCutOptions Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Text)
-> (Text -> Const Text Text) -> Double -> Const Text Double
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Double -> Text
floatToText)
  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ":d="
  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (ListenCutOptions
opt' ListenCutOptions -> Getting Text ListenCutOptions Text -> Text
forall s a. s -> Getting a s a -> a
^. (Double -> Const Text Double)
-> ListenCutOptions -> Const Text ListenCutOptions
forall a. Lens' (ListenCutOptionsT a) Double
silent_duration ((Double -> Const Text Double)
 -> ListenCutOptions -> Const Text ListenCutOptions)
-> ((Text -> Const Text Text) -> Double -> Const Text Double)
-> Getting Text ListenCutOptions Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Text)
-> (Text -> Const Text Text) -> Double -> Const Text Double
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Double -> Text
floatToText)
  , "-f"
  , "null"
  , "-"
  ]

parse :: (Text, Text) -> Interval Silent
parse :: (Text, Text) -> Interval Silent
parse xx :: (Text, Text)
xx = Interval :: forall e. Double -> Double -> Double -> Text -> Text -> Interval e
Interval { interval_start :: Double
interval_start       = Text -> Double
getStart (Text -> Double) -> Text -> Double
forall a b. (a -> b) -> a -> b
$ (Text, Text) -> Text
forall a b. (a, b) -> a
fst (Text, Text)
xx
                    , interval_end :: Double
interval_end         = Text -> Double
getEnd (Text -> Double) -> Text -> Double
forall a b. (a -> b) -> a -> b
$ (Text, Text) -> Text
forall a b. (a, b) -> b
snd (Text, Text)
xx
                    , interval_duration :: Double
interval_duration    = Text -> Double
getDuration (Text -> Double) -> Text -> Double
forall a b. (a -> b) -> a -> b
$ (Text, Text) -> Text
forall a b. (a, b) -> b
snd (Text, Text)
xx
                    , interval_input_start :: Text
interval_input_start = (Text, Text) -> Text
forall a b. (a, b) -> a
fst (Text, Text)
xx
                    , interval_input_end :: Text
interval_input_end   = (Text, Text) -> Text
forall a b. (a, b) -> b
snd (Text, Text)
xx
                    }

getStart :: Text -> Double
getStart :: Text -> Double
getStart line :: Text
line = String -> Double
forall a. Read a => String -> a
read (String -> Double) -> String -> Double
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '\'') ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ (String, String, String)
matches (String, String, String)
-> Getting String (String, String, String) String -> String
forall s a. s -> Getting a s a -> a
^. Getting String (String, String, String) String
forall s t a b. Field3 s t a b => Lens s t a b
_3
 where
  str :: String
str = Text -> String
Text.unpack Text
line
  matches :: (String, String, String)
  matches :: (String, String, String)
matches = String
str String -> String -> (String, String, String)
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ String
startMatch

startMatch :: String
startMatch :: String
startMatch = "(.*)?: "

pipe :: String
pipe :: String
pipe = " \\| "

getDuration :: Text -> Double
getDuration :: Text -> Double
getDuration line :: Text
line = String -> Double
forall a. Read a => String -> a
read (String -> Double) -> String -> Double
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '\'') ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ (String, String, String)
match2 (String, String, String)
-> Getting String (String, String, String) String -> String
forall s a. s -> Getting a s a -> a
^. Getting String (String, String, String) String
forall s t a b. Field1 s t a b => Lens s t a b
_1
 where
  str :: String
str = Text -> String
Text.unpack Text
line
  match1 :: (String, String, String)
  match1 :: (String, String, String)
match1 = String
str String -> String -> (String, String, String)
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ String
startMatch
  match2 :: (String, String, String)
  match2 :: (String, String, String)
match2 = ((String, String, String)
match1 (String, String, String)
-> Getting String (String, String, String) String -> String
forall s a. s -> Getting a s a -> a
^. Getting String (String, String, String) String
forall s t a b. Field3 s t a b => Lens s t a b
_3) String -> String -> (String, String, String)
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ String
pipe

getEnd :: Text -> Double
getEnd :: Text -> Double
getEnd line :: Text
line = String -> Double
forall a. Read a => String -> a
read (String -> Double) -> String -> Double
forall a b. (a -> b) -> a -> b
$ (String, String, String)
match2 (String, String, String)
-> Getting String (String, String, String) String -> String
forall s a. s -> Getting a s a -> a
^. Getting String (String, String, String) String
forall s t a b. Field3 s t a b => Lens s t a b
_3
 where
  str :: String
str = Text -> String
Text.unpack Text
line
  match1 :: (String, String, String)
  match1 :: (String, String, String)
match1 = String
str String -> String -> (String, String, String)
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ String
pipe
  match2 :: (String, String, String)
  match2 :: (String, String, String)
match2 = ((String, String, String)
match1 (String, String, String)
-> Getting String (String, String, String) String -> String
forall s a. s -> Getting a s a -> a
^. Getting String (String, String, String) String
forall s t a b. Field1 s t a b => Lens s t a b
_1) String -> String -> (String, String, String)
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ String
startMatch


-- | Detect the speech on the mkv file
detectSpeech :: ListenCutOptions -> Prelude.FilePath -> Prelude.FilePath -> Sh (Either ResultCode [WordFrame])
detectSpeech :: ListenCutOptions
-> String -> String -> Sh (Either ResultCode [WordFrame])
detectSpeech options :: ListenCutOptions
options tempdir :: String
tempdir inputFile :: String
inputFile = do
  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
$ String -> [Text] -> Sh [Text]
ffmpeg String
inputFile ([Text] -> Sh [Text]) -> [Text] -> Sh [Text]
forall a b. (a -> b) -> a -> b
$ (ListenCutOptions -> [Text]
forall a. ListenCutOptionsT a -> [Text]
specifyTracks ListenCutOptions
options) [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [
      String -> Text
Text.pack String
tmpMp3File
    ]
  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
$ String -> [Text] -> Sh [Text]
ffmpeg String
tmpMp3File [
    "-f", "s16le", "-acodec", "pcm_s16le", "-filter:a", "aresample=resampler=soxr:osr=16000", "-ac", "1", String -> Text
Text.pack String
tmpRawFile
    ]
  IO (Either ResultCode [WordFrame])
-> Sh (Either ResultCode [WordFrame])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either ResultCode [WordFrame])
 -> Sh (Either ResultCode [WordFrame]))
-> IO (Either ResultCode [WordFrame])
-> Sh (Either ResultCode [WordFrame])
forall a b. (a -> b) -> a -> b
$ String -> IO (Either ResultCode [WordFrame])
speechAnalyses String
tmpRawFile
  where
    tmpMp3File :: String
tmpMp3File = String
tempdir String -> ShowS
forall a. Semigroup a => a -> a -> a
<> "/" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> "speechdetect.mp3"
    tmpRawFile :: String
tmpRawFile = String
tempdir String -> ShowS
forall a. Semigroup a => a -> a -> a
<> "/" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> "speechdetect.raw"