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

module Cut.Lib
  ( entryPoint
  , combineDir
  , makeSrt
  )
where

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

entryPoint :: (MonadMask m, MonadUnliftIO m) => m ()
entryPoint =
  catch main $ \exec -> liftIO (print (exceptionString, exec :: SomeException))

exceptionString :: String
exceptionString = "Uncaught exception: "

main :: (MonadMask m, MonadUnliftIO m) => m ()
main = do
  options <- liftIO readSettings
  liftIO $ putStr "started with options: "
  liftIO $ print options

  parsed <- detectSoundInterval options
  case parsed of
    [] ->
      liftIO
        $ putStr
            "\n\nNo silence in input video detected. There is nothing to be cut so exiting.\n\n"
    _ -> case options ^. work_dir of
      Nothing ->
        withTempDirectory "/tmp" "streamedit" $ liftIO . runEdit options parsed
      Just x -> liftIO $ runEdit options parsed x

runEdit :: Options -> [Interval Sound] -> FilePath -> IO ()
runEdit options parsed tempDir = do
  extract options tempDir parsed
  shelly $ combineDir options tempDir
  getMusic options tempDir

combineDir :: Options -> FilePath -> Sh ()
combineDir _ tempDir = do
  res <- lsT $ fromText $ Text.pack tempDir
  let paths = Text.unlines $ flip (<>) "'" . ("file '" <>) <$> res
  writefile (fromText $ Text.pack $ tempDir <> "/input.txt") paths
  combine tempDir

readSettings :: IO Options
readSettings = customExecParser (prefs showHelpOnError) $ info
  parseRecord
  (fullDesc <> Options.Applicative.header "Cut the crap" <> progDesc
    "Automated video extracting, can cut out silences"
  )

musicFile :: FilePath
musicFile = "music.mp3"

withMusicFile :: FilePath
withMusicFile = "combined.mkv"

getMusic :: Options -> FilePath -> IO ()
getMusic opt' tempDir = do
  res <- case opt' ^. music_track of
    Nothing -> pure $ Text.pack combinedFile
    Just x  -> do
      shelly $ extractMusicTrack x (opt' ^. in_file) tempDir
      shelly $ mergeMusicAndVideo tempDir
      pure $ Text.pack (tempDir <> "/" <> withMusicFile)
  putStrLn "done get music"
  shelly $ cp (fromText res) (opt' ^. out_file . packed . to fromText)
  pure ()
  where combinedFile = tempDir <> "/" <> combineOutput

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

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


data SrtDisplay = SrtDisplay
  { _srt_from     :: DiffTime
  , _srt_to       :: DiffTime
  , _srt_words    :: Text
  , _srt_position :: Int
  } deriving (Show, Eq, Generic)

instance Semigroup SrtDisplay where
  (<>) a b = SrtDisplay{
    _srt_from = a ^. srt_from,
    _srt_to = b ^. srt_to,
    _srt_words = a ^. srt_words <> " " <> b ^. srt_words,
    _srt_position = a ^. srt_position
    }
instance Monoid SrtDisplay where
  mempty = SrtDisplay{
    _srt_from = 0,
    _srt_to = 0,
    _srt_words = mempty,
    _srt_position = 0
    }

srt_from :: Lens' SrtDisplay DiffTime
srt_from = field @"_srt_from"
srt_to :: Lens' SrtDisplay DiffTime
srt_to = field @"_srt_to"
srt_words :: Lens' SrtDisplay Text
srt_words = field @"_srt_words"
srt_position :: Lens' SrtDisplay Int
srt_position = field @"_srt_position"

makeSrt :: [WordFrame] -> Text.Text
makeSrt frames = fold $ fmap (formatSrt . foldl' (<>) mempty) $ groupBySentence $ imap (toSrtDisplay off) frames
  where off = fromMaybe noOffset $ frames ^? ix 0 . frame_from

groupBySentence :: [SrtDisplay] -> [[SrtDisplay]]
groupBySentence = snd . foldl' innerFold ([], []) -- face

innerFold :: ([SrtDisplay], [[SrtDisplay]]) -> SrtDisplay ->  ([SrtDisplay], [[SrtDisplay]])
innerFold (prev, res) x = if x ^. srt_words == "<sil>" then ([], prev : res) else
  (x : prev, res)


toSrtDisplay :: FrameOffset -> Int -> WordFrame -> SrtDisplay
toSrtDisplay firstOffset ix' frame = SrtDisplay
  { _srt_from     = frame ^. frame_from . to (toDiffTime firstOffset)
  , _srt_to       = frame ^. frame_to . to (toDiffTime firstOffset)
  , _srt_words    = frame ^. frame_word
  , _srt_position = 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 sentence = fold
  [ sentence ^. srt_position . to show . packed
  , "\n"
  , Text.pack
  $  formatTime defaultTimeLocale "%0H:%0M:%0S,000"
  $  sentence
  ^. srt_from
  , " --> "
  , Text.pack
  $  formatTime defaultTimeLocale "%0H:%0M:%0S,000"
  $  sentence
  ^. srt_to
  , "\n"
  , (sentence ^. srt_words)
  , "\n"
  , "\n"
  ]