diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -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. diff --git a/ruby-marshal.cabal b/ruby-marshal.cabal --- a/ruby-marshal.cabal +++ b/ruby-marshal.cabal @@ -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: diff --git a/src/Data/Ruby/Marshal.hs b/src/Data/Ruby/Marshal.hs --- a/src/Data/Ruby/Marshal.hs +++ b/src/Data/Ruby/Marshal.hs @@ -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 diff --git a/src/Data/Ruby/Marshal/Encoding.hs b/src/Data/Ruby/Marshal/Encoding.hs new file mode 100644 --- /dev/null +++ b/src/Data/Ruby/Marshal/Encoding.hs @@ -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" diff --git a/src/Data/Ruby/Marshal/Get.hs b/src/Data/Ruby/Marshal/Get.hs --- a/src/Data/Ruby/Marshal/Get.hs +++ b/src/Data/Ruby/Marshal/Get.hs @@ -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 . -getNil :: Marshal () -getNil = marshalLabel "Nil" $ tag 48 - --- | Deserialises and --- . -getBool :: Marshal Bool -getBool = marshalLabel "Bool" $ - True <$ tag 84 <|> False <$ tag 70 - --- | Deserialises . +-- | Parses . 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 . +-- | Parses . 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 . -getFloat :: Marshal Double -getFloat = do +-- | Parses . +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 . -getHash :: forall k v. Ord k => Marshal k -> Marshal v -> Marshal (DM.Map k v) -getHash k v = do +-- | Parses . +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 . -getIVar :: Marshal RubyObject -> Marshal (RubyObject, BS.ByteString) -getIVar g = do - string <- g - length <- getFixnum - if | length /= 1 -> fail "getIvar: expected single character" +-- | Parses . +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 . -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 . +-- | Parses . getString :: Marshal BS.ByteString -getString = do +getString = marshalLabel "RawString" $ do n <- getFixnum - x <- liftMarshal $ getBytes n - marshalLabel "RawString" $ return x + liftMarshal $ getBytes n --- | Deserialises . +-- | Parses . getSymbol :: Marshal BS.ByteString -getSymbol = do +getSymbol = marshalLabel "Symbol" $ do x <- getString writeCache $ RSymbol x - marshalLabel "Symbol" $ return x + return x --- | Deserialises . +-- | 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') diff --git a/src/Data/Ruby/Marshal/Int.hs b/src/Data/Ruby/Marshal/Int.hs new file mode 100644 --- /dev/null +++ b/src/Data/Ruby/Marshal/Int.hs @@ -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 diff --git a/src/Data/Ruby/Marshal/Internal/Int.hs b/src/Data/Ruby/Marshal/Internal/Int.hs deleted file mode 100644 --- a/src/Data/Ruby/Marshal/Internal/Int.hs +++ /dev/null @@ -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 diff --git a/src/Data/Ruby/Marshal/Monad.hs b/src/Data/Ruby/Marshal/Monad.hs new file mode 100644 --- /dev/null +++ b/src/Data/Ruby/Marshal/Monad.hs @@ -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 () diff --git a/src/Data/Ruby/Marshal/RubyObject.hs b/src/Data/Ruby/Marshal/RubyObject.hs new file mode 100644 --- /dev/null +++ b/src/Data/Ruby/Marshal/RubyObject.hs @@ -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 diff --git a/src/Data/Ruby/Marshal/Types.hs b/src/Data/Ruby/Marshal/Types.hs --- a/src/Data/Ruby/Marshal/Types.hs +++ b/src/Data/Ruby/Marshal/Types.hs @@ -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