I'm trying to implement diagnostics computation expression to log activities and and events using System.Diagnostics.DiagnosticSource NuGet.
But I can't figure out how my computation expression can execute regular statements between calls to custom operations.
This is my current implementation with a sample of how I want ot use it.
Ath the end it must wrap whole expression into try-finally and stop the activity using last context.
open System.Diagnostics
[<Struct>]
type DiagnosticsState = {
Activity : Activity voption
Context : obj
}
with
member this.StartActivity (source : DiagnosticSource) activityName =
if ValueOption.isSome this.Activity
then invalidOp "Use yield to stop previous activity"
let activity =
if source.IsEnabled (activityName) then
let activity = Activity (activityName)
let eventName = activityName + ".Event"
if source.IsEnabled (eventName)
then source.StartActivity (activity, this.Context)
else activity.Start()
|> ValueSome
else ValueNone
let state = this
{ state with Activity = activity; Context = Unchecked.defaultof<_> }
member this.StopActivity (source : DiagnosticSource) =
match this.Activity with
| ValueSome activity ->
source.StopActivity (activity, this.Context)
| ValueNone -> ()
type DiagnosticsBuilder (sourceName) =
let source = new DiagnosticListener (sourceName) :> DiagnosticSource
//member __.Zero () =
// { Activity = ValueNone; Context = ValueNone }
member __.Yield (_) =
{ Activity = ValueNone; Context = ValueNone }
//member __.Combine (state1 : DiagnosticsState, state2 : DiagnosticsState) =
// state1.StopActivity source
// state2
//member __.Delay (f) = f()
member __.For (state, action : _ -> DiagnosticsState) =
action state
[<CustomOperation("activity")>]
member __.Activity (state : DiagnosticsState, activityName) =
state.StartActivity source activityName
[<CustomOperation("context")>]
member __.Context<'Context> (state : DiagnosticsState, context : 'Context) =
{ state with Context = context :> obj }
[<CustomOperation("event")>]
member __.Event (state : DiagnosticsState, eventName) =
if source.IsEnabled (eventName) then
source.Write(eventName, state.Context)
state
member __.Run (state : DiagnosticsState) = state.StopActivity source
let diagnostics = DiagnosticsBuilder "libid";;
diagnostics {
context "5"
printf "fdf"
activity "ace"
context 5
}
Related
Can someone tell me how I can update a subitem in a nested record?
I want to set isSelected to true for the Item with value = "B"
type MyItem = {isSelected:bool; value:string}
type MyModel = {list:MyItem list}
let a = {isSelected = false; value = "A"}
let b = {isSelected = false; value = "B"}
let c = {isSelected = false; value = "C"}
let m = {list = [a;b;c]}
let m2 = { m with list = { m.list with ??? = { ??? }}}
I will not use mutable data structures.
Immutability is great but when dealing with nested immutable structures it can get a bit hairy. Especially if it's deeply nested.
One way to deal with this is so called Lenses.
So I increased the nesting level of the example a bit so that the value of lenses are more visible.
module Lenses =
// This lens is a pair of function, a getter that get's inner value of an object
// and a setter that sets the inner value of an object
// The cool thing is that a lens is composable meaning we can create a lens
// that allows us to get and set a deeply nested property succinctly
type Lens<'O, 'I> = L of ('O -> 'I)*('I -> 'O -> 'O)
let lens (g : 'O -> 'I) (s : 'I -> 'O -> 'O) = L (g, s)
// Gets an inner value
let get (L (g, _)) o = g o
// Sets an inner value
let set (L (_, s)) i o = s i o
// Updates an inner value given an updater function that sees the
// inner value and returns a new value
let over (L (g, s)) u o = s (u (g o)) o
// Compose two lenses into one, allows for navigation into deeply nested structures
let compose (L (og, os)) (L (ig, is)) =
let g o = ig (og o)
let s i o = os (is i (og o)) o
L (g, s)
type Lens<'O, 'I> with
static member (-->) (o, i) = compose o i
open Lenses
// I made the model a bit more complex to show benefit of lenses
type MySelection =
{
isSelected: bool
}
// Define a lens that updates the property, this code can potentially be generated
// Scala does this with macros, in F# there are other possibilities
static member isSelectedL : Lens<MySelection, bool> = lens (fun o -> o.isSelected) (fun i o -> { o with isSelected = i })
type MyValue =
{
value: string
}
static member valueL : Lens<MyValue, string> = lens (fun o -> o.value) (fun i o -> { o with value = i })
type MyItem =
{
selection : MySelection
value : MyValue
}
static member selectionL : Lens<MyItem, MySelection> = lens (fun o -> o.selection) (fun i o -> { o with selection = i })
static member valueL : Lens<MyItem, MyValue> = lens (fun o -> o.value ) (fun i o -> { o with value = i })
type MyModel =
{
list: MyItem list
}
static member listL : Lens<MyModel, MyItem list> = lens (fun o -> o.list) (fun i o -> { o with list = i })
[<EntryPoint>]
let main argv =
// Define example model
let a = {selection = {isSelected = false}; value = {value = "A"}}
let b = {selection = {isSelected = false}; value = {value = "B"}}
let c = {selection = {isSelected = false}; value = {value = "C"}}
let m = {list = [a;b;c]}
// Print it
printfn "%A" m
// Update the model
let m2 =
let mapper (v : MyItem) =
// Grabs the nest value using lens composition
let nestedValue = v |> get (MyItem.valueL --> MyValue.valueL)
let isSelected = nestedValue = "B"
// Set the nested isSelected using lens composition
v |> set (MyItem.selectionL --> MySelection.isSelectedL) isSelected
// Maps nested list property
m |> over MyModel.listL (List.map mapper)
printfn "%A" m2
0
Use List.map:
let m2 =
{ m with list =
List.map (fun item ->
if item.value = "B" then
{ item with isSelected = true }
else
item)
m.list
}
This will create a new list where every item is the same as before, except the one we want to "update" because we replace that with a new item where isSelected is true.
I am trying to understand the way fable is supposed to work with parent child composition. Things are quite easy when it comes to update method, init, and the definition of commands. But the view method and its dispatch method are tricky to find out
In my code, the child is:
module DeploymentView
type DeploymentTypeView =
| DeployContainerView
type Model = {
CurrentView : DeploymentTypeView option
}
type Msg =
| ShowDeployContainer
let init () : Model =
let initialModel = {
CurrentView = None
}
initialModel
let update (msg : Msg) (currentModel : Model) : Model * Cmd<Msg> =
match msg with
| ShowDeployContainer ->
let nextModel = {
currentModel with CurrentView = Some DeployContainerView
}
nextModel, Cmd.none
| _ -> currentModel, Cmd.none
let view (model : Model) (dispatch : Msg -> unit) =
[
Content.content [ Content.Modifiers [ Modifier.TextAlignment (Screen.All, TextAlignment.Left) ] ]
[
Heading.h3 [] [ str ("Deployments: ") ]
]
Columns.columns []
[
Column.column [] [ button "deploy container" (fun _ -> dispatch ShowDeployContainer) ]
]
]
And following this documentation about parent child processing I have define a parent like this one:
module Client
type PortalView =
| DeploymentView of DeploymentView.Model
| ProductAdministrationView
type Model = {
CurrentPortal : PortalView option
}
// The Msg type defines what events/actions can occur while the application is running
// the state of the application changes *only* in reaction to these events
type Msg =
| ShowDeployment
| ShowAdministration
| DeployContainerView of DeploymentView.Msg
// defines the initial state and initial command (= side-effect) of the application
let init () : Model * Cmd<Msg> =
let initialModel = {
CurrentPortal = None
}
initialModel, Cmd.none
let update (msg : Msg) (currentModel : Model) : Model * Cmd<Msg> =
match msg with
| ShowDeployment ->
let nextModel = {
currentModel with CurrentPortal = Some <| DeploymentView(DeploymentView.init())
}
nextModel, Cmd.none
| ShowAdministration ->
let nextModel = {
currentModel with CurrentPortal = Some ProductAdministrationView
}
nextModel, Cmd.none
| DeployContainerView msg' ->
let res, cmd =
match currentModel.CurrentPortal with
| Some(DeploymentView(m)) -> DeploymentView.update msg' m
| _ -> DeploymentView.init(), Cmd.none
{ currentModel with CurrentPortal = Some(DeploymentView(res)) }, Cmd.map DeployContainerView cmd
So far so good, my issue comes when it goes to the rendering of the view itself.
The client view uses a function as follows:
let view (model : Model) (dispatch : Msg -> unit)
where Msg is of type DeploymentView.Msg whereas in the parent view I have access to a dispatch of type Client.Msg -> unit. how can I decompose the parent dispatch to map it to the child dispatch signature?
You can very easily create a dispatch function that conforms to what the child expects by using the >> operator:
DeploymentView.view deploymentViewModel (DeployContainerView >> dispatch)
which is equivalent to doing:
DeploymentView.view deploymentViewModel (fun msg -> msg |> DeployContainerView |> dispatch)
That is, it wraps the child's message in DeployContainerView, then passes that to dispatch.
On another note, it is a common and good convention to use a Msg suffix on constructors used to wrap child msg types. You may want to consider renaming DeployContainerView to DeploymentContainerMsg.
I am not sure about "exclusive state management" thing in the title, I did my best making it up trying to put the problem concisely.
I am porting some of my C# code to F# trying to do it as idiomatic as I can. I have an entity that requests a number of ID's from a sequence in my database and then dispenses these ID to anyone in need. Once an id is given out it should no longer be available for anybody else. Hence there must be some sort of state associated with that entity that keeps track of the remaining number of IDs. Since using a mutable state is not idiomatic, what I can do is to write something like this:
let createIdManager =
let idToStartWith = 127
let allowed = 10
let givenOut = 0
(idToStartWith, allowed, givenOut)
-
let getNextAvailableId (idToStartWith, allowed, givenOut) =
if givenOut< allowed
then ((idToStartWith, allowed, givenOut+ 1), Some(idToStartWith + givenOut))
else ((idToStartWith, allowed, givenOut), None)
let (idManager, idOpt) = getNextAvailableId createIdManager()
match idOpt with
| Some(id) -> printf "Yay!"
| None -> reloadIdManager idManager |> getNextAvailableId
This approach is idiomatic (as far as I can tell) but extremely vulnerable. There are so many ways to get it messed up. My biggest concern is that once an id is advanced and a newer copy of id manager is made, there is no force that can stop you from using the older copy and get the same id again.
So how do I do exclusive state management, per se, in F#?
If you only need to initialize the set of ids once then you can simply hide a mutable reference to a list inside a local function scope, as in:
let nextId =
let idsRef = ref <| loadIdsFromDatabase()
fun () ->
match idsRef.Value with
| [] ->
None
| id::ids ->
idsRef := ids
Some id
let id1 = nextId ()
let id2 = nextId ()
You could use a state-monad(Computational Expression).
First we declare the state-monad
type State<'s,'a> = State of ('s -> 'a * 's)
type StateBuilder<'s>() =
member x.Return v : State<'s,_> = State(fun s -> v,s)
member x.Bind(State v, f) : State<'s,_> =
State(fun s ->
let (a,s) = v s
let (State v') = f a
v' s)
let withState<'s> = StateBuilder<'s>()
let runState (State f) init = f init
Then we define your 'IdManager' and a function to get the next available id as well as the new state after the execution of the function.
type IdManager = {
IdToStartWith : int
Allowed : int
GivenOut : int
}
let getNextId state =
if state.Allowed > state.GivenOut then
Some (state.IdToStartWith + state.GivenOut), { state with GivenOut = state.GivenOut + 1 }
else
None, state
Finally we define our logic that requests the ids and execute the state-monad.
let idStateProcess =
withState {
let! id1 = State(getNextId)
printfn "Got id %A" id1
let! id2 = State(getNextId)
printfn "Got id %A" id2
//...
return ()
}
let initState = { IdToStartWith = 127; Allowed = 10; GivenOut = 0 }
let (_, postState) =
runState
idStateProcess
initState //This should be loaded from database in your case
Output:
Got id Some 127
Got id Some 128
Having trouble with this code:
let subscribe (nm : NamespaceManager) (subName : string) (desc : TopicDescription) : Async<SubscriptionDescription> =
let rec first_create () =
async {
let! exists = desc |> exists nm
if exists then return! (then_create_subscription () : Async<SubscriptionDescription>)
try
let beginCreate = nm.BeginCreateTopic : string * AsyncCallback * obj -> IAsyncResult
logger.DebugFormat("creating topic '{0}'", desc)
let! tdesc = Async.FromBeginEnd(desc.Path, beginCreate, nm.EndCreateTopic)
return! first_create ()
with | :? MessagingEntityAlreadyExistsException -> return! then_create_subscription () }
and then_create_subscription () : Async<SubscriptionDescription> =
async {
let beginCreate = nm.BeginCreateSubscription : string * string * AsyncCallback * obj -> IAsyncResult
return! Async.FromBeginEnd(desc.Path, subName, beginCreate, nm.EndCreateSubscription) }
first_create ()
On line 5, it underlines then_create_subscription () : Async<SubscriptionDescription> stating:
Type mismatch. Expecting a Async<unit> but given a Async<SubscriptionDescription> The type 'unit' does not match the type 'SubscriptionDescription'
Exists looks like this:
let exists (nm : NamespaceManager ) (desc : PathBasedEntity) =
async { return! Async.FromBeginEnd(desc.Path, nm.BeginTopicExists, nm.EndTopicExists) }
I want it to create the topic and then go on to create the subscription for it.
Any ideas?
There needs to be an else branch after if, otherwise the if is a statement, not an expression. The else is not implicit.
I'm working through the book Land of Lisp in F# (yeah weird, I know). For their first example text adventure, they make use of global variable mutation and I'd like to avoid it. My monad-fu is weak, so right now I'm doing ugly state passing like this:
let pickUp player thing (objects: Map<Location, Thing list>) =
let objs = objects.[player.Location]
let attempt = objs |> List.partition (fun o -> o.Name = thing)
match attempt with
| [], _ -> "You cannot get that.", player, objs
| thing :: _, things ->
let player' = { player with Objects = thing :: player.Objects }
let msg = sprintf "You are now carrying %s %s" thing.Article thing.Name
msg, player', things
let player = { Location = Room; Objects = [] }
let objects =
[Room, [{ Name = "whiskey"; Article = "some" }; { Name = "bucket"; Article = "a" }];
Garden, [{ Name = "chain"; Article = "a length of" }]]
|> Map.ofList
let msg, p', o' = pickUp player "bucket" objects
// etc.
How can I factor out the explicit state to make it prettier? (Assume I have access to a State monad type if it helps; I know there is sample code for it in F# out there.)
If you want to use the state monad to thread the player's inventory and world state through the pickUp function, here's one approach:
type State<'s,'a> = State of ('s -> 'a * 's)
type StateBuilder<'s>() =
member x.Return v : State<'s,_> = State(fun s -> v,s)
member x.Bind(State v, f) : State<'s,_> =
State(fun s ->
let (a,s) = v s
let (State v') = f a
v' s)
let withState<'s> = StateBuilder<'s>()
let getState = State(fun s -> s,s)
let putState v = State(fun _ -> (),v)
let runState (State f) init = f init
type Location = Room | Garden
type Thing = { Name : string; Article : string }
type Player = { Location : Location; Objects : Thing list }
let pickUp thing =
withState {
let! (player, objects:Map<_,_>) = getState
let objs = objects.[player.Location]
let attempt = objs |> List.partition (fun o -> o.Name = thing)
match attempt with
| [], _ ->
return "You cannot get that."
| thing :: _, things ->
let player' = { player with Objects = thing :: player.Objects }
let objects' = objects.Add(player.Location, things)
let msg = sprintf "You are now carrying %s %s" thing.Article thing.Name
do! putState (player', objects')
return msg
}
let player = { Location = Room; Objects = [] }
let objects =
[Room, [{ Name = "whiskey"; Article = "some" }; { Name = "bucket"; Article = "a" }]
Garden, [{ Name = "chain"; Article = "a length of" }]]
|> Map.ofList
let (msg, (player', objects')) =
(player, objects)
|> runState (pickUp "bucket")
If you want to use mutable state in F#, then the best way is just to write a mutable object. You can declare a mutable Player type like this:
type Player(initial:Location, objects:ResizeArray<Thing>) =
let mutable location = initial
member x.AddThing(obj) =
objects.Add(obj)
member x.Location
with get() = location
and set(v) = location <- v
Using monads to hide mutable state isn't as common in F#. Using monads gives you essentially the same imperative programming model. It hides the passing of state, but it doesn't change the programming model - there is some mutable state that makes it impossible to parallelize the program.
If the example uses mutation, then it is probably because it was designed in an imperative way. You can, change the program architecture to make it more functional. For example, instead of picking the item (and modifying the player), the pickUp function could just return some object representing a request to pick the item. The world would then have some engine that evaluates these requests (collected from all players) and calculates the new state of the world.