erlang 0.2 → 0.2.1

raw patch · 6 files changed

+74/−19 lines, 6 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• erlang.cabal +1/−1
• src/Foreign/Erlang.hs +2/−6
• src/Foreign/Erlang/Network.hs +4/−7
• src/Foreign/Erlang/Processes.hs +2/−1
• src/Foreign/Erlang/Types.hs +64/−3
• src/Foreign/Erlang/Utilities.hs +1/−1

@@ -1,5 +1,5 @@ name:                erlang-version:             0.2+version:             0.2.1 stability:           alpha description:   Speaks the Erlang network protocol and impersonates an Erlang node

@@ -23,13 +23,9 @@   , module Foreign.Erlang.Utilities   ) where -import Foreign.Erlang.Network hiding (toNetwork)+import Foreign.Erlang.Network hiding (toNetwork, erlConnect) import Foreign.Erlang.OTP import Foreign.Erlang.Processes import Foreign.Erlang.Utilities     -import Foreign.Erlang.Types hiding (-    getA, getC, getErl, getN, geta, getn-  , putA, putC, putErl, putN, puta, putn-  , tag-  )+import Foreign.Erlang.Types (Erlang(..), ErlType(..), nth)

@@ -19,7 +19,7 @@   , ErlSend   -- ** Representation of Erlang nodes   , Name-  , Ip+  , HostName   , Node(..)   , erlConnect   , toNetwork@@ -34,7 +34,7 @@ import Data.List                (unfoldr) import Data.Word import Foreign.Erlang.Types-import Network                  (PortID(..), connectTo, withSocketsDo)+import Network                   import System.Directory         (getHomeDirectory) import System.FilePath          ((</>)) import System.IO@@ -137,13 +137,10 @@ -- | Name of an Erlang node. type Name = String --- | Ip address of a remote Erlang node.-type Ip   = String- -- | Representation of an Erlang node on the network.      data Node      = Short Name         -- ^ Local Erlang node.-    | Long Name Ip       -- ^ Remote Erlang node.+    | Long Name HostName -- ^ Remote Erlang node.       deriving (Eq,Show)  instance Erlang Node where@@ -209,7 +206,7 @@         let reply = take 16 . tail . map (fromIntegral . ord) . B.unpack $ msg         assert (digest == reply) $ return () -epmdLocal :: String+epmdLocal :: HostName epmdLocal = "127.0.0.1"              epmdPort :: PortID

@@ -55,6 +55,7 @@ genRef nodename id = ErlNewRef (ErlAtom nodename) 1 . toNetwork 4 . fromIntegral $ id  -- | Instantiate a Haskell node.  This initializes the FFI.+-- Node name should be a \'long name\' e.g. @\"haskell\@localhost\"@. createSelf          :: String -> IO Self createSelf nodename = do     inbox <- newEmptyMVar@@ -172,7 +173,7 @@ mboxRef                        :: MBox -> IO ErlType mboxRef mbox@(MBox pid _ self) = send self (ErlGenRef pid) >> mboxRecv mbox --- | Send an arbitrary message to the specified node and process. In Erlang equivalent to+-- | Send an arbitrary message to the specified node and process. It is equivalent in Erlang to -- -- > {Node, Pid} ! Msg. 

@@ -39,6 +39,12 @@ import qualified Data.ByteString.Lazy.Char8 as C import Data.ByteString.Lazy.Builder +import qualified Data.ByteString            as Byte+import Data.ByteString (ByteString)+import Control.Applicative+import Data.Bits(shiftL,complement,(.|.))++ nth                  :: Erlang a => Int -> ErlType -> a nth i (ErlTuple lst) = fromErlang $ lst !! i @@ -65,7 +71,10 @@     fromErlang = Prelude.id  instance Erlang Int where-    toErlang   x             = ErlInt x+    toErlang   x             +       | abs x <= 0x7FFFFFFF = ErlInt x        +       | otherwise           = ErlBigInt (fromIntegral x) -- Haskell Int (might) use 64 bits whether erlang's small Int use only 32 bit+     fromErlang (ErlInt x)    = x     fromErlang (ErlBigInt x) = fromIntegral x @@ -136,6 +145,15 @@ putErl (ErlList val)        = tag 'l' <> putN (length val) <> val' <> putErl ErlNull     where val' = mconcat . map putErl $ val   putErl (ErlBinary val)      = tag 'm' <> putN (length val) <> (lazyByteString . B.pack) val++putErl (ErlBigInt x) +       | len > 255      = tag 'o' <> putN len <> byteString val +       | otherwise      = tag 'n' <> putC len <> byteString val +   where+     val = integerToBytes x+     len = Byte.length val -1++ putErl (ErlRef node id creation) =     tag 'e' <>     putErl node <>@@ -154,8 +172,17 @@ getErl = do     tag <- liftM chr getC     case tag of+       'a' -> liftM ErlInt getC-      'b' -> liftM ErlInt getN++      'b' -> do x <- getN+                +                let valFrom32  +                      | x > 0x7FFFFFFF = x .|. complement 0xFFFFFFFF  +                      | otherwise      = x++                return (ErlInt valFrom32)+       'd' -> getn >>= liftM ErlAtom . getA       'e' -> do         node <- getErl@@ -188,13 +215,47 @@         null <- getErl         assert (null == ErlNull) $ return list       'm' -> getN >>= liftM ErlBinary . geta++      'n' -> do  len <- getC+                 raw <- getByteString (len+1)+                 ErlBigInt <$> bytesToInteger raw+      +      'o' -> do  len <- getN+                 raw <- getByteString (len+1)+                 ErlBigInt <$> bytesToInteger raw+       'r' -> do         len <- getn         node <- getErl         creation <- getC         id <- forM [1..4*len] (const getWord8)         return $ ErlNewRef node creation id-      x -> error [x]++      x -> fail $ "Unsupported serialization code: " ++ show (ord x)+++bytesToInteger :: ByteString -> Get Integer+bytesToInteger bts = case Byte.unpack bts of+                      0 : bts' -> return $          foldr step 0 bts'+                      1 : bts' -> return . negate $ foldr step 0 bts'+                      x : _    -> fail $ "Unexpected sign byte: " ++ show x+                      _        -> fail $ "Unexpected end of input at function 'bytesToInteger'"+  where+    step next acc = shiftL acc 8 + fromIntegral next+++integerToBytes :: Integer -> ByteString+integerToBytes int = Byte.pack +                   . fmap (fromIntegral.snd) +                   . takeWhile not_zero +                   $ iterate ((`divMod`256).fst) (abs int,sigByte)+  +  where+    not_zero (a,b)    = a + b /= 0+    sigByte | int > 0   = 0+            | otherwise = 1++  tag :: Char -> Builder              tag = charUtf8

@@ -21,7 +21,7 @@ -- MicroSeconds}.  Luckily though, Erlang uses the same epoch, so no -- further conversion is necessary. --- | Convert a tuple (from erlang:now()) to seconds from Jan 1, 1970.+-- | Convert a tuple (from @erlang:now()@) to seconds from Jan 1, 1970.  erlangTimeToSeconds :: Integral a => ErlType -> a erlangTimeToSeconds (ErlTuple [ErlInt ms, ErlInt s, _]) =