a bit of work on variable length encoding

* adding expecto (+fscheck, not used yet)
* expose a `runParser` function
* add a (failing) test for `getVarlen` (sample values taken from https://www.csie.ntu.edu.tw/~r92092/ref/midi/ "Variable Length Quantities")

Author: smoothdeveloper

paket.dependencies

@@ -1,3 +1,4 @@
 source https://www.nuget.org/api/v2
 
-nuget System.Memory
+nuget System.Memory
+nuget Expecto.FsCheck

paket.lock

@@ -30,17 +30,48 @@ module ParserMonad =
     type State = 
         { Position: Pos 
           RunningStatus: VoiceEvent
+          LastParse : obj
         }
-    
-    type ParseError = ParseError of position: Pos * message: ErrMsg
+        static member initial = { Position = 0; RunningStatus = VoiceEvent.StatusOff; LastParse = null }
+    type ParseError = 
+      ParseError of 
+        position: Pos 
+        * message: ErrMsg 
+        #if DEBUG
+        * lastToken : obj // need top level type, picking System.Object for now
+        #endif
+
+    let inline mkOtherParseError st (genMessage : Pos -> string) =
+      ParseError(
+        st.Position
+        , Other (genMessage st.Position)
+        #if DEBUG
+        , st.LastParse
+        #endif
+      )
+
+    let inline mkParseError st (errMsg: ErrMsg) =
+      ParseError(
+        st.Position
+        , errMsg
+        #if DEBUG
+        , st.LastParse
+        #endif
+      )
 
     type ParserMonad<'a> = 
         ParserMonad of (MidiData -> State -> Result<'a * State, ParseError> )
 
     let inline private apply1 (parser : ParserMonad<'a>) 
                        (midiData : byte[])
                        (state : State)  :  Result<'a * State, ParseError> = 
-        let (ParserMonad fn) = parser in fn midiData state
+        let (ParserMonad fn) = parser 
+        let result = fn midiData state
+        match result with
+        | Ok (r, state) ->
+          let state = { state with LastParse = r }
+          Ok (r, state)
+        | Error e -> Error e
 
     let inline mreturn (x:'a) : ParserMonad<'a> = 
         ParserMonad <| fun _ st -> Ok (x, st)
@@ -53,7 +84,7 @@ module ParserMonad =
             | Ok (ans, st1) -> apply1 (next ans) input st1
 
     let mzero () : ParserMonad<'a> = 
-        ParserMonad <| fun _ state -> Error (ParseError(state.Position, EOF "mzero"))
+        ParserMonad <| fun _ state -> Error (mkParseError state (EOF "mzero"))
 
     let inline mplus (parser1 : ParserMonad<'a>) (parser2 : ParserMonad<'a>) : ParserMonad<'a> = 
         ParserMonad <| fun input state -> 
@@ -92,26 +123,28 @@ module ParserMonad =
 
     let (parseMidi:ParserBuilder) = new ParserBuilder()
 
+    let runParser (ma:ParserMonad<'a>) input initialState =
+      apply1 ma input initialState
+      |> Result.map fst
+
     /// Run the parser on a file.
     let runParseMidi (ma : ParserMonad<'a>) (inputPath : string) : Result<'a, ParseError> = 
-        let input = File.ReadAllBytes inputPath
-        match apply1 ma input { Position = 0; RunningStatus = StatusOff} with
-        | Ok (ans, _) -> Ok ans
-        | Error msg -> Error msg
+        runParser ma (File.ReadAllBytes inputPath) State.initial
+
 
     /// Throw a parse error
     let parseError (genMessage : Pos -> string) : ParserMonad<'a> = 
-        ParserMonad <| fun _ st -> Error (ParseError(st.Position, Other (genMessage st.Position)))
+        ParserMonad <| fun _ st -> Error (mkOtherParseError st genMessage)
 
     /// Run the parser, if it fails swap the error message.
     let ( <??> ) (parser : ParserMonad<'a>) (genMessage : Pos -> string) : ParserMonad<'a> = 
         ParserMonad <| fun input st -> 
             match apply1 parser input st with
             | Ok result -> Ok result
-            | Error _ -> Error (ParseError(st.Position, Other (genMessage st.Position)))
+            | Error _ -> Error(mkOtherParseError st genMessage)
 
     let fatalError err =
-      ParserMonad <| fun _ st -> Error (ParseError(st.Position, err))
+      ParserMonad <| fun _ st -> Error (mkParseError st err)
 
     let getRunningEvent : ParserMonad<VoiceEvent> = 
         ParserMonad <| fun _ st -> Ok (st.RunningStatus , st)
@@ -134,9 +167,9 @@ module ParserMonad =
                 try 
                   match input,state with
                   | PositionValid -> f input state
-                  | PositionInvalid -> Error (ParseError(state.Position, EOF name))
+                  | PositionInvalid -> Error (mkParseError state (EOF name))
                 with
-                | e -> Error (ParseError(state.Position, (Other (sprintf "%A" e))))
+                | e -> Error (mkParseError state (Other (sprintf "%A" e)))
             )
 
     let peek : ParserMonad<byte> =

src/ZMidi/Internal/ParserMonad.fs

@@ -7,7 +7,7 @@ module ReadFile =
     //let midiFile : Parser = ()
     open ZMidi.Internal.ParserMonad
     open ZMidi.Internal.Utils
-    
+    open ZMidi.Internal.ExtraTypes
 
     /// Apply parse then apply the check, if the check fails report
     /// the error message. 
@@ -27,7 +27,10 @@ module ReadFile =
     let inline clearBit (bit: int) (i: ^T) =
       let mask = ~~~ (LanguagePrimitives.GenericOne <<< bit)
       i &&& mask
-
+    let inline msbHigh i =
+      match i with
+      | TestBit 7 -> true
+      | _ -> false
     let assertString (s: string) =
       postCheck (readString s.Length) ((=) s) (Other (sprintf "assertString: expected '%s'" s))
 
@@ -36,10 +39,24 @@ module ReadFile =
 
     let assertWord8 i =
       postCheck readByte ((=) i) (Other (sprintf "assertWord8: expected '%i'" i))
-
+    
     let getVarlen : ParserMonad<word32> =
       parseMidi {
-        failwith "getVarlen: not imple"
+        let! a = readByte
+        if msbHigh a then
+          let! b = readByte
+          if msbHigh b then
+            let! c = readByte
+            if msbHigh c then
+              let! d = readByte
+              return fromVarlen (V4(a,b,c,d))
+            else
+              return fromVarlen (V3(a,b,c))
+          else
+            return fromVarlen (V2(a, b))
+        else
+          return fromVarlen (V1 a)
+
       }
 
     let getVarlenText = gencount getVarlen readChar (fun _ b -> System.String b)

src/ZMidi/Read.fs

@@ -8,6 +8,7 @@
   </ItemGroup>
   <ItemGroup>
     <Compile Include="DataTypes.fs" />
+    <Compile Include="ExtraTypes.fs" />
     <Compile Include="Internal\Utils.fs" />
     <Compile Include="Internal\ParserMonad.fs" />
     <Compile Include="Read.fs" />

src/ZMidi/zmidi-fs-core.fsproj

@@ -0,0 +1,52 @@
+module ZMidi.Tests
+open Expecto
+open ZMidi.Internal.ParserMonad
+open ZMidi.ReadFile
+
+let tests =
+  test "parseVarlen" {
+      let cases = 
+        [|
+          {| input = [| 0x00uy |]; expected = 0u |}
+          {| input = [| 0x7fuy |]; expected = 127u |}
+          {| input = [| 0x80uy |]; expected = 128u |}
+          {| input = [| 0x03uy; 0xe8uy |]; expected = 1000u |}
+          {| input = [| 0x3fuy; 0xffuy |]; expected = 16383u |}
+          {| input = [| 0x0fuy; 0x42uy; 0x40uy |]; expected = 100000u |}
+        |]
+
+      let state = State.initial
+
+      let failures =
+        [|
+          for case in cases do
+        
+          let result = runParser getVarlen case.input state
+          if result <> (Ok (case.expected)) then
+            yield case, result
+        |]
+
+      if failures.Length > 0 then
+        let message = 
+          sprintf "%i failure(s):%s" 
+            failures.Length
+            (
+              System.Environment.NewLine
+              + (failures 
+                    |> Array.map 
+                        (fun (e, result) ->
+                          sprintf "exptected: %0x for %s, got %A" 
+                            e.expected
+                            (e.input |> Array.map (sprintf "%0x") |> String.concat " ")
+                            result
+                        ) |> String.concat System.Environment.NewLine
+              
+                    )
+                  )
+        failwithf "%s" message
+  }
+
+
+[<EntryPoint>]
+let main args =
+  runTestsWithArgs defaultConfig args tests

test/tests/Tests.fs

@@ -0,0 +1 @@
+Expecto.FsCheck

test/tests/paket.references

@@ -0,0 +1,15 @@
+<?xml version="1.0" encoding="utf-8"?>
+<Project Sdk="Microsoft.NET.Sdk">
+  <PropertyGroup>
+    <TargetFrameworks>netcoreapp2.0;net462</TargetFrameworks>
+    <OutputPath>..\..\build\$(Configuration)\$(Platform)</OutputPath>
+    <OutputType>Exe</OutputType>
+  </PropertyGroup>
+  <ItemGroup>
+    <Compile Include="Tests.fs" />
+  </ItemGroup>
+  <ItemGroup>
+    <ProjectReference Include="..\..\src\ZMidi\zmidi-fs-core.fsproj" />
+  </ItemGroup>
+  <Import Project="..\..\.paket\Paket.Restore.targets" />
+</Project>

test/tests/tests.fsproj

@@ -5,6 +5,8 @@ VisualStudioVersion = 16.0.29001.49
 MinimumVisualStudioVersion = 10.0.40219.1
 Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "zmidi-fs-core", "src\ZMidi\zmidi-fs-core.fsproj", "{18EE5ED6-5B88-423F-8066-93F875E8480B}"
 EndProject
+Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "tests", "test\tests\tests.fsproj", "{B7EFA64D-6859-41B2-8259-7F63F477E6C8}"
+EndProject
 Global
 	GlobalSection(SolutionConfigurationPlatforms) = preSolution
 		Debug|Any CPU = Debug|Any CPU
@@ -15,6 +17,10 @@ Global
 		{18EE5ED6-5B88-423F-8066-93F875E8480B}.Debug|Any CPU.Build.0 = Debug|Any CPU
 		{18EE5ED6-5B88-423F-8066-93F875E8480B}.Release|Any CPU.ActiveCfg = Release|Any CPU
 		{18EE5ED6-5B88-423F-8066-93F875E8480B}.Release|Any CPU.Build.0 = Release|Any CPU
+		{B7EFA64D-6859-41B2-8259-7F63F477E6C8}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
+		{B7EFA64D-6859-41B2-8259-7F63F477E6C8}.Debug|Any CPU.Build.0 = Debug|Any CPU
+		{B7EFA64D-6859-41B2-8259-7F63F477E6C8}.Release|Any CPU.ActiveCfg = Release|Any CPU
+		{B7EFA64D-6859-41B2-8259-7F63F477E6C8}.Release|Any CPU.Build.0 = Release|Any CPU
 	EndGlobalSection
 	GlobalSection(SolutionProperties) = preSolution
 		HideSolutionNode = FALSE