Skip to content

Use ReaderT from F#+ #6

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Draft
wants to merge 2 commits into
base: master
Choose a base branch
from
Draft
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension


Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
42 changes: 10 additions & 32 deletions src/ZMidi/Internal/ParserMonad.fs
Original file line number Diff line number Diff line change
Expand Up @@ -4,7 +4,8 @@ namespace ZMidi.Internal
module ParserMonad =

open System.IO

open FSharpPlus
open FSharpPlus.Data
open ZMidi.Internal.Utils

/// Status is either OFF or the previous VoiceEvent * Channel.
Expand Down Expand Up @@ -85,8 +86,7 @@ module ParserMonad =
#endif
)

type ParserMonad<'a> =
ParserMonad of (MidiData -> State -> Result<'a * State, ParseError> )
type ParserMonad<'a> = ReaderT<MidiData,StateT<State,Result<'a * State, ParseError>>>

let nullOut = new StreamWriter(Stream.Null) :> TextWriter
let mutable debug = false
Expand All @@ -100,7 +100,7 @@ module ParserMonad =
let inline private apply1 (parser : ParserMonad<'a>)
(midiData : byte[])
(state : State) : Result<'a * State, ParseError> =
let (ParserMonad fn) = parser
let fn = ReaderT.run parser >> StateT.run
try
let result = fn midiData state
let oldState = state
Expand Down Expand Up @@ -129,8 +129,9 @@ module ParserMonad =
)
)

let ParserMonad f = ReaderT (fun r -> StateT (fun s -> f r s))
let inline mreturn (x:'a) : ParserMonad<'a> =
ParserMonad <| fun _ st -> Ok (x, st)
ReaderT <| fun _ -> StateT (fun st -> Ok (x, st))

let inline private bindM (parser : ParserMonad<'a>)
(next : 'a -> ParserMonad<'b>) : ParserMonad<'b> =
Expand All @@ -156,31 +157,8 @@ module ParserMonad =

let (>>=) (m: ParserMonad<'a>) (k: 'a -> ParserMonad<'b>) : ParserMonad<'b> =
bindM m k

type ParserBuilder() =
member inline self.ReturnFrom (ma:ParserMonad<'a>) : ParserMonad<'a> = ma
member inline self.Return x = mreturn x
member inline self.Bind (p,f) = bindM p f
member inline self.Zero a = ParserMonad (fun input state -> Ok(a, state))
//member self.Combine (ma, mb) = ma >>= mb

// inspired from http://www.fssnip.net/7UJ/title/ResultBuilder-Computational-Expression
// probably broken
member inline self.TryFinally(m, compensation) =
try self.ReturnFrom(m)
finally compensation()

//member self.Delay(f: unit -> ParserMonad<'a>) : ParserMonad<'a> = f ()
//member self.Using(res:#System.IDisposable, body) =
// self.TryFinally(body res, fun () -> if not (isNull res) then res.Dispose())
//member self.While(guard, f) =
// if not (guard()) then self.Zero () else
// do f() |> ignore
// self.While(guard, f)
//member self.For(sequence:seq<_>, body) =
// self.Using(sequence.GetEnumerator(), fun enum -> self.While(enum.MoveNext, fun () -> self.Delay(fun () -> body enum.Current)))

let (parseMidi:ParserBuilder) = new ParserBuilder()

let parseMidi = monad

let runParser (ma:ParserMonad<'a>) input initialState =
apply1 ma input initialState
Expand Down Expand Up @@ -385,7 +363,7 @@ module ParserMonad =
<??> sprintf "word14be: failed at %i"

/// Parse a word32 (big endian).
let readUInt32be =
let readUInt32be : ParserMonad<_> =
parseMidi {
let! a = readByte
let! b = readByte
Expand All @@ -395,7 +373,7 @@ module ParserMonad =
}

/// Parse a word24 (big endian).
let readWord24be =
let readWord24be : ParserMonad<_> =
parseMidi {
let! a = readByte
let! b = readByte
Expand Down
2 changes: 1 addition & 1 deletion src/ZMidi/Read.fs
Original file line number Diff line number Diff line change
Expand Up @@ -186,7 +186,7 @@ module ReadFile =
|> function | Some i -> true
| None -> false

let rec sysExContPackets =
let rec sysExContPackets : ParserMonad<_> =
parseMidi {
let! d = deltaTime
let! b = getVarlenBytes
Expand Down
4 changes: 4 additions & 0 deletions src/ZMidi/zmidi-fs-core.fsproj
Original file line number Diff line number Diff line change
Expand Up @@ -21,4 +21,8 @@
<Compile Include="Write.fs" />
</ItemGroup>

<ItemGroup>
<PackageReference Include="FSharpPlus" Version="1.1.0-RC2" />
</ItemGroup>

</Project>