module Restyler.RemoteFile
    ( RemoteFile(..)
    , downloadRemoteFile
    ) where

import Restyler.Prelude

import Data.Aeson
import Data.Aeson.Casing
import Restyler.App.Class
import Restyler.Config.ExpectedKeys

data RemoteFile = RemoteFile
    { RemoteFile -> URL
rfUrl :: URL
    , RemoteFile -> FilePath
rfPath :: FilePath
    }
    deriving (RemoteFile -> RemoteFile -> Bool
(RemoteFile -> RemoteFile -> Bool)
-> (RemoteFile -> RemoteFile -> Bool) -> Eq RemoteFile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RemoteFile -> RemoteFile -> Bool
$c/= :: RemoteFile -> RemoteFile -> Bool
== :: RemoteFile -> RemoteFile -> Bool
$c== :: RemoteFile -> RemoteFile -> Bool
Eq, Int -> RemoteFile -> ShowS
[RemoteFile] -> ShowS
RemoteFile -> FilePath
(Int -> RemoteFile -> ShowS)
-> (RemoteFile -> FilePath)
-> ([RemoteFile] -> ShowS)
-> Show RemoteFile
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [RemoteFile] -> ShowS
$cshowList :: [RemoteFile] -> ShowS
show :: RemoteFile -> FilePath
$cshow :: RemoteFile -> FilePath
showsPrec :: Int -> RemoteFile -> ShowS
$cshowsPrec :: Int -> RemoteFile -> ShowS
Show, (forall x. RemoteFile -> Rep RemoteFile x)
-> (forall x. Rep RemoteFile x -> RemoteFile) -> Generic RemoteFile
forall x. Rep RemoteFile x -> RemoteFile
forall x. RemoteFile -> Rep RemoteFile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RemoteFile x -> RemoteFile
$cfrom :: forall x. RemoteFile -> Rep RemoteFile x
Generic)

instance FromJSON RemoteFile where
    parseJSON :: Value -> Parser RemoteFile
parseJSON = Options -> Value -> Parser RemoteFile
forall a.
(Generic a, GFromJSON Zero (Rep a), Selectors (Rep a)) =>
Options -> Value -> Parser a
genericParseJSONValidated (Options -> Value -> Parser RemoteFile)
-> Options -> Value -> Parser RemoteFile
forall a b. (a -> b) -> a -> b
$ ShowS -> Options
aesonPrefix ShowS
snakeCase

instance ToJSON RemoteFile where
    toJSON :: RemoteFile -> Value
toJSON = Options -> RemoteFile -> Value
forall a.
(Generic a, GToJSON Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (Options -> RemoteFile -> Value) -> Options -> RemoteFile -> Value
forall a b. (a -> b) -> a -> b
$ ShowS -> Options
aesonPrefix ShowS
snakeCase
    toEncoding :: RemoteFile -> Encoding
toEncoding = Options -> RemoteFile -> Encoding
forall a.
(Generic a, GToJSON Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding (Options -> RemoteFile -> Encoding)
-> Options -> RemoteFile -> Encoding
forall a b. (a -> b) -> a -> b
$ ShowS -> Options
aesonPrefix ShowS
snakeCase

downloadRemoteFile
    :: (HasLogFunc env, HasDownloadFile env) => RemoteFile -> RIO env ()
downloadRemoteFile :: RemoteFile -> RIO env ()
downloadRemoteFile RemoteFile {..} = do
    Utf8Builder -> RIO env ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logInfo (Utf8Builder -> RIO env ()) -> Utf8Builder -> RIO env ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Utf8Builder
forall a. IsString a => FilePath -> a
fromString (FilePath -> Utf8Builder) -> FilePath -> Utf8Builder
forall a b. (a -> b) -> a -> b
$ "Fetching remote file: " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
rfPath
    Text -> FilePath -> RIO env ()
forall env. HasDownloadFile env => Text -> FilePath -> RIO env ()
downloadFile (URL -> Text
getUrl URL
rfUrl) FilePath
rfPath