module Ribosome.Persist where

import Control.Exception (IOException, try)
import Control.Monad.Catch (MonadThrow)
import Data.Aeson (FromJSON, ToJSON, eitherDecodeFileStrict', encodeFile)
import Path (Abs, Dir, File, Path, Rel, addExtension, parent, parseAbsDir, parseRelDir, toFilePath, (</>))
import Path.IO (XdgDirectory(XdgCache), createDirIfMissing, doesFileExist, getXdgDir)

import Ribosome.Config.Setting (setting)
import qualified Ribosome.Config.Settings as S (persistenceDir)
import Ribosome.Control.Monad.Error (recoveryFor)
import Ribosome.Control.Monad.Ribo
import Ribosome.Data.PersistError (PersistError)
import qualified Ribosome.Data.PersistError as PersistError (PersistError(..))
import Ribosome.Data.SettingError (SettingError)

defaultPersistencePath :: MonadIO m => m (Path Abs Dir)
defaultPersistencePath :: m (Path Abs Dir)
defaultPersistencePath =
  IO (Path Abs Dir) -> m (Path Abs Dir)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Path Abs Dir) -> m (Path Abs Dir))
-> IO (Path Abs Dir) -> m (Path Abs Dir)
forall a b. (a -> b) -> a -> b
$ XdgDirectory -> Maybe (Path Rel Dir) -> IO (Path Abs Dir)
forall (m :: * -> *).
MonadIO m =>
XdgDirectory -> Maybe (Path Rel Dir) -> m (Path Abs Dir)
getXdgDir XdgDirectory
XdgCache Maybe (Path Rel Dir)
forall a. Maybe a
Nothing

persistencePath ::
  MonadRibo m =>
  NvimE e m =>
  MonadThrow m =>
  MonadDeepError e SettingError m =>
  Path Rel File ->
  m (Path Abs File)
persistencePath :: Path Rel File -> m (Path Abs File)
persistencePath Path Rel File
path = do
  Path Abs Dir
base <- m (Path Abs Dir)
forall (m :: * -> *). MonadIO m => m (Path Abs Dir)
defaultPersistencePath m (Path Abs Dir) -> m (Path Abs Dir) -> m (Path Abs Dir)
forall e (m :: * -> *) a. MonadError e m => m a -> m a -> m a
`recoveryFor` (FilePath -> m (Path Abs Dir)
forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Abs Dir)
parseAbsDir (FilePath -> m (Path Abs Dir)) -> m FilePath -> m (Path Abs Dir)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Setting FilePath -> m FilePath
forall e (m :: * -> *) a.
(NvimE e m, MonadRibo m, MonadDeepError e SettingError m,
 MsgpackDecode a) =>
Setting a -> m a
setting Setting FilePath
S.persistenceDir)
  Path Rel Dir
name <- FilePath -> m (Path Rel Dir)
forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Rel Dir)
parseRelDir (FilePath -> m (Path Rel Dir))
-> (Text -> FilePath) -> Text -> m (Path Rel Dir)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
forall a. ToString a => a -> FilePath
toString (Text -> m (Path Rel Dir)) -> m Text -> m (Path Rel Dir)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m Text
forall (m :: * -> *). MonadRibo m => m Text
pluginName
  return $ Path Abs Dir
base Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
name Path Rel Dir -> Path Rel File -> Path Rel File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
path

persistenceFile ::
  MonadRibo m =>
  NvimE e m =>
  MonadThrow m =>
  MonadDeepError e SettingError m =>
  Path Rel File ->
  m (Path Abs File)
persistenceFile :: Path Rel File -> m (Path Abs File)
persistenceFile Path Rel File
path = do
  Path Abs File
file <- Path Rel File -> m (Path Abs File)
forall (m :: * -> *) e.
(MonadRibo m, NvimE e m, MonadThrow m,
 MonadDeepError e SettingError m) =>
Path Rel File -> m (Path Abs File)
persistencePath Path Rel File
path
  Bool -> Path Abs Dir -> m ()
forall (m :: * -> *) b. MonadIO m => Bool -> Path b Dir -> m ()
createDirIfMissing Bool
True (Path Abs File -> Path Abs Dir
forall b t. Path b t -> Path b Dir
parent Path Abs File
file)
  FilePath -> Path Abs File -> m (Path Abs File)
forall (m :: * -> *) b.
MonadThrow m =>
FilePath -> Path b File -> m (Path b File)
addExtension FilePath
".json" Path Abs File
file

persistStore ::
  MonadRibo m =>
  NvimE e m =>
  MonadThrow m =>
  MonadDeepError e SettingError m =>
  ToJSON a =>
  Path Rel File ->
  a ->
  m ()
persistStore :: Path Rel File -> a -> m ()
persistStore Path Rel File
path a
a = do
  Path Abs File
file <- Path Rel File -> m (Path Abs File)
forall (m :: * -> *) e.
(MonadRibo m, NvimE e m, MonadThrow m,
 MonadDeepError e SettingError m) =>
Path Rel File -> m (Path Abs File)
persistenceFile Path Rel File
path
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> a -> IO ()
forall a. ToJSON a => FilePath -> a -> IO ()
encodeFile (Path Abs File -> FilePath
forall b t. Path b t -> FilePath
toFilePath Path Abs File
file) a
a

noSuchFile :: MonadDeepError e PersistError m => Path Abs File -> m a
noSuchFile :: Path Abs File -> m a
noSuchFile = PersistError -> m a
forall e e' (m :: * -> *) a. MonadDeepError e e' m => e' -> m a
throwHoist (PersistError -> m a)
-> (Path Abs File -> PersistError) -> Path Abs File -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> PersistError
PersistError.NoSuchFile (FilePath -> PersistError)
-> (Path Abs File -> FilePath) -> Path Abs File -> PersistError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs File -> FilePath
forall b t. Path b t -> FilePath
toFilePath

ensureExistence ::
  MonadIO m =>
  MonadDeepError e PersistError m =>
  Path Abs File ->
  m ()
ensureExistence :: Path Abs File -> m ()
ensureExistence Path Abs File
file = do
  Bool
exists <- IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Path Abs File -> IO Bool
forall (m :: * -> *) b. MonadIO m => Path b File -> m Bool
doesFileExist Path Abs File
file
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
exists (Path Abs File -> m ()
forall e (m :: * -> *) a.
MonadDeepError e PersistError m =>
Path Abs File -> m a
noSuchFile Path Abs File
file)

decodeError ::
  MonadDeepError e PersistError m =>
  Path Abs File ->
  Text ->
  m a
decodeError :: Path Abs File -> Text -> m a
decodeError Path Abs File
file = PersistError -> m a
forall e e' (m :: * -> *) a. MonadDeepError e e' m => e' -> m a
throwHoist (PersistError -> m a) -> (Text -> PersistError) -> Text -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text -> PersistError
PersistError.Decode (Path Abs File -> FilePath
forall b t. Path b t -> FilePath
toFilePath Path Abs File
file)

fileNotReadable ::
  MonadDeepError e PersistError m =>
  Path Abs File ->
  IOException ->
  m (Either String a)
fileNotReadable :: Path Abs File -> IOException -> m (Either FilePath a)
fileNotReadable Path Abs File
file IOException
_ = PersistError -> m (Either FilePath a)
forall e e' (m :: * -> *) a. MonadDeepError e e' m => e' -> m a
throwHoist (PersistError -> m (Either FilePath a))
-> PersistError -> m (Either FilePath a)
forall a b. (a -> b) -> a -> b
$ FilePath -> PersistError
PersistError.FileNotReadable (Path Abs File -> FilePath
forall b t. Path b t -> FilePath
toFilePath Path Abs File
file)

safeDecodeFile ::
  MonadIO m =>
  MonadDeepError e PersistError m =>
  FromJSON a =>
  Path Abs File ->
  m a
safeDecodeFile :: Path Abs File -> m a
safeDecodeFile Path Abs File
file = do
  Either FilePath a
result <- (IOException -> m (Either FilePath a))
-> (Either FilePath a -> m (Either FilePath a))
-> Either IOException (Either FilePath a)
-> m (Either FilePath a)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Path Abs File -> IOException -> m (Either FilePath a)
forall e (m :: * -> *) a.
MonadDeepError e PersistError m =>
Path Abs File -> IOException -> m (Either FilePath a)
fileNotReadable Path Abs File
file) Either FilePath a -> m (Either FilePath a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either IOException (Either FilePath a) -> m (Either FilePath a))
-> m (Either IOException (Either FilePath a))
-> m (Either FilePath a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (IO (Either IOException (Either FilePath a))
-> m (Either IOException (Either FilePath a))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either IOException (Either FilePath a))
 -> m (Either IOException (Either FilePath a)))
-> (Path Abs File -> IO (Either IOException (Either FilePath a)))
-> Path Abs File
-> m (Either IOException (Either FilePath a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either FilePath a)
-> IO (Either IOException (Either FilePath a))
forall e a. Exception e => IO a -> IO (Either e a)
try (IO (Either FilePath a)
 -> IO (Either IOException (Either FilePath a)))
-> (Path Abs File -> IO (Either FilePath a))
-> Path Abs File
-> IO (Either IOException (Either FilePath a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO (Either FilePath a)
forall a. FromJSON a => FilePath -> IO (Either FilePath a)
eitherDecodeFileStrict' (FilePath -> IO (Either FilePath a))
-> (Path Abs File -> FilePath)
-> Path Abs File
-> IO (Either FilePath a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs File -> FilePath
forall b t. Path b t -> FilePath
toFilePath (Path Abs File -> m (Either IOException (Either FilePath a)))
-> Path Abs File -> m (Either IOException (Either FilePath a))
forall a b. (a -> b) -> a -> b
$ Path Abs File
file)
  (Text -> m a) -> (a -> m a) -> Either Text a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Path Abs File -> Text -> m a
forall e (m :: * -> *) a.
MonadDeepError e PersistError m =>
Path Abs File -> Text -> m a
decodeError Path Abs File
file) a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text a -> m a)
-> (Either FilePath a -> Either Text a) -> Either FilePath a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Text) -> Either FilePath a -> Either Text a
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft FilePath -> Text
forall a. ToText a => a -> Text
toText (Either FilePath a -> m a) -> Either FilePath a -> m a
forall a b. (a -> b) -> a -> b
$ Either FilePath a
result

persistLoad ::
  MonadIO m =>
  MonadRibo m =>
  NvimE e m =>
  MonadThrow m =>
  MonadDeepError e SettingError m =>
  MonadDeepError e PersistError m =>
  FromJSON a =>
  Path Rel File ->
  m a
persistLoad :: Path Rel File -> m a
persistLoad Path Rel File
path = do
  Path Abs File
file <- Path Rel File -> m (Path Abs File)
forall (m :: * -> *) e.
(MonadRibo m, NvimE e m, MonadThrow m,
 MonadDeepError e SettingError m) =>
Path Rel File -> m (Path Abs File)
persistenceFile Path Rel File
path
  Path Abs File -> m ()
forall (m :: * -> *) e.
(MonadIO m, MonadDeepError e PersistError m) =>
Path Abs File -> m ()
ensureExistence Path Abs File
file
  Path Abs File -> m a
forall (m :: * -> *) e a.
(MonadIO m, MonadDeepError e PersistError m, FromJSON a) =>
Path Abs File -> m a
safeDecodeFile Path Abs File
file

mayPersistLoad ::
  MonadRibo m =>
  NvimE e m =>
  MonadDeepError e SettingError m =>
  MonadDeepError e PersistError m =>
  MonadThrow m =>
  FromJSON a =>
  Path Rel File ->
  m (Maybe a)
mayPersistLoad :: Path Rel File -> m (Maybe a)
mayPersistLoad =
  (PersistError -> m (Maybe a)) -> m (Maybe a) -> m (Maybe a)
forall e' e (m :: * -> *) a.
MonadDeepError e e' m =>
(e' -> m a) -> m a -> m a
catchAt PersistError -> m (Maybe a)
forall (m :: * -> *) e a.
(MonadError e m, DeepPrisms e PersistError) =>
PersistError -> m (Maybe a)
recover (m (Maybe a) -> m (Maybe a))
-> (Path Rel File -> m (Maybe a)) -> Path Rel File -> m (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Rel File -> m (Maybe a)
forall (m :: * -> *) e a.
(MonadIO m, MonadRibo m, NvimE e m, MonadThrow m,
 MonadDeepError e SettingError m, MonadDeepError e PersistError m,
 FromJSON a) =>
Path Rel File -> m a
persistLoad
  where
    recover :: PersistError -> m (Maybe a)
recover (PersistError.NoSuchFile FilePath
_) =
      Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
    recover PersistError
e =
      PersistError -> m (Maybe a)
forall e e' (m :: * -> *) a. MonadDeepError e e' m => e' -> m a
throwHoist PersistError
e