[Haskell-cafe] Advice needed on how to improve some code
Tom Ellis
tom-lists-haskell-cafe-2013 at jaguarpaw.co.uk
Thu Apr 16 08:33:05 UTC 2015
Oh sorry, I now see you were talking (at least) about other uses of >>=
where do notation would be very helpful.
On Thu, Apr 16, 2015 at 09:22:34AM +0100, Tom Ellis wrote:
> I rather like the >>= invocations. `do` notation would require naming
> intermediate variables.
>
> On Wed, Apr 15, 2015 at 11:19:30PM -0400, 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.
> > >
> > > 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
> > >
> > >
> > >
> > >
> > > _______________________________________________
> > > Haskell-Cafe mailing list
> > > Haskell-Cafe at haskell.org
> > > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe
> > >
>
> > _______________________________________________
> > Haskell-Cafe mailing list
> > Haskell-Cafe at haskell.org
> > http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe
>
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe
More information about the Haskell-Cafe
mailing list