{-# LANGUAGE CPP #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Data.Ruby.Marshal.Monad where
import Control.Applicative
import qualified Control.Monad.Fail as Fail
import qualified Control.Monad as Monad
import Control.Monad (join)
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
newtype Marshal a = Marshal {
Marshal a -> StateT Cache Get a
runMarshal :: StateT Cache Get a
} deriving (a -> Marshal b -> Marshal a
(a -> b) -> Marshal a -> Marshal b
(forall a b. (a -> b) -> Marshal a -> Marshal b)
-> (forall a b. a -> Marshal b -> Marshal a) -> Functor Marshal
forall a b. a -> Marshal b -> Marshal a
forall a b. (a -> b) -> Marshal a -> Marshal b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Marshal b -> Marshal a
$c<$ :: forall a b. a -> Marshal b -> Marshal a
fmap :: (a -> b) -> Marshal a -> Marshal b
$cfmap :: forall a b. (a -> b) -> Marshal a -> Marshal b
Functor, Functor Marshal
a -> Marshal a
Functor Marshal
-> (forall a. a -> Marshal a)
-> (forall a b. Marshal (a -> b) -> Marshal a -> Marshal b)
-> (forall a b c.
(a -> b -> c) -> Marshal a -> Marshal b -> Marshal c)
-> (forall a b. Marshal a -> Marshal b -> Marshal b)
-> (forall a b. Marshal a -> Marshal b -> Marshal a)
-> Applicative Marshal
Marshal a -> Marshal b -> Marshal b
Marshal a -> Marshal b -> Marshal a
Marshal (a -> b) -> Marshal a -> Marshal b
(a -> b -> c) -> Marshal a -> Marshal b -> Marshal c
forall a. a -> Marshal a
forall a b. Marshal a -> Marshal b -> Marshal a
forall a b. Marshal a -> Marshal b -> Marshal b
forall a b. Marshal (a -> b) -> Marshal a -> Marshal b
forall a b c. (a -> b -> c) -> Marshal a -> Marshal b -> Marshal c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: Marshal a -> Marshal b -> Marshal a
$c<* :: forall a b. Marshal a -> Marshal b -> Marshal a
*> :: Marshal a -> Marshal b -> Marshal b
$c*> :: forall a b. Marshal a -> Marshal b -> Marshal b
liftA2 :: (a -> b -> c) -> Marshal a -> Marshal b -> Marshal c
$cliftA2 :: forall a b c. (a -> b -> c) -> Marshal a -> Marshal b -> Marshal c
<*> :: Marshal (a -> b) -> Marshal a -> Marshal b
$c<*> :: forall a b. Marshal (a -> b) -> Marshal a -> Marshal b
pure :: a -> Marshal a
$cpure :: forall a. a -> Marshal a
$cp1Applicative :: Functor Marshal
Applicative, MonadState Cache)
instance Monad Marshal where
(Marshal StateT Cache Get a
ma) >>= :: Marshal a -> (a -> Marshal b) -> Marshal b
>>= a -> Marshal b
f = StateT Cache Get b -> Marshal b
forall a. StateT Cache Get a -> Marshal a
Marshal (StateT Cache Get b -> Marshal b)
-> (StateT Cache Get (StateT Cache Get b) -> StateT Cache Get b)
-> StateT Cache Get (StateT Cache Get b)
-> Marshal b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT Cache Get (StateT Cache Get b) -> StateT Cache Get b
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (StateT Cache Get (StateT Cache Get b) -> Marshal b)
-> StateT Cache Get (StateT Cache Get b) -> Marshal b
forall a b. (a -> b) -> a -> b
$ Marshal b -> StateT Cache Get b
forall a. Marshal a -> StateT Cache Get a
runMarshal (Marshal b -> StateT Cache Get b)
-> (a -> Marshal b) -> a -> StateT Cache Get b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Marshal b
f (a -> StateT Cache Get b)
-> StateT Cache Get a -> StateT Cache Get (StateT Cache Get b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Cache Get a
ma
#if !MIN_VERSION_base(4,13,0)
fail = Fail.fail
#endif
instance Fail.MonadFail Marshal where
fail :: String -> Marshal a
fail = StateT Cache Get a -> Marshal a
forall a. StateT Cache Get a -> Marshal a
Marshal (StateT Cache Get a -> Marshal a)
-> (String -> StateT Cache Get a) -> String -> Marshal a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StateT Cache Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
Monad.fail
liftMarshal :: Get a -> Marshal a
liftMarshal :: Get a -> Marshal a
liftMarshal = StateT Cache Get a -> Marshal a
forall a. StateT Cache Get a -> Marshal a
Marshal (StateT Cache Get a -> Marshal a)
-> (Get a -> StateT Cache Get a) -> Get a -> Marshal a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Get a -> StateT Cache Get a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
data Cache = Cache {
Cache -> Vector RubyObject
objects :: !(Vector RubyObject)
, Cache -> Vector RubyObject
symbols :: !(Vector RubyObject)
} deriving Int -> Cache -> ShowS
[Cache] -> ShowS
Cache -> String
(Int -> Cache -> ShowS)
-> (Cache -> String) -> ([Cache] -> ShowS) -> Show Cache
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Cache] -> ShowS
$cshowList :: [Cache] -> ShowS
show :: Cache -> String
$cshow :: Cache -> String
showsPrec :: Int -> Cache -> ShowS
$cshowsPrec :: Int -> Cache -> ShowS
Show
emptyCache :: Cache
emptyCache :: Cache
emptyCache = Cache :: Vector RubyObject -> Vector RubyObject -> Cache
Cache { symbols :: Vector RubyObject
symbols = Vector RubyObject
forall a. Vector a
V.empty, objects :: Vector RubyObject
objects = Vector RubyObject
forall a. Vector a
V.empty }
readCache :: Int -> (Cache -> Vector RubyObject) -> Marshal (Maybe RubyObject)
readCache :: Int -> (Cache -> Vector RubyObject) -> Marshal (Maybe RubyObject)
readCache Int
index Cache -> Vector RubyObject
f = (Cache -> Vector RubyObject) -> Marshal (Vector RubyObject)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets Cache -> Vector RubyObject
f Marshal (Vector RubyObject)
-> (Vector RubyObject -> Marshal (Maybe RubyObject))
-> Marshal (Maybe RubyObject)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Vector RubyObject
cache -> Maybe RubyObject -> Marshal (Maybe RubyObject)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe RubyObject -> Marshal (Maybe RubyObject))
-> Maybe RubyObject -> Marshal (Maybe RubyObject)
forall a b. (a -> b) -> a -> b
$ Vector RubyObject
cache Vector RubyObject -> Int -> Maybe RubyObject
forall a. Vector a -> Int -> Maybe a
V.!? Int
index
readObject :: Int -> Marshal (Maybe RubyObject)
readObject :: Int -> Marshal (Maybe RubyObject)
readObject Int
index = Int -> (Cache -> Vector RubyObject) -> Marshal (Maybe RubyObject)
readCache Int
index Cache -> Vector RubyObject
objects
readSymbol :: Int -> Marshal (Maybe RubyObject)
readSymbol :: Int -> Marshal (Maybe RubyObject)
readSymbol Int
index = Int -> (Cache -> Vector RubyObject) -> Marshal (Maybe RubyObject)
readCache Int
index Cache -> Vector RubyObject
symbols
writeCache :: RubyObject -> Marshal ()
writeCache :: RubyObject -> Marshal ()
writeCache RubyObject
object = do
Cache
cache <- Marshal Cache
forall s (m :: * -> *). MonadState s m => m s
get
case RubyObject
object of
RSymbol ByteString
_ -> do
Cache -> Marshal ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Cache -> Marshal ()) -> Cache -> Marshal ()
forall a b. (a -> b) -> a -> b
$ Cache
cache { symbols :: Vector RubyObject
symbols = Vector RubyObject -> RubyObject -> Vector RubyObject
forall a. Vector a -> a -> Vector a
V.snoc (Cache -> Vector RubyObject
symbols Cache
cache) RubyObject
object }
RIVar (RubyObject, RubyStringEncoding)
_ -> do
Cache -> Marshal ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Cache -> Marshal ()) -> Cache -> Marshal ()
forall a b. (a -> b) -> a -> b
$ Cache
cache { objects :: Vector RubyObject
objects = Vector RubyObject -> RubyObject -> Vector RubyObject
forall a. Vector a -> a -> Vector a
V.snoc (Cache -> Vector RubyObject
objects Cache
cache) RubyObject
object }
RArray Vector RubyObject
_ -> do
Cache -> Marshal ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Cache -> Marshal ()) -> Cache -> Marshal ()
forall a b. (a -> b) -> a -> b
$ Cache
cache { objects :: Vector RubyObject
objects = Vector RubyObject -> RubyObject -> Vector RubyObject
forall a. Vector a -> a -> Vector a
V.snoc (Cache -> Vector RubyObject
objects Cache
cache) RubyObject
object }
RHash Vector (RubyObject, RubyObject)
_ -> do
Cache -> Marshal ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Cache -> Marshal ()) -> Cache -> Marshal ()
forall a b. (a -> b) -> a -> b
$ Cache
cache { objects :: Vector RubyObject
objects = Vector RubyObject -> RubyObject -> Vector RubyObject
forall a. Vector a -> a -> Vector a
V.snoc (Cache -> Vector RubyObject
objects Cache
cache) RubyObject
object }
RubyObject
_ -> () -> Marshal ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()