F# exception handling multiple "Tries" - exception

I'm trying to read a bunch of csv files in SQL Server using SQL Bulk Insert and DataContext.ExecuteCommand. (Maybe this isn't the best way to do it, but it does allow me stay in the Type Provider context--as opposed to with SqlBulkCopy I think.) Now the upload is glitchy with intermittent success. Some files read in, some fail with "Data conversion error (truncation)". I think this has to do with the row terminators not always working.
When the upload works, it seems to be with the '0x0A' terminator. But when that fails, I want to try repeatedly again with other row terminators. So I want to go into a Try statement, and on failure go into another Try statement, and another if that one fails, ... . This may not be the best way to upload, but I am still curious about the Try logic for it's own state.
Here's what I've come up with so far and it's not too pretty (but it works). Cutting out a few nested layers:
let FileRead path =
try
db.DataContext.ExecuteCommand(#"BULK INSERT...ROWTERMINATOR='0x0A')") |> ignore
true
with
| exn ->
try
db.DataContext.ExecuteCommand(#"BULK INSERT...ROWTERMINATOR='\r')") |> ignore
true
with
| exn ->
try
db.DataContext.ExecuteCommand(#"BULK INSERT...ROWTERMINATOR='\n')") |> ignore
true
with
| exn ->
false
This doens't feel right but I haven't figured out any other syntax.
EDIT: What I ended up doing, just for the record. Appreciate being put on a productive path. There's plenty to improve in this. With one of the more significant things being to use Async's and run it Parallel (which I have gotten experience with in other sections).
type dbSchema = SqlDataConnection<dbConnection>
let db = dbSchema.GetDataContext()
let TryUpLd table pathFile rowTerm =
try
db.DataContext.ExecuteCommand( #"BULK INSERT " + table + " FROM '" + pathFile +
#"' WITH (FIELDTERMINATOR=',', FIRSTROW = 2, ROWTERMINATOR='"
+ rowTerm + "')" ) |> ignore
File.Delete (pathFile) |> Some
with
| exn -> None
let NxtUpLd UL intOpt =
match intOpt with
| None -> UL
| _ -> intOpt
let MoveTable ID table1 table2 =
//...
()
let NxtMoveTable MT intOpt =
match intOpt with
| Some i -> MT
| _ -> ()
let UpLdFile path (file:string) =
let (table1, table2) =
match path with
| p when p = dlXPath -> ("Data.dbo.ImportXs", "Data.dbo.Xs")
| p when p = dlYPath -> ("Data.dbo.ImportYs", "Data.dbo.Ys")
| _ -> ("ERROR path to tables", "")
let ID = file.Replace(fileExt, "")
let TryRowTerm = TryUpLd table1 (path + file)
TryRowTerm "0x0A"
|> NxtUpLd (TryRowTerm "\r")
|> NxtUpLd (TryRowTerm "\n")
|> NxtUpLd (TryRowTerm "\r\n")
|> NxtUpLd (TryRowTerm "\n\r")
|> NxtUpLd (TryRowTerm "\0")
|> NxtMoveTable (MoveTable ID table1 table2)
let UpLdData path =
let dir = new DirectoryInfo(path)
let fileList = dir.GetFiles()
fileList |> Array.iter (fun file -> UpLdFile path file.Name ) |> ignore

Here's one way to do it, using monadic composition.
First, define a function that takes another function as input, but converts any exception to a None value:
let attempt f =
try f () |> Some
with | _ -> None
This function has the type (unit -> 'a) -> 'a option; that is: f is inferred to be any function that takes unit as input, and returns a value. As you can see, if no exception happens, the return value from invoking f is wrapped in a Some case. The attempt function suppresses all exceptions, which you shouldn't normally do.
Next, define this attemptNext function:
let attemptNext f = function
| Some x -> Some x
| None -> attempt f
This function has the type (unit -> 'a) -> 'a option -> 'a option. If the input 'a option is Some then it's simply returned. In other words, the value is interpreted as already successful, so there's no reason to try the next function.
Otherwise, if the input 'a option is None, this is interpreted as though the previous step resulted in a failure. In that case, the input function f is attempted, using the attempt function.
This means that you can now compose functions together, and get the first successful result.
Here are some functions to test with:
let throwyFunction () = raise (new System.InvalidOperationException("Boo"))
let throwyFunction' x y = raise (new System.InvalidOperationException("Hiss"))
let goodFunction () = "Hooray"
let goodFunction' x y = "Yeah"
Try them out in F# Interactive:
> let res1 =
attempt throwyFunction
|> attemptNext (fun () -> throwyFunction' 42 "foo")
|> attemptNext goodFunction
|> attemptNext (fun () -> goodFunction' true 13.37);;
val res1 : string option = Some "Hooray"
> let res2 =
attempt goodFunction
|> attemptNext throwyFunction
|> attemptNext (fun () -> throwyFunction' 42 "foo")
|> attemptNext (fun () -> goodFunction' true 13.37);;
val res2 : string option = Some "Hooray"
> let res3 =
attempt (fun () -> throwyFunction' 42 "foo")
|> attemptNext throwyFunction
|> attemptNext (fun () -> goodFunction' true 13.37)
|> attemptNext goodFunction;;
val res3 : string option = Some "Yeah"
> let res4 =
attempt (fun () -> throwyFunction' 42 "foo")
|> attemptNext (fun () -> goodFunction' true 13.37)
|> attemptNext throwyFunction
|> attemptNext goodFunction;;
val res4 : string option = Some "Yeah"

Related

How to assert that a function throws an exception?

I can catch exceptions:
try some_fn () with | e -> print_endline "exception caught!"
but what about the other way around, detecting that a function does not throw an exception (when it should)?
I managed to write some very hacky way to achieve that: I create a wrapper around the function I want to test, which throws some specific exception at the end. I catch anything but that exception.
exception Finished
let check (fn : unit -> unit) =
let wrapper _ = (
fn ();
raise Finished)
in
try wrapper () with e when e <> Finished -> ()
in utop this works:
utop # check (fun _ -> ());;
Exception: Finished.
utop # check (fun _ -> failwith "hey");;
- : unit = ()
EDIT: my coworker suggested:
let should_fail fn =
if Result.try_with fn |> Result.is_ok then failwith "this test should fail"
Exceptions can be handled within pattern matching cases, allowing very clean expression for this check:
match some_fn () with
| exception _ -> print_endline "exception caught!"
| _ -> print_endline "error: no exception raised!"
We can abstract this check into a function:
let throws_exception f =
match f () with
| exception _ -> true
| _ -> false
Which we can use in an assertion like so:
assert (throws_exception (fun () -> raise (Failure "msg")))

F#: appending the value of an option to list option

I have a basic append function
let append item list = item :: list
And i have a' list option and option Some("something")
let listOption = Some []
I want to add the value "something" to listOption. How can I do it without using pattern matching and Option.get but by lifting append function?
Any help would be appreciated
You can use maybe computation expression
type MaybeBuilder() =
member this.Bind(m, f) = Option.bind f m
member this.Return(x) = Some x
let maybe = new MaybeBuilder()
let append item list = item :: list
let appendLifted item list =
maybe {
let! l = list
let! i = item
return append i l
}
[<EntryPoint>]
let main argv =
appendLifted (Some "abc") (Some [])
0
It looks like a home work...
If you want to add a value (not an option) at the head of a list option, you can simply do this which will return None if the list option is None:
let liftedAppend item optList =
optList |> Option.bind (fun list -> Some (item :: list))
liftedAppend signature is:
'a -> 'a list option -> 'a list option
But talking about lifting stricto sensu, as the signature of your append function is:
'a -> 'a list -> 'a list
the signature of the lifted function should be:
'a option -> 'a list option -> 'a list option
That means the first argument have to be an option and I guess you want to check if it's Some or None. If so attentively read other's replies.
You can use something like this, which the de-sugared Lanayx's computation expression.
let liftedAppend optItem optList =
optList |> Option.bind (fun list ->
optItem |> Option.bind (fun item -> Some (item :: list)))
This works:
listOption
|> Option.map (append 11)
|> printfn "%A" // Some [11]
but to create a lifted append:
let liftedAppend v = Option.map (append v)
listOption
|> liftedAppend 11
|> printfn "%A" // Some [11]
The signature of the functions are:
val append : 'a -> 'a list > 'a list
val liftedAppend: 'a -> 'a list option -> 'a list option
To pass both parameters as options you can use Option.map2:
let liftedAppend2 vO = vO |> Option.map2 append
listOption
|> liftedAppend2 (Some 11)
|> printfn "%A" // Some [11]
Which has signature:
val liftedAppend2: a option -> 'a list option -> 'a list option

F# - Why Seq.map does not propagate exceptions?

Imagine the following code:
let d = dict [1, "one"; 2, "two" ]
let CollectionHasValidItems keys =
try
let values = keys |> List.map (fun k -> d.Item k)
true
with
| :? KeyNotFoundException -> false
Now let us test it:
let keys1 = [ 1 ; 2 ]
let keys2 = [ 1 ; 2; 3 ]
let result1 = CollectionHasValidItems keys1 // true
let result2 = CollectionHasValidItems keys2 // false
This works as I would expect. But if we change List to Seq in the function, we get different behavior:
let keys1 = seq { 1 .. 2 }
let keys2 = seq { 1 .. 3 }
let result1 = CollectionHasValidItems keys1 // true
let result2 = CollectionHasValidItems keys2 // true
Here with keys2 I can see the exception message within values object in the debugger but no exception is thrown...
Why is it like this? I need some similar logic in my app and would prefer to work with sequences.
This is a classic example of a problem with side effects and lazy evaluation. Seq functions such as Seq.map are lazily evaluated, that means that the result of Seq.map will not be computed until the returned sequence is enumerated. In your example, this never occurs because you never do anything with values.
If you force the evaluation of the sequence by generating a concrete collection, like a list, you will get your exception and the function will return false:
let CollectionHasValidItems keys =
try
let values = keys |> Seq.map (fun k -> d.Item k) |> Seq.toList
true
with
| :? System.Collections.Generic.KeyNotFoundException -> false
As you've noticed, using List.map instead of Seq.map also resolves your issue because it will be eagerly evaluated when called, returning a new concrete list.
The key takeaway is, you have to be really careful about combining side effects with lazy evaluation. You can't rely on effects happening in the order that you initially expect.

How can I write this function only by using recursion in F#?

let rec n_cartesian_product = function
| [] -> [[]]
| x :: xs ->
let rest = n_cartesian_product xs
List.concat (List.map (fun i -> List.map (fun rs -> i :: rs) rest) x)
Hello! I wrote this function but I need to write it without using any List.* built-in functions. Since there's an inner function that calls an outer function, I assume I must define two mutually recursive functions.
Defining a concat function seemed easy:
let rec list_concat ( lst : 'a list list ) : 'a list =
match lst with
[] -> []
|x::xs -> x # (list_concat xs)
The problem is, I'm stuck at the definition of the functions which yield the argument for concat:
let rec fun_i rest =
match rest with
[] -> []
|x::xs -> fun_rs
and fun_rs =
fun_i :: fun_rs
I can't seem to devise a proper solution. Can you help me?
edit: for instance, given this input
[["A";"a"];["B";"b"];["C";"c"]]
I want this output:
[["A"; "B"; "C"]; ["A"; "B"; "c"]; ["A"; "b"; "C"]; ["A"; "b"; "c"];
["a"; "B"; "C"]; ["a"; "B"; "c"]; ["a"; "b"; "C"]; ["a"; "b"; "c"]]
N-Cartesian Product
To define the n cartesian product recursively, the easiest method is just to make recursive definitions of the functions used in your original (non-recursive) example:
let rec list_concat lst =
match lst with
|[] -> []
|x::xs -> x # (list_concat xs)
let rec list_map f lst =
match lst with
|[] -> []
|x::xs -> (f x) :: list_map f xs
let rec n_cartesian_product =
function
| [] -> [[]]
| x :: xs ->
let rest = n_cartesian_product xs
list_concat (list_map (fun head -> list_map (fun tail -> head :: tail) rest) x)
In terms of writing idiomatically in F#, it's best to write using more general functions (like fold), rather than making a lot of custom functions with explicit recursion. So, you could define some additional functions:
let list_collect f = list_concat << list_map f
let rec list_fold f acc lst =
match lst with
|[] -> acc
|hd::tl -> list_fold f (f acc hd) tl
let n_cartesian_product_folder rest first =
list_collect (fun head -> list_map (fun tail -> head :: tail) rest) first
Then we can redefine n_cartesian_product simply as:
let n_cartesian_product2 lst = list_fold (n_cartesian_product_folder) [[]] lst
If we were using F# core library functions (rather than custom recursive implementations) this approach would involve more standard code with less to go wrong.
Cartesian Product
(I'll leave this part here since apparently it was useful)
Define a function that takes a list of 'a and make a list of 'b * 'a where all of the things of type 'b are some supplied element y.
/// take a list of 'a and make a list of (y, 'a)
let rec tuplify y lst =
match lst with
|[] -> []
|x::xs -> (y, x) :: (tuplify y xs)
Then define a function that recurses through both my lists, calling tuplify on the current element of the first list and the entire second list and concat that with the recursive call to cartesian product.
/// cartesian product of two lists
let rec cartesianProduct lst1 lst2 =
match lst1 with
|[] -> []
|x::xs -> tuplify x lst2 # (cartesianProduct xs lst2)

Ocaml exception handling for opening input channel

As a beginner in Ocaml, I have this current working code:
...
let ch_in = open_in input_file in
try
proc_lines ch_in
with End_of_file -> close_in ch_in;;
Now I would like to add error handling for non-existing input files, I wrote this:
let ch_in = try Some (open_in input_file) with _ -> None in
match ch_in with
| Some x -> try proc_lines x with End_of_file -> close_in x
| None -> () ;;
and get an error message: This pattern matches values of type 'a option
but is here used to match values of type exn for the last line. If I substitute None for _, I get an error about incomplete matching.
I read that exn is the exception type. I'm sure I don't understand what is really going on here, so please point me to the right direction. Thanks!
When embedding pattern matches inside other pattern matches you need to encase the embedded match with either ( ... ) or begin ... end (syntactic sugar for parentheses):
let ch_in = try Some (open_in input_file) with _ -> None in
match ch_in with
| Some x -> (try proc_lines x with End_of_file -> close_in x)
| None -> () ;;