content: {-# LANGUAGE CPP, PackageImports, ScopedTypeVariables #-}
  -- | In which the state of a State monad is persisted to disk.
  module Control.Monad.Trans.State.Persistent where
  
  import Control.Applicative
  import Control.Monad
  #if MIN_VERSION_base(4,12,0) && !MIN_VERSION_base(4,13,0)
  import Control.Monad.Fail (MonadFail)
  #endif
  import Control.Monad.IO.Class
  import "mtl" Control.Monad.Trans
  import Control.Monad.Trans.Maybe
  import Control.Monad.Trans.State
  import Data.Functor.Identity
  import System.Directory
  import System.IO
  
  -- $setup
  -- >>> import System.FilePath
  -- >>> tmp <- getTemporaryDirectory
  -- >>> let f = tmp </> "doctest.txt"
  
  
  -- | Read and write the cache to a file. Not atomic.
  --
  -- >>> :{
  -- do { exists <- doesFileExist f
  --    ; when exists $ removeFile f
  --    }
  -- :}
  --
  -- >>> withPersistentState f 0 $ modify (+1) >> get
  -- 1
  -- >>> withPersistentState f 0 $ modify (+1) >> get
  -- 2
  --
  -- >>> removeFile f
  withPersistentState :: forall s a. (Read s, Show s, Eq s)
                      => FilePath -> s -> State s a -> IO a
  withPersistentState f default_s sx = do
      withPersistentStateT f default_s sTx
    where
      sTx :: StateT s IO a
      sTx = mapStateT (return . runIdentity) sx
  
  -- | A monad-transformer version of `withPersistentState`.
  --
  -- >>> :{
  -- do { exists <- doesFileExist f
  --    ; when exists $ removeFile f
  --    }
  -- :}
  --
  -- >>> withPersistentStateT f 0 $ lift (putStrLn "hello") >> modify (+1) >> get
  -- hello
  -- 1
  -- >>> withPersistentStateT f 0 $ lift (putStrLn "hello") >> modify (+1) >> get
  -- hello
  -- 2
  --
  --
  -- If the contents of the file has been corrupted, revert to the default value.
  --
  -- >>> withPersistentStateT f "." $ lift (putStrLn "hello") >> modify (++".") >> get
  -- hello
  -- ".."
  -- >>> withPersistentStateT f "." $ lift (putStrLn "hello") >> modify (++".") >> get
  -- hello
  -- "..."
  --
  --
  -- >>> removeFile f
  withPersistentStateT :: forall m s a. (Functor m, MonadIO m,
  #if MIN_VERSION_base(4,12,0)
                                         MonadFail m,
  #endif
                                         Read s, Show s, Eq s)
                       => FilePath -> s -> StateT s m a -> m a
  withPersistentStateT f default_s sx = do
      Just s <- runMaybeT (get_s <|> get_default_s)
      (x, s') <- runStateT sx s
      when (s' /= s) $ do
        liftIO $ writeFile f $ show s'
      return x
    where
      get_s :: MaybeT m s
      get_s = do
          exists <- liftIO $ doesFileExist f
          guard exists
  
          -- close the file even if the parsing fails
          Just s <- liftIO $ withFile f ReadMode $ \h -> do
            file_contents <- hGetContents h
            case reads file_contents of
              [(s, "")] -> return (Just s)
              _         -> return Nothing
          return s
  
      get_default_s :: MaybeT m s
      get_default_s = return default_s
  
  
  -- | Combine consecutive StateT transformers into a single StateT, so the state
  --   can be persisted to a single file.
  --
  -- >>> let sx = modify (+10)       :: StateT Int (State Int) ()
  -- >>> let tx = lift $ modify (*2) :: StateT Int (State Int) ()
  -- >>> execState (withCombinedState $ sx >> tx) (1, 2)
  -- (11,4)
  withCombinedState :: Monad m => StateT s (StateT t m) a -> StateT (s, t) m a
  withCombinedState ssx = do
      (s, t) <- get
      ((x, s'), t') <- lift $ runStateT (runStateT ssx s) t
      put (s', t')
      return x
  