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

-- | Deal with downloading and the cli options involved
module Cut.Download
  ( downloadIfNeccisary
  , downloadCutifNeccisary
  )
where

import           Control.Lens
import           Control.Monad
import           Control.Monad.Catch
import           Control.Monad.IO.Class
import           Cut.Options
import           Cut.Shell
import           Data.Foldable          (traverse_)
import           Data.Word
import           Network.URI            (URI)
import           Options.Applicative
import           Shelly                 hiding (FilePath, shelly)
import           System.Random

-- | Downloads a URI to the filepath returned
runYoutubeDL :: FileIO a -> URI -> IO FilePath
runYoutubeDL :: FileIO a -> URI -> IO FilePath
runYoutubeDL opts :: FileIO a
opts x :: URI
x = do
  -- we need to make our own because youtube-dl doesn't write to existing files
  -- System.IO.Temp would've worked neatly here.
  Word32
inputNumbers :: Word32 <- IO Word32
forall a. Random a => IO a
randomIO
  let inputChars :: String
      -- youtube-dl doesn't do .mkv (not supported)
      inputChars :: FilePath
inputChars = Word32 -> FilePath
forall a. Show a => a -> FilePath
show Word32
inputNumbers
      filePath :: String
      filePath :: FilePath
filePath = FilePath -> (FilePath -> FilePath) -> Maybe FilePath -> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
inputChars ((FilePath -> FilePath -> FilePath)
-> FilePath -> FilePath -> FilePath
forall a b c. (a -> b -> c) -> b -> a -> c
flip FilePath -> FilePath -> FilePath
forall filepath1 filepath2.
(ToFilePath filepath1, ToFilePath filepath2) =>
filepath1 -> filepath2 -> FilePath
(</>) FilePath
inputChars) (Maybe FilePath -> FilePath) -> Maybe FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FileIO a
opts FileIO a
-> Getting (Maybe FilePath) (FileIO a) (Maybe FilePath)
-> Maybe FilePath
forall s a. s -> Getting a s a -> a
^. Getting (Maybe FilePath) (FileIO a) (Maybe FilePath)
forall a. Lens' (FileIO a) (Maybe FilePath)
work_dir
      resultPath :: FilePath
resultPath = FilePath
filePath FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> ".mkv"
  Sh () -> IO ()
forall (m :: * -> *) a. MonadIO m => Sh a -> m a
shelly (Sh () -> IO ()) -> Sh () -> IO ()
forall a b. (a -> b) -> a -> b
$ 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
$ URI -> FilePath -> Sh [Text]
youtube_dl URI
x FilePath
filePath
    -- (#52): fix bug where youtube-dl doesn't always create .mkv file output
    Bool
out <- FilePath -> Sh Bool
test_f FilePath
filePath
    Bool -> Sh () -> Sh ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
out (Sh () -> Sh ()) -> Sh () -> Sh ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> Sh ()
mv FilePath
filePath FilePath
resultPath
  FilePath -> IO FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
resultPath -- because 'youtube_dl' sets merge-output-format

aquireFilePath :: FileIO InputSource -> IO (FileIO FilePath)
aquireFilePath :: FileIO InputSource -> IO (FileIO FilePath)
aquireFilePath x :: FileIO InputSource
x = do
  Maybe FilePath
result <- Maybe (IO FilePath) -> IO (Maybe FilePath)
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (Maybe (IO FilePath) -> IO (Maybe FilePath))
-> Maybe (IO FilePath) -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ (Maybe (IO FilePath)
runYoutube Maybe (IO FilePath) -> Maybe (IO FilePath) -> Maybe (IO FilePath)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (IO FilePath)
alreadyLocal)
  case Maybe FilePath
result of
    Nothing -> FilePath -> IO (FileIO FilePath)
forall a. HasCallStack => FilePath -> a
error (FilePath -> IO (FileIO FilePath))
-> FilePath -> IO (FileIO FilePath)
forall a b. (a -> b) -> a -> b
$ "Couldn't find " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FileIO InputSource -> FilePath
forall a. Show a => a -> FilePath
show FileIO InputSource
x
    Just y :: FilePath
y  -> FileIO FilePath -> IO (FileIO FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FileIO FilePath -> IO (FileIO FilePath))
-> FileIO FilePath -> IO (FileIO FilePath)
forall a b. (a -> b) -> a -> b
$ FileIO InputSource
x FileIO InputSource
-> (FileIO InputSource -> FileIO FilePath) -> FileIO FilePath
forall a b. a -> (a -> b) -> b
& (InputSource -> Identity FilePath)
-> FileIO InputSource -> Identity (FileIO FilePath)
forall a b. Lens (FileIO a) (FileIO b) a b
in_file ((InputSource -> Identity FilePath)
 -> FileIO InputSource -> Identity (FileIO FilePath))
-> FilePath -> FileIO InputSource -> FileIO FilePath
forall s t a b. ASetter s t a b -> b -> s -> t
.~ FilePath
y
  where
    runYoutube :: Maybe (IO FilePath)
    runYoutube :: Maybe (IO FilePath)
runYoutube = FileIO InputSource
x FileIO InputSource
-> Getting (First (IO FilePath)) (FileIO InputSource) (IO FilePath)
-> Maybe (IO FilePath)
forall s a. s -> Getting (First a) s a -> Maybe a
^? (InputSource -> Const (First (IO FilePath)) InputSource)
-> FileIO InputSource
-> Const (First (IO FilePath)) (FileIO InputSource)
forall a b. Lens (FileIO a) (FileIO b) a b
in_file ((InputSource -> Const (First (IO FilePath)) InputSource)
 -> FileIO InputSource
 -> Const (First (IO FilePath)) (FileIO InputSource))
-> ((IO FilePath -> Const (First (IO FilePath)) (IO FilePath))
    -> InputSource -> Const (First (IO FilePath)) InputSource)
-> Getting (First (IO FilePath)) (FileIO InputSource) (IO FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (URI -> Const (First (IO FilePath)) URI)
-> InputSource -> Const (First (IO FilePath)) InputSource
Prism' InputSource URI
input_src_remote ((URI -> Const (First (IO FilePath)) URI)
 -> InputSource -> Const (First (IO FilePath)) InputSource)
-> ((IO FilePath -> Const (First (IO FilePath)) (IO FilePath))
    -> URI -> Const (First (IO FilePath)) URI)
-> (IO FilePath -> Const (First (IO FilePath)) (IO FilePath))
-> InputSource
-> Const (First (IO FilePath)) InputSource
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (URI -> IO FilePath)
-> (IO FilePath -> Const (First (IO FilePath)) (IO FilePath))
-> URI
-> Const (First (IO FilePath)) URI
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (FileIO InputSource -> URI -> IO FilePath
forall a. FileIO a -> URI -> IO FilePath
runYoutubeDL FileIO InputSource
x)

    alreadyLocal :: Maybe (IO FilePath)
    alreadyLocal :: Maybe (IO FilePath)
alreadyLocal = Getting (First (IO FilePath)) (FileIO InputSource) (IO FilePath)
-> FileIO InputSource -> Maybe (IO FilePath)
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ((InputSource -> Const (First (IO FilePath)) InputSource)
-> FileIO InputSource
-> Const (First (IO FilePath)) (FileIO InputSource)
forall a b. Lens (FileIO a) (FileIO b) a b
in_file ((InputSource -> Const (First (IO FilePath)) InputSource)
 -> FileIO InputSource
 -> Const (First (IO FilePath)) (FileIO InputSource))
-> ((IO FilePath -> Const (First (IO FilePath)) (IO FilePath))
    -> InputSource -> Const (First (IO FilePath)) InputSource)
-> Getting (First (IO FilePath)) (FileIO InputSource) (IO FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Const (First (IO FilePath)) FilePath)
-> InputSource -> Const (First (IO FilePath)) InputSource
Prism' InputSource FilePath
input_src_local_file ((FilePath -> Const (First (IO FilePath)) FilePath)
 -> InputSource -> Const (First (IO FilePath)) InputSource)
-> ((IO FilePath -> Const (First (IO FilePath)) (IO FilePath))
    -> FilePath -> Const (First (IO FilePath)) FilePath)
-> (IO FilePath -> Const (First (IO FilePath)) (IO FilePath))
-> InputSource
-> Const (First (IO FilePath)) InputSource
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> IO FilePath)
-> (IO FilePath -> Const (First (IO FilePath)) (IO FilePath))
-> FilePath
-> Const (First (IO FilePath)) FilePath
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to FilePath -> IO FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure) FileIO InputSource
x

removeDownloaded :: FileIO InputSource -> FileIO FilePath -> IO ()
removeDownloaded :: FileIO InputSource -> FileIO FilePath -> IO ()
removeDownloaded cliInput :: FileIO InputSource
cliInput aquiredPath :: FileIO FilePath
aquiredPath =
  (URI -> IO ()) -> Maybe URI -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (IO () -> URI -> IO ()
forall a b. a -> b -> a
const (IO () -> URI -> IO ()) -> IO () -> URI -> IO ()
forall a b. (a -> b) -> a -> b
$  -- only do this if we got it from remote (we did the download)
               (FilePath -> IO ()) -> Maybe FilePath -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Sh () -> IO ()
forall (m :: * -> *) a. MonadIO m => Sh a -> m a
shelly (Sh () -> IO ()) -> (FilePath -> Sh ()) -> FilePath -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Sh ()
rm) (Maybe FilePath -> IO ()) -> Maybe FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FileIO FilePath
aquiredPath FileIO FilePath
-> Getting (First FilePath) (FileIO FilePath) FilePath
-> Maybe FilePath
forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting (First FilePath) (FileIO FilePath) FilePath
forall a b. Lens (FileIO a) (FileIO b) a b
in_file
               ) (Maybe URI -> IO ()) -> Maybe URI -> IO ()
forall a b. (a -> b) -> a -> b
$ FileIO InputSource
cliInput FileIO InputSource
-> Getting (First URI) (FileIO InputSource) URI -> Maybe URI
forall s a. s -> Getting (First a) s a -> Maybe a
^? (InputSource -> Const (First URI) InputSource)
-> FileIO InputSource -> Const (First URI) (FileIO InputSource)
forall a b. Lens (FileIO a) (FileIO b) a b
in_file ((InputSource -> Const (First URI) InputSource)
 -> FileIO InputSource -> Const (First URI) (FileIO InputSource))
-> ((URI -> Const (First URI) URI)
    -> InputSource -> Const (First URI) InputSource)
-> Getting (First URI) (FileIO InputSource) URI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (URI -> Const (First URI) URI)
-> InputSource -> Const (First URI) InputSource
Prism' InputSource URI
input_src_remote

-- | 'FileIO' can have a remote, if so we download that and pass the downloaded
--   path to the continuation, if not we simply pass the input path to
--   the continuation.
--   We need a continuation to clean up the downloaded file.
downloadIfNeccisary :: MonadMask m => MonadIO m => FileIO InputSource -> (FileIO FilePath -> m a) -> m a
downloadIfNeccisary :: FileIO InputSource -> (FileIO FilePath -> m a) -> m a
downloadIfNeccisary x :: FileIO InputSource
x = m (FileIO FilePath)
-> (FileIO FilePath -> m ()) -> (FileIO FilePath -> m a) -> m a
forall (m :: * -> *) a c b.
MonadMask m =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracket (IO (FileIO FilePath) -> m (FileIO FilePath)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (FileIO FilePath) -> m (FileIO FilePath))
-> IO (FileIO FilePath) -> m (FileIO FilePath)
forall a b. (a -> b) -> a -> b
$ FileIO InputSource -> IO (FileIO FilePath)
aquireFilePath FileIO InputSource
x) (IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ())
-> (FileIO FilePath -> IO ()) -> FileIO FilePath -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileIO InputSource -> FileIO FilePath -> IO ()
removeDownloaded FileIO InputSource
x)

-- | this does the same as 'downloadIfNeccisary' but makes it work for
--   'ListenCutOptionsT' with some type weaving
downloadCutifNeccisary :: MonadMask m => MonadIO m => ListenCutOptionsT InputSource -> ((ListenCutOptionsT FilePath) -> m a) -> m a
downloadCutifNeccisary :: ListenCutOptionsT InputSource
-> (ListenCutOptionsT FilePath -> m a) -> m a
downloadCutifNeccisary cut :: ListenCutOptionsT InputSource
cut fun :: ListenCutOptionsT FilePath -> m a
fun =
  FileIO InputSource -> (FileIO FilePath -> m a) -> m a
forall (m :: * -> *) a.
(MonadMask m, MonadIO m) =>
FileIO InputSource -> (FileIO FilePath -> m a) -> m a
downloadIfNeccisary (ListenCutOptionsT InputSource
cut ListenCutOptionsT InputSource
-> Getting
     (FileIO InputSource)
     (ListenCutOptionsT InputSource)
     (FileIO InputSource)
-> FileIO InputSource
forall s a. s -> Getting a s a -> a
^. Getting
  (FileIO InputSource)
  (ListenCutOptionsT InputSource)
  (FileIO InputSource)
forall a b.
Lens
  (ListenCutOptionsT a) (ListenCutOptionsT b) (FileIO a) (FileIO b)
lc_fileio) ((FileIO FilePath -> m a) -> m a)
-> (FileIO FilePath -> m a) -> m a
forall a b. (a -> b) -> a -> b
$
    ListenCutOptionsT FilePath -> m a
fun (ListenCutOptionsT FilePath -> m a)
-> (FileIO FilePath -> ListenCutOptionsT FilePath)
-> FileIO FilePath
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\y :: FileIO FilePath
y -> (FileIO InputSource -> Identity (FileIO FilePath))
-> ListenCutOptionsT InputSource
-> Identity (ListenCutOptionsT FilePath)
forall a b.
Lens
  (ListenCutOptionsT a) (ListenCutOptionsT b) (FileIO a) (FileIO b)
lc_fileio ((FileIO InputSource -> Identity (FileIO FilePath))
 -> ListenCutOptionsT InputSource
 -> Identity (ListenCutOptionsT FilePath))
-> FileIO FilePath
-> ListenCutOptionsT InputSource
-> ListenCutOptionsT FilePath
forall s t a b. ASetter s t a b -> b -> s -> t
.~ FileIO FilePath
y (ListenCutOptionsT InputSource -> ListenCutOptionsT FilePath)
-> ListenCutOptionsT InputSource -> ListenCutOptionsT FilePath
forall a b. (a -> b) -> a -> b
$ ListenCutOptionsT InputSource
cut)