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 = liftIO $ getXdgDir XdgCache Nothing persistencePath :: MonadRibo m => NvimE e m => MonadThrow m => MonadDeepError e SettingError m => Path Rel File -> m (Path Abs File) persistencePath path = do base <- defaultPersistencePath `recoveryFor` (parseAbsDir =<< setting S.persistenceDir) name <- parseRelDir . toString =<< pluginName return $ base name path persistenceFile :: MonadRibo m => NvimE e m => MonadThrow m => MonadDeepError e SettingError m => Path Rel File -> m (Path Abs File) persistenceFile path = do file <- persistencePath path createDirIfMissing True (parent file) addExtension ".json" file persistStore :: MonadRibo m => NvimE e m => MonadThrow m => MonadDeepError e SettingError m => ToJSON a => Path Rel File -> a -> m () persistStore path a = do file <- persistenceFile path liftIO $ encodeFile (toFilePath file) a noSuchFile :: MonadDeepError e PersistError m => Path Abs File -> m a noSuchFile = throwHoist . PersistError.NoSuchFile . toFilePath ensureExistence :: MonadIO m => MonadDeepError e PersistError m => Path Abs File -> m () ensureExistence file = do exists <- liftIO $ doesFileExist file unless exists (noSuchFile file) decodeError :: MonadDeepError e PersistError m => Path Abs File -> Text -> m a decodeError file = throwHoist . PersistError.Decode (toFilePath file) fileNotReadable :: MonadDeepError e PersistError m => Path Abs File -> IOException -> m (Either String a) fileNotReadable file _ = throwHoist $ PersistError.FileNotReadable (toFilePath file) safeDecodeFile :: MonadIO m => MonadDeepError e PersistError m => FromJSON a => Path Abs File -> m a safeDecodeFile file = do result <- either (fileNotReadable file) return =<< (liftIO . try . eitherDecodeFileStrict' . toFilePath $ file) either (decodeError file) return . mapLeft toText $ 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 = do file <- persistenceFile path ensureExistence file safeDecodeFile 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 = catchAt recover . persistLoad where recover (PersistError.NoSuchFile _) = return Nothing recover e = throwHoist e