module Vimeta.Core.Download
( withArtwork
, withDownload
) where
import qualified Data.ByteString.Lazy as BS
import Data.Maybe
import Data.Monoid
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Network.HTTP.Client as HC
import System.FilePath
import System.IO (Handle, hFlush)
import System.IO.Temp (withSystemTempFile)
import Vimeta.Core.Config
import Vimeta.Core.Vimeta
withArtwork :: (MonadIO m)
=> [Text]
-> (Maybe FilePath -> Vimeta IO a)
-> Vimeta m a
withArtwork urls = withDownload (listToMaybe $ candidates urls)
where
candidates :: [Text] -> [Text]
candidates = filter checkExtension . reverse
checkExtension :: Text -> Bool
checkExtension = goodExtension . takeExtension . Text.unpack . Text.toLower
goodExtension :: String -> Bool
goodExtension ext = ext == ".jpg" || ext == ".png"
withDownload :: (MonadIO m)
=> Maybe Text
-> (Maybe FilePath -> Vimeta IO a)
-> Vimeta m a
withDownload Nothing f = do
verbose "no URL to download"
runIOE $ runVimeta (f Nothing)
withDownload url f = do
context <- ask
let dryRun = configDryRun $ ctxConfig context
manager = ctxManager context
case (dryRun, url) of
(True, Nothing) -> verbose "dry-run: nothing to download" >>
runWithoutTempFile f
(False, Nothing) -> verbose "nothing to download" >>
runWithoutTempFile f
(True, Just u) -> verbose ("dry-run:" <> u) >>
runWithoutTempFile f
(False, Just u) -> verbose u >>
runWithTempFile u manager f
runWithTempFile :: (MonadIO m)
=> Text
-> HC.Manager
-> (Maybe FilePath -> Vimeta IO a)
-> Vimeta m a
runWithTempFile url manager vio = do
context <- ask
runIOE $ withSystemTempFile "vimeta" $ \name h -> do
downloadToHandle manager (Text.unpack url) h
execVimetaWithContext context $ vio (Just name)
runWithoutTempFile :: (MonadIO m)
=> (Maybe FilePath -> Vimeta IO a)
-> Vimeta m a
runWithoutTempFile vio = do
context <- ask
runIOE $ execVimetaWithContext context $ vio Nothing
downloadToHandle :: HC.Manager -> String -> Handle -> IO ()
downloadToHandle manager url handle = do
request <- HC.parseUrl url
response <- HC.httpLbs request manager
BS.hPut handle (HC.responseBody response)
hFlush handle