Permalink
Switch branches/tags
Nothing to show
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
183 lines (163 sloc) 6.19 KB
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
--------------------------------------------------------------------
-- |
-- Module : Data.Ruby.Marshal.Get
-- Copyright : (c) Philip Cunningham, 2015
-- License : MIT
--
-- Maintainer: hello@filib.io
-- Stability : experimental
-- Portability: portable
--
-- Parsers for Ruby Marshal format.
--
--------------------------------------------------------------------
module Data.Ruby.Marshal.Get (
-- * Ruby Marshal parsers
getMarshalVersion
, getRubyObject
) where
import Control.Applicative
import Control.Monad (liftM2)
import qualified Data.ByteString as BS
import Data.Ruby.Marshal.Encoding (toEnc)
import Data.Ruby.Marshal.Int
import Data.Ruby.Marshal.Monad (liftMarshal, readObject,
readSymbol, writeCache)
import Data.Ruby.Marshal.Types
import Data.Serialize.Get (Get, getBytes, getTwoOf, label)
import Data.String.Conv (toS)
import qualified Data.Vector as V
import Prelude
import Text.Read (readMaybe)
--------------------------------------------------------------------
-- Top-level functions.
-- | Parses Marshal version.
getMarshalVersion :: Marshal (Word8, Word8)
getMarshalVersion = liftAndLabel "Marshal Version" $
getTwoOf getWord8 getWord8 >>= \version -> case version of
(4, 8) -> return version
_ -> fail "marshal version unsupported"
-- | Parses a subset of Ruby objects.
getRubyObject :: Marshal RubyObject
getRubyObject = getMarshalVersion >> go
where
go :: Marshal RubyObject
go = liftMarshal getWord8 >>= \case
NilChar -> return RNil
TrueChar -> return $ RBool True
FalseChar -> return $ RBool False
FixnumChar -> RFixnum <$> getFixnum
FloatChar -> RFloat <$> getFloat
StringChar -> RString <$> getString
SymbolChar -> RSymbol <$> getSymbol
ObjectLinkChar -> RIVar <$> getObjectLink
SymlinkChar -> RSymbol <$> getSymlink
ArrayChar -> RArray <$> getArray go
HashChar -> RHash <$> getHash go go
IVarChar -> RIVar <$> getIVar go
_ -> return Unsupported
--------------------------------------------------------------------
-- Ancillary functions.
-- | Parses <http://ruby-doc.org/core-2.2.0/Array.html Array>.
getArray :: Marshal a -> Marshal (V.Vector a)
getArray g = marshalLabel "Fixnum" $ do
n <- getFixnum
V.replicateM n g
-- | Parses <http://ruby-doc.org/core-2.2.0/Fixnum.html Fixnum>.
getFixnum :: Marshal Int
getFixnum = liftAndLabel "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
-- | Parses <http://ruby-doc.org/core-2.2.0/Float.html Float>.
getFloat :: Marshal Float
getFloat = marshalLabel "Float" $ do
s <- getString
case readMaybe . toS $ s of
Just float -> return float
Nothing -> fail "expected float"
-- | Parses <http://ruby-doc.org/core-2.2.0/Hash.html Hash>.
getHash :: Marshal a -> Marshal b -> Marshal (V.Vector (a, b))
getHash k v = marshalLabel "Hash" $ do
n <- getFixnum
V.replicateM n (liftM2 (,) k v)
-- | Parses <http://docs.ruby-lang.org/en/2.1.0/marshal_rdoc.html#label-Instance+Variables Instance Variables>.
getIVar :: Marshal RubyObject -> Marshal (RubyObject, RubyStringEncoding)
getIVar g = marshalLabel "IVar" $ do
str <- g
len <- getFixnum
if | len /= 1 -> fail "expected single character"
| otherwise -> do
symbol <- g
denote <- g
case symbol of
RSymbol "E" ->
case denote of
RBool True -> return' (str, UTF_8)
RBool False -> return' (str, US_ASCII)
_ -> fail "expected bool"
RSymbol "encoding" ->
case denote of
RString enc -> return' (str, toEnc enc)
_ -> fail "expected string"
_ -> fail "invalid ivar"
where
return' result = do
writeCache $ RIVar result
return result
-- | Pulls an Instance Variable out of the object cache.
getObjectLink :: Marshal (RubyObject, RubyStringEncoding)
getObjectLink = marshalLabel "ObjectLink" $ do
index <- getFixnum
maybeObject <- readObject index
case maybeObject of
Just (RIVar x) -> return x
_ -> fail "invalid object link"
-- | Parses <http://ruby-doc.org/core-2.2.0/String.html String>.
getString :: Marshal BS.ByteString
getString = marshalLabel "RawString" $ do
n <- getFixnum
liftMarshal $ getBytes n
-- | Parses <http://ruby-doc.org/core-2.2.0/Symbol.html Symbol>.
getSymbol :: Marshal BS.ByteString
getSymbol = marshalLabel "Symbol" $ do
x <- getString
writeCache $ RSymbol x
return x
-- | Pulls a Symbol out of the symbol cache.
getSymlink :: Marshal BS.ByteString
getSymlink = marshalLabel "Symlink" $ do
index <- getFixnum
maybeObject <- readSymbol index
case maybeObject of
Just (RSymbol bs) -> return bs
_ -> fail "invalid symlink"
--------------------------------------------------------------------
-- Utility functions.
-- | Lift Get into Marshal monad and then label.
liftAndLabel :: String -> Get a -> Marshal a
liftAndLabel x y = liftMarshal $! label x y
-- | Label underlying Get in Marshal monad.
marshalLabel :: String -> Marshal a -> Marshal a
marshalLabel x y = y >>= \y' -> liftMarshal $! label x (return y')