{-# LANGUAGE ScopedTypeVariables #-}

-- |
-- Module      : Control.Auto.Serialize
-- Description : Serializing and deserializing 'Auto's to and from disk,
--               and also 'Auto' transformers focused around serialization.
-- Copyright   : (c) Justin Le 2015
-- License     : MIT
-- Maintainer  : justin@jle.im
-- Stability   : unstable
-- Portability : portable
--
-- This module provides tools for working with the automatically derived
-- serializability and resumability of 'Auto's.  The first half contains
-- boring wrappers around encoding and decoding to and from binary,
-- filepaths on disk, etc.
--
-- The second half contains 'Auto' transformers that "imbue" an 'Auto' with
-- IO serialization abilities.  Note that these all require an underlying
-- 'Monad' that is an instance of 'MonadIO'.
--
-- You have "identity-like" transformers that take an 'Auto' and spit it
-- back out operationally unchanged...but every step, it might do some
-- behind-the-scenes saving or re-load itself from disk when it is first
-- stepped.  Or you have some "trigger enhancers" that take normal 'Auto's
-- and give you the ability to "trigger" saving and loading events on the
-- 'Auto' using the 'Blip' mechanisms and blip stream semantics from
-- "Control.Auto.Blip".
--
-- Note that the entire 'Auto' construct is a little bit awkward when it
-- comes to performing IO effects --- it isn't exactly what they were
-- designed for originally.  Hooking on effects to stepping can be
-- powerful, but as of now, not much has been looked into meaningful error
-- handling when working with IO.  If you have any experience with this and
-- are willing to help, please feel free to send me an e-mail or open an
-- issue on the <https://github.com/mstksg/auto/issues issue tracker>!
--

module Control.Auto.Serialize (
  -- * Serializing and deserializing 'Auto's
  -- ** To and from "Data.Serialize" types
    saveAuto
  , resumeAuto
  -- ** To and from binary
  , encodeAuto
  , decodeAuto
  -- ** To and from disk
  , writeAuto
  , readAuto
  , readAutoDef
  -- * Imbuing 'Auto's with serialization
  -- ** Implicit automatic serialization
  , saving
  , loading'
  , loading
  , serializing'
  , serializing
  -- ** Triggered (blip stream-based) automatic serialization
  -- $onfrom
  -- *** External triggering
  , saveOnB
  , loadOnB'
  , loadOnB
  -- *** Intrinsic triggering
  , saveFromB
  , loadFromB'
  , loadFromB
  ) where

import Control.Applicative
import Control.Auto.Blip.Internal
import Control.Auto.Core
import Control.Exception
import Control.Monad
import Control.Monad.IO.Class
import Prelude
import System.IO.Error
import qualified Data.ByteString  as B

-- | Give a 'FilePath' and an 'Auto', and 'readAuto' will attempt to resume
-- the saved state of the 'Auto' from disk, reading from the given
-- 'FilePath'.  Will return 'Left' upon a decoding error, with the error,
-- and 'Right' if the decoding is succesful.
readAuto :: FilePath        -- ^ filepath to read from
         -> Auto m a b      -- ^ 'Auto' to resume
         -> IO (Either String (Auto m a b))
readAuto fp a = decodeAuto a <$> B.readFile fp

-- | Like 'readAuto', but will return the /original/ 'Auto' (instead of
-- a resumed one) if the file does not exist.
--
-- Useful if you want to "resume an 'Auto'" "if there is" a save state, or
-- just use it as-is if there isn't.
readAutoDef :: FilePath             -- ^ filepath to read from
            -> Auto m a b           -- ^ 'Auto' to resume
            -> IO (Either String (Auto m a b))
readAutoDef fp a = do
    esa <- try (readAuto fp a);
    case esa of
      Right a'                       -> return a'
      Left e | isDoesNotExistError e -> return (Right a)
             | otherwise             -> throw e

-- | Like 'readAuto', but will throw a runtime exception on a failure to
-- decode or an IO error.
readAutoErr :: FilePath             -- ^ filepath to read from
            -> Auto m a b           -- ^ 'Auto' to resume
            -> IO (Auto m a b)
readAutoErr fp a = do
    esa <- readAuto fp a
    return $ case esa of
      Left e   -> error $ "readAutoErr: Corrupted Auto binary -- " ++ e
      Right a' -> a'

-- | Given a 'FilePath' and an 'Auto', serialize and freeze the state of
-- the 'Auto' as binary to that 'FilePath'.
writeAuto :: FilePath       -- ^ filepath to write to
          -> Auto m a b     -- ^ 'Auto' to serialize
          -> IO ()
writeAuto fp a = B.writeFile fp (encodeAuto a)

-- | "Transforms" the given 'Auto' into an 'Auto' that constantly saves its
-- state to the given 'FilePath' at every "step".  Requires an underlying
-- 'MonadIO'.
--
-- Note that (unless the 'Auto' depends on IO), the resulting 'Auto' is
-- meant to be operationally /identical/ in its inputs/outputs to the
-- original one.
--
saving :: MonadIO m
       => FilePath          -- ^ filepath to write to
       -> Auto m a b        -- ^ 'Auto' to transform
       -> Auto m a b
saving fp = interceptO $ \(y, a') -> do
                             liftIO $ writeAuto fp a'
                             return y

-- | "Transforms" the given 'Auto' into an 'Auto' that, when you /first/
-- try to run or step it, "loads" itself from disk at the given 'FilePath'.
--
-- Will throw a runtime exception on either an I/O error or a decoding
-- error.
--
-- Note that (unless the 'Auto' depends on IO), the resulting 'Auto' is
-- meant to be operationally /identical/ in its inputs/outputs to the
-- /fast-forwarded/ original 'Auto'.
--
loading :: MonadIO m
        => FilePath         -- ^ filepath to read from
        -> Auto m a b       -- ^ 'Auto' to transform
        -> Auto m a b
loading fp a0 = mkAutoM (loading fp <$> resumeAuto a0)
                         (saveAuto a0)
                         $ \x -> do
                             a <- liftM loaded . liftIO $ readAutoErr fp a0
                             stepAuto a x
  where
    loaded a = mkAutoM (loading' fp <$> resumeAuto a)
                       (saveAuto a)
                       $ \x -> do
                           (y, a') <- stepAuto a x
                           return (y, loaded a')



-- | Like 'loading', except silently suppresses all I/O and decoding
-- errors; if there are errors, it returns back the given 'Auto' as-is.
--
-- Useful for when you aren't sure the save state is on disk or not yet,
-- and want to resume it only in the case that it is.
loading' :: MonadIO m
         => FilePath        -- ^ filepath to read from
         -> Auto m a b      -- ^ 'Auto' to transform (or return unchanged)
         -> Auto m a b
loading' fp a0 = mkAutoM (loading' fp <$> resumeAuto a0)
                         (saveAuto a0)
                         $ \x -> do
                             a <- do
                               ea' <- liftIO $ readAutoDef fp a0
                               case ea' of
                                 Right a' -> return (loaded a')
                                 Left _   -> return a0
                             stepAuto a x
  where
    loaded a = mkAutoM (loading' fp <$> resumeAuto a)
                       (saveAuto a)
                       $ \x -> do
                           (y, a') <- stepAuto a x
                           return (y, loaded a')

-- | A combination of 'saving' and 'loading'.  When the 'Auto' is first
-- run, it loads the save state from the given 'FilePath' and fast forwards
-- it.  Then, subsequently, it updates the save state on disk on every
-- step.
serializing :: MonadIO m
            => FilePath     -- ^ filepath to read from and write to
            -> Auto m a b   -- ^ 'Auto' to transform
            -> Auto m a b
serializing fp a = loading fp (saving fp a)

-- | Like 'serializing', except suppresses all I/O and decoding errors.
--
-- Useful in the case that when the 'Auto' is first run and there is no
-- save state yet on disk (or the save state is corrupted), it'll "start
-- a new one"; if there is one, it'll load it automatically.  Then, on
-- every further step in both cases, it'll update the save state.
serializing' :: MonadIO m
             => FilePath        -- ^ filepath to read from and write to
             -> Auto m a b      -- ^ 'Auto' to transform
             -> Auto m a b
serializing' fp a = loading' fp (saving fp a)

-- $onfrom
--
-- Note that these follow the naming conventions from
-- "Control.Auto.Switch": Something "from" a blip stream is a thing
-- triggered by the 'Auto' itself, and something "on" a blip stream is
-- a thing triggered externally, from another 'Auto'.

-- | Takes an 'Auto' that produces a blip stream with a 'FilePath' and
-- a value, and turns it into an 'Auto' that, outwardly, produces just the
-- value.
--
-- Whenever the output blip stream emits, it automatically serializes and
-- saves the state of the 'Auto' to the emitted 'FilePath'.
--
-- In practice, this allows any 'Auto' to basically control when it wants
-- to "save", by providing a blip stream.
--
-- The following is an alternative implementation of 'saving', except
-- saving every two steps instead of every step:
--
-- @
-- saving2 fp a = 'saveFromB' (a '&&&' ('every' 2 . 'pure' fp))
-- @
--
-- Or, in proc notation:
--
-- > saving2 fp a = saveFromB $ proc x -> do
-- >     y <- a       -< x
-- >     b <- every 2 -< fp
-- >     id -< (y, b)
--
-- (Recall that @'every' n@ is the "Auto" that emits the received value
-- every @n@ steps)
--
-- In useful real-world cases, you can have the 'Auto' decide whether or
-- not to save itself based on its input.  Like, for example, when it
-- detects a certain user command, or when the user has reached a given
-- location.
--
-- The following takes a 'FilePath' and an 'Auto' (@a@), and turns it into
-- an 'Auto' that "saves" whenever @a@ crosses over from positive to
-- negative.
--
-- @
-- saveOnNegative fp a = saveFromB $ proc x -> do
--     y       <- a            -< x
--     saveNow <- 'became' (< 0) -< y
--     id       -< (y, fp '<$' saveNow)
-- @
--
-- Contrast to 'saveOnB', where the saves are triggered by outside input.
-- In this case, the saves are triggered by the 'Auto' to be saved itself.
--
saveFromB :: MonadIO m
          => Auto m a (b, Blip FilePath)    -- ^ 'Auto' producing a value
                                            --   @b@ and a blip stream
                                            --   with a 'FilePath' to save
                                            --   to
          -> Auto m a b
saveFromB = interceptO $ \((y, b), a') -> do
                             case b of
                               Blip p -> liftIO $ writeAuto p a'
                               _      -> return ()
                             return y

-- | Takes an 'Auto' that outputs a @b@ and a blip stream of 'FilePath's
-- and returns an 'Auto' that ouputs only that @b@ stream...but every time
-- the blip stream emits, it "resets/loads" itself from that 'FilePath'.
--
-- The following is a re-implementation of 'loading'...except delayed by
-- one (the second step that is run is the first "resumed" step).
--
-- @
-- loading2 fp a = 'loadFromB' $ proc x -> do
--     y       <- a           -< x
--     loadNow <- 'immediately' -< fp
--     'id'       -< (y, loadNow)
-- @
--
-- (the blip stream emits only once, immediately, to re-load).
--
-- In the real world, you could have the 'Auto' decide to reset or resume
-- itself based on a user command:
--
-- @
-- loadFrom = loadFromB $ proc x -> do
--     steps  <- count -< ()
--     toLoad <- case words x of
--                   ("load":fp:_) -> do
--                       immediately -< fp
--                   _             -> do
--                       never       -< ()
--     id      -< (steps, toLoad)
-- @
--
-- This will throw a runtime error on an IO exception or parsing error.
--
loadFromB :: MonadIO m
          => Auto m a (b, Blip FilePath)    -- ^ 'Auto' with an output
                                            --     and a blip stream to
                                            --     trigger re-loading
                                            --     itself from the given
                                            --     filepath
          -> Auto m a b
loadFromB a = mkAutoM (loadFromB' <$> resumeAuto a)
                      (saveAuto a)
                      $ \x -> do
                          ((y, b), a') <- stepAuto a x
                          a'' <- case b of
                                   Blip p -> liftIO $ readAutoErr p a'
                                   NoBlip -> return a'
                          return (y, loadFromB' a'')

-- | Like 'loadFromB', except silently ignores errors.  When a load is
-- requested, but there is an IO or parse error, the loading is skipped.
loadFromB' :: MonadIO m
           => Auto m a (b, Blip FilePath)   -- ^ 'Auto' with an output
                                            --     and a blip stream to
                                            --     trigger re-loading
                                            --     itself from the given
                                            --     filepath
           -> Auto m a b
loadFromB' a0 = mkAutoM (loadFromB' <$> resumeAuto a0)
                        (saveAuto a0)
                        $ \x -> do
                            ((y, b), a1) <- stepAuto a0 x
                            a2 <- case b of
                                    Blip p -> do
                                      ea3 <- liftIO $ readAutoDef p a1
                                      case ea3 of
                                        Right a3 -> return a3
                                        Left _   -> return a1
                                    NoBlip -> return a1
                            return (y, loadFromB' a2)

-- | Takes an 'Auto' and basically "wraps" it so that you can trigger saves
-- with a blip stream.
--
-- For example, we can take @'sumFrom' 0@:
--
-- @
-- 'saveOnB' ('sumFrom' 0) :: 'Auto' 'IO' ('Int', 'Blip' 'FilePath') 'Int'
-- @
--
-- It'll behave just like @'sumFrom' 0@ (with the input you pass in the
-- first field of the tuple)...and whenever the blip stream (the second
-- field of the input tuple) emits, it'll save the state of @'sumFrom' 0@
-- to disk at the given 'FilePath'.
--
-- Contrast to 'saveFromB', where the 'Auto' itself can trigger saves; in
-- this one, saves are triggered "externally".
--
-- Might be useful in similar situations as 'saveFromB', except if you want
-- to trigger the save externally.
--
saveOnB :: MonadIO m
        => Auto m a b       -- ^ 'Auto' to make saveable-by-trigger
        -> Auto m (a, Blip FilePath) b
saveOnB a = mkAutoM (saveOnB <$> resumeAuto a)
                    (saveAuto a)
                    $ \(x, b) -> do
                      case b of
                        Blip p -> liftIO $ writeAuto p a
                        NoBlip -> return ()
                      (y, a') <- stepAuto a x
                      return (y, saveOnB a')

-- | Takes an 'Auto' and basically "wraps" it so that you can trigger
-- loads/resumes from a file with a blip stream.
--
-- For example, we can take @'sumFrom' 0@:
--
-- @
-- 'loadOnB' ('sumFrom' 0) :: 'Auto' 'IO' ('Int', 'Blip' 'FilePath') 'Int'
-- @
--
-- It'll behave just like @'sumFrom' 0@ (with the input you pass in the
-- first field of the tiple)...and whenever the blip stream (the second
-- field of the input tuple) emits, it'll "reset" and "reload" the
-- @'sumFrom' 0@ from the 'FilePath' on disk.
--
-- Will throw a runtime exception if there is an IO error or a parse error.
--
-- Contrast to 'loadFromB', where the 'Auto' itself can trigger
-- reloads/resets; in this one, the loads are triggered "externally".
--
-- Might be useful in similar situations as 'loadFromB', except if you want
-- to trigger the loading externally.
--
loadOnB :: MonadIO m
        => Auto m a b       -- ^ 'Auto' to make reloadable-by-trigger
        -> Auto m (a, Blip FilePath) b
loadOnB a = mkAutoM (loadOnB' <$> resumeAuto a)
                    (saveAuto a)
                    $ \(x, b) -> do
                        a' <- case b of
                                Blip p -> liftIO $ readAutoErr p a
                                NoBlip -> return a
                        (y, a'') <- stepAuto a' x
                        return (y, loadOnB' a'')

-- | Like 'loadOnB', except silently ignores errors.  When a load is
-- requested, but there is an IO or parse error, the loading is skipped.
loadOnB' :: MonadIO m
         => Auto m a b      -- ^ 'Auto' to make reloadable-by-trigger
         -> Auto m (a, Blip FilePath) b
loadOnB' a0 = mkAutoM (loadOnB' <$> resumeAuto a0)
                      (saveAuto a0)
                      $ \(x, b) -> do
                          a1 <- case b of
                                  Blip p -> do
                                    ea2 <- liftIO $ readAutoDef p a0
                                    case ea2 of
                                      Right a2 -> return a2
                                      Left _   -> return a0
                                  NoBlip -> return a0
                          (y, a2) <- stepAuto a1 x
                          return (y, loadOnB' a2)