-- |
--
-- Copyright:
--   This file is part of the package vimeta. It is subject to the
--   license terms in the LICENSE file found in the top-level
--   directory of this distribution and at:
--
--     https://github.com/pjones/vimeta
--
--   No part of this package, including this file, may be copied,
--   modified, propagated, or distributed except according to the terms
--   contained in the LICENSE file.
--
-- License: BSD-2-Clause
module Vimeta.Core.Vimeta
  ( Vimeta (..),
    Context (..),
    MonadIO,
    throwError,
    runIO,
    runIOE,
    tmdb,
    verbose,
    execVimetaWithContext,
    execVimeta,
    runVimeta,
  )
where

import Byline (BylineT, MonadByline, runBylineT)
import Control.Monad.Catch
import Control.Monad.Except
import qualified Data.Text.IO as Text
import GHC.IO.Encoding (setLocaleEncoding, utf8)
import qualified Network.API.TheMovieDB as TMDb
import Network.HTTP.Client (Manager, newManager)
import Network.HTTP.Client.TLS (tlsManagerSettings)
import Vimeta.Core.Cache
import Vimeta.Core.Config

data Context = Context
  { Context -> Manager
ctxManager :: Manager,
    Context -> Config
ctxConfig :: Config,
    Context -> Configuration
ctxTMDBCfg :: TMDb.Configuration,
    Context -> Handle
ctxVerboseH :: Handle
  }

newtype Vimeta m a = Vimeta
  {Vimeta m a -> ReaderT Context (BylineT (ExceptT String m)) a
unV :: ReaderT Context (BylineT (ExceptT String m)) a}
  deriving
    ( a -> Vimeta m b -> Vimeta m a
(a -> b) -> Vimeta m a -> Vimeta m b
(forall a b. (a -> b) -> Vimeta m a -> Vimeta m b)
-> (forall a b. a -> Vimeta m b -> Vimeta m a)
-> Functor (Vimeta m)
forall a b. a -> Vimeta m b -> Vimeta m a
forall a b. (a -> b) -> Vimeta m a -> Vimeta m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (m :: * -> *) a b. a -> Vimeta m b -> Vimeta m a
forall (m :: * -> *) a b. (a -> b) -> Vimeta m a -> Vimeta m b
<$ :: a -> Vimeta m b -> Vimeta m a
$c<$ :: forall (m :: * -> *) a b. a -> Vimeta m b -> Vimeta m a
fmap :: (a -> b) -> Vimeta m a -> Vimeta m b
$cfmap :: forall (m :: * -> *) a b. (a -> b) -> Vimeta m a -> Vimeta m b
Functor,
      Functor (Vimeta m)
a -> Vimeta m a
Functor (Vimeta m)
-> (forall a. a -> Vimeta m a)
-> (forall a b. Vimeta m (a -> b) -> Vimeta m a -> Vimeta m b)
-> (forall a b c.
    (a -> b -> c) -> Vimeta m a -> Vimeta m b -> Vimeta m c)
-> (forall a b. Vimeta m a -> Vimeta m b -> Vimeta m b)
-> (forall a b. Vimeta m a -> Vimeta m b -> Vimeta m a)
-> Applicative (Vimeta m)
Vimeta m a -> Vimeta m b -> Vimeta m b
Vimeta m a -> Vimeta m b -> Vimeta m a
Vimeta m (a -> b) -> Vimeta m a -> Vimeta m b
(a -> b -> c) -> Vimeta m a -> Vimeta m b -> Vimeta m c
forall a. a -> Vimeta m a
forall a b. Vimeta m a -> Vimeta m b -> Vimeta m a
forall a b. Vimeta m a -> Vimeta m b -> Vimeta m b
forall a b. Vimeta m (a -> b) -> Vimeta m a -> Vimeta m b
forall a b c.
(a -> b -> c) -> Vimeta m a -> Vimeta m b -> Vimeta m c
forall (m :: * -> *). Functor (Vimeta m)
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (m :: * -> *) a. a -> Vimeta m a
forall (m :: * -> *) a b. Vimeta m a -> Vimeta m b -> Vimeta m a
forall (m :: * -> *) a b. Vimeta m a -> Vimeta m b -> Vimeta m b
forall (m :: * -> *) a b.
Vimeta m (a -> b) -> Vimeta m a -> Vimeta m b
forall (m :: * -> *) a b c.
(a -> b -> c) -> Vimeta m a -> Vimeta m b -> Vimeta m c
<* :: Vimeta m a -> Vimeta m b -> Vimeta m a
$c<* :: forall (m :: * -> *) a b. Vimeta m a -> Vimeta m b -> Vimeta m a
*> :: Vimeta m a -> Vimeta m b -> Vimeta m b
$c*> :: forall (m :: * -> *) a b. Vimeta m a -> Vimeta m b -> Vimeta m b
liftA2 :: (a -> b -> c) -> Vimeta m a -> Vimeta m b -> Vimeta m c
$cliftA2 :: forall (m :: * -> *) a b c.
(a -> b -> c) -> Vimeta m a -> Vimeta m b -> Vimeta m c
<*> :: Vimeta m (a -> b) -> Vimeta m a -> Vimeta m b
$c<*> :: forall (m :: * -> *) a b.
Vimeta m (a -> b) -> Vimeta m a -> Vimeta m b
pure :: a -> Vimeta m a
$cpure :: forall (m :: * -> *) a. a -> Vimeta m a
$cp1Applicative :: forall (m :: * -> *). Functor (Vimeta m)
Applicative,
      Applicative (Vimeta m)
a -> Vimeta m a
Applicative (Vimeta m)
-> (forall a b. Vimeta m a -> (a -> Vimeta m b) -> Vimeta m b)
-> (forall a b. Vimeta m a -> Vimeta m b -> Vimeta m b)
-> (forall a. a -> Vimeta m a)
-> Monad (Vimeta m)
Vimeta m a -> (a -> Vimeta m b) -> Vimeta m b
Vimeta m a -> Vimeta m b -> Vimeta m b
forall a. a -> Vimeta m a
forall a b. Vimeta m a -> Vimeta m b -> Vimeta m b
forall a b. Vimeta m a -> (a -> Vimeta m b) -> Vimeta m b
forall (m :: * -> *). Applicative (Vimeta m)
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
forall (m :: * -> *) a. a -> Vimeta m a
forall (m :: * -> *) a b. Vimeta m a -> Vimeta m b -> Vimeta m b
forall (m :: * -> *) a b.
Vimeta m a -> (a -> Vimeta m b) -> Vimeta m b
return :: a -> Vimeta m a
$creturn :: forall (m :: * -> *) a. a -> Vimeta m a
>> :: Vimeta m a -> Vimeta m b -> Vimeta m b
$c>> :: forall (m :: * -> *) a b. Vimeta m a -> Vimeta m b -> Vimeta m b
>>= :: Vimeta m a -> (a -> Vimeta m b) -> Vimeta m b
$c>>= :: forall (m :: * -> *) a b.
Vimeta m a -> (a -> Vimeta m b) -> Vimeta m b
$cp1Monad :: forall (m :: * -> *). Applicative (Vimeta m)
Monad,
      Monad (Vimeta m)
Monad (Vimeta m)
-> (forall a. IO a -> Vimeta m a) -> MonadIO (Vimeta m)
IO a -> Vimeta m a
forall a. IO a -> Vimeta m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall (m :: * -> *). MonadIO m => Monad (Vimeta m)
forall (m :: * -> *) a. MonadIO m => IO a -> Vimeta m a
liftIO :: IO a -> Vimeta m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> Vimeta m a
$cp1MonadIO :: forall (m :: * -> *). MonadIO m => Monad (Vimeta m)
MonadIO,
      MonadReader Context,
      MonadError String,
      Monad (Vimeta m)
Monad (Vimeta m)
-> (forall a. F PrimF a -> Vimeta m a) -> MonadByline (Vimeta m)
F PrimF a -> Vimeta m a
forall a. F PrimF a -> Vimeta m a
forall (m :: * -> *). Monad (Vimeta m)
forall (m :: * -> *).
Monad m -> (forall a. F PrimF a -> m a) -> MonadByline m
forall (m :: * -> *) a. F PrimF a -> Vimeta m a
liftByline :: F PrimF a -> Vimeta m a
$cliftByline :: forall (m :: * -> *) a. F PrimF a -> Vimeta m a
$cp1MonadByline :: forall (m :: * -> *). Monad (Vimeta m)
MonadByline
    )

runIO :: (MonadIO m) => IO a -> Vimeta m a
runIO :: IO a -> Vimeta m a
runIO IO a
io = IO (Either SomeException a) -> Vimeta m (Either SomeException a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> IO (Either SomeException a)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try IO a
io) Vimeta m (Either SomeException a)
-> (Either SomeException a -> Vimeta m a) -> Vimeta m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either SomeException a -> Vimeta m a
forall (m :: * -> *) a.
Monad m =>
Either SomeException a -> Vimeta m a
sinkIO
  where
    sinkIO :: (Monad m) => Either SomeException a -> Vimeta m a
    sinkIO :: Either SomeException a -> Vimeta m a
sinkIO (Left SomeException
e) = String -> Vimeta m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (SomeException -> String
forall b a. (Show a, IsString b) => a -> b
show SomeException
e)
    sinkIO (Right a
a) = a -> Vimeta m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a

runIOE :: (MonadIO m) => IO (Either String a) -> Vimeta m a
runIOE :: IO (Either String a) -> Vimeta m a
runIOE IO (Either String a)
io = IO (Either String a) -> Vimeta m (Either String a)
forall (m :: * -> *) a. MonadIO m => IO a -> Vimeta m a
runIO IO (Either String a)
io Vimeta m (Either String a)
-> (Either String a -> Vimeta m a) -> Vimeta m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> Vimeta m a)
-> (a -> Vimeta m a) -> Either String a -> Vimeta m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Vimeta m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> Vimeta m a)
-> (String -> String) -> String -> Vimeta m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall b a. (Show a, IsString b) => a -> b
show) a -> Vimeta m a
forall (m :: * -> *) a. Monad m => a -> m a
return

-- | Run a 'TheMovieDB' operation.
tmdb :: (MonadIO m) => TMDb.TheMovieDB a -> Vimeta m a
tmdb :: TheMovieDB a -> Vimeta m a
tmdb TheMovieDB a
t = do
  Context
context' <- Vimeta m Context
forall r (m :: * -> *). MonadReader r m => m r
ask

  let manager :: Manager
manager = Context -> Manager
ctxManager Context
context'
      key :: Key
key = Config -> Key
configTMDBKey (Context -> Config
ctxConfig Context
context')
      settings :: Settings
settings = Key -> Settings
TMDb.defaultSettings Key
key

  Either Error a
result <- IO (Either Error a) -> Vimeta m (Either Error a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Manager -> Settings -> TheMovieDB a -> IO (Either Error a)
forall a.
Manager -> Settings -> TheMovieDB a -> IO (Either Error a)
TMDb.runTheMovieDBWithManager Manager
manager Settings
settings TheMovieDB a
t)

  case Either Error a
result of
    Left Error
e -> String -> Vimeta m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Error -> String
forall b a. (Show a, IsString b) => a -> b
show Error
e)
    Right a
r -> a -> Vimeta m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r

verbose :: (MonadIO m) => Text -> Vimeta m ()
verbose :: Key -> Vimeta m ()
verbose Key
msg = do
  Context
context <- Vimeta m Context
forall r (m :: * -> *). MonadReader r m => m r
ask

  let okay :: Bool
okay =
        Config -> Bool
configVerbose (Context -> Config
ctxConfig Context
context)
          Bool -> Bool -> Bool
|| Config -> Bool
configDryRun (Context -> Config
ctxConfig Context
context)

  Bool -> Vimeta m () -> Vimeta m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
okay (Vimeta m () -> Vimeta m ()) -> Vimeta m () -> Vimeta m ()
forall a b. (a -> b) -> a -> b
$ IO () -> Vimeta m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Vimeta m ()) -> IO () -> Vimeta m ()
forall a b. (a -> b) -> a -> b
$ Handle -> Key -> IO ()
Text.hPutStrLn (Context -> Handle
ctxVerboseH Context
context) Key
msg

loadTMDBConfig ::
  (MonadIO m) =>
  Manager ->
  TMDb.Settings ->
  ExceptT String m TMDb.Configuration
loadTMDBConfig :: Manager -> Settings -> ExceptT String m Configuration
loadTMDBConfig Manager
manager Settings
settings = do
  Either Error Configuration
result <-
    ExceptT String m (Either Error Configuration)
-> ExceptT String m (Either Error Configuration)
forall (m :: * -> *) e.
MonadIO m =>
m (Either e Configuration) -> m (Either e Configuration)
cacheTMDBConfig
      ( IO (Either Error Configuration)
-> ExceptT String m (Either Error Configuration)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either Error Configuration)
 -> ExceptT String m (Either Error Configuration))
-> IO (Either Error Configuration)
-> ExceptT String m (Either Error Configuration)
forall a b. (a -> b) -> a -> b
$ Manager
-> Settings
-> TheMovieDB Configuration
-> IO (Either Error Configuration)
forall a.
Manager -> Settings -> TheMovieDB a -> IO (Either Error a)
TMDb.runTheMovieDBWithManager Manager
manager Settings
settings TheMovieDB Configuration
TMDb.config
      )

  case Either Error Configuration
result of
    Left Error
e -> String -> ExceptT String m Configuration
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Error -> String
forall b a. (Show a, IsString b) => a -> b
show Error
e)
    Right Configuration
c -> Configuration -> ExceptT String m Configuration
forall (m :: * -> *) a. Monad m => a -> m a
return Configuration
c

-- | Very primitive way of running a 'Vimeta' value with the given 'Context'.
-- Mostly useful for running vimeta action within another vimeta
-- action.
execVimetaWithContext ::
  (MonadIO m, MonadMask m) =>
  Context ->
  Vimeta m a ->
  m (Either String a)
execVimetaWithContext :: Context -> Vimeta m a -> m (Either String a)
execVimetaWithContext Context
context Vimeta m a
vimeta =
  Vimeta m a -> ReaderT Context (BylineT (ExceptT String m)) a
forall (m :: * -> *) a.
Vimeta m a -> ReaderT Context (BylineT (ExceptT String m)) a
unV Vimeta m a
vimeta
    ReaderT Context (BylineT (ExceptT String m)) a
-> (ReaderT Context (BylineT (ExceptT String m)) a
    -> BylineT (ExceptT String m) a)
-> BylineT (ExceptT String m) a
forall a b. a -> (a -> b) -> b
& (ReaderT Context (BylineT (ExceptT String m)) a
-> Context -> BylineT (ExceptT String m) a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
`runReaderT` Context
context)
    BylineT (ExceptT String m) a
-> (BylineT (ExceptT String m) a -> ExceptT String m (Maybe a))
-> ExceptT String m (Maybe a)
forall a b. a -> (a -> b) -> b
& BylineT (ExceptT String m) a -> ExceptT String m (Maybe a)
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
BylineT m a -> m (Maybe a)
runBylineT
    ExceptT String m (Maybe a)
-> (ExceptT String m (Maybe a) -> ExceptT String m a)
-> ExceptT String m a
forall a b. a -> (a -> b) -> b
& (ExceptT String m (Maybe a)
-> (Maybe a -> ExceptT String m a) -> ExceptT String m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ExceptT String m a
-> (a -> ExceptT String m a) -> Maybe a -> ExceptT String m a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> ExceptT String m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"EOF") a -> ExceptT String m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure)
    ExceptT String m a
-> (ExceptT String m a -> m (Either String a))
-> m (Either String a)
forall a b. a -> (a -> b) -> b
& ExceptT String m a -> m (Either String a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT

-- | Force the current process to use UTF-8 for output.
forceUTF8 :: IO ()
forceUTF8 :: IO ()
forceUTF8 = TextEncoding -> IO ()
setLocaleEncoding TextEncoding
utf8

-- | Run a 'Vimeta' operation after loading the configuration file
-- from disk.
execVimeta ::
  (MonadIO m, MonadMask m) =>
  -- | Modify configuration before running.
  (Config -> Config) ->
  -- | The Vimeta value to execute.
  Vimeta m a ->
  -- | The result.
  m (Either String a)
execVimeta :: (Config -> Config) -> Vimeta m a -> m (Either String a)
execVimeta Config -> Config
cf Vimeta m a
vimeta = ExceptT String m a -> m (Either String a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT String m a -> m (Either String a))
-> ExceptT String m a -> m (Either String a)
forall a b. (a -> b) -> a -> b
$ do
  IO () -> ExceptT String m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ()
forceUTF8
  Config
config <- Config -> Config
cf (Config -> Config)
-> ExceptT String m Config -> ExceptT String m Config
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExceptT String m Config
forall (m :: * -> *). MonadIO m => ExceptT String m Config
readConfig
  Manager
manager <- IO Manager -> ExceptT String m Manager
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Manager -> ExceptT String m Manager)
-> IO Manager -> ExceptT String m Manager
forall a b. (a -> b) -> a -> b
$ ManagerSettings -> IO Manager
newManager ManagerSettings
tlsManagerSettings
  Configuration
tc <- Manager -> Settings -> ExceptT String m Configuration
forall (m :: * -> *).
MonadIO m =>
Manager -> Settings -> ExceptT String m Configuration
loadTMDBConfig Manager
manager (Key -> Settings
TMDb.defaultSettings (Config -> Key
configTMDBKey Config
config))
  m (Either String a) -> ExceptT String m a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either String a) -> ExceptT String m a)
-> m (Either String a) -> ExceptT String m a
forall a b. (a -> b) -> a -> b
$ Context -> Vimeta m a -> m (Either String a)
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
Context -> Vimeta m a -> m (Either String a)
execVimetaWithContext (Manager -> Config -> Configuration -> Handle -> Context
Context Manager
manager Config
config Configuration
tc Handle
stdout) Vimeta m a
vimeta

-- | Simple wrapper around 'execVimeta'.
runVimeta :: (MonadIO m, MonadMask m) => Vimeta m a -> m (Either String a)
runVimeta :: Vimeta m a -> m (Either String a)
runVimeta = (Config -> Config) -> Vimeta m a -> m (Either String a)
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
(Config -> Config) -> Vimeta m a -> m (Either String a)
execVimeta Config -> Config
forall a. a -> a
id