{-# 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_start       :: Double
  , interval_end         :: Double
  , interval_duration    :: Double
  , interval_input_start :: Text
  , interval_input_end   :: Text
  } deriving (Show, Generic)

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        :: [(Text, Text)]
      linedUp        = zipped lines'
      parsed         :: [Interval Silent]
      parsed         = parse <$> linedUp
      fancyResult    :: [Interval Sound]
      fancyResult    = detector opts parsed
      negativeResult :: Maybe (Interval Sound)
      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

  liftIO $ putStrLn "-----------------------------------------"
  liftIO $ putStrLn "-----------------sounds-----------------"
  liftIO $ putStrLn "-----------------------------------------"
  liftIO $ traverse_ print fancyResult

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

  where
      detector       :: ListenCutOptions -> [Interval Silent] -> [Interval Sound]
      detector       = if opts ^. cut_noise then detectSilence else detectSound

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

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

detectSound :: ListenCutOptions -> [Interval Silent] -> [Interval Sound]
detectSound opts silences =
  reverse $ snd $ fun soundedParts finalSound
  where
    soundedParts :: (Interval Silent, [Interval Sound])
    soundedParts = foldl' fun (Interval 0 0 0 "" "", []) silences

    fun = flip $ silentIntoSounded opts


silentIntoSounded
  :: ListenCutOptions
  -> Interval Silent
  -> (Interval Silent, [Interval Sound])
  -> (Interval Silent, [Interval Sound])
silentIntoSounded opts current prev = (current, soundedInterval : snd prev)
 where
  soundedInterval = Interval
    { interval_start       = soundStart
    , interval_end         = soundEnd - 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"