JsonState.hs

{- 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