module Ribosome.Persist( persistStore, persistenceFile, persistencePath, defaultPersistencePath, persistLoad, ) where import GHC.IO.Exception (IOException) import Control.Exception (try) import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.Trans.Except (ExceptT(ExceptT), catchE) import Data.Aeson (ToJSON, FromJSON, encode, eitherDecode) import qualified Data.ByteString.Lazy as B (writeFile, readFile, ByteString) import System.FilePath (takeDirectory, ()) import System.Directory (getXdgDirectory, XdgDirectory(XdgCache), createDirectoryIfMissing) import Ribosome.Monad (liftExceptT) import Ribosome.Data.Ribo (Ribo) import qualified Ribosome.Data.Ribo as Ribo (name) import Ribosome.Config.Setting (settingE) import qualified Ribosome.Config.Settings as S (persistenceDir) defaultPersistencePath :: FilePath -> IO FilePath defaultPersistencePath = getXdgDirectory XdgCache persistencePath :: FilePath -> Ribo e FilePath persistencePath path = do name <- Ribo.name let prefixed = name path custom <- settingE S.persistenceDir either (const $ liftIO $ defaultPersistencePath prefixed) (\c -> return $ c prefixed) custom persistenceFile :: FilePath -> Ribo e FilePath persistenceFile path = do file <- persistencePath path liftIO $ createDirectoryIfMissing True (takeDirectory file) return $ file ++ ".json" persistStore :: ToJSON a => FilePath -> a -> Ribo e () persistStore path a = do file <- persistenceFile path liftIO $ B.writeFile file (encode a) noSuchFile :: Monad m => FilePath -> ExceptT String m a noSuchFile file = ExceptT $ return $ Left $ "persistence file " ++ file ++ " doesn't exist" safeReadFile :: MonadIO m => FilePath -> m (Either IOException B.ByteString) safeReadFile file = liftIO $ try $ B.readFile file persistLoad :: FromJSON a => FilePath -> ExceptT String (Ribo e) a persistLoad path = do file <- liftExceptT $ persistenceFile path json <- catchE (ExceptT $ safeReadFile file) (const $ noSuchFile file) ExceptT $ return $ eitherDecode json