ruby-marshal-0.0.1: src/Data/Ruby/Marshal/Get.hs
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
--------------------------------------------------------------------
-- |
-- Module : Data.Ruby.Marshal.Get
-- Copyright : (c) Philip Cunningham, 2015
-- License : MIT
--
-- Maintainer: hello@filib.io
-- Stability : experimental
-- Portability: portable
--
-- Ruby Marshal deserialiser using @Data.Serialize@.
--
--------------------------------------------------------------------
module Data.Ruby.Marshal.Get (
getMarshalVersion
, getRubyObject
, getNil
, getBool
, getArray
, getFixnum
, getFloat
, getHash
, getIVar
, getObjectLink
, getString
, getSymbol
, getSymlink
) where
import Control.Applicative
import Data.Ruby.Marshal.Internal.Int
import Data.Ruby.Marshal.Types
import Control.Monad (guard, liftM2, replicateM)
import Control.Monad.State (get, gets, put)
import Data.Serialize.Get (Get, getBytes, getTwoOf, label)
import Data.String.Conv (toS)
import Text.Read (readMaybe)
import qualified Data.ByteString as BS
import qualified Data.Map.Strict as DM
import qualified Data.Vector as V
import Prelude hiding (length)
--------------------------------------------------------------------
-- Top-level functions.
-- | Deserialises Marshal version.
getMarshalVersion :: Marshal (Word8, Word8)
getMarshalVersion = marshalLabel "Marshal Version" $
getTwoOf getWord8 getWord8
-- | Deserialises a subset of Ruby objects.
getRubyObject :: Marshal RubyObject
getRubyObject = getMarshalVersion >> go
where
go :: Marshal RubyObject
go = liftMarshal getWord8 >>= \case
NilC -> return RNil
TrueC -> return $ RBool True
FalseC -> return $ RBool False
ArrayC -> RArray <$> getArray go
FixnumC -> RFixnum <$> getFixnum
FloatC -> RFloat <$> getFloat
HashC -> RHash <$> getHash go go
IVarC -> RIVar <$> getIVar go
ObjectLinkC -> RIVar <$> getObjectLink
StringC -> RString <$> getString
SymbolC -> RSymbol <$> getSymbol
SymlinkC -> RSymbol <$> getSymlink
_ -> return $ RError Unsupported
--------------------------------------------------------------------
-- Ancillary functions.
-- | Deserialises <http://ruby-doc.org/core-2.2.0/NilClass.html nil>.
getNil :: Marshal ()
getNil = marshalLabel "Nil" $ tag 48
-- | Deserialises <http://ruby-doc.org/core-2.2.0/TrueClass.html true> and
-- <http://ruby-doc.org/core-2.2.0/FalseClass.html false>.
getBool :: Marshal Bool
getBool = marshalLabel "Bool" $
True <$ tag 84 <|> False <$ tag 70
-- | Deserialises <http://ruby-doc.org/core-2.2.0/Array.html Array>.
getArray :: Marshal a -> Marshal (V.Vector a)
getArray g = do
n <- getFixnum
x <- V.replicateM n g
marshalLabel "Array" $ return x
-- | Deserialises <http://ruby-doc.org/core-2.2.0/Fixnum.html Fixnum>.
getFixnum :: Marshal Int
getFixnum = marshalLabel "Fixnum" $ do
x <- getInt8
if | x == 0 -> fromIntegral <$> return x
| x == 1 -> fromIntegral <$> getWord8
| x == -1 -> fromIntegral <$> getNegInt16
| x == 2 -> fromIntegral <$> getWord16le
| x == -2 -> fromIntegral <$> getInt16le
| x == 3 -> fromIntegral <$> getWord24le
| x == -3 -> fromIntegral <$> getInt24le
| x == 4 -> fromIntegral <$> getWord32le
| x == -4 -> fromIntegral <$> getInt32le
| x >= 6 -> fromIntegral <$> return (x - 5)
| x <= -6 -> fromIntegral <$> return (x + 5)
| otherwise -> empty
where
getNegInt16 :: Get Int16
getNegInt16 = do
x <- fromIntegral <$> getInt8
if x >= 0 && x <= 127 then return (x - 256) else return x
-- | Deserialises <http://ruby-doc.org/core-2.2.0/Float.html Float>.
getFloat :: Marshal Double
getFloat = do
s <- getString
x <- case readMaybe . toS $ s of
Just float -> return float
Nothing -> fail "getFloat"
marshalLabel "Float" $ return x
-- | Deserialises <http://ruby-doc.org/core-2.2.0/Hash.html Hash>.
getHash :: forall k v. Ord k => Marshal k -> Marshal v -> Marshal (DM.Map k v)
getHash k v = do
n <- getFixnum
x <- DM.fromList `fmap` replicateM n (liftM2 (,) k v)
marshalLabel "Hash" $ return x
-- | Deserialises <http://docs.ruby-lang.org/en/2.1.0/marshal_rdoc.html#label-Instance+Variables Instance Variables>.
getIVar :: Marshal RubyObject -> Marshal (RubyObject, BS.ByteString)
getIVar g = do
string <- g
length <- getFixnum
if | length /= 1 -> fail "getIvar: expected single character"
| otherwise -> do
symbol <- g
denote <- g
case symbol of
RSymbol "E" -> case denote of
RBool True -> cacheAndReturn string "UTF-8"
RBool False -> cacheAndReturn string "US-ASCII"
_ -> fail "getIVar: expected bool"
RSymbol "encoding" -> case denote of
RString enc -> cacheAndReturn string enc
_ -> fail "getIVar: expected string"
_ -> fail "getIVar: invalid ivar"
where
cacheAndReturn string enc = do
let result = (string, enc)
writeCache $ RIVar result
marshalLabel "IVar" $ return result
-- | Deserialises <http://ruby-doc.org/core-2.2.0/Symbol.html Symbol>.
getObjectLink :: Marshal (RubyObject, BS.ByteString)
getObjectLink = do
index <- getFixnum
maybeObject <- readObject index
case maybeObject of
Just (RIVar x) -> return x
_ -> fail "getObjectLink"
-- | Deserialises <http://ruby-doc.org/core-2.2.0/String.html String>.
getString :: Marshal BS.ByteString
getString = do
n <- getFixnum
x <- liftMarshal $ getBytes n
marshalLabel "RawString" $ return x
-- | Deserialises <http://ruby-doc.org/core-2.2.0/Symbol.html Symbol>.
getSymbol :: Marshal BS.ByteString
getSymbol = do
x <- getString
writeCache $ RSymbol x
marshalLabel "Symbol" $ return x
-- | Deserialises <http://ruby-doc.org/core-2.2.0/Symbol.html Symbol>.
getSymlink :: Marshal BS.ByteString
getSymlink = do
index <- getFixnum
maybeObject <- readSymbol index
case maybeObject of
Just (RSymbol bs) -> return bs
_ -> fail "getSymlink"
--------------------------------------------------------------------
-- Utility functions.
-- | Lift label into Marshal monad.
marshalLabel :: String -> Get a -> Marshal a
marshalLabel x y = liftMarshal $ label x y
-- | Guard against invalid input.
tag :: Word8 -> Get ()
tag t = label "Tag" $
getWord8 >>= \b -> guard $ t == b
-- | Look up object in our object cache.
readObject :: Int -> Marshal (Maybe RubyObject)
readObject index = gets _objects >>= \objectCache ->
return $ objectCache V.!? index
-- | Look up a symbol in our symbol cache.
readSymbol :: Int -> Marshal (Maybe RubyObject)
readSymbol index = gets _symbols >>= \symbolCache ->
return $ symbolCache V.!? index
-- | 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 ()