{-# 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, when)
import           Data.Monoid                ((<>))
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 :: Marshal (Word8, Word8)
getMarshalVersion = String -> Get (Word8, Word8) -> Marshal (Word8, Word8)
forall a. String -> Get a -> Marshal a
liftAndLabel String
"Marshal Version" (Get (Word8, Word8) -> Marshal (Word8, Word8))
-> Get (Word8, Word8) -> Marshal (Word8, Word8)
forall a b. (a -> b) -> a -> b
$
  Get Word8 -> Get Word8 -> Get (Word8, Word8)
forall a b. Get a -> Get b -> Get (a, b)
getTwoOf Get Word8
getWord8 Get Word8
getWord8 Get (Word8, Word8)
-> ((Word8, Word8) -> Get (Word8, Word8)) -> Get (Word8, Word8)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Word8, Word8)
version -> case (Word8, Word8)
version of
    (Word8
4, Word8
8) -> (Word8, Word8) -> Get (Word8, Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8, Word8)
version
    (Word8, Word8)
_      -> String -> Get (Word8, Word8)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"marshal version unsupported"

-- | Parses a subset of Ruby objects.
getRubyObject :: Marshal RubyObject
getRubyObject :: Marshal RubyObject
getRubyObject = Marshal (Word8, Word8)
getMarshalVersion Marshal (Word8, Word8) -> Marshal RubyObject -> Marshal RubyObject
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Marshal RubyObject
go
  where
    go :: Marshal RubyObject
    go :: Marshal RubyObject
go = Get Word8 -> Marshal Word8
forall a. Get a -> Marshal a
liftMarshal Get Word8
getWord8 Marshal Word8
-> (Word8 -> Marshal RubyObject) -> Marshal RubyObject
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
           Word8
NilChar        -> RubyObject -> Marshal RubyObject
forall (m :: * -> *) a. Monad m => a -> m a
return RubyObject
RNil
           Word8
TrueChar       -> RubyObject -> Marshal RubyObject
forall (m :: * -> *) a. Monad m => a -> m a
return (RubyObject -> Marshal RubyObject)
-> RubyObject -> Marshal RubyObject
forall a b. (a -> b) -> a -> b
$ Bool -> RubyObject
RBool Bool
True
           Word8
FalseChar      -> RubyObject -> Marshal RubyObject
forall (m :: * -> *) a. Monad m => a -> m a
return (RubyObject -> Marshal RubyObject)
-> RubyObject -> Marshal RubyObject
forall a b. (a -> b) -> a -> b
$ Bool -> RubyObject
RBool Bool
False
           Word8
FixnumChar     -> Int -> RubyObject
RFixnum (Int -> RubyObject) -> Marshal Int -> Marshal RubyObject
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Marshal Int
getFixnum
           Word8
FloatChar      -> Float -> RubyObject
RFloat (Float -> RubyObject) -> Marshal Float -> Marshal RubyObject
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Marshal Float
getFloat
           Word8
StringChar     -> ByteString -> RubyObject
RString (ByteString -> RubyObject)
-> Marshal ByteString -> Marshal RubyObject
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Marshal ByteString
getString
           Word8
SymbolChar     -> ByteString -> RubyObject
RSymbol (ByteString -> RubyObject)
-> Marshal ByteString -> Marshal RubyObject
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Marshal ByteString
getSymbol
           Word8
ObjectLinkChar -> Marshal RubyObject
getObjectLink
           Word8
SymlinkChar    -> ByteString -> RubyObject
RSymbol (ByteString -> RubyObject)
-> Marshal ByteString -> Marshal RubyObject
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Marshal ByteString
getSymlink
           Word8
ArrayChar      -> do
             RubyObject
result <- Vector RubyObject -> RubyObject
RArray (Vector RubyObject -> RubyObject)
-> Marshal (Vector RubyObject) -> Marshal RubyObject
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Marshal RubyObject -> Marshal (Vector RubyObject)
forall a. Marshal a -> Marshal (Vector a)
getArray Marshal RubyObject
go
             RubyObject -> Marshal ()
writeCache RubyObject
result
             RubyObject -> Marshal RubyObject
forall (f :: * -> *) a. Applicative f => a -> f a
pure RubyObject
result
           Word8
HashChar       -> do
             RubyObject
result <- Vector (RubyObject, RubyObject) -> RubyObject
RHash (Vector (RubyObject, RubyObject) -> RubyObject)
-> Marshal (Vector (RubyObject, RubyObject)) -> Marshal RubyObject
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Marshal RubyObject
-> Marshal RubyObject -> Marshal (Vector (RubyObject, RubyObject))
forall a b. Marshal a -> Marshal b -> Marshal (Vector (a, b))
getHash Marshal RubyObject
go Marshal RubyObject
go
             RubyObject -> Marshal ()
writeCache RubyObject
result
             RubyObject -> Marshal RubyObject
forall (f :: * -> *) a. Applicative f => a -> f a
pure RubyObject
result
           Word8
IVarChar       -> (RubyObject, RubyStringEncoding) -> RubyObject
RIVar ((RubyObject, RubyStringEncoding) -> RubyObject)
-> Marshal (RubyObject, RubyStringEncoding) -> Marshal RubyObject
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Marshal RubyObject -> Marshal (RubyObject, RubyStringEncoding)
getIVar Marshal RubyObject
go
           Word8
_              -> RubyObject -> Marshal RubyObject
forall (m :: * -> *) a. Monad m => a -> m a
return RubyObject
Unsupported

--------------------------------------------------------------------
-- Ancillary functions.

-- | Parses <http://ruby-doc.org/core-2.2.0/Array.html Array>.
getArray :: Marshal a -> Marshal (V.Vector a)
getArray :: Marshal a -> Marshal (Vector a)
getArray Marshal a
g = String -> Marshal (Vector a) -> Marshal (Vector a)
forall a. String -> Marshal a -> Marshal a
marshalLabel String
"Fixnum" (Marshal (Vector a) -> Marshal (Vector a))
-> Marshal (Vector a) -> Marshal (Vector a)
forall a b. (a -> b) -> a -> b
$ do
  Int
n <- Marshal Int
getFixnum
  Int -> Marshal a -> Marshal (Vector a)
forall (m :: * -> *) a. Monad m => Int -> m a -> m (Vector a)
V.replicateM Int
n Marshal a
g

-- | Parses <http://ruby-doc.org/core-2.2.0/Fixnum.html Fixnum>.
getFixnum :: Marshal Int
getFixnum :: Marshal Int
getFixnum = String -> Get Int -> Marshal Int
forall a. String -> Get a -> Marshal a
liftAndLabel String
"Fixnum" (Get Int -> Marshal Int) -> Get Int -> Marshal Int
forall a b. (a -> b) -> a -> b
$ do
  Int8
x <- Get Int8
getInt8
  if | Int8
x Int8 -> Int8 -> Bool
forall a. Eq a => a -> a -> Bool
== Int8
0 -> Int8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int8 -> Int) -> Get Int8 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int8 -> Get Int8
forall (m :: * -> *) a. Monad m => a -> m a
return Int8
x
     | Int8
x Int8 -> Int8 -> Bool
forall a. Eq a => a -> a -> Bool
== Int8
1 -> Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> Get Word8 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
     | Int8
x Int8 -> Int8 -> Bool
forall a. Eq a => a -> a -> Bool
== -Int8
1 -> Int16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int16 -> Int) -> Get Int16 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int16
getNegInt16
     | Int8
x Int8 -> Int8 -> Bool
forall a. Eq a => a -> a -> Bool
== Int8
2 -> Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int) -> Get Word16 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16le
     | Int8
x Int8 -> Int8 -> Bool
forall a. Eq a => a -> a -> Bool
== -Int8
2 -> Int16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int16 -> Int) -> Get Int16 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int16
getInt16le
     | Int8
x Int8 -> Int8 -> Bool
forall a. Eq a => a -> a -> Bool
== Int8
3 -> Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Get Word32 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord24le
     | Int8
x Int8 -> Int8 -> Bool
forall a. Eq a => a -> a -> Bool
== -Int8
3 -> Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Int) -> Get Int32 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int32
getInt24le
     | Int8
x Int8 -> Int8 -> Bool
forall a. Eq a => a -> a -> Bool
== Int8
4 -> Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Get Word32 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
getWord32le
     | Int8
x Int8 -> Int8 -> Bool
forall a. Eq a => a -> a -> Bool
== -Int8
4 -> Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Int) -> Get Int32 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int32
getInt32le
     | Int8
x Int8 -> Int8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int8
6 -> Int8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int8 -> Int) -> Get Int8 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int8 -> Get Int8
forall (m :: * -> *) a. Monad m => a -> m a
return (Int8
x Int8 -> Int8 -> Int8
forall a. Num a => a -> a -> a
- Int8
5)
     | Int8
x Int8 -> Int8 -> Bool
forall a. Ord a => a -> a -> Bool
<= -Int8
6 -> Int8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int8 -> Int) -> Get Int8 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int8 -> Get Int8
forall (m :: * -> *) a. Monad m => a -> m a
return (Int8
x Int8 -> Int8 -> Int8
forall a. Num a => a -> a -> a
+ Int8
5)
     | Bool
otherwise -> Get Int
forall (f :: * -> *) a. Alternative f => f a
empty
  where
    getNegInt16 :: Get Int16
    getNegInt16 :: Get Int16
getNegInt16 = do
      Int16
x <- Int8 -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int8 -> Int16) -> Get Int8 -> Get Int16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int8
getInt8
      if Int16
x Int16 -> Int16 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int16
0 Bool -> Bool -> Bool
&& Int16
x Int16 -> Int16 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int16
127
        then Int16 -> Get Int16
forall (m :: * -> *) a. Monad m => a -> m a
return (Int16
x Int16 -> Int16 -> Int16
forall a. Num a => a -> a -> a
- Int16
256)
        else Int16 -> Get Int16
forall (m :: * -> *) a. Monad m => a -> m a
return Int16
x

-- | Parses <http://ruby-doc.org/core-2.2.0/Float.html Float>.
getFloat :: Marshal Float
getFloat :: Marshal Float
getFloat = String -> Marshal Float -> Marshal Float
forall a. String -> Marshal a -> Marshal a
marshalLabel String
"Float" (Marshal Float -> Marshal Float) -> Marshal Float -> Marshal Float
forall a b. (a -> b) -> a -> b
$ do
  ByteString
s <- Marshal ByteString
getString
  case String -> Maybe Float
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Float)
-> (ByteString -> String) -> ByteString -> Maybe Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
forall a b. StringConv a b => a -> b
toS (ByteString -> Maybe Float) -> ByteString -> Maybe Float
forall a b. (a -> b) -> a -> b
$ ByteString
s of
    Just Float
float -> Float -> Marshal Float
forall (m :: * -> *) a. Monad m => a -> m a
return Float
float
    Maybe Float
Nothing    -> String -> Marshal Float
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"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 :: Marshal a -> Marshal b -> Marshal (Vector (a, b))
getHash Marshal a
k Marshal b
v = String -> Marshal (Vector (a, b)) -> Marshal (Vector (a, b))
forall a. String -> Marshal a -> Marshal a
marshalLabel String
"Hash" (Marshal (Vector (a, b)) -> Marshal (Vector (a, b)))
-> Marshal (Vector (a, b)) -> Marshal (Vector (a, b))
forall a b. (a -> b) -> a -> b
$ do
  Int
n <- Marshal Int
getFixnum
  Int -> Marshal (a, b) -> Marshal (Vector (a, b))
forall (m :: * -> *) a. Monad m => Int -> m a -> m (Vector a)
V.replicateM Int
n ((a -> b -> (a, b)) -> Marshal a -> Marshal b -> Marshal (a, b)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) Marshal a
k Marshal b
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 :: Marshal RubyObject -> Marshal (RubyObject, RubyStringEncoding)
getIVar Marshal RubyObject
g = String
-> Marshal (RubyObject, RubyStringEncoding)
-> Marshal (RubyObject, RubyStringEncoding)
forall a. String -> Marshal a -> Marshal a
marshalLabel String
"IVar" (Marshal (RubyObject, RubyStringEncoding)
 -> Marshal (RubyObject, RubyStringEncoding))
-> Marshal (RubyObject, RubyStringEncoding)
-> Marshal (RubyObject, RubyStringEncoding)
forall a b. (a -> b) -> a -> b
$ do
  RubyObject
str <- Marshal RubyObject
g
  Int
len <- Marshal Int
getFixnum
  if | Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
1 -> String -> Marshal (RubyObject, RubyStringEncoding)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expected single character"
     | Bool
otherwise -> do
        RubyObject
symbol <- Marshal RubyObject
g
        RubyObject
denote <- Marshal RubyObject
g
        case RubyObject
symbol of
          RSymbol ByteString
"E" ->
            case RubyObject
denote of
              RBool Bool
True  -> (RubyObject, RubyStringEncoding)
-> Marshal (RubyObject, RubyStringEncoding)
return' (RubyObject
str, RubyStringEncoding
UTF_8)
              RBool Bool
False -> (RubyObject, RubyStringEncoding)
-> Marshal (RubyObject, RubyStringEncoding)
return' (RubyObject
str, RubyStringEncoding
US_ASCII)
              RubyObject
_           -> String -> Marshal (RubyObject, RubyStringEncoding)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expected bool"
          RSymbol ByteString
"encoding" ->
            case RubyObject
denote of
              RString ByteString
enc -> (RubyObject, RubyStringEncoding)
-> Marshal (RubyObject, RubyStringEncoding)
return' (RubyObject
str, ByteString -> RubyStringEncoding
toEnc ByteString
enc)
              RubyObject
_           -> String -> Marshal (RubyObject, RubyStringEncoding)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expected string"
          RubyObject
_ -> String -> Marshal (RubyObject, RubyStringEncoding)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid ivar"
  where
    return' :: (RubyObject, RubyStringEncoding)
-> Marshal (RubyObject, RubyStringEncoding)
return' (RubyObject, RubyStringEncoding)
result = do
      RubyObject -> Marshal ()
writeCache (RubyObject -> Marshal ()) -> RubyObject -> Marshal ()
forall a b. (a -> b) -> a -> b
$ (RubyObject, RubyStringEncoding) -> RubyObject
RIVar (RubyObject, RubyStringEncoding)
result
      (RubyObject, RubyStringEncoding)
-> Marshal (RubyObject, RubyStringEncoding)
forall (m :: * -> *) a. Monad m => a -> m a
return (RubyObject, RubyStringEncoding)
result

-- | Pulls an Instance Variable out of the object cache.
getObjectLink :: Marshal RubyObject
getObjectLink :: Marshal RubyObject
getObjectLink = String -> Marshal RubyObject -> Marshal RubyObject
forall a. String -> Marshal a -> Marshal a
marshalLabel String
"ObjectLink" (Marshal RubyObject -> Marshal RubyObject)
-> Marshal RubyObject -> Marshal RubyObject
forall a b. (a -> b) -> a -> b
$ do
  Int
index <- Marshal Int
getFixnum
  Bool -> Marshal () -> Marshal ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
index Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (Marshal () -> Marshal ()) -> Marshal () -> Marshal ()
forall a b. (a -> b) -> a -> b
$ String -> Marshal ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Marshal ()) -> String -> Marshal ()
forall a b. (a -> b) -> a -> b
$ String
"invalid object link (index=0)"
  Maybe RubyObject
maybeObject <- Int -> Marshal (Maybe RubyObject)
readObject (Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
  case Maybe RubyObject
maybeObject of
    Just RubyObject
x -> RubyObject -> Marshal RubyObject
forall (m :: * -> *) a. Monad m => a -> m a
return RubyObject
x
    Maybe RubyObject
x      -> String -> Marshal RubyObject
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Marshal RubyObject) -> String -> Marshal RubyObject
forall a b. (a -> b) -> a -> b
$ String
"invalid object link (index=" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
index String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
", target=" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Maybe RubyObject -> String
forall a. Show a => a -> String
show Maybe RubyObject
x String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
")"

-- | Parses <http://ruby-doc.org/core-2.2.0/String.html String>.
getString :: Marshal BS.ByteString
getString :: Marshal ByteString
getString = String -> Marshal ByteString -> Marshal ByteString
forall a. String -> Marshal a -> Marshal a
marshalLabel String
"RawString" (Marshal ByteString -> Marshal ByteString)
-> Marshal ByteString -> Marshal ByteString
forall a b. (a -> b) -> a -> b
$ do
  Int
n <- Marshal Int
getFixnum
  Get ByteString -> Marshal ByteString
forall a. Get a -> Marshal a
liftMarshal (Get ByteString -> Marshal ByteString)
-> Get ByteString -> Marshal ByteString
forall a b. (a -> b) -> a -> b
$ Int -> Get ByteString
getBytes Int
n

-- | Parses <http://ruby-doc.org/core-2.2.0/Symbol.html Symbol>.
getSymbol :: Marshal BS.ByteString
getSymbol :: Marshal ByteString
getSymbol = String -> Marshal ByteString -> Marshal ByteString
forall a. String -> Marshal a -> Marshal a
marshalLabel String
"Symbol" (Marshal ByteString -> Marshal ByteString)
-> Marshal ByteString -> Marshal ByteString
forall a b. (a -> b) -> a -> b
$ do
  ByteString
x <- Marshal ByteString
getString
  RubyObject -> Marshal ()
writeCache (RubyObject -> Marshal ()) -> RubyObject -> Marshal ()
forall a b. (a -> b) -> a -> b
$ ByteString -> RubyObject
RSymbol ByteString
x
  ByteString -> Marshal ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
x

-- | Pulls a Symbol out of the symbol cache.
getSymlink :: Marshal BS.ByteString
getSymlink :: Marshal ByteString
getSymlink = String -> Marshal ByteString -> Marshal ByteString
forall a. String -> Marshal a -> Marshal a
marshalLabel String
"Symlink" (Marshal ByteString -> Marshal ByteString)
-> Marshal ByteString -> Marshal ByteString
forall a b. (a -> b) -> a -> b
$ do
  Int
index <- Marshal Int
getFixnum
  Maybe RubyObject
maybeObject <- Int -> Marshal (Maybe RubyObject)
readSymbol Int
index
  case Maybe RubyObject
maybeObject of
    Just (RSymbol ByteString
bs) -> ByteString -> Marshal ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bs
    Maybe RubyObject
_                 -> String -> Marshal ByteString
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid symlink"

--------------------------------------------------------------------
-- Utility functions.

-- | Lift Get into Marshal monad and then label.
liftAndLabel :: String -> Get a -> Marshal a
liftAndLabel :: String -> Get a -> Marshal a
liftAndLabel String
x Get a
y = Get a -> Marshal a
forall a. Get a -> Marshal a
liftMarshal (Get a -> Marshal a) -> Get a -> Marshal a
forall a b. (a -> b) -> a -> b
$! String -> Get a -> Get a
forall a. String -> Get a -> Get a
label String
x Get a
y

-- | Label underlying Get in Marshal monad.
marshalLabel :: String -> Marshal a -> Marshal a
marshalLabel :: String -> Marshal a -> Marshal a
marshalLabel String
x Marshal a
y = Marshal a
y Marshal a -> (a -> Marshal a) -> Marshal a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
y' -> Get a -> Marshal a
forall a. Get a -> Marshal a
liftMarshal (Get a -> Marshal a) -> Get a -> Marshal a
forall a b. (a -> b) -> a -> b
$! String -> Get a -> Get a
forall a. String -> Get a -> Get a
label String
x (a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return a
y')