Persist.hs

{- This file is part of settings.
 -
 - 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/>.
 -}

module Data.Settings.Persist
    ( mkSaveSettings
    , loadSettings
    )
where

import Control.Debounce (mkDebounce)
import Control.Monad (liftM)
import qualified Data.ByteString.Lazy as B
import Data.Aeson (FromJSON, ToJSON, eitherDecode)
import Data.Aeson.Encode.Pretty (encodePretty)
import Data.Time.Units (TimeUnit)
import System.IO.Error (tryIOError)

saveAction :: ToJSON s => FilePath -> s -> IO ()
saveAction file s = B.writeFile file $ encodePretty s

-- | Prepare a save action which writes settings 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 
--
-- You can call the returned action from your UI thread as a reaction to a
-- settings change, without worrying about delay or IO load.
mkSaveSettings :: (TimeUnit t, ToJSON s) => t -> FilePath -> IO (s -> IO ())
mkSaveSettings interval file =
    liftM fst $ mkDebounce interval (saveAction file)

-- | Try to load settings 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 settings are returned.
loadSettings :: FromJSON s => FilePath -> IO (Either (Bool, String) s)
loadSettings file = do
    errOrStr <- tryIOError (B.readFile file)
    let pairOrStr = either (Left . (,) False . show) Right errOrStr
    return $ pairOrStr >>= either (Left . (,) True) Right . eitherDecode