From 63d34635cc895019a3c4e510e5d10a6a715e2e85 Mon Sep 17 00:00:00 2001
From: Yves Fischer <yvesf-git@xapek.org>
Date: Sat, 17 Mar 2012 21:20:27 +0100
Subject: layer2 works somehow

---
 Network/EBus/Layer2.hs | 162 +++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 162 insertions(+)
 create mode 100644 Network/EBus/Layer2.hs

(limited to 'Network/EBus/Layer2.hs')

diff --git a/Network/EBus/Layer2.hs b/Network/EBus/Layer2.hs
new file mode 100644
index 0000000..496e9b1
--- /dev/null
+++ b/Network/EBus/Layer2.hs
@@ -0,0 +1,162 @@
+import Control.Applicative
+import Data.Attoparsec
+import Data.Attoparsec.Enumerator (iterParser)
+import Data.Attoparsec.Combinator as C
+import Data.ByteString (ByteString)
+import Data.Enumerator
+import Data.Enumerator.Binary (enumHandle)
+import Data.Word (Word8)
+import System.IO (hSetBinaryMode,stdin)
+
+-- ebus :: Parser EbusPacket
+-- ebus = do{ skipMany1 $ char '\xaa'
+--          ; source <- anyChar
+--          ; destination <- anyChar
+--          ; primaryCommand <- anyChar
+--          ; secondaryCommand <- anyChar
+--          ; payloadLength <- anyChar
+--          ; payload <- count (fromEnum payloadLength) ebusPayload
+--          ; followup <- 
+--            if destination == '\xfe' then 
+--              -- Broadcast - no further data
+--              do{ crc <- anyChar
+--                ; syn <- char '\xaa'    
+--                ; return "broadcast"
+--                  <|> fail "Failed to parse Broadcast Packet"
+--                }
+--            else
+--              try( -- Master-Master - no further data
+--                do{ crc <- anyChar
+--                  ; ack <- char '\x00' -- ACK OK
+--                  ; syn <- char '\xaa'
+--                  ; return "master-master"
+--                  })
+--              <|> 
+--              try( -- Master Slave
+--                do{ crc <- anyChar
+--                  ; ack <- char '\x00'
+--                  ; payloadSlaveLength <- anyChar
+--                  ; payloadSlave <- count (fromEnum payloadSlaveLength) ebusPayload
+--                  ; crcSlave <- anyChar
+--                  ; ackSlave <- char '\x00'
+--                  ; synSlave <- char '\xaa'
+--                  ; return "master-slave"
+--                  })
+--              <|> fail "Failed to parse Master-Master/Master-Slave Packet"
+--          ; return $ EbusPacket 
+--                    source destination
+--                    primaryCommand secondaryCommand 
+--                    payloadLength followup []
+--          }
+
+
+-- | Ebus Layer2 Constants
+ebusConstant :: String -> Word8
+ebusConstant "SYN" = 0xaa
+ebusConstant "ACK" = 0x00
+ebusConstant "BROADCAST" = 0xff
+ebusConstant "ESCAPE" = 0xa9
+ebusConstant "ESCAPE_ESCAPE" = 0x00
+ebusConstant "ESCAPE_SYN" = 0x01
+ebusConstant _ = 0x00
+
+-- | Ebus Packet Types
+data EbusType = EbusBroadcast 
+              | EbusMasterMaster 
+              | EbusMasterSlave
+              deriving (Show)
+
+-- | Ebus Packet representation
+data EbusPacket = EbusPacket { 
+  ebusPacketType :: EbusType,
+  ebusPacketSource :: Word8,
+  ebusPacketDestination :: Word8,
+  ebusPacketPrimaryCommand :: Word8,
+  ebusPacketSecondaryCommand :: Word8,
+  ebusPacketPayloadLength :: Word8,
+  ebusPacketPayload :: [Word8],
+  ebusPacketPayloadSlave :: Maybe [Word8]
+  } deriving (Show)
+
+parserPayload :: Parser Word8
+parserPayload = do{ word8 $ ebusConstant "ESCAPE"
+                  ; word8 $ ebusConstant "ESCAPE_ESCAPE"
+                  ; return $ ebusConstant "ESCAPE"}
+                <|>
+                do{ word8 $ ebusConstant "ESCAPE"
+                  ; word8 $ ebusConstant "ESCAPE_SYN"
+                  ; return $ ebusConstant "SYN"}
+                <|>
+                anyWord8;
+
+parser :: Parser EbusPacket
+parser = do{ 
+  C.skipMany $ word8 $ ebusConstant "SYN"
+  ; source <- anyWord8
+  ; destination <- anyWord8
+  ; primaryCommand <- anyWord8
+  ; secondaryCommand <- anyWord8
+  ; payloadLength <- anyWord8
+  ; payload <- C.count (fromIntegral payloadLength) parserPayload
+  ; followup <-
+    if destination == 0xfe then
+      -- Broadcast
+      do{ crc <- anyWord8
+        ; {- syn -} word8 $ ebusConstant "SYN"
+        ; return (EbusBroadcast, crc, Nothing)}
+      <|>
+      fail "Failed to parse Broadcast Paket"
+    else
+      -- Master-Master
+      try( 
+        do{ crc <- anyWord8
+          ; {- ack -} word8 $ ebusConstant "ACK"
+          ; {- syn -} word8 $ ebusConstant "SYN"
+          ; return (EbusMasterMaster, crc, Nothing)})
+      <|> 
+      -- Master Slave
+      try(
+        do{ crc <- anyWord8
+          ; {- ack -} word8 $ ebusConstant "ACK"
+          ; payloadSlaveLength <- anyWord8
+          ; payloadSlave <- C.count (fromIntegral payloadSlaveLength) parserPayload
+          ; crcSlave <- anyWord8
+          ; {- ackSlave -} word8 $ ebusConstant "ACK"
+          ; {- synSlave -} word8 $ ebusConstant "SYN"
+          ; return (EbusMasterSlave, crc, (Just (payloadSlave, crcSlave)))})
+      <|> 
+      fail "Failed to parse Master-Master/Master-Slave Packet"
+  ; do {
+      if True then --CHECK CRC
+        return $ EbusPacket EbusMasterMaster source destination primaryCommand secondaryCommand payloadLength payload  (Just [])
+      else
+        fail "CRC Check failed"}
+    <|> fail "Failed to parse packet"
+  }
+
+main = do
+  -- * Select binary mode (True) or text mode (False) on a open handle. (See also openBinaryFile.) 
+  hSetBinaryMode stdin True  
+  -- * run
+  -- Run an iteratee until it finishes, and return either the final value (if it succeeded) or the error (if it failed).
+  -- * run_
+  -- Like run, except errors are converted to exceptions and thrown. Primarily useful for small scripts or other simple cases. 
+  
+  maybePacket <- run( enumSource $$ runParser )
+  case maybePacket of
+    Right result -> print result
+    Left error -> print error
+
+  maybePacket <- run( enumSource $$ runParser )
+  case maybePacket of
+    Right result -> print result
+    Left error -> print error
+
+
+enumSource :: Enumerator ByteString IO a
+enumSource = enumHandle 1 stdin
+
+runParser :: Iteratee ByteString IO EbusPacket
+runParser = do
+  p <- iterParser parser
+  return p
-- 
cgit v1.2.1