Purescript 0.15.4

Tidy up the parser a little.  The only change is now a depedency on
bifunctors.

CHANGELOG.md

@@ -1,6 +1,10 @@
 # Changelog
 
-### Version 4.0,0 (2022-04-06)
+### Version 4.0.1 (pending)
+* PS Compiler 0.15.4
+* add dependency on bifunctors
+
+### Version 4.0.0 (2022-04-06)
 
 * PS Compiler 0.15.0
 * (replace test-unit with spec)

bower.json

@@ -18,6 +18,7 @@
   },
   "dependencies": {
     "purescript-prelude": "^6.0.0",
+    "purescript-bifunctors": "^6.0.0",
     "purescript-lists": "^7.0.0",
     "purescript-string-parsers": "^8.0.0",
     "purescript-integers": "^6.0.0",

package.json

@@ -8,7 +8,7 @@
   },
   "devDependencies": {
     "pulp": "^16.0.0",
-    "purescript": "^0.15.0",
+    "purescript": "^0.15.4",
     "purescript-psa": "^0.6.0",
     "spago": "^0.20.9"
   }

packages.dhall

@@ -105,7 +105,7 @@ in  upstream
 -------------------------------
 -}
 let upstream =
-      https://github.com/purescript/package-sets/releases/download/psc-0.15.0-20220502/packages.dhall
-        sha256:38d347aeba9fe6359c208abe87a5cecf1ffb14294f11ad19664ae35c59b6e29a
+      https://github.com/purescript/package-sets/releases/download/psc-0.15.4-20220901/packages.dhall
+        sha256:f1531b29c21ac437ffe5666c1b6cc76f0a9c29d3c9d107ff047aa2567744994f
 
 in  upstream

spago.dhall

@@ -5,6 +5,7 @@ You can edit this file as you like.
 { name = "midi"
 , dependencies =
   [ "arrays"
+  , "bifunctors"
   , "control"
   , "effect"
   , "either"

src/Data/Midi/Parser.purs

@@ -10,8 +10,9 @@ import Data.Midi
 
 import Control.Alt ((<|>))
 import Data.Array (cons, fromFoldable) as Array
+import Data.Bifunctor (lmap)
 import Data.Char (fromCharCode, toCharCode)
-import Data.Either (Either(..))
+import Data.Either (Either)
 import Data.Foldable (foldl)
 import Data.Int (pow)
 import Data.Int.Bits (and, shl)
@@ -368,6 +369,15 @@ timeSignature :: Parser Event
 timeSignature =
   bchar 0x58 *> bchar 0x04 *> (buildTimeSig <$> int8 <*> int8 <*> int8 <*> int8) <?> "time signature"
 
+  where
+  buildTimeSig :: Int -> Int -> Int -> Int -> Event
+  buildTimeSig nn dd cc bb =
+    let
+      denom =
+        2 `pow` dd
+    in
+      TimeSignature nn denom cc bb
+
 keySignature :: Parser Event
 keySignature =
   bchar 0x59 *> bchar 0x02 *> (KeySignature <$> signedInt8 <*> int8)
@@ -388,6 +398,13 @@ streamSysEx =
   buildStreamSysEx <$> bchar 0xF0  <*>
     (many1Till notSysExEnd (char $ unsafeFromCharCode sysExTerminator))
 
+  where
+  -- build a SysEx message for a stream-based SysEx event
+  -- this simply means appending the terminating 0xF7 to the data bytes
+  buildStreamSysEx :: Int -> Nel.NonEmptyList Char -> Event
+  buildStreamSysEx sysExType bytes =
+    buildSysEx sysExType (bytes <> (Nel.singleton $ unsafeFromCharCode sysExTerminator))
+
 {- parse an unspecified meta event
 
    The possible range for an event type is 00-7F. Not all values in this range are
@@ -418,30 +435,76 @@ noteOn :: Parser Event
 noteOn =
   buildNote <$> brange 0x90 0x9F <*> int8 <*> int8 <?> "note on"
 
+  where
+  -- build NoteOn (unless the velocity is zero in which case NoteOff)
+  buildNote :: Int -> Int -> Int -> Event
+  buildNote cmd note velocity =
+    let
+      channel =
+        and cmd 0x0F
+    in
+      case (velocity == 0) of
+        true ->
+          NoteOff channel note velocity
+
+        _ ->
+          NoteOn channel note velocity
+
+
 noteOff :: Parser Event
 noteOff =
   buildNoteOff <$> brange 0x80 0x8F <*> int8 <*> int8 <?> "note off"
 
+  where
+  buildNoteOff :: Int -> Int -> Int -> Event
+  buildNoteOff cmd note velocity =
+    channelBuilder3 NoteOff cmd note velocity
+
 noteAfterTouch :: Parser Event
 noteAfterTouch =
   buildNoteAfterTouch <$> brange 0xA0 0xAF <*> int8 <*> int8 <?> "note after touch"
 
+  where
+  buildNoteAfterTouch :: Int -> Int -> Int -> Event
+  buildNoteAfterTouch cmd note pressure =
+    channelBuilder3 NoteAfterTouch cmd note pressure
+
 controlChange :: Parser Event
 controlChange =
   buildControlChange <$> brange 0xB0 0xBF <*> int8 <*> int8 <?> "control change"
 
+  where 
+  buildControlChange :: Int -> Int -> Int -> Event
+  buildControlChange cmd num value =
+    channelBuilder3 ControlChange cmd num value
+
 programChange :: Parser Event
 programChange =
   buildProgramChange <$> brange 0xC0 0xCF <*> int8 <?> "program change"
 
+  where 
+  buildProgramChange :: Int -> Int -> Event
+  buildProgramChange cmd num =
+    channelBuilder2 ProgramChange cmd num
+
 channelAfterTouch :: Parser Event
 channelAfterTouch =
   buildChannelAfterTouch <$> brange 0xD0 0xDF <*> int8 <?> "channel after touch"
 
+  where 
+  buildChannelAfterTouch :: Int -> Int -> Event
+  buildChannelAfterTouch cmd num =
+    channelBuilder2 ChannelAfterTouch cmd num
+
 pitchBend :: Parser Event
 pitchBend =
   buildPitchBend <$> brange 0xE0 0xEF <*> int8 <*> int8 <?> "pitch bend"
 
+  where
+  buildPitchBend :: Int -> Int -> Int -> Event
+  buildPitchBend cmd lsb msb =
+    channelBuilder2 PitchBend cmd $ lsb + (shl msb 7)
+
 -- running status is somewhat anomalous.  It inherits the 'type' of the last event parsed,
 -- (here called the parent) which must be a channel event.
 -- We now macro-expand the running status message to be the type (and use the channel status)
@@ -495,23 +558,6 @@ buildRecording :: Header -> List Track -> Recording
 buildRecording h ts =
   Recording { header: h, tracks : ts }
 
--- build NoteOn (unless the velocity is zero in which case NoteOff)
-buildNote :: Int -> Int -> Int -> Event
-buildNote cmd note velocity =
-  let
-    channel =
-      and cmd 0x0F
-
-    isOff =
-      (velocity == 0)
-  in
-    case isOff of
-      true ->
-        NoteOff channel note velocity
-
-      _ ->
-        NoteOn channel note velocity
-
 -- abstract builders that construct MidiEvents that all have the same shape
 channelBuilder3 :: (Int -> Int -> Int -> Event) -> Int -> Int -> Int -> Event
 channelBuilder3 construct cmd x y =
@@ -529,52 +575,6 @@ channelBuilder2 construct cmd x =
   in
     construct channel x
 
--- build NoteOff
-buildNoteOff :: Int -> Int -> Int -> Event
-buildNoteOff cmd note velocity =
-  channelBuilder3 NoteOff cmd note velocity
-
--- build Note AfterTouch AKA Polyphonic Key Pressure
-buildNoteAfterTouch :: Int -> Int -> Int -> Event
-buildNoteAfterTouch cmd note pressure =
-  channelBuilder3 NoteAfterTouch cmd note pressure
-
--- build Control Change
-buildControlChange :: Int -> Int -> Int -> Event
-buildControlChange cmd num value =
-  channelBuilder3 ControlChange cmd num value
-
--- build Program Change
-buildProgramChange :: Int -> Int -> Event
-buildProgramChange cmd num =
-  channelBuilder2 ProgramChange cmd num
-
--- build Channel AfterTouch AKA Channel Key Pressure
-buildChannelAfterTouch :: Int -> Int -> Event
-buildChannelAfterTouch cmd num =
-  channelBuilder2 ChannelAfterTouch cmd num
-
--- build Pitch Bend
-buildPitchBend :: Int -> Int -> Int -> Event
-buildPitchBend cmd lsb msb =
-  channelBuilder2 PitchBend cmd $ lsb + (shl msb 7)
-
--- build a Time Signature
-buildTimeSig :: Int -> Int -> Int -> Int -> Event
-buildTimeSig nn dd cc bb =
-  let
-    denom =
-      2 `pow` dd
-  in
-    TimeSignature nn denom cc bb
-
--- build a SysEx message for a stream-based SysEx event
--- this simply means appending the terminating 0xF7 to the data bytes
-buildStreamSysEx :: Int -> Nel.NonEmptyList Char -> Event
-buildStreamSysEx sysExType bytes =
-  buildSysEx sysExType (bytes <> (Nel.singleton $ unsafeFromCharCode sysExTerminator))
-  --  buildSysEx sysExType (bytes <> (unsafeFromCharCode sysExTerminator : Nil))
-
 buildSysEx :: Int -> Nel.NonEmptyList Char -> Event
 buildSysEx sysExType bytes =
   let
@@ -599,7 +599,6 @@ consumeOverspill actual expected =
                     count (cnt - expected) int8
         )
 
-
 -- utils
 catChars :: List Char -> String
 catChars =
@@ -609,29 +608,17 @@ unsafeFromCharCode :: Int -> Char
 unsafeFromCharCode i =
   fromMaybe 'a' $ fromCharCode i
 
-
 -- exported functions
 
 -- | Parse a MIDI event that emanates from a Web MIDI connection to the browser.
 parseMidiEvent :: String -> Either String Event
 parseMidiEvent s =
-  case runParser midiStreamEvent s of
-  --  case runParser (midiEvent Nothing) s of
-    Right n ->
-      Right n
-
-    Left e ->
-      Left $ show e
+  lmap show $ runParser midiStreamEvent s
 
 -- | Parse a normalised MIDI string.
 parse :: String -> Either String Recording
 parse s =
-  case runParser midi s of
-    Right n ->
-      Right n
-
-    Left e ->
-      Left $ show e
+  lmap show $ runParser midi s
 
 -- | Normalise the input. The un-normalised input can by obtained (for example)
 -- | by using readAsBinaryString or else by using XMLHttpRequest and then  making
@@ -649,9 +636,4 @@ normalise =
 -- | Parse a MIDI message.  Probably only useful for debug purposes.
 parseMidiMessage :: String -> Either String Message
 parseMidiMessage s =
-  case runParser (midiMessage Nothing) s of
-    Right n ->
-      Right n
-
-    Left e ->
-      Left $ show e
+  lmap show $ runParser (midiMessage Nothing) s