Parameterized exception type [duplicate] - f#

How can I define an exception like the following?
exception CustomExn<'TMessage> of 'TMessage list

Maybe you can just inherit from System.Exception?
type CustomExn<'TMessage> (message:'TMessage list) =
inherit System.Exception ()
let test =
try
raise (CustomExn["string"] )
with
| :? CustomExn<string> -> "CustomExn of string"
| :? CustomExn<int> -> "CustomExn of int"
| _ -> "Everything else"

Not sure it is possible with F# Exception Definitions according to specs (page 164-165)
This one also NOT A GOOD SOLUTION because try with will only catch ExceptionList<string> in this case so there is no good way to make it generic
type ExceptionList<'a>(msgList: 'a list) =
inherit Exception()
member __.MessageList = msgList
let mock() =
raise <| ExceptionList(["failed"])
try
mock() //raises ExceptionList<string>
with
//this catch block won't fire, because it is not generic, it is ExceptionList<obj>
| :? ExceptionList<_> as exnList ->
exnList.MessageList
|> List.iter (printfn "%A")
The better way though: Result<'a,'b list>:
let mock'() =
if DateTime.Now.Ticks % 2L = 0L
then Ok()
else Error(["failed"])
let result = mock'()
match result with
| Ok _ -> printfn "Ok!"
| Error (msgList) ->
msgList
|> List.iter (printfn "%A")
Added There is a workaround with type loss:
type ExceptionList(msgList: obj list) =
inherit Exception()
member __.MessageList = msgList
// Here is F# exception definition
exception CustomException of ExceptionList
let failwithMany msgs =
raise <| CustomException (ExceptionList(msgs))
let mock() =
//zero type checking here
failwithMany[1;2;"a";[];"failed"]
try
mock()
with
// exnList is list of objects
| CustomException exnList ->
exnList.MessageList
|> List.iter (printfn "%A")

Related

How to use bind and map in place of nested matches

F# 6.0.3
I have seen some solutions on Google that are close to what I need; but being a Newbie I can't quite get how to use bind and map to get the solution.
I have many working procedures of the following format:
Example #1:
let saveAllDiagnosis =
let savealldiagnosis = match m.Encounter with
| None -> failwith "No encounter found"
| Some e -> match e.EncounterId with
| None -> failwith "No Encounter id found"
| Some id -> m.AllDiagnosisList
|> List.iter ( fun dx -> match dx.Key with
| None -> ()
| Some k -> Async.RunSynchronously (editAllDiagnosisInPreviousEncountersAsync id dx))
savealldiagnosis
Example #2
let saveEncounterDiagnosis =
let savedx = match m.Encounter with
| None -> failwith "No encounter found"
| Some e -> match e.EncounterId with
| None -> failwith "No Encounter id found"
| Some id -> m.BillingDiagnosisList |> List.iter ( fun dx -> Async.RunSynchronously (saveDxAsync id dx))
savedx
As can be seen, these are nested methods with almost identical behavior--differing only in the async procedure being called and the initializing list. What I would like to do is something along the lines of:
let runProcedures (fn: Model->Async) Model = ????
That is, a single procedue that encapsulates everything except the Async method and it's parameters but manages all the "None"s in a better way.
I hope my intent is clear.
TIA
If you are happy with using exceptions, then you do not even need railway-oriented programming (ROP). ROP is useful for more complex validation tasks, but I think exceptions are often perfectly reasonable and easy way of handling errors. In your case, you could define a helper that extracts a value of option<'T> or fails with a given error message:
let orFailWith msg opt =
match opt with
| Some v -> v
| None -> failwithf "%s" msg
Using this, you can then rewrite your code as follows:
let saveAllDiagnosis =
let e = m.Encounter |> orFailWith "No encounter found"
let id = e.EncounterId |> orFailWith "No Encounter id found"
for dx in m.AllDiagnosisList do
dx.Key |> Option.iter (fun k ->
editAllDiagnosisInPreviousEncountersAsync id dx |> Async.RunSynchronously)
let saveEncounterDiagnosis =
let e = m.Encounter |> orFailWith "No encounter found"
let id = e.EncounterId |> orFailWith "No Encounter id found"
for dx in m.BillingDiagnosisList do
saveDxAsync id dx |> Async.RunSynchronously
As I do not know the broader context of this, it is hard to say more - your code is imperative, but that may be perfectly fine if you are following the sandwich pattern.
Using mentioned ROP code can be rewritten as such. Result is used to track error and throw it at the end of pipeline. With current design is possible to avoid exceptions by just logging error instead of throwing at before last line.
type Encounter = { EncounterId : int option }
type Diagnostic = { Key : int option }
type Thing = {
Encounter : Encounter option
AllDiagnosisList : Diagnostic list
}
let editAllDiagnosisInPreviousEncountersAsync id diag = async { return () }
module Result =
let ofOption err opt =
match opt with
| Some v -> Ok v
| None -> Error err
let join res =
match res with
| Error v
| Ok v -> v
let saveAllDiagnosis m =
m.Encounter
|> Result.ofOption "No encounter found" // get value from option or log error
|> Result.map (fun e -> e.EncounterId)
|> Result.bind (Result.ofOption "No Encounter id found") // get EncounterId or log error
|> Result.map (fun id -> (
m.AllDiagnosisList
|> Seq.where (fun dx -> dx.Key.IsSome)
|> Seq.iter (fun dx -> Async.RunSynchronously (editAllDiagnosisInPreviousEncountersAsync id dx))
))
|> Result.mapError failwith // throw error
|> Result.join // Convert Result<unit, unit> into unit
The solutions posted above are very helpful to this newbie. But adding my own two cents worth, I going with this:
let _deleteDxFromEncounterAsync (encounterId:int) (dx:Diagnosis) : Async<unit> = deleteDxFromEncounterAsync encounterId dx.Description
let _deleteDxFromAllPreviousEncountersAsync (encounterId:int) (dx:Diagnosis) : Async<unit> = deleteDxFromAllPreviousEncountersAsync encounterId dx.Description
let _saveDxAsync (encounterId:int) (dx:Diagnosis) : Async<unit> = saveDxAsync encounterId dx
let _editAllDiagnosisInPreviousEncountersAsync (encounterId:int) (dx:Diagnosis) : Async<unit> = editAllDiagnosisInPreviousEncountersAsync encounterId dx
let listchk (dxs:Diagnosis list) : Diagnosis list option =
match dxs with
| [] -> None
| _ -> Some dxs
let _save (fn:int -> Diagnosis-> Async<unit>) (dxs:Diagnosis list) : unit =
match dxs |> listchk, m.Encounter |> Option.bind (fun v -> v.EncounterId) with
| Some dxs, Some id -> dxs |> List.iter (fun dx -> Async.RunSynchronously(fn id dx))
| _,_ -> failwith "Missing Encounter or EncounterId or Empty List"
m.DeletedBillingDiagnosis |>_save _deleteDxFromEncounterAsync
m.DeletedAllDiagnosis |>_save _deleteDxFromAllPreviousEncountersAsync
m.BillingDiagnosisList |>_save _saveDxAsync
m.AllDiagnosisList |> List.filter (fun dx -> dx.Key.IsSome) |>_save _editAllDiagnosisInPreviousEncountersAsync
For speed, in the future, I will probably have the Async functions act on the entire list at one time rather then one item; but for now, this code comes closest to my intent in asking the question. IMPROVEMENTS AND CRITISM IS GLADDLY APPRECIATED! F# is fun!
Thanks to all.

F# Compiler Service: get a list of names visible in the scope

How can I get get a list of names visible in the scope with FSC?
I tried this:
#r "../../packages/FSharp.Compiler.Service.16.0.2/lib/net45/FSharp.Compiler.Service.dll"
open Microsoft.FSharp.Compiler
open Microsoft.FSharp.Compiler.SourceCodeServices
do
let file = "TestFileName.fsx"
let checker = SourceCodeServices.FSharpChecker.Create()
let code =
"""
let testStr = "x"
t
"""
async{
let! options, _ = checker.GetProjectOptionsFromScript(file,code)
let! parseRes,checkAnser = checker.ParseAndCheckFileInProject(file, 0, code, options)
match checkAnser with
| FSharpCheckFileAnswer.Succeeded checkRes ->
let! decls =
checkRes.GetDeclarationListInfo(
Some parseRes, //ParsedFileResultsOpt
3 , //line
1 , //colAtEndOfPartialName
"t" , //lineText
[ "t" ] , //qualifyingNames
"" , //partialName
( fun _ -> [] ) //getAllSymbols: (unit -> AssemblySymbol list)
)
if Seq.isEmpty decls.Items then
printfn "*no declarations found*"
else
decls.Items
|> Seq.sortBy (fun d -> d.Name)
|> Seq.truncate 10
|> Seq.iter (fun d -> printfn "decl: %s" d.Name)
| _ -> failwithf "*Parsing did not finish... "
} |> Async.RunSynchronously
but it only prints "no declarations found". I would expect not only testStr but also all the other names that are available by default.
I did not find an example in the documentation.
qualifyingNames should be an empty list, it’s for dot separated prefix, excluding the last (possibly partial) ident. However, there is no a method in FCS that returns unfiltered list of names for scope, yet it’s really easy to add one.
With the answer of vasily-kirichenko and using the current FCS 17.0.1 I came up with this solution:
#r "../../packages/FSharp.Compiler.Service.17.0.1/lib/net45/FSharp.Compiler.Service.dll"
open Microsoft.FSharp.Compiler
open Microsoft.FSharp.Compiler.SourceCodeServices
do
let file = "TestFileName.fsx"
let checker = SourceCodeServices.FSharpChecker.Create()
let code =
"""
let testStr = "x"
testStr.
"""
async{
let! options, _ = checker.GetProjectOptionsFromScript(file,code)
let! parseRes,checkAnser = checker.ParseAndCheckFileInProject(file, 0, code, options)
match checkAnser with
| FSharpCheckFileAnswer.Succeeded checkRes ->
let! decls =
let partialName = PartialLongName.Empty 6 //use any location before before the dot to get all declarations in scope
//let partialName = PartialLongName.Empty 7 //use the loacation of the dot (7) to get memebers of string
checkRes.GetDeclarationListInfo(
Some parseRes, // ParsedFileResultsOpt
3 , // line
"testStr." , // lineText
partialName, // PartialLongName
( fun _ -> [] ) // getAllSymbols: (unit -> AssemblySymbol list)
)
if Seq.isEmpty decls.Items then
printfn "*no declarations found*"
else
decls.Items
|> Seq.sortBy (fun d -> d.Name)
|> Seq.truncate 10
|> Seq.iter (fun d -> printfn "decl: %s" d.Name)
| _ -> failwithf "*Parsing did not finish... "
} |> Async.RunSynchronously

how can I parameterize a F# class

The class below is a wrapper around an async MailboxProcessor that exposes
a few operations to C# assemblies. However, I don't want just a few
Map<string,int>
instances, I need several different Map<'K,'V> instances where 'K and 'V vary.
I hope I don't need a functor for that (it probably doesn't exist in F#).
module Flib.AsyncEvents
open System.Collections.Generic
type KVcoll = Map<string,int>
type Msg = Request of string * int option | Fetch of AsyncReplyChannel<KVcoll> | Clear
#nowarn "40"
type myAgent () = class
let dictAgent = MailboxProcessor.Start(fun inbox->
let dict = ref Map.empty
let rec loop = async {
let! msg = inbox.Receive()
match msg with
| Request (key, Some value) -> dict := Map.add key value !dict
| Request (key, None) -> dict := Map.remove key !dict
| Fetch(reply) -> reply.Reply(!dict)
| Clear -> dict := Map.empty
return! loop
}
loop)
member this.add(key, value) = dictAgent.Post (Request (key, Some value))
member this.del(key) = dictAgent.Post (Request(key, None))
member this.fetch() = dictAgent.PostAndReply((fun reply -> Fetch(reply)), timeout = 9000)
member this.lookup(key) = try 0, Map.find key (this.fetch()) // success
with | :? KeyNotFoundException -> -1, 0 // failure
member this.size() = this.fetch().Count
member this.clear() = dictAgent.Post (Clear)
member this.print() =
this.fetch() |> Map.iter (fun k v -> printfn "%s => %d" k v)
printfn "done"
end
By the way, this is prototype quality code, clearly not as good as it can be.
I'm not sure I understand the question fully, but if you want to create a type that can be used with different types of values, you can define the class as generic:
type Msg<'K, 'V when 'K : comparison> =
| Request of 'K * 'V option
| Fetch of AsyncReplyChannel<Map<'K, 'V>>
| Clear
type MyAgent<'K, 'V when 'K : comparison> () = class
let dictAgent = MailboxProcessor.Start(fun inbox->
let dict : Map<'K, 'V> ref = ref Map.empty
let rec loop = async {
// (same as before)
}
loop)
To make this work, you'll need to avoid code that restricts the type of keys and values to a particular type. In you case lookup was returning 0 as the default value and print was expecting strings. So you can replace those with something like:
member this.lookup(key) = Map.tryFind key (this.fetch())
member this.print() =
this.fetch() |> Map.iter (fun k v -> printfn "%A => %A" k v)
printfn "done"

FsUnit assert exception message

How to assert on exception message in FsUnit? Something like this from NUnit:
[<Test>]
let ShouldThrowExceptionAndLog() =
Assert.That
((fun () -> Calculator.Calculate "-1"),
Throws.Exception.With.Property("Message").EqualTo("Negatives not allowed: -1"))
EDIT: I don't care about the exception itself, I'd like to test the exception MESSAGE.
AFAIK there is no out-of-the-box matcher to do what you want, but it's easy enough to create one yourself:
open NHamcrest
let throwAnyWithMessage m =
CustomMatcher<obj>(m,
fun f -> match f with
| :? (unit -> unit) as testFunc ->
try
testFunc()
false
with
| ex -> ex.Message = m
| _ -> false )
usage:
(fun () -> raise <| Exception("Foo") |> ignore) |> should throwAnyWithMessage "Foo" // pass
(fun () -> raise <| Exception("Bar") |> ignore) |> should throwAnyWithMessage "Foo" // fail

F#: Downcast seq to IEnumerator

Why is it that in F#, I can do this...
let s = seq { for i in 0 .. 4095 do yield i } :?> IEnumerator
... but this throws a System.InvalidCastException?
let s = Seq.init 4095 (fun i -> i) :?> IEnumerator
A sequence expression creates an object that implements IEnumerable<T> and IEnumerator<T>
let s = seq { for i in 0 .. 4095 do yield i }
printfn "%b" (s :? IEnumerable<int>) // true
printfn "%b" (s :? IEnumerator<int>) // true
But Seq.init does not:
let s = Seq.init 4095 (fun i -> i)
printfn "%b" (s :? IEnumerable<int>) // true
printfn "%b" (s :? IEnumerator<int>) // false
You could refactor your code to use IEnumerable<T> instead of IEnumerator since both constructs produce an IEnumerable<T>.
Alternatively, if you really want an IEnumerator, you could simply call GetEnumerator to return an Enumerator from an Enumerable:
let s = (Seq.init 4095 (fun i -> i)).GetEnumerator()
printfn "%b" (s :? IEnumerable<int>) // false
printfn "%b" (s :? IEnumerator<int>) // true
If you look at the specification, you sequence expression is converted to:
Seq.collect (fun pat -> Seq.singleton(pat)) (0 .. 4095)
if you look at the source for the definition of Seq.collect it is:
let collect f sources = map f sources |> concat
and if you look at the definition for concat it is:
let concat sources =
checkNonNull "sources" sources
mkConcatSeq sources
mkConcatSeq is defined as:
let mkConcatSeq (sources: seq<'U :> seq<'T>>) =
mkSeq (fun () -> new ConcatEnumerator<_,_>(sources) :> IEnumerator<'T>)
so you can see that the returned sequence implements IEnumerator<'T> and therefore IEnumerator.
Now Seq.init is defined as:
let init count f =
if count < 0 then invalidArg "count" (SR.GetString(SR.inputMustBeNonNegative))
mkSeq (fun () -> IEnumerator.upto (Some (count-1)) f)
and mkSeq is defined as:
let mkSeq f =
{ new IEnumerable<'U> with
member x.GetEnumerator() = f()
interface IEnumerable with
member x.GetEnumerator() = (f() :> IEnumerator) }
so it only implements IEnumerable<'T> and not IEnumerator.

Resources