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