Skip to content

Instantly share code, notes, and snippets.

@kspeakman
Last active September 8, 2022 19:19
Show Gist options
  • Save kspeakman/58b137777a7fe98542ec46864d985e83 to your computer and use it in GitHub Desktop.
Save kspeakman/58b137777a7fe98542ec46864d985e83 to your computer and use it in GitHub Desktop.
Event parser
namespace Utilities
type EventType = string
type EventData = string
type EventParser<'union, 'meta> =
{
Deserializers : Map<EventType, EventData option -> Result<'union, exn>>
Serialize : 'union -> Result<EventType * EventData option, exn>
ParseMeta : string -> Result<'meta, exn>
}
type ParseConfig =
{
ParseObj: System.Type -> string -> obj
Serialize: obj -> string
}
module EventParser =
open Microsoft.FSharp.Reflection
module Internal =
let serializeCustomEx serialize (value: 'union) =
let case, fieldValues = FSharpValue.GetUnionFields(value, typeof<'union>)
let jsonOpt =
Array.tryHead fieldValues
|> Option.map serialize
(case.Name, jsonOpt)
let createParserCustom<'t> (parseObj: System.Type -> string -> obj) =
let deserializeEx (value: string) : 't =
parseObj typeof<'t> value
:?> 't
Result.liftEx id deserializeEx
let createEventParserCustom<'union> parseObj (case: UnionCaseInfo) =
let fieldOpt = Array.tryHead (case.GetFields())
let deserializeEx =
match fieldOpt with
| None ->
let deserialize (_: string option) =
FSharpValue.MakeUnion(case, Array.empty)
:?> 'union
deserialize
| Some field ->
let deserialize (json: string option) =
parseObj field.PropertyType json.Value
|> fun o -> FSharpValue.MakeUnion(case, Array.singleton o)
:?> 'union
deserialize
Result.liftEx id deserializeEx
/// Merge deserializers for old events into the current event parser.
/// The resulting parser will deserialize both current and old events,
/// but old events will be translated to a current event using the upgrade function.
///
/// NOTE: Old and current type names should not overlap.
let mergeDeserializers (old: EventParser<'old, 'meta>) (upgrade: 'old -> 'event) (parser: EventParser<'event, 'meta>) =
let update newMap oldType oldDeserialize =
let deserialize s =
oldDeserialize s
|> Result.map upgrade
Map.add oldType deserialize newMap
let deserializers = Map.fold update parser.Deserializers old.Deserializers
{ parser with
Deserializers = deserializers
}
let deserialize (parser: EventParser<'event, 'meta>) sType sEventOpt =
match Map.tryFind sType parser.Deserializers with
| None -> None
| Some deserialize ->
Some (deserialize sEventOpt)
/// Creates a Map of parsers for each union case.
/// The Map key is the union case name.
let createCustom<'union, 'meta> cfg : EventParser<'union, 'meta> =
let parserMap =
FSharpType.GetUnionCases(typeof<'union>)
|> Array.map (fun case -> case.Name, Internal.createEventParserCustom<'union> cfg.ParseObj case)
|> Map.ofArray
{
Deserializers = parserMap
Serialize = Result.liftEx id (Internal.serializeCustomEx cfg.Serialize)
ParseMeta = Internal.createParserCustom<'meta> cfg.ParseObj
}
namespace Utilities
module Result =
/// change a function to return a Result when it may throw an exception
let liftEx fEx f x =
try
Ok (f x)
with ex ->
Error (fEx ex)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment