Reactogon/Translator/SortMessage.hs

   1 {-# LANGUAGE Arrows #-}
   2
   3 -- The idea is that the stream of data coming from the MIDI input port
   4 -- will be sorted in three categories: note on events, controller
   5 -- events and other events. The latter will be transmitted as is
   6 -- through the whole systems.
   7
   8 module Reactogon.Translator.SortMessage where
   9
  10 import qualified Data.Bifunctor               as BF
  11 import           Data.Maybe
  12 import           FRP.Yampa
  13 import           Reactogon.Semantics
  14 import           Reactogon.Translator.Message
  15
  16 -- TEMPORARY
  17 data Controller = Lol
  18 --
  19
  20 sortRawMessages :: [RawMessage] -> ([Message], [RawMessage])
  21 sortRawMessages = sortRawMessages' ([],[])
  22   where sortRawMessages' r [] = r
  23         sortRawMessages' (m, rm) (x:xs)
  24           | isNothing nm = sortRawMessages' (m, x:rm) xs
  25           | otherwise = sortRawMessages' ((fromJust nm) :m, rm) xs
  26           where nm = fromRawMessage x
  27
  28 -- NoteOn messages are on the right, other Control messages are on the
  29 -- left. For now we throw away NoteOff messages.
  30 sortNotes :: [Message] -> ([Message], [Message])
  31 sortNotes = sortNotes' ([],[])
  32   where sortNotes' r [] = r
  33         sortNotes' (n, c) (x:xs)
  34           | isNoteOn x = sortNotes' (x:n, c) xs
  35           | isNoteOff x = sortNotes' (n,c) xs
  36           | isControl x = sortNotes' (n,x:c) xs
  37           | otherwise = sortNotes' (n,c) xs
  38 {-
  39 sortMessages :: [RawMessage] -> ([Note], [Control], [RawMessage])
  40 sortMessages = (\((a,b),c) -> (a,b,c)) . BF.first sortNotes . sortRawMessages
  41 -}
  42
  43 -- Note messages are converted to PlayHeads
  44 sortMessages :: SF ([Message], [Message]) ([Note], [Controller])
  45 sortMessages = proc (notes, ctrl) -> do
  46   notes' <- arr $ map convertNotes   -< notes
  47   ctrl'  <- arr $ map convertControl -< ctrl
  48   returnA -< (notes', ctrl')
  49
  50 -- /!\ Unsafe function that shouldn't be exported.
  51 convertNotes :: Message -> Note
  52 convertNotes = undefined
  53
  54 -- /!\ Unsafe function that shouldn't be exported.
  55 convertControl :: Message -> Controller
  56 convertControl _ = Lol
  57
  58 gatherMessages :: ([Note], [Controller], [RawMessage]) -> [Message]
  59 gatherMessages ([], [], []) = []
  60 gatherMessages _ = undefined
  61
  62 readMessages :: SF ([RawMessage]) ([Note], [Controller], [RawMessage])
  63 readMessages = undefined