[Haskell-cafe] How to avoid floods of fromIntegral (in ALSA.Sequencer)

Niklas Hambüchen mail at nh2.me
Sun Nov 3 14:35:01 UTC 2013


It depends a bit:

What is supposed to happen / what happens in your library when one of
the numbers is larger than a Word8?

That usually determines where / how the conversion fits in nicely.

For example, if you already know that all the values in DtzEvent can
only be Word8s, then they should probably already be Word8s and not Int.

On 03/11/13 13:46, martin wrote:
> Hello all,
> 
> in my recent attempts to work with ALSA.Sequencer, I frequently stumble across the problem that this library uses
> GHC.Word.Word8 (don't know where this comes from), but I am passing in plain Ints. Adding a fromIntegral solves this
> issue, but I end up with code like the following:
> 
> type T = Int -- time
> type C = Int -- channel
> type N = Int -- note
> type V = Int -- velocity
> type L = Int -- LSB
> type M = Int -- MSB
> type P = Int -- program
> type X = Int -- something
> 
> data DtzEvent = NoteOn C N V
>           | NoteOff C N V
>           | ProgChange C P
>           | PitchBend C X
>           | BankSelMsb C X
>           | BankSelLsb C X
> ...
> 
> playSong :: DtzEvents -> IO()
> playSong events = runContT (foo "128:0" 120 (map render events)) print
>          where
>              render (t,(NoteOn c n v)) = ((fromIntegral t), noteOn (fromIntegral c) (fromIntegral n) (fromIntegral v))
>              render (t,(NoteOff c n v)) = ((fromIntegral t), noteOff (fromIntegral c) (fromIntegral n) (fromIntegral v))
>              render (t,(ProgChange c p)) = ((fromIntegral t), progChange (fromIntegral c) (fromIntegral p))
>              render (t,(PitchBend c x)) = ((fromIntegral t), pitchBend (fromIntegral c) (fromIntegral x))
>              render (t,(BankSelMsb c x)) = ((fromIntegral t), bankSelMsb (fromIntegral c) (fromIntegral x))
>              render (t,(BankSelLsb c x)) = ((fromIntegral t), bankSelLsb (fromIntegral c) (fromIntegral x))
> 
> The last piece looks pretty ugly. Is there a way to avoid this?
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
> 


More information about the Haskell-Cafe mailing list