Analyze.hs

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)

data Silent
data Sound

data Interval e = Interval
  { interval_start       :: Double
  , interval_end         :: Double
  , interval_duration    :: Double
  , interval_input_start :: Text
  , interval_input_end   :: Text
  } deriving Show

detectSoundInterval :: (MonadMask m, MonadUnliftIO m) => ListenCutOptions -> m [Interval Sound]
detectSoundInterval opts = do
  lines'' <- shelly $ detectShell opts
  let linesRes = do
        line <- lines''
        if takeOnlyLines line then pure $ Right line else pure $ Left line
      lines' = linesRes ^.. traversed . _Right

  liftIO $ putStrLn "-----------------------------------------"
  liftIO $ putStrLn "-----------------actual lines-----------------"
  liftIO $ putStrLn "-----------------------------------------"
  liftIO $ Text.putStrLn $ Text.unlines lines'

  liftIO $ putStrLn "-----------------------------------------"
  liftIO $ putStrLn "-----------------filtered lines-----------------"
  liftIO $ putStrLn "-----------------------------------------"
  liftIO $ Text.putStrLn $ Text.unlines (linesRes ^.. traversed . _Left)

  let linedUp        = zipped lines'
      parsed         = parse <$> linedUp
      detector       = if opts ^. cut_noise then detectSilence else detectSound
      fancyResult    = detector opts parsed
      negativeResult = find ((0 >) . interval_duration) fancyResult

  liftIO $ putStrLn "-----------------------------------------"
  liftIO $ putStrLn "-----------------lined up-----------------"
  liftIO $ putStrLn "-----------------------------------------"
  liftIO $ traverse_ print linedUp

  liftIO $ putStrLn "-----------------------------------------"
  liftIO $ putStrLn "-----------------parsed-----------------"
  liftIO $ putStrLn "-----------------------------------------"
  liftIO $ traverse_ print parsed

  if isJust negativeResult
    then do
      liftIO $ traverse_ print fancyResult
      liftIO $ print negativeResult
      error "Found negative durations"
    else pure fancyResult

takeOnlyLines :: Text -> Bool
takeOnlyLines matchWith = matches
 where
  silenceRegex :: String
  silenceRegex = ".*silencedetect.*"
  matches :: Bool
  matches = Text.unpack matchWith =~ silenceRegex

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

detectSilence :: ListenCutOptions -> [Interval Silent] -> [Interval Sound]
detectSilence _ = coerce

detectSound :: ListenCutOptions -> [Interval Silent] -> [Interval Sound]
detectSound opts =
  --  -- TODO figure out why these durations get recorded as < 0
  reverse . snd . foldl' (flip (compare' opts)) (Interval 0 0 0 "" "", [])

compare'
  :: ListenCutOptions
  -> Interval Silent
  -> (Interval Silent, [Interval Sound])
  -> (Interval Silent, [Interval Sound])
compare' opts current prev = (current, soundedInterval : snd prev)
 where
  soundedInterval = Interval
    { interval_start       = interval_end $ fst prev
    , interval_end         = interval_start current - margin
    , interval_duration    = (soundEnd - soundStart) + margin
    , interval_input_start =
      interval_input_start (fst prev) <> "," <> interval_input_end (fst prev)
    , interval_input_end   = interval_input_start current
                             <> ","
                             <> interval_input_end current
    }
  soundEnd   = interval_start current
  soundStart = interval_end $ fst prev

  margin     = opts ^. detect_margin


detectShell :: ListenCutOptions -> Sh [Text]
detectShell opt' = ffmpeg (opt' ^. lc_fileio . in_file . packed)
  ["-map"
  , voice_track_map opt'
  , "-filter:a"
                 -- , "silencedetect=noise=-30dB:d=0.5"
  , "silencedetect=noise="
  <> (opt' ^. silent_treshold . to floatToText)
  <> ":d="
  <> (opt' ^. silent_duration . to floatToText)
  , "-f"
  , "null"
  , "-"
  ]

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

getStart :: Text -> Double
getStart line = read $ takeWhile (/= '\'') $ matches ^. _3
 where
  str = Text.unpack line
  matches :: (String, String, String)
  matches = str =~ startMatch

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

pipe :: String
pipe = " \\| "

getDuration :: Text -> Double
getDuration line = read $ takeWhile (/= '\'') $ match2 ^. _1
 where
  str = Text.unpack line
  match1 :: (String, String, String)
  match1 = str =~ startMatch
  match2 :: (String, String, String)
  match2 = (match1 ^. _3) =~ pipe

getEnd :: Text -> Double
getEnd line = read $ match2 ^. _3
 where
  str = Text.unpack line
  match1 :: (String, String, String)
  match1 = str =~ pipe
  match2 :: (String, String, String)
  match2 = (match1 ^. _1) =~ startMatch


-- | Detect the speech on the mkv file
detectSpeech :: ListenCutOptions -> Prelude.FilePath -> Prelude.FilePath -> Sh (Either ResultCode [WordFrame])
detectSpeech options tempdir inputFile = do
  void $ ffmpeg inputFile $ (specifyTracks options) <> [
      Text.pack tmpMp3File
    ]
  void $ ffmpeg tmpMp3File [
    "-f", "s16le", "-acodec", "pcm_s16le", "-filter:a", "aresample=resampler=soxr:osr=16000", "-ac", "1", Text.pack tmpRawFile
    ]
  liftIO $ speechAnalyses tmpRawFile
  where
    tmpMp3File = tempdir <> "/" <> "speechdetect.mp3"
    tmpRawFile = tempdir <> "/" <> "speechdetect.raw"