{- This file is part of json-state. - - Written in 2015 by fr33domlover <fr33domlover@rel4tion.org>. - - ♡ Copying is an act of love. Please copy, reuse and share. - - The author(s) have dedicated all copyright and related and neighboring - rights to this software to the public domain worldwide. This software is - distributed without any warranty. - - You should have received a copy of the CC0 Public Domain Dedication along - with this software. If not, see - <http://creativecommons.org/publicdomain/zero/1.0/>. -} -- | This module provides a function for loading a state value from a JSON -- file, and a function which generates a safe scalable saver function. The -- JSON files are written using the @aeson-pretty@ package, so that they are -- easy to read and modify manually if needed. -- -- The save function generator, @mkSaveState@, returns a function which -- saves settings when called, but only at most once in @t@, the time interval -- passed to the generator. For example, if you pass an interval of 3 seconds, -- you can safely call the generated save function even 100 times a second, and -- the JSON file will still get updated just once in 3 seconds, avoiding an -- overload of file I/O. -- -- The actual saving happens in a dedicated worker thread, so even when a save -- does occur, it won't block the caller thread. The generator can be called -- once at program start, and the returned save function saved in application -- state. -- -- 'mkSaveStateVC' works similarly, but additionally provides a saver function -- which commits the change into a git repo. -- -- Note that while this simple periodic save-to-file method can serve a simple -- standalone application well, it won't work if you wish your data to be -- shared by multiple applications and allow them to read and write it at the -- same time. If that's the case, check out the @acid-state@ package, and other -- persistence related packages. module Data.JsonState ( loadState , mkSaveState , mkSaveStateVC , mkSaveStateChoose , stateFilePath ) where import Control.Debounce (mkDebounce) import Control.Monad (liftM, when) import Data.Aeson (FromJSON, ToJSON, eitherDecode) import Data.Aeson.Encode.Pretty (encodePretty) import Data.Time.Units (TimeUnit) import Lib.Git import System.IO.Error (tryIOError) import qualified Data.ByteString.Lazy as B -- | Try to load state from a file. -- -- If an error occurs, 'Left' a pair is returned. The boolean indicates whether -- reading the file failed ('False') or parsing the content failed ('True'). -- The string is an error description. -- -- If the operation succeeds, 'Right' the loaded state data is returned. loadState :: FromJSON s => FilePath -- ^ File to load -> IO (Either (Bool, String) s) loadState file = do errOrStr <- tryIOError (B.readFile file) let pairOrStr = either (Left . (,) False . show) Right errOrStr return $ pairOrStr >>= either (Left . (,) True) Right . eitherDecode saveAction :: ToJSON s => FilePath -> s -> IO () saveAction file s = B.writeFile file $ encodePretty s -- | Prepare a save action which writes state into a JSON file. This action -- defers the work to a separate dedicated thread, and ensures the file isn't -- saved more than once within the given time interval. -- -- The action is non-blocking but there is a chance a save is missed if saves -- are triggered simultaneously from different threads. -- -- You can call the returned action from your UI thread as a reaction to a -- state change, without worrying about delay or IO load. mkSaveState :: (TimeUnit t, ToJSON s) => t -- ^ Minimal time interval between saves -> FilePath -- ^ File to save -> IO (s -> IO ()) mkSaveState interval file = liftM fst $ mkDebounce interval (saveAction file) saveActionVC :: ToJSON s => FilePath -> Config -> String -> (s, Bool) -> IO () saveActionVC file cfg msg (s, git) = do saveAction (configCwd cfg ++ '/' : file) s when git $ runGit cfg $ do add [file] commit [] "json-state" "json@state" msg [] -- | Like 'mkSaveState', but also takes a repository path. Creates a Git -- repository there if there isn't yet. Two save actions are returned. The -- first one simply saves state to a file, just like in 'mkSaveState'. The -- second one saves to file and then commits it into the Git repository. -- -- Note that the file path is relative to the repo path. For example, if you -- have the repo in \"/home/joe/repo\" and the file is \"/home/joe/repo/file\", -- pass just \"file\" as the file path. mkSaveStateVC :: (TimeUnit t, ToJSON s) => t -- ^ Minimal time interval between saves -> FilePath -- ^ File to save, path relative to repo path -> FilePath -- ^ Path of the Git repository -> String -- ^ Commit message to use in automatic commits -> IO ( s -> IO () , s -> IO () ) mkSaveStateVC interval file repo msg = do let cfg = makeConfig repo Nothing runGit cfg $ initDB False action <- liftM fst $ mkDebounce interval (saveActionVC file cfg msg) let withgit s = action (s, True) nogit s = action (s, False) return (nogit, withgit) -- | This is a variant which returns a single save action, which either uses or -- doesn't use a Git repo. If the repo path (3rd argument) is 'Nothing', then -- Git isn't used at all and the file path is treated like 'mkSaveState' would. -- Otherwise, i.e. if a repo path is specified, the returned action will commit -- changes to the Git repo, and the repo and file path arguments are treated -- like 'mkSaveStateVC' would, i.e. the file path is relative to the repo. -- -- If you use this function, also use 'stateFilePath' to determine the correct -- path to pass to 'loadState'. mkSaveStateChoose :: (TimeUnit t, ToJSON s) => t -- ^ Minimal time interval between saves -> FilePath -- ^ File to save. If the repo path (next argument) is -- 'Nothing', no Git repo is used, and this path is relative -- to the process working dir, or absolute. If a repo path is -- specified, this path is relative to repo path, and the -- returned action also commits the file to the Git repo. -> Maybe FilePath -- ^ Optional path of the Git repository. If you pass -- 'Nothing', a Git repo won't be used. If you pass 'Just' a -- repo path, the save action will commit the change. -> String -- ^ Commit message to use in automatic commits -> IO (s -> IO ()) mkSaveStateChoose interval file (Just repo) msg = liftM snd $ mkSaveStateVC interval file repo msg mkSaveStateChoose interval file Nothing _msg = mkSaveState interval file -- | If you use 'mkSaveStateChoose' to save the state, that function combines -- the repo path and the file path when needed, to determine the full path of -- the state file. But then, how do you determine which path to pass to -- 'loadState'? This is exactly what this function does. Pass it the optional -- repo path and the file path you passed to 'mkSaveStateChoose', and you'll -- get a full path you can pass to 'loadState'. stateFilePath :: FilePath -> Maybe FilePath -> FilePath stateFilePath file (Just dir@(_:_)) = if last dir == '/' then dir ++ file else dir ++ '/' : file stateFilePath file _ = file