-- | Run shell programs
--
--   We mostly add a lot of logging to figure out what goes on
module Cut.Shell
  ( ffmpeg
  , ffmpeg'
  , floatToText
  , youtube_dl
  , shelly
  )
where

import           Data.Text (Text)
import qualified Data.Text as Text
import           Numeric
import           Shelly(Sh)
import qualified Shelly as Sh
import Network.URI(URI)
import Text.Printf
import Data.Time
import System.IO(stdout, hFlush)
import Control.Monad.IO.Class

-- | Wrap ffmpeg for convenience and logging
--  technically supports multiple inputs but for convenice we threw that.
ffmpeg :: Prelude.FilePath -> [Text] -> Sh [Text]
ffmpeg :: FilePath -> [Text] -> Sh [Text]
ffmpeg file :: FilePath
file args :: [Text]
args = [Text] -> Sh [Text]
ffmpeg' ("-y" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: "-i" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: FilePath -> Text
Text.pack FilePath
file Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
args)

ffmpeg' :: [Text] -> Sh [Text]
ffmpeg' :: [Text] -> Sh [Text]
ffmpeg' = FilePath -> [Text] -> Sh [Text]
run "ffmpeg"

-- | Format floats for cli
floatToText :: Double -> Text
floatToText :: Double -> Text
floatToText = FilePath -> Text
Text.pack (FilePath -> Text) -> (Double -> FilePath) -> Double -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> FilePath -> FilePath) -> FilePath -> Double -> FilePath
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Maybe Int -> Double -> FilePath -> FilePath
forall a. RealFloat a => Maybe Int -> a -> FilePath -> FilePath
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just 10)) ""

-- | Wrapper for shelley that always flushes stdout
shelly :: MonadIO m => Sh a -> m a
shelly :: Sh a -> m a
shelly x :: Sh a
x = do
  a
res <- Sh a -> m a
forall (m :: * -> *) a. MonadIO m => Sh a -> m a
Sh.shelly Sh a
x
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Handle -> IO ()
hFlush Handle
stdout -- flush stdout per command run
  a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
res

run :: FilePath -> [Text] -> Sh [Text]
run :: FilePath -> [Text] -> Sh [Text]
run command :: FilePath
command args :: [Text]
args = do
  UTCTime
time' <- IO UTCTime -> Sh UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  let format :: FilePath
format = TimeLocale -> FilePath -> UTCTime -> FilePath
forall t. FormatTime t => TimeLocale -> FilePath -> t -> FilePath
formatTime TimeLocale
defaultTimeLocale "%F %T" UTCTime
time'
  IO () -> Sh ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Sh ()) -> IO () -> Sh ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
putStrLn "--- "
  IO () -> Sh ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Sh ()) -> IO () -> Sh ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> FilePath -> Text -> IO ()
forall r. PrintfType r => FilePath -> r
printf "%s: %s %s" FilePath
format FilePath
command ([Text] -> Text
Text.unwords [Text]
args)
  IO () -> Sh ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Sh ()) -> IO () -> Sh ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
putStrLn "   " -- flush
  FilePath -> [Text] -> Sh ()
Sh.run_ FilePath
command [Text]
args
  IO () -> Sh ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Sh ()) -> IO () -> Sh ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
putStrLn "--- "
  [Text]
result <- Text -> [Text]
Text.lines (Text -> [Text]) -> Sh Text -> Sh [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sh Text
Sh.lastStderr
  [Text] -> Sh [Text]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Text]
result

youtube_dl :: URI -> FilePath -> Sh [Text]
youtube_dl :: URI -> FilePath -> Sh [Text]
youtube_dl uri :: URI
uri path' :: FilePath
path' = FilePath -> [Text] -> Sh [Text]
run "youtube-dl" [Text]
args
  where
    args :: [Text]
args = [FilePath -> Text
Text.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ URI -> FilePath
forall a. Show a => a -> FilePath
show URI
uri
           , "-o", FilePath -> Text
Text.pack FilePath
path'
           , "--merge-output-format", "mkv"
           , "--no-check-certificate"
           ]