Monad.hs

{-# LANGUAGE GeneralizedNewtypeDeriving #-}

--------------------------------------------------------------------
-- |
-- Module    : Data.Ruby.Marshal.Monad
-- Copyright : (c) Philip Cunningham, 2015
-- License   : MIT
--
-- Maintainer:  hello@filib.io
-- Stability :  experimental
-- Portability: portable
--
-- Marshal monad provides an object cache over the Get monad.
--
--------------------------------------------------------------------

module Data.Ruby.Marshal.Monad where

import           Control.Applicative
import           Control.Monad.State.Strict   (MonadState, StateT, get, gets,
                                               lift, put)
import           Data.Ruby.Marshal.RubyObject (RubyObject (..))
import           Data.Serialize.Get           (Get)
import           Data.Vector                  (Vector)
import qualified Data.Vector                  as V
import           Prelude

-- | Marshal monad endows the underlying Get monad with State.
newtype Marshal a = Marshal {
  runMarshal :: StateT Cache Get a
} deriving (Functor, Applicative, Monad, MonadState Cache)

-- | Lift Get monad into Marshal monad.
liftMarshal :: Get a -> Marshal a
liftMarshal = Marshal . lift

-- | State that we must carry around during deserialisation.
data Cache = Cache {
    objects :: !(Vector RubyObject)
    -- ^ object cache.
  , symbols :: !(Vector RubyObject)
    -- ^ symbol cache.
} deriving Show

-- | Constructs an empty cache to store symbols and objects.
emptyCache :: Cache
emptyCache = Cache { symbols = V.empty, objects = V.empty }

-- | Look up value in cache.
readCache :: Int -> (Cache -> Vector RubyObject) -> Marshal (Maybe RubyObject)
readCache index f = gets f >>= \cache -> return $ cache V.!? index

-- | Look up object in object cache.
readObject :: Int -> Marshal (Maybe RubyObject)
readObject index = readCache index objects

-- | Look up a symbol in symbol cache.
readSymbol :: Int -> Marshal (Maybe RubyObject)
readSymbol index = readCache index symbols

-- | Write an object to the appropriate cache.
writeCache :: RubyObject -> Marshal ()
writeCache object = do
  cache <- get
  case object of
    RIVar _   -> put $ cache { objects = V.snoc (objects cache) object }
    RSymbol _ -> put $ cache { symbols = V.snoc (symbols cache) object }
    _         -> return ()