[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