ruby-marshal 0.0.1 → 0.1.0
raw patch · 10 files changed
+827/−308 lines, 10 filesdep +ruby-marshaldep ~basedep ~bytestringdep ~cereal
Dependencies added: ruby-marshal
Dependency ranges changed: base, bytestring, cereal, containers, mtl, string-conv, vector
Files
- CHANGELOG.md +20/−0
- ruby-marshal.cabal +47/−28
- src/Data/Ruby/Marshal.hs +12/−13
- src/Data/Ruby/Marshal/Encoding.hs +336/−0
- src/Data/Ruby/Marshal/Get.hs +76/−121
- src/Data/Ruby/Marshal/Int.hs +63/−0
- src/Data/Ruby/Marshal/Internal/Int.hs +0/−63
- src/Data/Ruby/Marshal/Monad.hs +69/−0
- src/Data/Ruby/Marshal/RubyObject.hs +141/−0
- src/Data/Ruby/Marshal/Types.hs +63/−83
+ CHANGELOG.md view
@@ -0,0 +1,20 @@+# 0.1.0++- Separated modules by concern.+- Hid underlying Get monad from consumers to allow us to change the parsing+ library without breaking consumers should a more performant one become+ available.+- Added Rubyable type class to make it easier to go between RubyObject and plain+ Haskell values.+- Replaced Double with Float as per Marshal format.+- Replaced internal representation of Hash with Vector of tuples to simplify+ Rubyable type class and usage for consumers.+- Added more type safety by extracting ADT of all possible Ruby string+ encodings.+- Re-ordered parser to try parsing simpler objects first.+- Used strict State monad instead of non-strict.++# 0.0.1++- Completed fully-functioning parser for a subset of Ruby objects serialised+ with Ruby's Marshal format.
ruby-marshal.cabal view
@@ -1,16 +1,31 @@-name: ruby-marshal-version: 0.0.1-synopsis: Parse a subset of Ruby objects serialised with Marshal.dump.-description: Parse a subset of Ruby objects serialised with Marshal.dump.-homepage: https://github.com/filib/ruby-marshal-license: MIT-license-file: LICENSE-author: Philip Cunningham-maintainer: hello@filib.io-category: Data-build-type: Simple-tested-with: GHC == 7.8, GHC == 7.10-cabal-version: >= 1.10+name:+ ruby-marshal+version:+ 0.1.0+synopsis:+ Parse a subset of Ruby objects serialised with Marshal.dump.+description:+ Parse a subset of Ruby objects serialised with Marshal.dump.+homepage:+ https://github.com/filib/ruby-marshal+license:+ MIT+license-file:+ LICENSE+author:+ Philip Cunningham+maintainer:+ hello@filib.io+category:+ Data+build-type:+ Simple+tested-with:+ GHC == 7.8, GHC == 7.10+cabal-version:+ >= 1.10+extra-source-files:+ CHANGELOG.md Source-repository head type: git@@ -27,20 +42,23 @@ hs-source-dirs: src build-depends:- base >= 4.7 && < 5- , cereal >= 0.3.5.0 && < 0.5.0.0- , bytestring >= 0.9.0- , containers >= 0.5.0- , string-conv >= 0.1- , mtl >= 2.2- , vector >= 0.10.0+ base >= 4.7 && <= 5+ , cereal >= 0.4.0 && <= 0.5.0+ , bytestring >= 0.9.0 && <= 0.12.0+ , containers >= 0.5.0 && <= 0.6.0+ , string-conv >= 0.1 && <= 0.2+ , mtl >= 2.2.0 && <= 2.3.0+ , vector >= 0.10.0 && <= 0.11.0 default-language: Haskell2010 exposed-modules: Data.Ruby.Marshal+ , Data.Ruby.Marshal.Encoding , Data.Ruby.Marshal.Get+ , Data.Ruby.Marshal.Int+ , Data.Ruby.Marshal.Monad+ , Data.Ruby.Marshal.RubyObject , Data.Ruby.Marshal.Types- , Data.Ruby.Marshal.Internal.Int test-suite spec ghc-options:@@ -48,14 +66,15 @@ hs-source-dirs: src, test build-depends:- base >= 4.7 && < 5- , cereal >= 0.3.5.0 && < 0.5.0.0- , bytestring >= 0.9.0- , containers >= 0.5.0.0+ ruby-marshal -any+ , base+ , bytestring+ , cereal+ , containers , hspec- , mtl >= 2.2- , string-conv >= 0.1- , vector >= 0.10.0+ , mtl+ , string-conv+ , vector default-language: Haskell2010 other-modules:
src/Data/Ruby/Marshal.hs view
@@ -8,29 +8,32 @@ -- Stability : experimental -- Portability: portable ----- Simple interface to deserialise Ruby Marshal binary.+-- Simple interface to parse Ruby Marshal binary. -- -------------------------------------------------------------------- module Data.Ruby.Marshal (- -- * Simple interface to deserialise Ruby Marshal binary+ -- * Decoding decode , decodeEither+ -- * Lifting into and lowering from RubyObject+ , fromRuby+ , toRuby -- * Re-exported modules- , module Data.Ruby.Marshal.Get , module Data.Ruby.Marshal.Types ) where import Data.Ruby.Marshal.Get-import Data.Ruby.Marshal.Types (Cache(..), RubyObject(..), Marshal(..))+import Data.Ruby.Marshal.RubyObject+import Data.Ruby.Marshal.Types -import Control.Monad.State (evalStateT)-import Data.Serialize (runGet)+import Control.Monad.State.Strict (evalStateT)+import Data.Ruby.Marshal.Monad (emptyCache, runMarshal)+import Data.Serialize (runGet) import qualified Data.ByteString as BS-import qualified Data.Vector as V --- | Deserialises a subset of Ruby objects serialised with Marshal, Ruby's+-- | Parses a subset of Ruby objects serialised with Marshal, Ruby's -- built-in binary serialisation format. decode :: BS.ByteString -- ^ Serialised Ruby object@@ -38,17 +41,13 @@ -- ^ De-serialisation result decode = hush . decodeEither --- | Deserialises a subset of Ruby objects serialised with Marshal, Ruby's+-- | Parses a subset of Ruby objects serialised with Marshal, Ruby's -- built-in binary serialisation format. decodeEither :: BS.ByteString -- ^ Serialised Ruby object -> Either String RubyObject -- ^ Error message or de-serialisation result decodeEither = runGet (evalStateT (runMarshal getRubyObject) emptyCache)---- | Constructs an empty cache to store symbols and objects.-emptyCache :: Cache-emptyCache = Cache { _symbols = V.empty, _objects = V.empty } -- | Converts an Either to a Maybe. hush :: Either a b -> Maybe b
+ src/Data/Ruby/Marshal/Encoding.hs view
@@ -0,0 +1,336 @@+{-# LANGUAGE OverloadedStrings #-}++--------------------------------------------------------------------+-- |+-- Module : Data.Ruby.Marshal.Encoding+-- Copyright : (c) Philip Cunningham, 2015+-- License : MIT+--+-- Maintainer: hello@filib.io+-- Stability : experimental+-- Portability: portable+--+-- Ruby encoding types.+--+--------------------------------------------------------------------++module Data.Ruby.Marshal.Encoding (+ -- * The @RubyStringEncoding@ type+ fromEnc+ , toEnc+ , RubyStringEncoding(..)+) where++import qualified Data.ByteString as BS++-- | ADT representing all supported Ruby encodings.+data RubyStringEncoding = ASCII_8BIT+ | Big5+ | Big5_HKSCS+ | Big5_UAO+ | CP50220+ | CP50221+ | CP51932+ | CP850+ | CP852+ | CP855+ | CP949+ | CP950+ | CP951+ | EUC_JP+ | EUC_JP_2004+ | EUC_KR+ | EUC_TW+ | Emacs_Mule+ | EucJP_ms+ | GB12345+ | GB18030+ | GB1988+ | GB2312+ | GBK+ | IBM437+ | IBM737+ | IBM775+ | IBM852+ | IBM855+ | IBM857+ | IBM860+ | IBM861+ | IBM862+ | IBM863+ | IBM864+ | IBM865+ | IBM866+ | IBM869+ | ISO_2022_JP+ | ISO_2022_JP_2+ | ISO_2022_JP_KDDI+ | ISO_8859_1+ | ISO_8859_10+ | ISO_8859_11+ | ISO_8859_13+ | ISO_8859_14+ | ISO_8859_15+ | ISO_8859_16+ | ISO_8859_2+ | ISO_8859_3+ | ISO_8859_4+ | ISO_8859_5+ | ISO_8859_6+ | ISO_8859_7+ | ISO_8859_8+ | ISO_8859_9+ | KOI8_R+ | KOI8_U+ | MacCentEuro+ | MacCroatian+ | MacCyrillic+ | MacGreek+ | MacIceland+ | MacJapanese+ | MacRoman+ | MacRomania+ | MacThai+ | MacTurkish+ | MacUkraine+ | SJIS_DoCoMo+ | SJIS_KDDI+ | SJIS_SoftBank+ | Shift_JIS+ | Stateless_ISO_2022_JP+ | Stateless_ISO_2022_JP_KDDI+ | TIS_620+ | US_ASCII+ | UTF8_DoCoMo+ | UTF8_KDDI+ | UTF8_MAC+ | UTF8_SoftBank+ | UTF_16+ | UTF_16BE+ | UTF_16LE+ | UTF_32+ | UTF_32BE+ | UTF_32LE+ | UTF_7+ | UTF_8+ | Windows_1250+ | Windows_1251+ | Windows_1252+ | Windows_1253+ | Windows_1254+ | Windows_1255+ | Windows_1256+ | Windows_1257+ | Windows_1258+ | Windows_31J+ | Windows_874+ | UnsupportedEncoding+ deriving (Eq, Ord, Show)++-- | Lifts encoding strings into encoding ADT.+toEnc :: BS.ByteString -> RubyStringEncoding+toEnc "ASCII-8BIT" = ASCII_8BIT+toEnc "UTF-8" = UTF_8+toEnc "US-ASCII" = US_ASCII+toEnc "Big5" = Big5+toEnc "Big5-HKSCS" = Big5_HKSCS+toEnc "Big5-UAO" = Big5_UAO+toEnc "CP949" = CP949+toEnc "Emacs-Mule" = Emacs_Mule+toEnc "EUC-JP" = EUC_JP+toEnc "EUC-KR" = EUC_KR+toEnc "EUC-TW" = EUC_TW+toEnc "GB18030" = GB18030+toEnc "GBK" = GBK+toEnc "ISO-8859-1" = ISO_8859_1+toEnc "ISO-8859-2" = ISO_8859_2+toEnc "ISO-8859-3" = ISO_8859_3+toEnc "ISO-8859-4" = ISO_8859_4+toEnc "ISO-8859-5" = ISO_8859_5+toEnc "ISO-8859-6" = ISO_8859_6+toEnc "ISO-8859-7" = ISO_8859_7+toEnc "ISO-8859-8" = ISO_8859_8+toEnc "ISO-8859-9" = ISO_8859_9+toEnc "ISO-8859-10" = ISO_8859_10+toEnc "ISO-8859-11" = ISO_8859_11+toEnc "ISO-8859-13" = ISO_8859_13+toEnc "ISO-8859-14" = ISO_8859_14+toEnc "ISO-8859-15" = ISO_8859_15+toEnc "ISO-8859-16" = ISO_8859_16+toEnc "KOI8-R" = KOI8_R+toEnc "KOI8-U" = KOI8_U+toEnc "Shift_JIS" = Shift_JIS+toEnc "UTF-16BE" = UTF_16BE+toEnc "UTF-16LE" = UTF_16LE+toEnc "UTF-32BE" = UTF_32BE+toEnc "UTF-32LE" = UTF_32LE+toEnc "Windows-31J" = Windows_31J+toEnc "Windows-1251" = Windows_1251+toEnc "IBM437" = IBM437+toEnc "IBM737" = IBM737+toEnc "IBM775" = IBM775+toEnc "CP850" = CP850+toEnc "IBM852" = IBM852+toEnc "CP852" = CP852+toEnc "IBM855" = IBM855+toEnc "CP855" = CP855+toEnc "IBM857" = IBM857+toEnc "IBM860" = IBM860+toEnc "IBM861" = IBM861+toEnc "IBM862" = IBM862+toEnc "IBM863" = IBM863+toEnc "IBM864" = IBM864+toEnc "IBM865" = IBM865+toEnc "IBM866" = IBM866+toEnc "IBM869" = IBM869+toEnc "Windows-1258" = Windows_1258+toEnc "GB1988" = GB1988+toEnc "macCentEuro" = MacCentEuro+toEnc "macCroatian" = MacCroatian+toEnc "macCyrillic" = MacCyrillic+toEnc "macGreek" = MacGreek+toEnc "macIceland" = MacIceland+toEnc "macRoman" = MacRoman+toEnc "macRomania" = MacRomania+toEnc "macThai" = MacThai+toEnc "macTurkish" = MacTurkish+toEnc "macUkraine" = MacUkraine+toEnc "CP950" = CP950+toEnc "CP951" = CP951+toEnc "stateless-ISO-2022-JP" = Stateless_ISO_2022_JP+toEnc "eucJP-ms" = EucJP_ms+toEnc "CP51932" = CP51932+toEnc "EUC-JP-2004" = EUC_JP_2004+toEnc "GB2312" = GB2312+toEnc "GB12345" = GB12345+toEnc "ISO-2022-JP" = ISO_2022_JP+toEnc "ISO-2022-JP-2" = ISO_2022_JP_2+toEnc "CP50220" = CP50220+toEnc "CP50221" = CP50221+toEnc "Windows-1252" = Windows_1252+toEnc "Windows-1250" = Windows_1250+toEnc "Windows-1256" = Windows_1256+toEnc "Windows-1253" = Windows_1253+toEnc "Windows-1255" = Windows_1255+toEnc "Windows-1254" = Windows_1254+toEnc "TIS-620" = TIS_620+toEnc "Windows-874" = Windows_874+toEnc "Windows-1257" = Windows_1257+toEnc "MacJapanese" = MacJapanese+toEnc "UTF-7" = UTF_7+toEnc "UTF8-MAC" = UTF8_MAC+toEnc "UTF-16" = UTF_16+toEnc "UTF-32" = UTF_32+toEnc "UTF8-DoCoMo" = UTF8_DoCoMo+toEnc "SJIS-DoCoMo" = SJIS_DoCoMo+toEnc "UTF8-KDDI" = UTF8_KDDI+toEnc "SJIS-KDDI" = SJIS_KDDI+toEnc "ISO-2022-JP-KDDI" = ISO_2022_JP_KDDI+toEnc "stateless-ISO-2022-JP-KDDI" = Stateless_ISO_2022_JP_KDDI+toEnc "UTF8-SoftBank" = UTF8_SoftBank+toEnc "SJIS-SoftBank" = SJIS_SoftBank+toEnc _ = UnsupportedEncoding++-- | Lowers encoding ADT into an encoding string.+fromEnc :: RubyStringEncoding -> BS.ByteString+fromEnc ASCII_8BIT = "ASCII-8BIT"+fromEnc UTF_8 = "UTF-8"+fromEnc US_ASCII = "US-ASCII"+fromEnc Big5 = "Big5"+fromEnc Big5_HKSCS = "Big5-HKSCS"+fromEnc Big5_UAO = "Big5-UAO"+fromEnc CP949 = "CP949"+fromEnc Emacs_Mule = "Emacs-Mule"+fromEnc EUC_JP = "EUC-JP"+fromEnc EUC_KR = "EUC-KR"+fromEnc EUC_TW = "EUC-TW"+fromEnc GB18030 = "GB18030"+fromEnc GBK = "GBK"+fromEnc ISO_8859_1 = "ISO-8859-1"+fromEnc ISO_8859_2 = "ISO-8859-2"+fromEnc ISO_8859_3 = "ISO-8859-3"+fromEnc ISO_8859_4 = "ISO-8859-4"+fromEnc ISO_8859_5 = "ISO-8859-5"+fromEnc ISO_8859_6 = "ISO-8859-6"+fromEnc ISO_8859_7 = "ISO-8859-7"+fromEnc ISO_8859_8 = "ISO-8859-8"+fromEnc ISO_8859_9 = "ISO-8859-9"+fromEnc ISO_8859_10 = "ISO-8859-10"+fromEnc ISO_8859_11 = "ISO-8859-11"+fromEnc ISO_8859_13 = "ISO-8859-13"+fromEnc ISO_8859_14 = "ISO-8859-14"+fromEnc ISO_8859_15 = "ISO-8859-15"+fromEnc ISO_8859_16 = "ISO-8859-16"+fromEnc KOI8_R = "KOI8-R"+fromEnc KOI8_U = "KOI8-U"+fromEnc Shift_JIS = "Shift_JIS"+fromEnc UTF_16BE = "UTF-16BE"+fromEnc UTF_16LE = "UTF-16LE"+fromEnc UTF_32BE = "UTF-32BE"+fromEnc UTF_32LE = "UTF-32LE"+fromEnc Windows_31J = "Windows-31J"+fromEnc Windows_1251 = "Windows-1251"+fromEnc IBM437 = "IBM437"+fromEnc IBM737 = "IBM737"+fromEnc IBM775 = "IBM775"+fromEnc CP850 = "CP850"+fromEnc IBM852 = "IBM852"+fromEnc CP852 = "CP852"+fromEnc IBM855 = "IBM855"+fromEnc CP855 = "CP855"+fromEnc IBM857 = "IBM857"+fromEnc IBM860 = "IBM860"+fromEnc IBM861 = "IBM861"+fromEnc IBM862 = "IBM862"+fromEnc IBM863 = "IBM863"+fromEnc IBM864 = "IBM864"+fromEnc IBM865 = "IBM865"+fromEnc IBM866 = "IBM866"+fromEnc IBM869 = "IBM869"+fromEnc Windows_1258 = "Windows-1258"+fromEnc GB1988 = "GB1988"+fromEnc MacCentEuro = "macCentEuro"+fromEnc MacCroatian = "macCroatian"+fromEnc MacCyrillic = "macCyrillic"+fromEnc MacGreek = "macGreek"+fromEnc MacIceland = "macIceland"+fromEnc MacRoman = "macRoman"+fromEnc MacRomania = "macRomania"+fromEnc MacThai = "macThai"+fromEnc MacTurkish = "macTurkish"+fromEnc MacUkraine = "macUkraine"+fromEnc CP950 = "CP950"+fromEnc CP951 = "CP951"+fromEnc Stateless_ISO_2022_JP = "stateless-ISO-2022-JP"+fromEnc EucJP_ms = "eucJP-ms"+fromEnc CP51932 = "CP51932"+fromEnc EUC_JP_2004 = "EUC-JP-2004"+fromEnc GB2312 = "GB2312"+fromEnc GB12345 = "GB12345"+fromEnc ISO_2022_JP = "ISO-2022-JP"+fromEnc ISO_2022_JP_2 = "ISO-2022-JP-2"+fromEnc CP50220 = "CP50220"+fromEnc CP50221 = "CP50221"+fromEnc Windows_1252 = "Windows-1252"+fromEnc Windows_1250 = "Windows-1250"+fromEnc Windows_1256 = "Windows-1256"+fromEnc Windows_1253 = "Windows-1253"+fromEnc Windows_1255 = "Windows-1255"+fromEnc Windows_1254 = "Windows-1254"+fromEnc TIS_620 = "TIS-620"+fromEnc Windows_874 = "Windows-874"+fromEnc Windows_1257 = "Windows-1257"+fromEnc MacJapanese = "MacJapanese"+fromEnc UTF_7 = "UTF-7"+fromEnc UTF8_MAC = "UTF8-MAC"+fromEnc UTF_16 = "UTF-16"+fromEnc UTF_32 = "UTF-32"+fromEnc UTF8_DoCoMo = "UTF8-DoCoMo"+fromEnc SJIS_DoCoMo = "SJIS-DoCoMo"+fromEnc UTF8_KDDI = "UTF8-KDDI"+fromEnc SJIS_KDDI = "SJIS-KDDI"+fromEnc ISO_2022_JP_KDDI = "ISO-2022-JP-KDDI"+fromEnc Stateless_ISO_2022_JP_KDDI = "stateless-ISO-2022-JP-KDDI"+fromEnc UTF8_SoftBank = "UTF8-SoftBank"+fromEnc SJIS_SoftBank = "SJIS-SoftBank"+fromEnc _ = "UnsupportedEncoding"
src/Data/Ruby/Marshal/Get.hs view
@@ -2,7 +2,6 @@ {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-}-{-# LANGUAGE RankNTypes #-} -------------------------------------------------------------------- -- |@@ -14,93 +13,73 @@ -- Stability : experimental -- Portability: portable ----- Ruby Marshal deserialiser using @Data.Serialize@.+-- Parsers for Ruby Marshal format. -- -------------------------------------------------------------------- module Data.Ruby.Marshal.Get (+ -- * Ruby Marshal parsers 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.Int import Data.Ruby.Marshal.Types+import Prelude -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 Control.Monad (liftM2)+import Data.Ruby.Marshal.Encoding (toEnc)+import Data.Ruby.Marshal.Monad (liftMarshal, readObject, readSymbol, writeCache)+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.+-- | Parses Marshal version. getMarshalVersion :: Marshal (Word8, Word8)-getMarshalVersion = marshalLabel "Marshal Version" $- getTwoOf getWord8 getWord8+getMarshalVersion = liftAndLabel "Marshal Version" $+ getTwoOf getWord8 getWord8 >>= \version -> case version of+ (4, 8) -> return version+ _ -> fail "marshal version unsupported" --- | Deserialises a subset of Ruby objects.+-- | Parses 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+ 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. --- | 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>.+-- | Parses <http://ruby-doc.org/core-2.2.0/Array.html Array>. getArray :: Marshal a -> Marshal (V.Vector a)-getArray g = do+getArray g = marshalLabel "Fixnum" $ do n <- getFixnum- x <- V.replicateM n g- marshalLabel "Array" $ return x+ V.replicateM n g --- | Deserialises <http://ruby-doc.org/core-2.2.0/Fixnum.html Fixnum>.+-- | Parses <http://ruby-doc.org/core-2.2.0/Fixnum.html Fixnum>. getFixnum :: Marshal Int-getFixnum = marshalLabel "Fixnum" $ do+getFixnum = liftAndLabel "Fixnum" $ do x <- getInt8 if | x == 0 -> fromIntegral <$> return x | x == 1 -> fromIntegral <$> getWord8@@ -120,105 +99,81 @@ 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+-- | Parses <http://ruby-doc.org/core-2.2.0/Float.html Float>.+getFloat :: Marshal Float+getFloat = marshalLabel "Float" $ do s <- getString- x <- case readMaybe . toS $ s of+ case readMaybe . toS $ s of Just float -> return float- Nothing -> fail "getFloat"- marshalLabel "Float" $ return x+ Nothing -> fail "expected float" --- | 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+-- | 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- x <- DM.fromList `fmap` replicateM n (liftM2 (,) k v)- marshalLabel "Hash" $ return x+ V.replicateM n (liftM2 (,) k v) --- | 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"+-- | 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 -> cacheAndReturn string "UTF-8"- RBool False -> cacheAndReturn string "US-ASCII"- _ -> fail "getIVar: expected bool"+ RBool True -> return' (str, UTF_8)+ RBool False -> return' (str, US_ASCII)+ _ -> fail "expected bool" RSymbol "encoding" -> case denote of- RString enc -> cacheAndReturn string enc- _ -> fail "getIVar: expected string"- _ -> fail "getIVar: invalid ivar"+ RString enc -> return' (str, toEnc enc)+ _ -> fail "expected string"+ _ -> fail "invalid ivar" where- cacheAndReturn string enc = do- let result = (string, enc)+ return' result = do writeCache $ RIVar result- marshalLabel "IVar" $ return result+ return result --- | Deserialises <http://ruby-doc.org/core-2.2.0/Symbol.html Symbol>.-getObjectLink :: Marshal (RubyObject, BS.ByteString)-getObjectLink = do+-- | 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 "getObjectLink"+ _ -> fail "invalid object link" --- | Deserialises <http://ruby-doc.org/core-2.2.0/String.html String>.+-- | Parses <http://ruby-doc.org/core-2.2.0/String.html String>. getString :: Marshal BS.ByteString-getString = do+getString = marshalLabel "RawString" $ do n <- getFixnum- x <- liftMarshal $ getBytes n- marshalLabel "RawString" $ return x+ liftMarshal $ getBytes n --- | Deserialises <http://ruby-doc.org/core-2.2.0/Symbol.html Symbol>.+-- | Parses <http://ruby-doc.org/core-2.2.0/Symbol.html Symbol>. getSymbol :: Marshal BS.ByteString-getSymbol = do+getSymbol = marshalLabel "Symbol" $ do x <- getString writeCache $ RSymbol x- marshalLabel "Symbol" $ return x+ return x --- | Deserialises <http://ruby-doc.org/core-2.2.0/Symbol.html Symbol>.+-- | Pulls a Symbol out of the symbol cache. getSymlink :: Marshal BS.ByteString-getSymlink = do+getSymlink = marshalLabel "Symlink" $ do index <- getFixnum maybeObject <- readSymbol index case maybeObject of Just (RSymbol bs) -> return bs- _ -> fail "getSymlink"+ _ -> fail "invalid symlink" -------------------------------------------------------------------- -- 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+-- | Lift Get into Marshal monad and then label.+liftAndLabel :: String -> Get a -> Marshal a+liftAndLabel x y = liftMarshal $! label x y --- | 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 ()+-- | Label underlying Get in Marshal monad.+marshalLabel :: String -> Marshal a -> Marshal a+marshalLabel x y = y >>= \y' -> liftMarshal $! label x (return y')
+ src/Data/Ruby/Marshal/Int.hs view
@@ -0,0 +1,63 @@+--------------------------------------------------------------------+-- |+-- Module : Data.Ruby.Marshal.Int+-- Copyright : (c) Philip Cunningham, 2015+-- License : MIT+--+-- Maintainer: hello@filib.io+-- Stability : experimental+-- Portability: portable+--+-- Parsers for signed and unsigned integrals.+--+--------------------------------------------------------------------++module Data.Ruby.Marshal.Int (+ -- * Signed integrals+ getInt8+ , getInt16le+ , getInt24le+ , getInt32le+ , Int16+ -- * Unsigned integrals+ , getWord8+ , getWord16le+ , getWord24le+ , getWord32le+ , Word8+) where++import Control.Applicative+import Prelude++import Data.Bits ((.|.), shiftL)+import Data.Int (Int8, Int16, Int32)+import Data.Serialize.Get (Get, getBytes, getWord8, getWord16le, getWord32le)+import Data.Word (Word8, Word32)++import qualified Data.ByteString as BS++-- | Read an Int8.+getInt8 :: Get Int8+getInt8 = fromIntegral <$> getWord8++-- | Read an Int16.+getInt16le :: Get Int16+getInt16le = fromIntegral <$> getWord16le++-- | Read a Word24 in little endian format. Since Word24 unavailable in Data.Int+-- we use Word32.+getWord24le :: Get Word32+getWord24le = do+ s <- getBytes 3+ return $! (fromIntegral (s `BS.index` 2) `shiftL` 16) .|.+ (fromIntegral (s `BS.index` 1) `shiftL` 8) .|.+ fromIntegral (s `BS.index` 0)++-- | Read an Int24. Since Int24 unavailable in Data.Int we use Int32.+getInt24le :: Get Int32+getInt24le = fromIntegral <$> getWord24le++-- | Read an Int32.+getInt32le :: Get Int32+getInt32le = fromIntegral <$> getWord32le
− src/Data/Ruby/Marshal/Internal/Int.hs
@@ -1,63 +0,0 @@------------------------------------------------------------------------ |--- Module : Data.Ruby.Marshal.Internal.Int--- Copyright : (c) Philip Cunningham, 2015--- License : MIT------ Maintainer: hello@filib.io--- Stability : experimental--- Portability: portable------ Helper module for parsing Int.--------------------------------------------------------------------------module Data.Ruby.Marshal.Internal.Int (- -- * Signed integrals- getInt8- , getInt16le- , getInt24le- , getInt32le- , Int16- -- * Unsigned integrals- , getWord8- , getWord16le- , getWord24le- , getWord32le- , Word8-) where--import Control.Applicative-import Prelude--import Data.Bits ((.|.), shiftL)-import Data.Int (Int8, Int16, Int32)-import Data.Serialize.Get (Get, getBytes, getWord8, getWord16le, getWord32le)-import Data.Word (Word8, Word32)--import qualified Data.ByteString as BS---- | Read an Int8.-getInt8 :: Get Int8-getInt8 = fromIntegral <$> getWord8---- | Read an Int16.-getInt16le :: Get Int16-getInt16le = fromIntegral <$> getWord16le---- | Read a Word24 in little endian format. Since Word24 unavailable in Data.Int--- we use Word32.-getWord24le :: Get Word32-getWord24le = do- s <- getBytes 3- return $! (fromIntegral (s `BS.index` 2) `shiftL` 16) .|.- (fromIntegral (s `BS.index` 1) `shiftL` 8) .|.- fromIntegral (s `BS.index` 0)---- | Read an Int24. Since Int24 unavailable in Data.Int we use Int32.-getInt24le :: Get Int32-getInt24le = fromIntegral <$> getWord24le---- | Read an Int32.-getInt32le :: Get Int32-getInt32le = fromIntegral <$> getWord32le
+ src/Data/Ruby/Marshal/Monad.hs view
@@ -0,0 +1,69 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++--------------------------------------------------------------------+-- |+-- Module : Data.Ruby.Marshal.Monad+-- Copyright : (c) Philip Cunningham, 2015+-- License : MIT+--+-- Maintainer: hello@filib.io+-- Stability : experimental+-- Portability: portable+--+-- Marshal monad provides an object cache over the Get monad.+--+--------------------------------------------------------------------++module Data.Ruby.Marshal.Monad where++import Control.Applicative+import Prelude++import Control.Monad.State.Strict (get, gets, lift, put, MonadState, StateT)+import Data.Ruby.Marshal.RubyObject (RubyObject(..))+import Data.Serialize.Get (Get)+import Data.Vector (Vector)++import qualified Data.Vector as V++-- | Marshal monad endows the underlying Get monad with State.+newtype Marshal a = Marshal {+ runMarshal :: StateT Cache Get a+} deriving (Functor, Applicative, Monad, MonadState Cache)++-- | Lift Get monad into Marshal monad.+liftMarshal :: Get a -> Marshal a+liftMarshal = Marshal . lift++-- | State that we must carry around during deserialisation.+data Cache = Cache {+ objects :: !(Vector RubyObject)+ -- ^ object cache.+ , symbols :: !(Vector RubyObject)+ -- ^ symbol cache.+} deriving Show++-- | Constructs an empty cache to store symbols and objects.+emptyCache :: Cache+emptyCache = Cache { symbols = V.empty, objects = V.empty }++-- | Look up value in cache.+readCache :: Int -> (Cache -> Vector RubyObject) -> Marshal (Maybe RubyObject)+readCache index f = gets f >>= \cache -> return $ cache V.!? index++-- | Look up object in object cache.+readObject :: Int -> Marshal (Maybe RubyObject)+readObject index = readCache index objects++-- | Look up a symbol in symbol cache.+readSymbol :: Int -> Marshal (Maybe RubyObject)+readSymbol index = readCache index symbols++-- | 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 ()
+ src/Data/Ruby/Marshal/RubyObject.hs view
@@ -0,0 +1,141 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE IncoherentInstances #-}+{-# LANGUAGE LambdaCase #-}++--------------------------------------------------------------------+-- |+-- Module : Data.Ruby.Marshal.RubyObject+-- Copyright : (c) Philip Cunningham, 2015+-- License : MIT+--+-- Maintainer: hello@filib.io+-- Stability : experimental+-- Portability: portable+--+-- Core RubyObject data representation.+--+--------------------------------------------------------------------++module Data.Ruby.Marshal.RubyObject where++import Control.Applicative+import Prelude++import Control.Arrow ((***))+import Data.Ruby.Marshal.Encoding (RubyStringEncoding(..))++import qualified Data.ByteString as BS+import qualified Data.Map.Strict as DM+import qualified Data.Vector as V++-- | Representation of a Ruby object.+data RubyObject+ = RNil+ -- ^ represents @nil@+ | RBool !Bool+ -- ^ represents @true@ or @false@+ | RFixnum {-# UNPACK #-} !Int+ -- ^ represents a @Fixnum@+ | RArray !(V.Vector RubyObject)+ -- ^ represents an @Array@+ | RHash !(V.Vector (RubyObject, RubyObject))+ -- ^ represents an @Hash@+ | RIVar !(RubyObject, RubyStringEncoding)+ -- ^ represents an @IVar@+ | RString !BS.ByteString+ -- ^ represents a @String@+ | RFloat {-# UNPACK #-} !Float+ -- ^ represents a @Float@+ | RSymbol !BS.ByteString+ -- ^ represents a @Symbol@+ | Unsupported+ -- ^ represents an invalid object+ deriving (Eq, Ord, Show)++-- | Transform plain Haskell values to RubyObjects and back.+class Rubyable a where+ -- | Takes a plain Haskell value and lifts into RubyObject+ toRuby :: a -> RubyObject+ -- | Takes a RubyObject transforms it into a more general Haskell value.+ fromRuby :: RubyObject -> Maybe a++-- core instances++instance Rubyable RubyObject where+ toRuby = id+ fromRuby = Just++instance Rubyable () where+ toRuby _ = RNil+ fromRuby = \case+ RNil -> Just ()+ _ -> Nothing++instance Rubyable Bool where+ toRuby = RBool+ fromRuby = \case+ RBool x -> Just x+ _ -> Nothing++instance Rubyable Int where+ toRuby = RFixnum+ fromRuby = \case+ RFixnum x -> Just x+ _ -> Nothing++instance Rubyable a => Rubyable (V.Vector a) where+ toRuby = RArray . V.map toRuby+ fromRuby = \case+ RArray x -> V.mapM fromRuby x+ _ -> Nothing++instance (Rubyable a, Rubyable b) => Rubyable (V.Vector (a, b)) where+ toRuby x = RHash $ V.map (toRuby *** toRuby) x+ fromRuby = \case+ RHash x -> V.mapM (\(k, v) -> (,) <$> fromRuby k <*> fromRuby v) x+ _ -> Nothing++instance Rubyable BS.ByteString where+ toRuby = RSymbol+ fromRuby = \case+ RSymbol x -> Just x+ _ -> Nothing++instance Rubyable Float where+ toRuby = RFloat+ fromRuby = \case+ RFloat x -> Just x+ _ -> Nothing++instance Rubyable (BS.ByteString, RubyStringEncoding) where+ toRuby (x, y) = RIVar (RString x, y)+ fromRuby = \case+ RIVar (RString x, y) -> Just (x, y)+ _ -> Nothing++-- nil like++instance Rubyable a => Rubyable (Maybe a) where+ toRuby = \case+ Just x -> toRuby x+ Nothing -> RNil++ fromRuby = \case+ RNil -> Just Nothing+ x -> fromRuby x++-- array like++instance Rubyable a => Rubyable [a] where+ toRuby = toRuby . V.fromList+ fromRuby x = V.toList <$> fromRuby x++-- map like++instance (Rubyable a, Rubyable b) => Rubyable [(a, b)] where+ toRuby = toRuby . V.fromList+ fromRuby x = V.toList <$> fromRuby x++instance (Rubyable a, Rubyable b, Ord a) => Rubyable (DM.Map a b) where+ toRuby = toRuby . DM.toList+ fromRuby x = DM.fromList <$> fromRuby x
src/Data/Ruby/Marshal/Types.hs view
@@ -1,88 +1,68 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE PatternSynonyms #-} -module Data.Ruby.Marshal.Types where--import Control.Applicative-import Prelude--import Control.Monad.State (lift, MonadState, StateT)-import Data.Map (Map)-import Data.Serialize.Get (Get)-import Data.Vector (Vector)--import qualified Data.ByteString as BS--data Cache = Cache {- _objects :: Vector RubyObject- -- ^ object cache.- , _symbols :: Vector RubyObject- -- ^ symbol cache.- } deriving Show---- | Convey when unsupported object encountered.-data Error- = Unsupported- -- ^ represents an unsupported Ruby object- deriving (Eq, Ord, Show)---- | Marshal monad endows the underling Get monad with State.-newtype Marshal a = Marshal {- runMarshal :: StateT Cache Get a- } deriving (Functor, Applicative, Monad, MonadState Cache)---- | Lift Get monad into Marshal monad.-liftMarshal :: Get a -> Marshal a-liftMarshal = Marshal . lift+--------------------------------------------------------------------+-- |+-- Module : Data.Ruby.Marshal.Types+-- Copyright : (c) Philip Cunningham, 2015+-- License : MIT+--+-- Maintainer: hello@filib.io+-- Stability : experimental+-- Portability: portable+--+-- Common types for Ruby Marshal deserialisation.+--+-------------------------------------------------------------------- --- | Representation of a Ruby object.-data RubyObject- = RNil- -- ^ represents @nil@- | RBool !Bool- -- ^ represents @true@ or @false@- | RFixnum {-# UNPACK #-} !Int- -- ^ represents a @Fixnum@- | RArray !(Vector RubyObject)- -- ^ represents an @Array@- | RHash !(Map RubyObject RubyObject)- -- ^ represents an @Hash@- | RIVar !(RubyObject, BS.ByteString)- -- ^ represents an @IVar@- | RString !BS.ByteString- -- ^ represents a @String@- | RFloat {-# UNPACK #-} !Double- -- ^ represents a @Float@- | RSymbol !BS.ByteString- -- ^ represents a @Symbol@- | RError !Error- -- ^ represents an invalid object- deriving (Eq, Ord, Show)+module Data.Ruby.Marshal.Types (+ -- * Marshal Monad+ Marshal+ -- * Internal cache+ , Cache+ -- * Ruby string encodings+ , RubyStringEncoding(..)+ -- * Ruby object+ , RubyObject(..)+ -- * Patterns+ , pattern NilChar+ , pattern FalseChar+ , pattern TrueChar+ , pattern ArrayChar+ , pattern FixnumChar+ , pattern FloatChar+ , pattern HashChar+ , pattern IVarChar+ , pattern ObjectLinkChar+ , pattern StringChar+ , pattern SymbolChar+ , pattern SymlinkChar+) where --- See docs.ruby-lang.org for more information--- http://docs.ruby-lang.org/en/2.1.0/marshal_rdoc.html#label-Stream+Format+import Data.Ruby.Marshal.Encoding+import Data.Ruby.Marshal.Monad+import Data.Ruby.Marshal.RubyObject --- | NilClass-pattern NilC = 48--- | FalseClass-pattern FalseC = 70--- | TrueClass-pattern TrueC = 84--- | Array-pattern ArrayC = 91--- | Fixnum-pattern FixnumC = 105--- | Float-pattern FloatC = 102--- | Hash-pattern HashC = 123--- | IVar-pattern IVarC = 73--- | Object link-pattern ObjectLinkC = 64--- | String-pattern StringC = 34--- | Symbol-pattern SymbolC = 58--- | Symlink-pattern SymlinkC = 59+-- | Character that represents NilCharlass.+pattern NilChar = 48+-- | Character that represents FalseClass.+pattern FalseChar = 70+-- | Character that represents TrueClass.+pattern TrueChar = 84+-- | Character that represents Array.+pattern ArrayChar = 91+-- | Character that represents Fixnum.+pattern FixnumChar = 105+-- | Character that represents Float.+pattern FloatChar = 102+-- | Character that represents Hash.+pattern HashChar = 123+-- | Character that represents IVar.+pattern IVarChar = 73+-- | Character that represents Object link.+pattern ObjectLinkChar = 64+-- | Character that represents String.+pattern StringChar = 34+-- | Character that represents Symbol.+pattern SymbolChar = 58+-- | Character that represents Symlink.+pattern SymlinkChar = 59