From b8435b0668236b509595e9da9cc71372f78c2b4e Mon Sep 17 00:00:00 2001
From: Jesper Louis Andersen <jesper.louis.andersen@gmail.com>
Date: Mon, 30 Mar 2015 23:43:24 +0200
Subject: [PATCH] Use Control.Applicative as a parser.

Control.Applicative often simplifies parsers and this is no exception. Use the
applicative <$> and <*> to run the 'getErl' function which simplifies its structure
and makes it more clear what is going on.

While here, destroy a couple of liftM's, now we have started to use applicatives.
---
 src/Foreign/Erlang/Network.hs | 10 ++++---
 src/Foreign/Erlang/Types.hs   | 50 ++++++++++++-----------------------
 2 files changed, 24 insertions(+), 36 deletions(-)

diff --git a/src/Foreign/Erlang/Network.hs b/src/Foreign/Erlang/Network.hs
index 2a920f3..6ec73b6 100644
--- a/src/Foreign/Erlang/Network.hs
+++ b/src/Foreign/Erlang/Network.hs
@@ -13,6 +13,7 @@ module Foreign.Erlang.Network (
   , handshakeS
   ) where
 
+import Control.Applicative      ((<$>))
 import Control.Concurrent       (threadDelay)
 import Control.Exception        (assert, bracketOnError)
 import Control.Monad            (liftM)
@@ -68,15 +69,18 @@ erlDigest cookie challenge = let
     [(n, _)] = readHex . show . md5 . B.pack $ cookie ++ show challenge
     in toNetwork 16 n
 
+packLen = fromIntegral . B.length
+
 packn, packN :: B.ByteString -> Put
-packn msg = putn (fromIntegral . B.length $ msg) >> putLazyByteString msg
-packN msg = putN (fromIntegral . B.length $ msg) >> putLazyByteString msg
+packn msg = putn (packLen msg) >> putLazyByteString msg
+packN msg = putN (packLen msg) >> putLazyByteString msg
+
 
 sendMessage :: (B.ByteString -> Put) -> (B.ByteString -> IO ()) -> B.ByteString -> IO ()
 sendMessage pack out = out . runPut . pack
 
 recvMessage            :: Int -> (Int -> IO B.ByteString) -> IO B.ByteString
-recvMessage hdrlen inf = (liftM (unpack hdrlen) $ inf hdrlen) >>= inf
+recvMessage hdrlen inf = (unpack hdrlen <$> inf hdrlen) >>= inf
   where
     unpack 2 = runGet getn
     unpack 4 = runGet getN
diff --git a/src/Foreign/Erlang/Types.hs b/src/Foreign/Erlang/Types.hs
index 9a76626..5bd3812 100644
--- a/src/Foreign/Erlang/Types.hs
+++ b/src/Foreign/Erlang/Types.hs
@@ -18,8 +18,9 @@ module Foreign.Erlang.Types (
   , tag
   ) where
 
+import Control.Applicative ((<$>), (<*>))
 import Control.Exception  (assert)
-import Control.Monad      (forM, liftM)
+import Control.Monad      (forM, liftM, (=<<))
 import Data.Binary
 import Data.Binary.Get
 import Data.Binary.Put
@@ -145,44 +146,27 @@ putErl (ErlNewRef node creation id) = do
     mapM_ putWord8 id
 
 getErl = do
-    tag <- liftM chr getC
+    tag <- chr <$> getC
     case tag of
-      'a' -> liftM ErlInt getC
-      'b' -> liftM ErlInt getN
-      'd' -> getn >>= liftM ErlAtom . getA
-      'e' -> do
-        node <- getErl
-        id <- getN
-        creation <- getC
-        return $ ErlRef node id creation
-      'f' -> do
-        node <- getErl
-        id <- getN
-        creation <- getC
-        return $ ErlPort node id creation
-      'g' -> do
-        node <- getErl
-        id <- getN
-        serial <- getN
-        creation <- getC
-        return $ ErlPid node id serial creation
-      'h' -> getC >>= \len -> liftM ErlTuple $ forM [1..len] (const getErl)
-      'i' -> getN >>= \len -> liftM ErlTuple $ forM [1..len] (const getErl)
+      'a' -> ErlInt <$> getC
+      'b' -> ErlInt <$> getN
+      'd' -> ErlAtom <$> (getA =<< getn)
+      'e' -> ErlRef <$> getErl <*> getN <*> getC
+      'f' -> ErlPort <$> getErl <*> getN <*> getC
+      'g' -> ErlPid <$> getErl <*> getN <*> getN <*> getC
+      'h' -> ErlTuple <$> (getC >>= getCount getErl)
+      'i' -> ErlTuple <$> (getN >>= getCount getErl)
       'j' -> return ErlNull
-      'k' -> getn >>= liftM ErlString . getA
+      'k' -> ErlString <$> (getA =<< getn)
       'l' -> do
-        len <- getN
-        list <- liftM ErlList $ forM [1..len] (const getErl)
+        list <- ErlList <$> (getN >>= getCount getErl)
         null <- getErl
         assert (null == ErlNull) $ return list
-      'm' -> getN >>= liftM ErlBinary . geta
-      'r' -> do
-        len <- getn
-        node <- getErl
-        creation <- getC
-        id <- forM [1..4*len] (const getWord8)
-        return $ ErlNewRef node creation id
+      'm' -> ErlBinary <$> (geta =<< getN)
+      'r' -> ErlNewRef <$> getErl <*> getC <*> (getn >>= getCount getWord8)
       x -> error [x]
+  where
+    getCount x len = forM [1..len] (const x)
 
 tag = putC . ord