module Vimeta.Core.Download
( withArtwork,
withDownload,
)
where
import qualified Data.ByteString.Lazy as LByteString
import qualified Data.Text as Text
import qualified Network.HTTP.Client as HC
import System.FilePath
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 :: [Text] -> (Maybe FilePath -> Vimeta IO a) -> Vimeta m a
withArtwork [Text]
urls = Maybe Text -> (Maybe FilePath -> Vimeta IO a) -> Vimeta m a
forall (m :: * -> *) a.
MonadIO m =>
Maybe Text -> (Maybe FilePath -> Vimeta IO a) -> Vimeta m a
withDownload ([Text] -> Maybe Text
forall a. [a] -> Maybe a
listToMaybe ([Text] -> Maybe Text) -> [Text] -> Maybe Text
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
candidates [Text]
urls)
where
candidates :: [Text] -> [Text]
candidates :: [Text] -> [Text]
candidates = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter Text -> Bool
checkExtension ([Text] -> [Text]) -> ([Text] -> [Text]) -> [Text] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
forall a. [a] -> [a]
reverse
checkExtension :: Text -> Bool
checkExtension :: Text -> Bool
checkExtension = FilePath -> Bool
goodExtension (FilePath -> Bool) -> (Text -> FilePath) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
takeExtension (FilePath -> FilePath) -> (Text -> FilePath) -> Text -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
forall a. ToString a => a -> FilePath
toString (Text -> FilePath) -> (Text -> Text) -> Text -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
Text.toLower
goodExtension :: String -> Bool
goodExtension :: FilePath -> Bool
goodExtension FilePath
ext = FilePath
ext FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
".jpg" Bool -> Bool -> Bool
|| FilePath
ext FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
".png"
withDownload ::
(MonadIO m) =>
Maybe Text ->
(Maybe FilePath -> Vimeta IO a) ->
Vimeta m a
withDownload :: Maybe Text -> (Maybe FilePath -> Vimeta IO a) -> Vimeta m a
withDownload Maybe Text
Nothing Maybe FilePath -> Vimeta IO a
f = do
Text -> Vimeta m ()
forall (m :: * -> *). MonadIO m => Text -> Vimeta m ()
verbose Text
"no URL to download"
IO (Either FilePath a) -> Vimeta m a
forall (m :: * -> *) a.
MonadIO m =>
IO (Either FilePath a) -> Vimeta m a
runIOE (IO (Either FilePath a) -> Vimeta m a)
-> IO (Either FilePath a) -> Vimeta m a
forall a b. (a -> b) -> a -> b
$ Vimeta IO a -> IO (Either FilePath a)
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
Vimeta m a -> m (Either FilePath a)
runVimeta (Maybe FilePath -> Vimeta IO a
f Maybe FilePath
forall a. Maybe a
Nothing)
withDownload Maybe Text
url Maybe FilePath -> Vimeta IO a
f = do
Context
context <- Vimeta m Context
forall r (m :: * -> *). MonadReader r m => m r
ask
let dryRun :: Bool
dryRun = Config -> Bool
configDryRun (Config -> Bool) -> Config -> Bool
forall a b. (a -> b) -> a -> b
$ Context -> Config
ctxConfig Context
context
manager :: Manager
manager = Context -> Manager
ctxManager Context
context
case (Bool
dryRun, Maybe Text
url) of
(Bool
True, Maybe Text
Nothing) ->
Text -> Vimeta m ()
forall (m :: * -> *). MonadIO m => Text -> Vimeta m ()
verbose Text
"dry-run: nothing to download"
Vimeta m () -> Vimeta m a -> Vimeta m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Maybe FilePath -> Vimeta IO a) -> Vimeta m a
forall (m :: * -> *) a.
MonadIO m =>
(Maybe FilePath -> Vimeta IO a) -> Vimeta m a
runWithoutTempFile Maybe FilePath -> Vimeta IO a
f
(Bool
False, Maybe Text
Nothing) ->
Text -> Vimeta m ()
forall (m :: * -> *). MonadIO m => Text -> Vimeta m ()
verbose Text
"nothing to download"
Vimeta m () -> Vimeta m a -> Vimeta m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Maybe FilePath -> Vimeta IO a) -> Vimeta m a
forall (m :: * -> *) a.
MonadIO m =>
(Maybe FilePath -> Vimeta IO a) -> Vimeta m a
runWithoutTempFile Maybe FilePath -> Vimeta IO a
f
(Bool
True, Just Text
u) ->
Text -> Vimeta m ()
forall (m :: * -> *). MonadIO m => Text -> Vimeta m ()
verbose (Text
"dry-run:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
u)
Vimeta m () -> Vimeta m a -> Vimeta m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Maybe FilePath -> Vimeta IO a) -> Vimeta m a
forall (m :: * -> *) a.
MonadIO m =>
(Maybe FilePath -> Vimeta IO a) -> Vimeta m a
runWithoutTempFile Maybe FilePath -> Vimeta IO a
f
(Bool
False, Just Text
u) ->
Text -> Vimeta m ()
forall (m :: * -> *). MonadIO m => Text -> Vimeta m ()
verbose Text
u
Vimeta m () -> Vimeta m a -> Vimeta m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> Manager -> (Maybe FilePath -> Vimeta IO a) -> Vimeta m a
forall (m :: * -> *) a.
MonadIO m =>
Text -> Manager -> (Maybe FilePath -> Vimeta IO a) -> Vimeta m a
runWithTempFile Text
u Manager
manager Maybe FilePath -> Vimeta IO a
f
runWithTempFile ::
(MonadIO m) =>
Text ->
HC.Manager ->
(Maybe FilePath -> Vimeta IO a) ->
Vimeta m a
runWithTempFile :: Text -> Manager -> (Maybe FilePath -> Vimeta IO a) -> Vimeta m a
runWithTempFile Text
url Manager
manager Maybe FilePath -> Vimeta IO a
vio = do
Context
context <- Vimeta m Context
forall r (m :: * -> *). MonadReader r m => m r
ask
IO (Either FilePath a) -> Vimeta m a
forall (m :: * -> *) a.
MonadIO m =>
IO (Either FilePath a) -> Vimeta m a
runIOE (IO (Either FilePath a) -> Vimeta m a)
-> IO (Either FilePath a) -> Vimeta m a
forall a b. (a -> b) -> a -> b
$
FilePath
-> (FilePath -> Handle -> IO (Either FilePath a))
-> IO (Either FilePath a)
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
FilePath -> (FilePath -> Handle -> m a) -> m a
withSystemTempFile FilePath
"vimeta" ((FilePath -> Handle -> IO (Either FilePath a))
-> IO (Either FilePath a))
-> (FilePath -> Handle -> IO (Either FilePath a))
-> IO (Either FilePath a)
forall a b. (a -> b) -> a -> b
$ \FilePath
name Handle
h -> do
Manager -> FilePath -> Handle -> IO ()
downloadToHandle Manager
manager (Text -> FilePath
forall a. ToString a => a -> FilePath
toString Text
url) Handle
h
Context -> Vimeta IO a -> IO (Either FilePath a)
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
Context -> Vimeta m a -> m (Either FilePath a)
execVimetaWithContext Context
context (Vimeta IO a -> IO (Either FilePath a))
-> Vimeta IO a -> IO (Either FilePath a)
forall a b. (a -> b) -> a -> b
$ Maybe FilePath -> Vimeta IO a
vio (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
name)
runWithoutTempFile ::
(MonadIO m) =>
(Maybe FilePath -> Vimeta IO a) ->
Vimeta m a
runWithoutTempFile :: (Maybe FilePath -> Vimeta IO a) -> Vimeta m a
runWithoutTempFile Maybe FilePath -> Vimeta IO a
vio = do
Context
context <- Vimeta m Context
forall r (m :: * -> *). MonadReader r m => m r
ask
IO (Either FilePath a) -> Vimeta m a
forall (m :: * -> *) a.
MonadIO m =>
IO (Either FilePath a) -> Vimeta m a
runIOE (IO (Either FilePath a) -> Vimeta m a)
-> IO (Either FilePath a) -> Vimeta m a
forall a b. (a -> b) -> a -> b
$ Context -> Vimeta IO a -> IO (Either FilePath a)
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
Context -> Vimeta m a -> m (Either FilePath a)
execVimetaWithContext Context
context (Vimeta IO a -> IO (Either FilePath a))
-> Vimeta IO a -> IO (Either FilePath a)
forall a b. (a -> b) -> a -> b
$ Maybe FilePath -> Vimeta IO a
vio Maybe FilePath
forall a. Maybe a
Nothing
downloadToHandle :: HC.Manager -> String -> Handle -> IO ()
downloadToHandle :: Manager -> FilePath -> Handle -> IO ()
downloadToHandle Manager
manager FilePath
url Handle
handle = do
Request
request <- FilePath -> IO Request
forall (m :: * -> *). MonadThrow m => FilePath -> m Request
HC.parseRequest FilePath
url
Response ByteString
response <- Request -> Manager -> IO (Response ByteString)
HC.httpLbs Request
request Manager
manager
Handle -> ByteString -> IO ()
LByteString.hPut Handle
handle (Response ByteString -> ByteString
forall body. Response body -> body
HC.responseBody Response ByteString
response)
Handle -> IO ()
forall (m :: * -> *). MonadIO m => Handle -> m ()
hFlush Handle
handle