[Haskell-cafe] Advice needed on how to improve some code

Claude Heiland-Allen claude at mathr.co.uk
Thu Apr 16 04:18:48 UTC 2015


On 16/04/15 04:19, David Feuer wrote:
> I haven't dug into the guts of this *at all*, but why don't you start by
> using `do` notation instead of a million >>= invocations? It also looks
> like you may have some common patterns you can exploit by defining some
> more functions.
>
> On Wed, Apr 15, 2015 at 8:57 PM, Jeff <jeff at datalinktech.com.au> wrote:
>
>> Hello,
>>
>> I am seeking some advice on how I might improve a bit of code.
>> The function in question reads and parses part of a binary protocol,
>> storing the parsed info as it proceeds.
>>
>> parseDeviceData is called by parseDevice (shown further down).
>>
>> It looks to me like there should be a more concise, less repetitive way to
>> do what
>> parseDeviceData does.  Any advice on this would be greatly appreciated.


Lens[0] might help abstract the common pattern of nested record updates.

You should be able to get it into something that looks more like this:

     whenBit flag parser setter pld
       | view dataMask pld `testBit` fromEnum flag = do
          s <- parser
          return $ set setter (Just s) pld
       | otherwise = return pld

     parseDevicePayloadData = foldr (>=>) return
       [ whenBit Sys parseDeviceSysData sysData
       , whenBit GPS parseDeviceGPSData gpsData
       ...
       ]


[0] http://hackage.haskell.org/package/lens


Claude

>>
>>    parseDeviceData :: P.Payload -> Parser P.Payload
>>    parseDeviceData pl =
>>      let
>>        mdm = P.dataMask ( P.payloadData pl )
>>      in
>>        ( let pld = P.payloadData pl in
>>          if testBit mdm ( fromEnum D.Sys )
>>            then
>>              parseDeviceSysData >>=
>>              ( \s -> return ( pl { P.payloadData = pld { P.sysData = Just s
>> } } ) )
>>            else
>>              return pl ) >>=
>>        ( \pl' -> let pld = P.payloadData pl' in
>>                   if testBit mdm ( fromEnum D.GPS )
>>                     then
>>                       parseDeviceGPSData >>=
>>                       ( \s -> return ( pl' { P.payloadData = pld {
>> P.gpsData = Just s } } ) )
>>                     else
>>                       return pl' ) >>=
>>        ( \pl' -> let pld = P.payloadData pl' in
>>                   if testBit mdm ( fromEnum D.GSM )
>>                     then
>>                       parseDeviceGSMData >>=
>>                       ( \s -> return ( pl' { P.payloadData = pld {
>> P.gsmData = Just s } } ) )
>>                     else
>>                       return pl' ) >>=
>>        ( \pl' -> let pld = P.payloadData pl' in
>>                   if testBit mdm ( fromEnum D.COT )
>>                     then
>>                       parseDeviceCOTData >>=
>>                       ( \s -> return ( pl' { P.payloadData = pld {
>> P.cotData = Just s } } ) )
>>                     else
>>                       return pl' ) >>=
>>        ( \pl' -> let pld = P.payloadData pl' in
>>                   if testBit mdm ( fromEnum D.ADC )
>>                     then
>>                       parseDeviceADCData >>=
>>                       ( \s -> return ( pl' { P.payloadData = pld {
>> P.adcData = Just s } } ) )
>>                     else
>>                       return pl' ) >>=
>>        ( \pl' -> let pld = P.payloadData pl' in
>>                   if testBit mdm ( fromEnum D.DTT )
>>                     then
>>                       parseDeviceDTTData >>=
>>                       ( \s -> return ( pl' { P.payloadData = pld {
>> P.dttData = Just s } } ) )
>>                     else
>>                       return pl' ) >>=
>>        ( \pl' -> let pld = P.payloadData pl' in
>>                   if testBit mdm ( fromEnum D.OneWire )
>>                     then
>>                       parseDeviceOneWireData >>=
>>                       ( \s -> return ( pl' { P.payloadData = pld {
>> P.iwdData = Just s } } ) )
>>                     else
>>                       return pl' ) >>=
>>        ( \pl' -> if testBit mdm ( fromEnum D.ETD )
>>                   then
>>                     parseDeviceEventData pl'
>>                   else
>>                     return pl' )
>>
>> The Parser above is a Data.Binary.Strict.Get wrapped in a StateT, where
>> the state is a top-level
>> structure for holding the parsed packet.
>>
>>    parseDevice :: Bool -> Parser ()
>>    parseDevice _hasEvent =
>>      parseTimestamp >>=
>>      ( \ts ->
>>          if _hasEvent
>>            then
>>              lift getWord8 >>=
>>              ( \e -> lift getWord16be >>=
>>                ( \mdm ->
>>                    return ( P.Payload "" ( Just ts ) $
>>                      P.blankDevicePayloadData { P.dataMask = mdm
>>                                               , P.eventID = toEnum (
>> fromIntegral e .&. 0x7f )
>>                                               , P.deviceStatusFlag =
>> testBit e 7
>>                                               , P.hasEvent = True
>>                                               } ) ) )
>>            else
>>              lift getWord16be >>=
>>              ( \mdm ->
>>                  return ( P.Payload "" ( Just ts ) $
>>                    P.blankDevicePayloadData { P.dataMask = mdm } ) )
>>      ) >>=
>>      parseDeviceData >>=
>>      ( \dpl -> get >>= ( \p -> put ( p { P.payloads = dpl : P.payloads p }
>> ) ) )
>>
>>
>> Here are the data types for the Packet and Payload:
>>
>>
>>    data Payload = Payload { imei        :: !BS.ByteString
>>                           , timestamp   :: Maybe Word64
>>                           , payloadData :: PayloadData
>>                           }
>>
>>    data PayloadData = HeartBeatPL
>>                     | SMSFwdPL { smsMesg    :: !BS.ByteString }
>>                     | SerialPL { auxData    :: !Word8
>>                                , fixFlag    :: !Word8
>>                                , gpsCoord   :: !GPSCoord
>>                                , serialData :: !BS.ByteString
>>                                }
>>                     | DevicePL { hasEvent         :: !Bool
>>                                , deviceStatusFlag :: !Bool
>>                                , eventID          :: !E.EventID
>>                                , dataMask         :: !Word16
>>                                , sysData          :: Maybe DS.SysData
>>                                , gpsData          :: Maybe DGP.GPSData
>>                                , gsmData          :: Maybe DGS.GSMData
>>                                , cotData          :: Maybe DC.COTData
>>                                , adcData          :: Maybe DA.ADCData
>>                                , dttData          :: Maybe DD.DTTData
>>                                , iwdData          :: Maybe DO.OneWireData
>>                                , etdSpd           :: Maybe ES.SpeedEvent
>>                                , etdGeo           :: Maybe EG.GeoEvent
>>                                , etdHealth        :: Maybe EH.HealthEvent
>>                                , etdHarsh         :: Maybe EHD.HarshEvent
>>                                , etdOneWire       :: Maybe EO.OneWireEvent
>>                                , etdADC           :: Maybe EA.ADCEvent
>>                                }
>>                                deriving ( Show )
>>
>>    data Packet = Packet { protocolVersion  :: !Word8
>>                         , packetType       :: !PT.PacketType
>>                         , deviceID         :: Maybe BS.ByteString
>>                         , payloads         :: ![ Payload ]
>>                         , crc              :: !Word16
>>                         }
>>                         deriving ( Show )
>>
>> Lastly, here is the Parser monad transformer:
>>
>>    module G6S.Parser where
>>
>>      import Control.Monad.State.Strict
>>      import Data.Binary.Strict.Get
>>      import qualified Data.ByteString as BS
>>
>>      import qualified G6S.Packet as GP
>>
>>      type Parser = StateT GP.Packet Get
>>
>>      runParser :: Parser a -> BS.ByteString -> Maybe a
>>      runParser p bs =
>>        let
>>          ( result, _ ) = runGet ( runStateT p GP.initPacket ) bs
>>        in
>>          case result of
>>            Right tup -> Just $ fst tup
>>            Left _ -> Nothing
>>
>>
>> I hope there is enough info here.
>>
>> Thanks,
>> Jeff

-- 
http://mathr.co.uk



More information about the Haskell-Cafe mailing list