{-# LANGUAGE GeneralizedNewtypeDeriving, ScopedTypeVariables #-}
module Vimeta.Core.Vimeta
( Vimeta (..)
, Context (..)
, MonadIO
, die
, runIO
, runIOE
, tmdb
, verbose
, execVimetaWithContext
, execVimeta
, runVimeta
, ask
, asks
, liftIO
) where
import Control.Applicative
import Control.Exception
import Control.Monad.Except
import Control.Monad.Reader
import Data.Text (Text)
import qualified Data.Text.IO as Text
import Network.API.TheMovieDB (TheMovieDB, Key, runTheMovieDBWithManager)
import qualified Network.API.TheMovieDB as TheMovieDB
import Network.HTTP.Client (Manager, newManager)
import Network.HTTP.Client.TLS (tlsManagerSettings)
import System.IO (Handle, stdout)
import Vimeta.Core.Cache
import Vimeta.Core.Config
import Prelude
data Context = Context
{ ctxManager :: Manager
, ctxConfig :: Config
, ctxTMDBCfg :: TheMovieDB.Configuration
, ctxVerboseH :: Handle
}
newtype Vimeta m a =
Vimeta {unV :: ReaderT Context (ExceptT String m) a}
deriving (Functor, Applicative, Monad, MonadIO, MonadReader Context)
die :: (Monad m) => String -> Vimeta m a
die message = Vimeta $ lift (throwError message)
runIO :: (MonadIO m) => IO a -> Vimeta m a
runIO io = liftIO (try io) >>= sinkIO
where sinkIO :: (Monad m) => Either SomeException a -> Vimeta m a
sinkIO (Left e) = die (show e)
sinkIO (Right a) = return a
runIOE :: (MonadIO m) => IO (Either String a) -> Vimeta m a
runIOE io = runIO io >>= either (die . show) return
tmdb :: (MonadIO m) => TheMovieDB a -> Vimeta m a
tmdb t = do
context' <- ask
let manager = ctxManager context'
key = configTMDBKey (ctxConfig context')
result <- liftIO (runTheMovieDBWithManager manager key t)
case result of
Left e -> die (show e)
Right r -> return r
verbose :: (MonadIO m) => Text -> Vimeta m ()
verbose msg = do
context <- ask
let okay = configVerbose (ctxConfig context) ||
configDryRun (ctxConfig context)
when okay $ liftIO $ Text.hPutStrLn (ctxVerboseH context) msg
loadTMDBConfig :: (MonadIO m) => Manager -> Key -> ExceptT String m TheMovieDB.Configuration
loadTMDBConfig manager key = do
result <- cacheTMDBConfig (liftIO $ runTheMovieDBWithManager manager key TheMovieDB.config)
case result of
Left e -> throwError (show e)
Right c -> return c
execVimetaWithContext :: Context
-> Vimeta m a
-> m (Either String a)
execVimetaWithContext context vimeta =
runExceptT $ runReaderT (unV vimeta) context
execVimeta :: (MonadIO m)
=> (Config -> Config)
-> Vimeta m a
-> m (Either String a)
execVimeta cf vimeta = runExceptT $ do
config <- cf <$> readConfig
manager <- liftIO $ newManager tlsManagerSettings
tc <- loadTMDBConfig manager (configTMDBKey config)
ExceptT $ execVimetaWithContext (Context manager config tc stdout) vimeta
runVimeta :: (MonadIO m) => Vimeta m a -> m (Either String a)
runVimeta = execVimeta id