{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
module Data.Ruby.Marshal.Get (
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)
getMarshalVersion :: Marshal (Word8, Word8)
getMarshalVersion :: Marshal (Word8, Word8)
getMarshalVersion = String -> Get (Word8, Word8) -> Marshal (Word8, Word8)
forall a. String -> Get a -> Marshal a
liftAndLabel "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
>>= \version :: (Word8, Word8)
version -> case (Word8, Word8)
version of
(4, 8) -> (Word8, Word8) -> Get (Word8, Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8, Word8)
version
_ -> String -> Get (Word8, Word8)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "marshal version unsupported"
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
NilChar -> RubyObject -> Marshal RubyObject
forall (m :: * -> *) a. Monad m => a -> m a
return RubyObject
RNil
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
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
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
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
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
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
ObjectLinkChar -> (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, RubyStringEncoding)
getObjectLink
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
ArrayChar -> 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
HashChar -> 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
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
_ -> RubyObject -> Marshal RubyObject
forall (m :: * -> *) a. Monad m => a -> m a
return RubyObject
Unsupported
getArray :: Marshal a -> Marshal (V.Vector a)
getArray :: Marshal a -> Marshal (Vector a)
getArray g :: Marshal a
g = String -> Marshal (Vector a) -> Marshal (Vector a)
forall a. String -> Marshal a -> Marshal a
marshalLabel "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
getFixnum :: Marshal Int
getFixnum :: Marshal Int
getFixnum = String -> Get Int -> Marshal Int
forall a. String -> Get a -> Marshal a
liftAndLabel "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
== 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
== 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
== -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
== 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
== -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
== 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
== -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
== 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
== -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
>= 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
- 5)
| Int8
x Int8 -> Int8 -> Bool
forall a. Ord a => a -> a -> Bool
<= -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
+ 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
>= 0 Bool -> Bool -> Bool
&& Int16
x Int16 -> Int16 -> Bool
forall a. Ord a => a -> a -> Bool
<= 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
- 256)
else Int16 -> Get Int16
forall (m :: * -> *) a. Monad m => a -> m a
return Int16
x
getFloat :: Marshal Float
getFloat :: Marshal Float
getFloat = String -> Marshal Float -> Marshal Float
forall a. String -> Marshal a -> Marshal a
marshalLabel "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 -> Float -> Marshal Float
forall (m :: * -> *) a. Monad m => a -> m a
return Float
float
Nothing -> String -> Marshal Float
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "expected float"
getHash :: Marshal a -> Marshal b -> Marshal (V.Vector (a, b))
getHash :: Marshal a -> Marshal b -> Marshal (Vector (a, b))
getHash k :: Marshal a
k v :: Marshal b
v = String -> Marshal (Vector (a, b)) -> Marshal (Vector (a, b))
forall a. String -> Marshal a -> Marshal a
marshalLabel "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)
getIVar :: Marshal RubyObject -> Marshal (RubyObject, RubyStringEncoding)
getIVar :: Marshal RubyObject -> Marshal (RubyObject, RubyStringEncoding)
getIVar g :: Marshal RubyObject
g = String
-> Marshal (RubyObject, RubyStringEncoding)
-> Marshal (RubyObject, RubyStringEncoding)
forall a. String -> Marshal a -> Marshal a
marshalLabel "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
/= 1 -> String -> Marshal (RubyObject, RubyStringEncoding)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "expected single character"
| Bool
otherwise -> do
RubyObject
symbol <- Marshal RubyObject
g
RubyObject
denote <- Marshal RubyObject
g
case RubyObject
symbol of
RSymbol "E" ->
case RubyObject
denote of
RBool True -> (RubyObject, RubyStringEncoding)
-> Marshal (RubyObject, RubyStringEncoding)
return' (RubyObject
str, RubyStringEncoding
UTF_8)
RBool False -> (RubyObject, RubyStringEncoding)
-> Marshal (RubyObject, RubyStringEncoding)
return' (RubyObject
str, RubyStringEncoding
US_ASCII)
_ -> String -> Marshal (RubyObject, RubyStringEncoding)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "expected bool"
RSymbol "encoding" ->
case RubyObject
denote of
RString enc :: ByteString
enc -> (RubyObject, RubyStringEncoding)
-> Marshal (RubyObject, RubyStringEncoding)
return' (RubyObject
str, ByteString -> RubyStringEncoding
toEnc ByteString
enc)
_ -> String -> Marshal (RubyObject, RubyStringEncoding)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "expected string"
_ -> String -> Marshal (RubyObject, RubyStringEncoding)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "invalid ivar"
where
return' :: (RubyObject, RubyStringEncoding)
-> Marshal (RubyObject, RubyStringEncoding)
return' result :: (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
getObjectLink :: Marshal (RubyObject, RubyStringEncoding)
getObjectLink :: Marshal (RubyObject, RubyStringEncoding)
getObjectLink = String
-> Marshal (RubyObject, RubyStringEncoding)
-> Marshal (RubyObject, RubyStringEncoding)
forall a. String -> Marshal a -> Marshal a
marshalLabel "ObjectLink" (Marshal (RubyObject, RubyStringEncoding)
-> Marshal (RubyObject, RubyStringEncoding))
-> Marshal (RubyObject, RubyStringEncoding)
-> Marshal (RubyObject, RubyStringEncoding)
forall a b. (a -> b) -> a -> b
$ do
Int
index <- Marshal Int
getFixnum
Maybe RubyObject
maybeObject <- Int -> Marshal (Maybe RubyObject)
readObject Int
index
case Maybe RubyObject
maybeObject of
Just (RIVar x :: (RubyObject, RubyStringEncoding)
x) -> (RubyObject, RubyStringEncoding)
-> Marshal (RubyObject, RubyStringEncoding)
forall (m :: * -> *) a. Monad m => a -> m a
return (RubyObject, RubyStringEncoding)
x
_ -> String -> Marshal (RubyObject, RubyStringEncoding)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "invalid object link"
getString :: Marshal BS.ByteString
getString :: Marshal ByteString
getString = String -> Marshal ByteString -> Marshal ByteString
forall a. String -> Marshal a -> Marshal a
marshalLabel "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
getSymbol :: Marshal BS.ByteString
getSymbol :: Marshal ByteString
getSymbol = String -> Marshal ByteString -> Marshal ByteString
forall a. String -> Marshal a -> Marshal a
marshalLabel "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
getSymlink :: Marshal BS.ByteString
getSymlink :: Marshal ByteString
getSymlink = String -> Marshal ByteString -> Marshal ByteString
forall a. String -> Marshal a -> Marshal a
marshalLabel "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 bs :: ByteString
bs) -> ByteString -> Marshal ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bs
_ -> String -> Marshal ByteString
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "invalid symlink"
liftAndLabel :: String -> Get a -> Marshal a
liftAndLabel :: String -> Get a -> Marshal a
liftAndLabel x :: String
x y :: 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
marshalLabel :: String -> Marshal a -> Marshal a
marshalLabel :: String -> Marshal a -> Marshal a
marshalLabel x :: String
x y :: 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
>>= \y' :: 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')