<commit_before>-------------------------------------------------------------------------------
-- |
-- Module      :  System.Hardware.KansasAmber.Comm
--                Based on System.Hardware.Arduino.comm
-- Copyright   :  (c) University of Kansas
--                System.Hardware.Arduino (c) <NAME>
-- License     :  BSD3
-- Stability   :  experimental
--
-- Internal representation of the firmata protocol.
-------------------------------------------------------------------------------
{-# LANGUAGE GADTs      #-}

module System.Hardware.KansasAmber.Protocol(packageCommand, packageProcedure, unpackageResponse, parseQueryResult) where

import Data.Bits            (xor)
import Data.Word (Word8)

import qualified Data.ByteString as B

import System.Hardware.KansasAmber.Data
import System.Hardware.KansasAmber.Utils

-- | Maximum size of a firmata message
maxFirmwareSize :: Int
maxFirmwareSize = 128

buildCommand :: FirmwareCmd -> [Word8] -> B.ByteString
buildCommand cmd bs = B.pack $ firmwareCmdVal cmd : bs

-- | Package a request as a sequence of bytes to be sent to the board
-- using the Firmata protocol.
packageCommand :: ArduinoConnection -> Command -> IO B.ByteString
packageCommand c SystemReset = 
    return $ buildCommand BC_CMD_SYSTEM_RESET []
packageCommand c (SetPinMode p m) = do
    return $ buildCommand BC_CMD_SET_PIN_MODE [p, fromIntegral $ fromEnum m]
packageCommand c (DigitalWrite p b)  = do
    return $ buildCommand DIG_CMD_WRITE_PIN [p, if b then 1 else 0]
packageCommand c (AnalogWrite p w) = do
    return $ buildCommand ALG_CMD_WRITE_PIN (p : (word16ToBytes w))
packageCommand c (I2CWrite sa w8s) = 
    return $ buildCommand I2C_CMD_WRITE (sa : w8s)
packageCommand c (DeleteTask tid) = 
    return $ buildCommand SCHED_CMD_DELETE_TASK [tid]
packageCommand c (DelayMillis ms) = 
    return $ buildCommand BC_CMD_DELAY_MILLIS (word32ToBytes ms)
packageCommand c (DelayMicros ms) = 
    return $ buildCommand BC_CMD_DELAY_MICROS (word32ToBytes ms)
packageCommand c (ScheduleTask tid tt)    = 
    return $ buildCommand SCHED_CMD_SCHED_TASK (tid : word32ToBytes tt)
packageCommand c (CreateTask tid m)       = do
    td <- packageTaskData c m
    let taskSize = fromIntegral (B.length td)
    return $ buildCommand SCHED_CMD_CREATE_TASK (tid : (word16ToBytes taskSize))
                                    `B.append` (genAddToTaskCmds td)
  where
    maxCmdSize = maxFirmwareSize - 3
    genAddToTaskCmds tds | fromIntegral (B.length tds) > maxCmdSize = 
        addToTask (B.take maxCmdSize tds) 
            `B.append` (genAddToTaskCmds (B.drop maxCmdSize tds))
    genAddToTaskCmds tds = addToTask tds
    addToTask tds' = buildCommand SCHED_CMD_ADD_TO_TASK ([tid, fromIntegral $ B.length tds'] ++ (B.unpack tds'))
{- 
packageCommand c (StepperConfig dev TwoWire d sr p1 p2 _ _) = do
    ipin1 <-  getInternalPin c p1 
    ipin2 <-  getInternalPin c p2
    let pn1 = fromIntegral $ pinNo ipin1
        pn2 = fromIntegral $ pinNo ipin2
    return $ sysEx STEPPER_DATA ([stepperCmdVal CONFIG_STEPPER,dev,((stepDelayVal d) .|. 0x02)] ++ (word16ToArduinoBytes sr) ++ [pn1,pn2])
packageCommand c (StepperConfig dev FourWire d sr p1 p2 (Just p3) (Just p4)) = do 
    ipin1 <-  getInternalPin c p1 
    ipin2 <-  getInternalPin c p2
    ipin3 <-  getInternalPin c p3 
    ipin4 <-  getInternalPin c p4
    let pn1 = fromIntegral $ pinNo ipin1
        pn2 = fromIntegral $ pinNo ipin2
        pn3 = fromIntegral $ pinNo ipin3
        pn4 = fromIntegral $ pinNo ipin4
    return $ sysEx STEPPER_DATA ([stepperCmdVal CONFIG_STEPPER,dev,((stepDelayVal d) .|. 0x04)] ++ (word16ToArduinoBytes sr) ++ [pn1,pn2,pn3,pn4])
packageCommand c (StepperConfig _ FourWire _ _ _ _ _ _) = 
    runDie c "KansasAmber: FourWire steppers require specification of 4 pins for config"  []
packageCommand c (StepperConfig dev StepDir d sr dp sp _ _) = do
    dipin <-  getInternalPin c dp 
    sipin <-  getInternalPin c sp
    let pnd = fromIntegral $ pinNo dipin
        pns = fromIntegral $ pinNo sipin
    return $ sysEx STEPPER_DATA ([stepperCmdVal CONFIG_STEPPER,dev,((stepDelayVal d) .|. 0x01)] ++ (word16ToArduinoBytes sr) ++ [pnd,pns])
packageCommand c (StepperStep dev sd ns sp (Just ac)) =
    return $ sysEx STEPPER_DATA ([stepperCmdVal STEP_STEPPER,dev,(stepDirVal sd)] ++ (word32To3ArduinoBytes ns) ++ (word16ToArduinoBytes sp) ++ (intTo4ArduinoBytes ac))
packageCommand c (StepperStep dev sd ns sp Nothing) =
    return $ sysEx STEPPER_DATA ([stepperCmdVal STEP_STEPPER,dev,(stepDirVal sd)] ++ (word32To3ArduinoBytes ns) ++ (word16ToArduinoBytes sp))
packageCommand c (ServoConfig p min max)  = do
    ipin <- getInternalPin c p
    return $ sysEx SERVO_CONFIG ([fromIntegral $ pinNo ipin] ++ (word16ToArduinoBytes min) ++ (word16ToArduinoBytes max))
-}

packageTaskData :: ArduinoConnection -> Arduino a -> IO B.ByteString
packageTaskData conn commands =
      packageTaskData' conn commands B.empty
  where
      packBind :: ArduinoConnection -> Arduino a -> (a -> Arduino b) -> IO B.ByteString -> IO B.ByteString
      packBind c (Return a)      k cmds = do
          cs <- cmds
          packageTaskData' c (k a) cs
      packBind c (Bind m k1)    k2 cmds = packBind c m (\ r -> Bind (k1 r) k2) cmds
      packBind c (Command cmd) k cmds = do
          proc <- packageCommand c cmd
          cs <- cmds
          packageTaskData' c (k ()) (B.append cs proc)
      packBind c (Local local) k cmds = packLocal c local k cmds
      packBind c (Procedure procedure) k cmds = packProcedure c procedure k cmds

      -- For sending as part of a Scheduler task, locals make no sense.  
      -- Instead of signalling an error, at this point they are just ignored.
      packLocal :: ArduinoConnection -> Local a -> (a -> Arduino b) -> IO B.ByteString -> IO B.ByteString
      packLocal c (Debug _) k cmds = do
          cs <- cmds 
          packageTaskData' c (k ()) cs
      packLocal c (Die _ _) k cmds = do
          cs <- cmds 
          packageTaskData' c (k ()) cs

      packProcedure :: ArduinoConnection -> Procedure a -> (a -> Arduino b) -> IO B.ByteString -> IO B.ByteString
      packProcedure c QueryFirmware k cmds = do 
          cs <- cmds           
          packageTaskData' c (k (0,0)) cs
      packProcedure c QueryProcessor k cmds = do 
          cs <- cmds           
          packageTaskData' c (k ATMEGA8) cs
      packProcedure c (DigitalRead _) k cmds = do 
          cs <- cmds           
          packageTaskData' c (k False) cs
      packProcedure c (AnalogRead _) k cmds = do 
          cs <- cmds           
          packageTaskData' c (k 0) cs
--      packProcedure c (Pulse _ _ _ _) k cmds = do
--          cs <- cmds 
--          packageTaskData' c (k 0) cs
      packProcedure c QueryAllTasks k cmds = do
          cs <- cmds
          packageTaskData' c (k ([])) cs
      packProcedure c (QueryTask _) k cmds = do
          cs <- cmds
          packageTaskData' c (k Nothing) cs

      packageTaskData' :: ArduinoConnection -> Arduino a -> B.ByteString -> IO B.ByteString
      packageTaskData' c (Bind m k) cmds = packBind c m k (return cmds)
      packageTaskData' c (Return a) cmds = return cmds
      packageTaskData' c cmd        cmds = packBind c cmd Return (return cmds)

packageProcedure :: Procedure a -> B.ByteString
packageProcedure QueryFirmware       = 
    buildCommand BS_CMD_REQUEST_VERSION []
packageProcedure QueryProcessor      = 
    buildCommand BS_CMD_REQUEST_TYPE []
packageProcedure (DigitalRead p)     = 
    buildCommand DIG_CMD_READ_PIN [p]
packageProcedure (AnalogRead p)      = 
    buildCommand ALG_CMD_READ_PIN [p]
packageProcedure (I2CRead sa Nothing cnt)    = 
    buildCommand I2C_CMD_READ [sa,cnt]
packageProcedure (I2CRead sa (Just sr) cnt) = 
    buildCommand I2C_CMD_READ_REG ((sa : (word16ToBytes sr)) ++ [cnt])
packageProcedure QueryAllTasks       = 
    buildCommand SCHED_CMD_QUERY_ALL []
packageProcedure (QueryTask tid)     = 
    buildCommand SCHED_CMD_QUERY [tid]
-- packageProcedure (Pulse p b dur to)       = sysEx    PULSE                   ([fromIntegral (pinNo p), if b then 1 else 0] ++ concatMap toArduinoBytes (word32ToBytes dur ++ word32ToBytes to))

-- | Unpackage a SysEx response
unpackageResponse :: [Word8] -> Response<commit_msg>Add task command length<commit_after>-------------------------------------------------------------------------------
-- |
-- Module      :  System.Hardware.KansasAmber.Comm
--                Based on System.Hardware.Arduino.comm
-- Copyright   :  (c) University of Kansas
--                System.Hardware.Arduino (c) <NAME>
-- License     :  BSD3
-- Stability   :  experimental
--
-- Internal representation of the firmata protocol.
-------------------------------------------------------------------------------
{-# LANGUAGE GADTs      #-}

module System.Hardware.KansasAmber.Protocol(packageCommand, packageProcedure, unpackageResponse, parseQueryResult) where

import Data.Bits            (xor)
import Data.Word (Word8)

import qualified Data.ByteString as B

import System.Hardware.KansasAmber.Data
import System.Hardware.KansasAmber.Utils

-- | Maximum size of a firmata message
maxFirmwareSize :: Int
maxFirmwareSize = 128

buildCommand :: FirmwareCmd -> [Word8] -> B.ByteString
buildCommand cmd bs = B.pack $ firmwareCmdVal cmd : bs

-- | Package a request as a sequence of bytes to be sent to the board
-- using the Firmata protocol.
packageCommand :: ArduinoConnection -> Command -> IO B.ByteString
packageCommand c SystemReset = 
    return $ buildCommand BC_CMD_SYSTEM_RESET []
packageCommand c (SetPinMode p m) = do
    return $ buildCommand BC_CMD_SET_PIN_MODE [p, fromIntegral $ fromEnum m]
packageCommand c (DigitalWrite p b)  = do
    return $ buildCommand DIG_CMD_WRITE_PIN [p, if b then 1 else 0]
packageCommand c (AnalogWrite p w) = do
    return $ buildCommand ALG_CMD_WRITE_PIN (p : (word16ToBytes w))
packageCommand c (I2CWrite sa w8s) = 
    return $ buildCommand I2C_CMD_WRITE (sa : w8s)
packageCommand c (DeleteTask tid) = 
    return $ buildCommand SCHED_CMD_DELETE_TASK [tid]
packageCommand c (DelayMillis ms) = 
    return $ buildCommand BC_CMD_DELAY_MILLIS (word32ToBytes ms)
packageCommand c (DelayMicros ms) = 
    return $ buildCommand BC_CMD_DELAY_MICROS (word32ToBytes ms)
packageCommand c (ScheduleTask tid tt)    = 
    return $ buildCommand SCHED_CMD_SCHED_TASK (tid : word32ToBytes tt)
packageCommand c (CreateTask tid m)       = do
    td <- packageTaskData c m
    let taskSize = fromIntegral (B.length td)
    return $ buildCommand SCHED_CMD_CREATE_TASK (tid : (word16ToBytes taskSize))
                                    `B.append` (genAddToTaskCmds td)
  where
    maxCmdSize = maxFirmwareSize - 3
    genAddToTaskCmds tds | fromIntegral (B.length tds) > maxCmdSize = 
        addToTask (B.take maxCmdSize tds) 
            `B.append` (genAddToTaskCmds (B.drop maxCmdSize tds))
    genAddToTaskCmds tds = addToTask tds
    addToTask tds' = buildCommand SCHED_CMD_ADD_TO_TASK ([tid, fromIntegral $ B.length tds'] ++ (B.unpack tds'))
{- 
packageCommand c (StepperConfig dev TwoWire d sr p1 p2 _ _) = do
    ipin1 <-  getInternalPin c p1 
    ipin2 <-  getInternalPin c p2
    let pn1 = fromIntegral $ pinNo ipin1
        pn2 = fromIntegral $ pinNo ipin2
    return $ sysEx STEPPER_DATA ([stepperCmdVal CONFIG_STEPPER,dev,((stepDelayVal d) .|. 0x02)] ++ (word16ToArduinoBytes sr) ++ [pn1,pn2])
packageCommand c (StepperConfig dev FourWire d sr p1 p2 (Just p3) (Just p4)) = do 
    ipin1 <-  getInternalPin c p1 
    ipin2 <-  getInternalPin c p2
    ipin3 <-  getInternalPin c p3 
    ipin4 <-  getInternalPin c p4
    let pn1 = fromIntegral $ pinNo ipin1
        pn2 = fromIntegral $ pinNo ipin2
        pn3 = fromIntegral $ pinNo ipin3
        pn4 = fromIntegral $ pinNo ipin4
    return $ sysEx STEPPER_DATA ([stepperCmdVal CONFIG_STEPPER,dev,((stepDelayVal d) .|. 0x04)] ++ (word16ToArduinoBytes sr) ++ [pn1,pn2,pn3,pn4])
packageCommand c (StepperConfig _ FourWire _ _ _ _ _ _) = 
    runDie c "KansasAmber: FourWire steppers require specification of 4 pins for config"  []
packageCommand c (StepperConfig dev StepDir d sr dp sp _ _) = do
    dipin <-  getInternalPin c dp 
    sipin <-  getInternalPin c sp
    let pnd = fromIntegral $ pinNo dipin
        pns = fromIntegral $ pinNo sipin
    return $ sysEx STEPPER_DATA ([stepperCmdVal CONFIG_STEPPER,dev,((stepDelayVal d) .|. 0x01)] ++ (word16ToArduinoBytes sr) ++ [pnd,pns])
packageCommand c (StepperStep dev sd ns sp (Just ac)) =
    return $ sysEx STEPPER_DATA ([stepperCmdVal STEP_STEPPER,dev,(stepDirVal sd)] ++ (word32To3ArduinoBytes ns) ++ (word16ToArduinoBytes sp) ++ (intTo4ArduinoBytes ac))
packageCommand c (StepperStep dev sd ns sp Nothing) =
    return $ sysEx STEPPER_DATA ([stepperCmdVal STEP_STEPPER,dev,(stepDirVal sd)] ++ (word32To3ArduinoBytes ns) ++ (word16ToArduinoBytes sp))
packageCommand c (ServoConfig p min max)  = do
    ipin <- getInternalPin c p
    return $ sysEx SERVO_CONFIG ([fromIntegral $ pinNo ipin] ++ (word16ToArduinoBytes min) ++ (word16ToArduinoBytes max))
-}

packageTaskData :: ArduinoConnection -> Arduino a -> IO B.ByteString
packageTaskData conn commands =
      packageTaskData' conn commands B.empty
  where
      packBind :: ArduinoConnection -> Arduino a -> (a -> Arduino b) -> IO B.ByteString -> IO B.ByteString
      packBind c (Return a)      k cmds = do
          cs <- cmds
          packageTaskData' c (k a) cs
      packBind c (Bind m k1)    k2 cmds = packBind c m (\ r -> Bind (k1 r) k2) cmds
      packBind c (Command cmd) k cmds = do
          packCmd <- packageCommand c cmd
          cs <- cmds
          packageTaskData' c (k ()) (B.append cs (lenPackage packCmd))
      packBind c (Local local) k cmds = packLocal c local k cmds
      packBind c (Procedure procedure) k cmds = packProcedure c procedure k cmds

      -- For sending as part of a Scheduler task, locals make no sense.  
      -- Instead of signalling an error, at this point they are just ignored.
      packLocal :: ArduinoConnection -> Local a -> (a -> Arduino b) -> IO B.ByteString -> IO B.ByteString
      packLocal c (Debug _) k cmds = do
          cs <- cmds 
          packageTaskData' c (k ()) cs
      packLocal c (Die _ _) k cmds = do
          cs <- cmds 
          packageTaskData' c (k ()) cs

      packProcedure :: ArduinoConnection -> Procedure a -> (a -> Arduino b) -> IO B.ByteString -> IO B.ByteString
      packProcedure c QueryFirmware k cmds = do 
          cs <- cmds           
          packageTaskData' c (k (0,0)) cs
      packProcedure c QueryProcessor k cmds = do 
          cs <- cmds           
          packageTaskData' c (k ATMEGA8) cs
      packProcedure c (DigitalRead _) k cmds = do 
          cs <- cmds           
          packageTaskData' c (k False) cs
      packProcedure c (AnalogRead _) k cmds = do 
          cs <- cmds           
          packageTaskData' c (k 0) cs
--      packProcedure c (Pulse _ _ _ _) k cmds = do
--          cs <- cmds 
--          packageTaskData' c (k 0) cs
      packProcedure c QueryAllTasks k cmds = do
          cs <- cmds
          packageTaskData' c (k ([])) cs
      packProcedure c (QueryTask _) k cmds = do
          cs <- cmds
          packageTaskData' c (k Nothing) cs

      packageTaskData' :: ArduinoConnection -> Arduino a -> B.ByteString -> IO B.ByteString
      packageTaskData' c (Bind m k) cmds = packBind c m k (return cmds)
      packageTaskData' c (Return a) cmds = return cmds
      packageTaskData' c cmd        cmds = packBind c cmd Return (return cmds)

      lenPackage :: B.ByteString -> B.ByteString
      lenPackage package = B.cons (fromIntegral $ B.length package) package      

packageProcedure :: Procedure a -> B.ByteString
packageProcedure QueryFirmware       = 
    buildCommand BS_CMD_REQUEST_VERSION []
packageProcedure QueryProcessor      = 
    buildCommand BS_CMD_REQUEST_TYPE []
packageProcedure (DigitalRead p)     = 
    buildCommand DIG_CMD_READ_PIN [p]
packageProcedure (AnalogRead p)      = 
    buildCommand ALG_CMD_READ_PIN [p]
packageProcedure (I2CRead sa Nothing cnt)    = 
    buildCommand I2C_CMD_READ [sa,cnt]
packageProcedure (I2CRead sa (Just sr) cnt) = 
    buildCommand I2C_CMD_READ_REG ((sa : (word16ToBytes sr)) ++ [cnt])
packageProcedure QueryAllTasks       = 
    buildCommand SCHED_CMD_QUERY_ALL []
packageProcedure (QueryTask tid)     = 
    buildCommand SCHED_CMD_QUERY [tid]
-- packageProcedure (Pulse p b dur to)       = sysEx    PULSE                   ([fromIntegral (pinNo p), if b then 1 else 0] ++ concatMap toArduinoBytes (word32ToBytes dur ++ word32ToBytes to))

-- | Unpackage a SysEx response
unpackageResponse :: [Word8] -> Response
{'fraction_non_alphanumeric': 0.10382284102502551, 'fraction_numerical': 0.01344295745063914, 'mean_word_length': 2.658397365532382, 'pattern_counts': {'":': 0, '<': 49, '<?xml version=': 0, '>': 62, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 2, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5987002', 'n_tokens_mistral': 5535, 'n_tokens_neox': 5227, 'n_words': 1663}