{-# 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           Control.Arrow              ((***))
import qualified Data.ByteString            as BS
import qualified Data.Map.Strict            as DM
import           Data.Ruby.Marshal.Encoding (RubyStringEncoding (..))
import qualified Data.Vector                as V
import           Prelude

-- | 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 (RubyObject -> RubyObject -> Bool
(RubyObject -> RubyObject -> Bool)
-> (RubyObject -> RubyObject -> Bool) -> Eq RubyObject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RubyObject -> RubyObject -> Bool
$c/= :: RubyObject -> RubyObject -> Bool
== :: RubyObject -> RubyObject -> Bool
$c== :: RubyObject -> RubyObject -> Bool
Eq, Eq RubyObject
Eq RubyObject
-> (RubyObject -> RubyObject -> Ordering)
-> (RubyObject -> RubyObject -> Bool)
-> (RubyObject -> RubyObject -> Bool)
-> (RubyObject -> RubyObject -> Bool)
-> (RubyObject -> RubyObject -> Bool)
-> (RubyObject -> RubyObject -> RubyObject)
-> (RubyObject -> RubyObject -> RubyObject)
-> Ord RubyObject
RubyObject -> RubyObject -> Bool
RubyObject -> RubyObject -> Ordering
RubyObject -> RubyObject -> RubyObject
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RubyObject -> RubyObject -> RubyObject
$cmin :: RubyObject -> RubyObject -> RubyObject
max :: RubyObject -> RubyObject -> RubyObject
$cmax :: RubyObject -> RubyObject -> RubyObject
>= :: RubyObject -> RubyObject -> Bool
$c>= :: RubyObject -> RubyObject -> Bool
> :: RubyObject -> RubyObject -> Bool
$c> :: RubyObject -> RubyObject -> Bool
<= :: RubyObject -> RubyObject -> Bool
$c<= :: RubyObject -> RubyObject -> Bool
< :: RubyObject -> RubyObject -> Bool
$c< :: RubyObject -> RubyObject -> Bool
compare :: RubyObject -> RubyObject -> Ordering
$ccompare :: RubyObject -> RubyObject -> Ordering
$cp1Ord :: Eq RubyObject
Ord, Int -> RubyObject -> ShowS
[RubyObject] -> ShowS
RubyObject -> String
(Int -> RubyObject -> ShowS)
-> (RubyObject -> String)
-> ([RubyObject] -> ShowS)
-> Show RubyObject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RubyObject] -> ShowS
$cshowList :: [RubyObject] -> ShowS
show :: RubyObject -> String
$cshow :: RubyObject -> String
showsPrec :: Int -> RubyObject -> ShowS
$cshowsPrec :: Int -> RubyObject -> ShowS
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 :: RubyObject -> RubyObject
toRuby = RubyObject -> RubyObject
forall a. a -> a
id
  fromRuby :: RubyObject -> Maybe RubyObject
fromRuby = RubyObject -> Maybe RubyObject
forall a. a -> Maybe a
Just

instance Rubyable () where
  toRuby :: () -> RubyObject
toRuby ()
_ = RubyObject
RNil
  fromRuby :: RubyObject -> Maybe ()
fromRuby = \case
    RubyObject
RNil -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
    RubyObject
_    -> Maybe ()
forall a. Maybe a
Nothing

instance Rubyable Bool where
  toRuby :: Bool -> RubyObject
toRuby = Bool -> RubyObject
RBool
  fromRuby :: RubyObject -> Maybe Bool
fromRuby = \case
    RBool Bool
x -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
x
    RubyObject
_       -> Maybe Bool
forall a. Maybe a
Nothing

instance Rubyable Int where
  toRuby :: Int -> RubyObject
toRuby = Int -> RubyObject
RFixnum
  fromRuby :: RubyObject -> Maybe Int
fromRuby = \case
    RFixnum Int
x -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
x
    RubyObject
_         -> Maybe Int
forall a. Maybe a
Nothing

instance Rubyable a => Rubyable (V.Vector a) where
  toRuby :: Vector a -> RubyObject
toRuby = Vector RubyObject -> RubyObject
RArray (Vector RubyObject -> RubyObject)
-> (Vector a -> Vector RubyObject) -> Vector a -> RubyObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> RubyObject) -> Vector a -> Vector RubyObject
forall a b. (a -> b) -> Vector a -> Vector b
V.map a -> RubyObject
forall a. Rubyable a => a -> RubyObject
toRuby
  fromRuby :: RubyObject -> Maybe (Vector a)
fromRuby = \case
    RArray Vector RubyObject
x -> (RubyObject -> Maybe a) -> Vector RubyObject -> Maybe (Vector a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Vector a -> m (Vector b)
V.mapM RubyObject -> Maybe a
forall a. Rubyable a => RubyObject -> Maybe a
fromRuby Vector RubyObject
x
    RubyObject
_        -> Maybe (Vector a)
forall a. Maybe a
Nothing

instance (Rubyable a, Rubyable b) => Rubyable (V.Vector (a, b)) where
  toRuby :: Vector (a, b) -> RubyObject
toRuby Vector (a, b)
x = Vector (RubyObject, RubyObject) -> RubyObject
RHash (Vector (RubyObject, RubyObject) -> RubyObject)
-> Vector (RubyObject, RubyObject) -> RubyObject
forall a b. (a -> b) -> a -> b
$ ((a, b) -> (RubyObject, RubyObject))
-> Vector (a, b) -> Vector (RubyObject, RubyObject)
forall a b. (a -> b) -> Vector a -> Vector b
V.map (a -> RubyObject
forall a. Rubyable a => a -> RubyObject
toRuby (a -> RubyObject)
-> (b -> RubyObject) -> (a, b) -> (RubyObject, RubyObject)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** b -> RubyObject
forall a. Rubyable a => a -> RubyObject
toRuby) Vector (a, b)
x
  fromRuby :: RubyObject -> Maybe (Vector (a, b))
fromRuby = \case
    RHash Vector (RubyObject, RubyObject)
x -> ((RubyObject, RubyObject) -> Maybe (a, b))
-> Vector (RubyObject, RubyObject) -> Maybe (Vector (a, b))
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Vector a -> m (Vector b)
V.mapM (\(RubyObject
k, RubyObject
v) -> (,) (a -> b -> (a, b)) -> Maybe a -> Maybe (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RubyObject -> Maybe a
forall a. Rubyable a => RubyObject -> Maybe a
fromRuby RubyObject
k Maybe (b -> (a, b)) -> Maybe b -> Maybe (a, b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RubyObject -> Maybe b
forall a. Rubyable a => RubyObject -> Maybe a
fromRuby RubyObject
v) Vector (RubyObject, RubyObject)
x
    RubyObject
_       -> Maybe (Vector (a, b))
forall a. Maybe a
Nothing

instance Rubyable BS.ByteString where
  toRuby :: ByteString -> RubyObject
toRuby = ByteString -> RubyObject
RSymbol
  fromRuby :: RubyObject -> Maybe ByteString
fromRuby = \case
    RSymbol ByteString
x -> ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
x
    RubyObject
_         -> Maybe ByteString
forall a. Maybe a
Nothing

instance Rubyable Float where
  toRuby :: Float -> RubyObject
toRuby = Float -> RubyObject
RFloat
  fromRuby :: RubyObject -> Maybe Float
fromRuby = \case
    RFloat Float
x -> Float -> Maybe Float
forall a. a -> Maybe a
Just Float
x
    RubyObject
_        -> Maybe Float
forall a. Maybe a
Nothing

instance Rubyable (BS.ByteString, RubyStringEncoding) where
  toRuby :: (ByteString, RubyStringEncoding) -> RubyObject
toRuby (ByteString
x, RubyStringEncoding
y) = (RubyObject, RubyStringEncoding) -> RubyObject
RIVar (ByteString -> RubyObject
RString ByteString
x, RubyStringEncoding
y)
  fromRuby :: RubyObject -> Maybe (ByteString, RubyStringEncoding)
fromRuby = \case
    RIVar (RString ByteString
x, RubyStringEncoding
y) -> (ByteString, RubyStringEncoding)
-> Maybe (ByteString, RubyStringEncoding)
forall a. a -> Maybe a
Just (ByteString
x, RubyStringEncoding
y)
    RubyObject
_                    -> Maybe (ByteString, RubyStringEncoding)
forall a. Maybe a
Nothing

-- nil like

instance Rubyable a => Rubyable (Maybe a) where
  toRuby :: Maybe a -> RubyObject
toRuby = \case
    Just a
x  -> a -> RubyObject
forall a. Rubyable a => a -> RubyObject
toRuby a
x
    Maybe a
Nothing -> RubyObject
RNil
  fromRuby :: RubyObject -> Maybe (Maybe a)
fromRuby = \case
    RubyObject
RNil -> Maybe a -> Maybe (Maybe a)
forall a. a -> Maybe a
Just Maybe a
forall a. Maybe a
Nothing
    RubyObject
x    -> RubyObject -> Maybe (Maybe a)
forall a. Rubyable a => RubyObject -> Maybe a
fromRuby RubyObject
x

-- array like

instance Rubyable a => Rubyable [a] where
  toRuby :: [a] -> RubyObject
toRuby = Vector a -> RubyObject
forall a. Rubyable a => a -> RubyObject
toRuby (Vector a -> RubyObject) -> ([a] -> Vector a) -> [a] -> RubyObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Vector a
forall a. [a] -> Vector a
V.fromList
  fromRuby :: RubyObject -> Maybe [a]
fromRuby RubyObject
x = Vector a -> [a]
forall a. Vector a -> [a]
V.toList (Vector a -> [a]) -> Maybe (Vector a) -> Maybe [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RubyObject -> Maybe (Vector a)
forall a. Rubyable a => RubyObject -> Maybe a
fromRuby RubyObject
x

-- map like

instance (Rubyable a, Rubyable b) => Rubyable [(a, b)] where
  toRuby :: [(a, b)] -> RubyObject
toRuby = Vector (a, b) -> RubyObject
forall a. Rubyable a => a -> RubyObject
toRuby (Vector (a, b) -> RubyObject)
-> ([(a, b)] -> Vector (a, b)) -> [(a, b)] -> RubyObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(a, b)] -> Vector (a, b)
forall a. [a] -> Vector a
V.fromList
  fromRuby :: RubyObject -> Maybe [(a, b)]
fromRuby RubyObject
x = Vector (a, b) -> [(a, b)]
forall a. Vector a -> [a]
V.toList (Vector (a, b) -> [(a, b)])
-> Maybe (Vector (a, b)) -> Maybe [(a, b)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RubyObject -> Maybe (Vector (a, b))
forall a. Rubyable a => RubyObject -> Maybe a
fromRuby RubyObject
x

instance (Rubyable a, Rubyable b, Ord a) => Rubyable (DM.Map a b) where
  toRuby :: Map a b -> RubyObject
toRuby = [(a, b)] -> RubyObject
forall a. Rubyable a => a -> RubyObject
toRuby ([(a, b)] -> RubyObject)
-> (Map a b -> [(a, b)]) -> Map a b -> RubyObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map a b -> [(a, b)]
forall k a. Map k a -> [(k, a)]
DM.toList
  fromRuby :: RubyObject -> Maybe (Map a b)
fromRuby RubyObject
x = [(a, b)] -> Map a b
forall k a. Ord k => [(k, a)] -> Map k a
DM.fromList ([(a, b)] -> Map a b) -> Maybe [(a, b)] -> Maybe (Map a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RubyObject -> Maybe [(a, b)]
forall a. Rubyable a => RubyObject -> Maybe a
fromRuby RubyObject
x