How do I use the F# Reflection library? - reflection

I am trying to follow this example (from p137 of Rob Pickering's "Foundations of F#" book) but I can't get it to work with the latest F# CTP.
I appear to be missing the definition of 'Value' on the 3rd line where it does
Value.GetInfo(x)
This generates :
error FS0039: The namespace or module 'Value' is not defined.
Can anyone tell me where this is coming from or what the new syntax is if this is now done differently? (be gentle - this is my first play with F#)
Here's the example I am working from:-
#light
open Microsoft.FSharp.Reflection
let printTupleValues x =
match Value.GetInfo(x) with
| TupleValue vals ->
print_string "("
vals
|> List.iteri
(fun i v ->
if i <> List.length vals - 1 then
Printf.printf " %s, " (any_to_string v)
else
print_any v)
print_string " )"
| _ -> print_string "not a tuple"
printTupleValues ("hello world", 1)

The F# reflection library was rewritten for either Beta 1 or the CTP. Here is your code slightly changed to use the new library, and to avoid using the F# PlusPack (print_string is for OCaml compatibility).
open Microsoft.FSharp.Reflection
let printTupleValues x =
if FSharpType.IsTuple( x.GetType() ) then
let s =
FSharpValue.GetTupleFields( x )
|> Array.map (fun a -> a.ToString())
|> Array.reduce (fun a b -> sprintf "%s, %s" a b)
printfn "(%s)" s
else
printfn "not a tuple"
printTupleValues ("hello world", 1)

Or, if you prefer using match to decompose the tuple, then try this using an active pattern. Advantage is you can add support for additional types pretty easily.
open Microsoft.FSharp.Reflection
let (|ParseTuple|_|) = function
| o when FSharpType.IsTuple( o.GetType() ) ->
Some( FSharpValue.GetTupleFields(o) )
| _ -> None
let printTupleValues = function
| ParseTuple vals ->
let s =
vals
|> Array.map (fun a -> a.ToString())
|> Array.reduce (fun a b -> sprintf "%s, %s" a b)
printfn "(%s)" s
| _ ->
printf "not a tuple"
printTupleValues ("hello world", 1)

I don't know whether your function has been renamed or removed in the current F# versions.
You should take a look at FSharp.Reflection in your IDE's object explorer to check that and maybe read this page.

Related

How can I determine the json path to a field within a record without actually hard coding the path?

I would like to work with the following type
type RecordPath<'a,'b> = {
Get: 'a -> 'b
Path:string
}
It's purpose is to define a getter for going from record type 'a to some field within 'a of type 'b. It also gives the path to that field for the json representation of the record.
For example, consider the following fields.
type DateWithoutTimeBecauseWeirdlyDotnetDoesNotHaveThisConcept = {
Year:uint
Month:uint
Day:uint
}
type Person = {
FullName:string
PassportNumber:string
BirthDate:DateWithoutTimeBecauseWeirdlyDotnetDoesNotHaveThisConcept
}
type Team = {
TeamName:string
TeamMembers:Person list
}
An example RecordPath might be
let birthYearPath = {
Get = fun (team:Team) -> team.TeamMembers |> List.map (fun p -> p.BirthDate.Year)
Path = "$.TeamMember[*].BirthDate.Year" //using mariadb format for json path
}
Is there some way of letting a library user create this record without ever actually needing to specify the string explicitly. Ideally there is some strongly typed way of the user specifying the fields involved. Maybe some kind of clever use of reflection?
It just occurred to me that with a language that supports macros, this would be possible. But can it be done in F#?
PS: I notice that I left out the s in "TeamMembers" in the path. This is the kind of thing I want to guard against to make it easier on the user.
As you noted in the comments, F# has a quotation mechanism that lets you do this. You can create those explicitly using <# ... #> notation or implicitly using a somewhat more elengant automatic quoting mechanism. The quotations are farily close representations of the F# code, so converting them to the desired path format is not going to be easy, but I think it can be done.
I tried to get this to work at least for your small example. First, I needed a helper function that does two transformations on the code and turns:
let x = e1 in e2 into e2[x <- e1] (using the notation e2[x <- e1] to mean a subsitution, i.e. expression e2 with all occurences of x replaced by e1)
e1 |> fun x -> e2 into e2[x <- e1]
This is all I needed for your example, but it's likely you'll need a few more cases:
open Microsoft.FSharp.Quotations
let rec simplify dict e =
let e' = simplifyOne dict e
if e' <> e then simplify dict e' else e'
and simplifyOne dict = function
| Patterns.Call(None, op, [e; Patterns.Lambda(v, body)])
when op.Name = "op_PipeRight" ->
simplify (Map.add v e dict) body
| Patterns.Let(v, e, body) -> simplify (Map.add v e dict) body
| ExprShape.ShapeVar(v) when Map.containsKey v dict -> dict.[v]
| ExprShape.ShapeVar(v) -> Expr.Var(v)
| ExprShape.ShapeLambda(v, e) -> Expr.Lambda(v, simplify dict e)
| ExprShape.ShapeCombination(o, es) ->
ExprShape.RebuildShapeCombination(o, List.map (simplify dict) es)
With this pre-processing, I managed to write an extractPath function like this:
let rec extractPath var = function
| Patterns.Call(None, op, [Patterns.Lambda(v, body); inst]) when op.Name = "Map" ->
extractPath var inst + "[*]." + extractPath v.Name body
| Patterns.PropertyGet(Some(Patterns.Var v), p, []) when v.Name = var -> p.Name
| Patterns.PropertyGet(Some e, p, []) -> extractPath var e + "." + p.Name
| e -> failwithf "Unexpected expression: %A" e
This looks for (1) a call to map function, (2) a property access on a variable that represents the data source and (3) a property access where the instance has some more property accesses.
The following now works for your small example (but probably for nothing else!)
type Path =
static member Make([<ReflectedDefinition(true)>] f:Expr<'T -> 'R>) =
match f with
| Patterns.WithValue(f, _, Patterns.Lambda(v, body)) ->
{ Get = f :?> 'T -> 'R
Path = "$." + extractPath v.Name (simplify Map.empty body) }
| _ -> failwith "Unexpected argument"
Path.Make(fun (team:Team) -> team.TeamMembers |> List.map (fun p -> p.BirthDate.Year))
The way I solved this is
let jsonPath userExpr =
let rec innerLoop expr state =
match expr with
|Patterns.Lambda(_, body) ->
innerLoop body state
|Patterns.PropertyGet(Some parent, propInfo, []) ->
sprintf ".%s%s" propInfo.Name state |> innerLoop parent
|Patterns.Call (None, _, expr1::[Patterns.Let (v, expr2, _)]) when v.Name = "mapping"->
let parentPath = innerLoop expr1 "[*]"
let childPath = innerLoop expr2 ""
parentPath + childPath
|ExprShape.ShapeVar x ->
state
|_ ->
failwithf "Unsupported expression: %A" expr
innerLoop userExpr "" |> sprintf "$%s"
type Path =
static member Make([<ReflectedDefinition(true)>] f:Expr<'T -> 'R>) =
match f with
|Patterns.WithValue(f, _, expr) ->
let path = jsonPath expr
{
Get = f :?> 'T -> 'R
Path = path
}
| _ -> failwith "Unexpected argument"
Caveat: I don't know enough about these techniques to tell if Tomas' answer performs better in some edge cases than mine.

F# How should I think about delimiting items in sequences?

Apologies for a rookie question. I'm trying to change my mental paradigm from procedural to functional.
For instance, suppose I have a list of names that I want to print like this "John, Paul, George, and Ringo." But this code does not satisfy:
let names = [ "John"; "Paul"; "George"; "Ringo" ]
names |> Seq.iter (fun s -> printf "%s, " s)
My procedural instinct is to seek a way to insinuate a predicate into that lambda so that it can branch between ", " or ", and " or ". " depending upon where we're at iterating the sequence. I think that's wrong, but I'm feeling around for what's right.
Would it be better to split the sequence in parts?
In this case it seems that we want to split the sequence into parts corresponding to distinct delimiter behaviors. We want to split it at the end, so we can't use Seq. But we can use List.splitAt instead.
let start, ending = List.splitAt (names.Length - 1) names
let penultimate, last = List.splitAt 1 ending
start |> Seq.iter (fun s -> printf "%s, " s)
penultimate |> Seq.iter (fun s -> printf "%s, and " s)
last |> Seq.iter (fun s -> printf "%s. " s)
Is this a righteous approach? Is there a better solution I've overlooked? Am I thinking along the right lines?
The general approach I take to tackle these kind of problems is to split them into smaller parts and solve individually:
an empty list [] results in ""
one element ["a"] results in "a."
two elements [ "a"; "b" ] result in "a and b."
more elements (that is a :: rest) result in "a, " + takeCareOf rest, where takeCareOf follows above rules. Note that we don't need to know the length of the full list.
Above recipe directly translates to F# (and functional languages in general):
let rec commaAndDot' = function
| [] -> ()
| [ a ] -> printfn "%s." a
| a :: [ b ] -> printfn "%s and %s." a b
| a :: rest -> printf "%s, " a; commaAndDot' rest
Are we done yet? No, commaAndDot' violates the Single Responsibility Principle because the function implements our 'business logic' and prints to the console. Let's fix that:
let rec commaAndDot'' = function
| [] -> ""
| [ a ] -> sprintf "%s." a
| a :: [ b ] -> sprintf "%s and %s." a b
| a :: rest -> sprintf "%s, " a + commaAndDot'' rest
As an additional benefit we can now call the function in parallel and the output does not get mixed up anymore.
Are we done yet? No, above function is not tail-recursive (we need to compute commaAndDot'' rest before concatenating it to the current result) and would blow the stack for large lists. A standard approach to fixing this is to introduce an accumulator acc:
let commaAndDot''' words =
let rec helper acc = function
| [] -> acc
| [ a ] -> sprintf "%s%s." acc a
| a :: [ b ] -> sprintf "%s%s and %s." acc a b
| a :: rest -> helper (acc + sprintf "%s, " a) rest
helper "" words
Are we done yet? No, commaAndDot''' creates a lot of strings for intermediate results. Thanks to F# not being a pure language, we can leverage local (private, non-observable) mutation to optimize for memory and speed:
let commaAndDot words =
let sb = System.Text.StringBuilder()
let rec helper = function
| [] -> sb
| [ a ] -> sprintf "%s." a |> sb.Append
| a :: [ b ] -> sprintf "%s and %s." a b |> sb.Append
| a :: rest ->
sprintf "%s, " a |> sb.Append |> ignore
helper rest
helper words |> string
Are we done yet? Probably... at least this is something I would consider idiomatic F# and happily commit. For optimising further (e.g. Appending commas and dots separately or changing the order of the patterns) I'd first write micro-benchmarks before sacrificing readability.
All versions generate the same output:
commaAndDot [] // ""
commaAndDot [ "foo" ] // "foo."
commaAndDot [ "foo"; "bar" ] // "foo and bar."
commaAndDot [ "Hello"; "World"; "F#" ] // "Hello, World and F#."
Update: SCNR, created a benchmark... results are below as a HTML snippet (for nice tabular data).
BuilderOpt is the StringBuilder version with the [] case moved to the bottom,
BuilderChained is with chained Append calls, e.g. sb.Append(a).Append(" and ").Append(b) and BuilderFormat is e.g. sb.AppendFormat("{0} and {1}", a, b). Full source code available.
As expected, 'simpler' versions perform better for small lists, the larger the list the better BuilderChained. Concat performs better than I expected but does not produce the right output (missing ".", lacking one case). Yield gets rather slow...
<!DOCTYPE html>
<html lang='en'>
<head>
<meta charset='utf-8' />
<title>Benchmark.CommaAndDot</title>
<style type="text/css">
table { border-collapse: collapse; display: block; width: 100%; overflow: auto; }
td, th { padding: 6px 13px; border: 1px solid #ddd; }
tr { background-color: #fff; border-top: 1px solid #ccc; }
tr:nth-child(even) { background: #f8f8f8; }
</style>
</head>
<body>
<pre><code>
BenchmarkDotNet=v0.11.1, OS=Windows 10.0.16299.726 (1709/FallCreatorsUpdate/Redstone3)
Intel Core i7 CPU 950 3.07GHz (Nehalem), 1 CPU, 8 logical and 4 physical cores
Frequency=2998521 Hz, Resolution=333.4977 ns, Timer=TSC
[Host] : .NET Framework 4.7.2 (CLR 4.0.30319.42000), 64bit LegacyJIT-v4.7.3190.0 DEBUG
DefaultJob : .NET Framework 4.7.2 (CLR 4.0.30319.42000), 64bit RyuJIT-v4.7.3190.0
</code></pre>
<pre><code></code></pre>
<table>
<thead><tr><th> Method</th><th>Verbosity</th><th> Mean</th><th>Error</th><th>StdDev</th><th> Median</th><th>Scaled</th><th>ScaledSD</th>
</tr>
</thead><tbody><tr><td>Concat</td><td>0</td><td>39.905 ns</td><td>0.0592 ns</td><td>0.0494 ns</td><td>39.906 ns</td><td>1.02</td><td>0.11</td>
</tr><tr><td>Yield</td><td>0</td><td>27.235 ns</td><td>0.0772 ns</td><td>0.0603 ns</td><td>27.227 ns</td><td>0.69</td><td>0.07</td>
</tr><tr><td>Accumulator</td><td>0</td><td>1.956 ns</td><td>0.0109 ns</td><td>0.0096 ns</td><td>1.954 ns</td><td>0.05</td><td>0.01</td>
</tr><tr><td>Builder</td><td>0</td><td>32.384 ns</td><td>0.2986 ns</td><td>0.2331 ns</td><td>32.317 ns</td><td>0.82</td><td>0.09</td>
</tr><tr><td>BuilderOpt</td><td>0</td><td>33.664 ns</td><td>1.0371 ns</td><td>0.9194 ns</td><td>33.402 ns</td><td>0.86</td><td>0.09</td>
</tr><tr><td>BuilderChained</td><td>0</td><td>39.671 ns</td><td>1.2097 ns</td><td>3.5669 ns</td><td>41.339 ns</td><td>1.00</td><td>0.00</td>
</tr><tr><td>BuilderFormat</td><td>0</td><td>40.276 ns</td><td>0.8909 ns</td><td>1.8792 ns</td><td>39.494 ns</td><td>1.02</td><td>0.12</td>
</tr><tr><td>Concat</td><td>1</td><td>153.116 ns</td><td>1.1592 ns</td><td>0.9050 ns</td><td>152.706 ns</td><td>0.87</td><td>0.01</td>
</tr><tr><td>Yield</td><td>1</td><td>154.522 ns</td><td>0.2890 ns</td><td>0.2256 ns</td><td>154.479 ns</td><td>0.88</td><td>0.00</td>
</tr><tr><td>Accumulator</td><td>1</td><td>223.342 ns</td><td>0.3678 ns</td><td>0.2872 ns</td><td>223.412 ns</td><td>1.27</td><td>0.00</td>
</tr><tr><td>Builder</td><td>1</td><td>232.194 ns</td><td>0.2951 ns</td><td>0.2465 ns</td><td>232.265 ns</td><td>1.32</td><td>0.00</td>
</tr><tr><td>BuilderOpt</td><td>1</td><td>232.016 ns</td><td>0.5654 ns</td><td>0.4722 ns</td><td>232.170 ns</td><td>1.31</td><td>0.00</td>
</tr><tr><td>BuilderChained</td><td>1</td><td>176.473 ns</td><td>0.3918 ns</td><td>0.3272 ns</td><td>176.341 ns</td><td>1.00</td><td>0.00</td>
</tr><tr><td>BuilderFormat</td><td>1</td><td>219.262 ns</td><td>6.7995 ns</td><td>6.3603 ns</td><td>217.003 ns</td><td>1.24</td><td>0.03</td>
</tr><tr><td>Concat</td><td>10</td><td>1,284.042 ns</td><td>1.7035 ns</td><td>1.4225 ns</td><td>1,283.443 ns</td><td>1.68</td><td>0.05</td>
</tr><tr><td>Yield</td><td>10</td><td>6,532.667 ns</td><td>12.6169 ns</td><td>10.5357 ns</td><td>6,533.504 ns</td><td>8.55</td><td>0.24</td>
</tr><tr><td>Accumulator</td><td>10</td><td>2,701.483 ns</td><td>4.8509 ns</td><td>4.5376 ns</td><td>2,700.208 ns</td><td>3.54</td><td>0.10</td>
</tr><tr><td>Builder</td><td>10</td><td>1,865.668 ns</td><td>5.0275 ns</td><td>3.9252 ns</td><td>1,866.920 ns</td><td>2.44</td><td>0.07</td>
</tr><tr><td>BuilderOpt</td><td>10</td><td>1,820.402 ns</td><td>2.7853 ns</td><td>2.3258 ns</td><td>1,820.464 ns</td><td>2.38</td><td>0.07</td>
</tr><tr><td>BuilderChained</td><td>10</td><td>764.334 ns</td><td>19.8528 ns</td><td>23.6334 ns</td><td>756.988 ns</td><td>1.00</td><td>0.00</td>
</tr><tr><td>BuilderFormat</td><td>10</td><td>1,177.186 ns</td><td>1.9584 ns</td><td>1.6354 ns</td><td>1,177.897 ns</td><td>1.54</td><td>0.04</td>
</tr><tr><td>Concat</td><td>100</td><td>25,579.773 ns</td><td>824.1504 ns</td><td>688.2028 ns</td><td>25,288.873 ns</td><td>5.33</td><td>0.14</td>
</tr><tr><td>Yield</td><td>100</td><td>421,872.560 ns</td><td>902.5023 ns</td><td>753.6302 ns</td><td>421,782.071 ns</td><td>87.87</td><td>0.23</td>
</tr><tr><td>Accumulator</td><td>100</td><td>80,579.168 ns</td><td>227.7392 ns</td><td>177.8038 ns</td><td>80,547.868 ns</td><td>16.78</td><td>0.05</td>
</tr><tr><td>Builder</td><td>100</td><td>15,047.790 ns</td><td>26.2248 ns</td><td>21.8989 ns</td><td>15,048.903 ns</td><td>3.13</td><td>0.01</td>
</tr><tr><td>BuilderOpt</td><td>100</td><td>15,287.117 ns</td><td>39.8679 ns</td><td>31.1262 ns</td><td>15,293.739 ns</td><td>3.18</td><td>0.01</td>
</tr><tr><td>BuilderChained</td><td>100</td><td>4,800.966 ns</td><td>11.3614 ns</td><td>10.0716 ns</td><td>4,801.450 ns</td><td>1.00</td><td>0.00</td>
</tr><tr><td>BuilderFormat</td><td>100</td><td>8,382.896 ns</td><td>87.8963 ns</td><td>68.6236 ns</td><td>8,368.400 ns</td><td>1.75</td><td>0.01</td>
</tr></tbody></table>
</body>
</html>
I prefer using String.concat:
let names = [ "John"; "Paul"; "George"; "Ringo" ]
names
|> List.mapi (fun i n -> if i = names.Length - 1 && i > 0 then "and " + n else n)
|> String.concat ", "
|> printfn "%s"
Basic techniques are mentioned in the accepted answer: problem deconstruction and separation of concerns. There is either no element, or there is an element followed by either ., , and, or ,, depending on its position relative to the end of the input sequence.
Assuming that the input is of type string list, this can be fairly well expressed by a recursive, pattern matching function definition, wrapped inside a list sequence expression to ensure tail recursion. The match does nothing if the input is empty, so it returns an empty list; it returns a sub-list for the other terminating case, otherwise it appends to the sub-list the results of the recursion.
The concatenation as the desired target type string is a separate, final step, as proposed in another answer.
let rec seriesComma xs = [
match xs with
| [] -> ()
| [x] -> yield! [x; "."]
| x::[y] -> yield! [x; ", and "]; yield! seriesComma [y]
| x::xs -> yield! [x; ", "]; yield! seriesComma xs ]
["Chico"; "Harpo"; "Groucho"; "Gummo"; "Zeppo"]
|> seriesComma |> String.concat ""
// val it : string = "Chico, Harpo, Groucho, Gummo, and Zeppo."
Seq.Reduce is the simplest way to make a delimited list, but including the "and" before the last item adds some complexity. Below I show a way to do it in two steps, but the recursive approach in the accepted answer is probably more true to the Functional Programming paradigm.
let names = [ "John"; "Paul"; "George"; "Ringo" ]
let delimitedNames = names |> Seq.reduce (fun x y -> sprintf "%s, %s" x y)
let replaceLastOccurrence (hayStack: string) (needle: string) (newNeedle: string) =
let idx = hayStack.LastIndexOf needle
match idx with
| -1 -> hayStack
| _ -> hayStack.Remove(idx, needle.Length).Insert(idx, newNeedle)
replaceLastOccurrence delimitedNames "," ", and"
See https://msdn.microsoft.com/en-us/visualfsharpdocs/conceptual/seq.reduce%5B%27t%5D-function-%5Bfsharp%5D?f=255&MSPPError=-2147217396
Well, a more functional-looking solution could be something like this:
let names = [ "John"; "Paul"; "George"; "Ringo" ]
names
|> Seq.tailBack
|> Seq.iter (fun s -> printf "%s, " s)
names
|> Seq.last
|> fun s -> printf "and %s" s
Where tailBack can be defined in some SequenceExtensions.fs like
module Seq
let tailBack seq =
seq
|> Seq.rev
|> Seq.tail
|> Seq.rev
This way you do not deal much with indexes, variables and all that procedural stuff.
Ideally you would leverage options here, like
names
|> Seq.tryLast
|> Option.iter (fun s -> printf "and %s" s)
With this you would also avoid possible argument exceptions. But options in functional programming is another (nice) concept than sequences.
Also, here a particular task matters. I believe this solution is quite inefficient - we iterate the sequence too many times. Maybe in some cases fussing with indexes will be the way to go.

Accidental recursion, blowing up the stack with Seq.append, without using `rec`

I had code that was waiting to blow up something lurking around. Using F# 4.1 Result it is similar to this:
module Result =
let unwindSeq (sourceSeq: #seq<Result<_, _>>) =
sourceSeq
|> Seq.fold (fun state res ->
match state with
| Error e -> Error e
| Ok innerResult ->
match res with
| Ok suc ->
Seq.singleton suc
|> Seq.append innerResult
|> Ok
| Error e -> Error e) (Ok Seq.empty)
The obvious bottleneck here is Seq.singleton added to Seq.append. I understand that this is slow (and badly written), but why does it have to blow up the stack? I don't think that Seq.append is inherently recursive...
// blows up stack, StackOverflowException
Seq.init 1000000 Result.Ok
|> Result.unwindSeq
|> printfn "%A"
And as an aside, to unwind a sequence of Result, I fixed this function by using a simple try-catch-reraise, but that feels sub-par too. Any ideas as to how to do this more idiomatically without force-evaluating the sequence or blowing up the stack?
Not-so-perfect unwinding (it also forces the result-fail type), but at least without pre-evaluation of the sequence:
let unwindSeqWith throwArgument (sourceSeq: #seq<Result<_, 'a -> 'b>>) =
try
sourceSeq
|> Seq.map (throwOrReturnWith throwArgument)
|> Ok
with
| e ->
(fun _ -> raise e)
|> Error
I believe the idiomatic way of folding a sequence of Results in the way you suggest would be:
let unwindSeq<'a,'b> =
Seq.fold<Result<'a,'b>, Result<'a seq, 'b>>
(fun acc cur -> acc |> Result.bind (fun a -> cur |> Result.bind (Seq.singleton >> Seq.append a >> Ok)))
(Ok Seq.empty)
Not that this will be any faster than your current implementation, it just leverages Result.bind to do most of the work. I believe the stack is overflowing because a recursive function somewhere in the F# library, likely in the Seq module. My best evidence for this is that materializing the sequence to a List first seems to make it work, as in the following example:
let results =
Seq.init 2000000 (fun i -> if i <= 1000000 then Result.Ok i else Error "too big")
|> Seq.toList
results
|> unwindSeq
|> printfn "%A"
However, this may not work in your production scenario if the sequence is too big to materialize in memory.

F# stop Seq.map when a predicate evaluates true

I'm currently generating a sequence in a similar way to:
migrators
|> Seq.map (fun m -> m())
The migrator function is ultimately returning a discriminated union like:
type MigratorResult =
| Success of string * TimeSpan
| Error of string * Exception
I want to stop the map once I encounter my first Error but I need to include the Error in the final sequence.
I have something like the following to display a final message to the user
match results |> List.rev with
| [] -> "No results equals no migrators"
| head :: _ ->
match head with
| Success (dt, t) -> "All migrators succeeded"
| Error (dt, ex) -> "Migration halted owing to error"
So I need:
A way to stop the mapping when one of the map steps produces an Error
A way to have that error be the final element added to the sequence
I appreciate there may be a different sequence method other than map that will do this, I'm new to F# and searching online hasn't yielded anything as yet!
I guess there are multiple approaches here, but one way would be to use unfold:
migrators
|> Seq.unfold (fun ms ->
match ms with
| m :: tl ->
match m () with
| Success res -> Some (Success res, tl)
| Error res -> Some (Error res, [])
| [] -> None)
|> List.ofSeq
Note the List.ofSeq at the end, that's just there for realizing the sequence. A different way to go would be to use sequence comprehensions, some might say it results in a clearer code.
The ugly things Tomaš alludes to are 1) mutable state, and 2) manipulation of the underlying enumerator. A higher-order function which returns up to and including when the predicate holds would then look like this:
module Seq =
let takeUntil pred (xs : _ seq) = seq{
use en = xs.GetEnumerator()
let flag = ref true
while !flag && en.MoveNext() do
flag := not <| pred en.Current
yield en.Current }
seq{1..10} |> Seq.takeUntil (fun x -> x % 5 = 0)
|> Seq.toList
// val it : int list = [1; 2; 3; 4; 5]
For your specific application, you'd map the cases of the DU to a boolean.
(migrators : seq<MigratorResult>)
|> Seq.takeUntil (function Success _ -> false | Error _ -> true)
I think the answer from #scrwtp is probably the nicest way to do this if your input is reasonably small (and you can turn it into an F# list to use pattern matching). I'll add one more version, which works when your input is just a sequence and you do not want to turn it into a list.
Essentially, you want to do something that's almost like Seq.takeWhile, but it gives you one additional item at the end (the one, for which the predicate fails).
To use a simpler example, the following returns all numbers from a sequence until one that is divisible by 5:
let nums = [ 2 .. 10 ]
nums
|> Seq.map (fun m -> m % 5)
|> Seq.takeWhile (fun n -> n <> 0)
So, you basically just need to look one element ahead - to do this, you could use Seq.pairwise which gives you the current and the next element in the sequence"
nums
|> Seq.map (fun m -> m % 5)
|> Seq.pairwise // Get sequence of pairs with the next value
|> Seq.takeWhile (fun (p, n) -> p <> 0) // Look at the next value for test
|> Seq.mapi (fun i (p, n) -> // For the first item, we return both
if i = 0 then [p;n] else [n]) // for all other, we return the second
|> Seq.concat
The only ugly thing here is that you then need to flatten the sequence again using mapi and concat.
This is not very nice, so a good thing to do would be to define your own higher-order function like Seq.takeUntilAfter that encapsulates the behavior you need (and hides all the ugly things). Then your code could just use the function and look nice & readable (and you can experiment with other ways of implementing this).

How do I printf a map in OCaml?

open Map
open Pretty
let d_doc () (x : doc) : doc = x
let d_str () = text
let d_map d_k d_v () m : doc =
printf "{%a}"
d_doc
(Map.fold (fun k v acc -> printf "%a, %a -> %a" d_doc acc d_k k d_v v) m (text ""))
tells me "Error: Unbound value Map.fold". How do I do this? (I'd like either a pointer to a reference that explains how to use Map functions (or module functions in general), a standard library pretty printer for maps, and/or a fix for my code.)
I realize this post is old, but for the future visitor, the following works:
module IntMap = Map.Make(Int)
type map = string IntMap.t
let pp_map ppf (m : map) =
IntMap.iter (fun k v -> Format.fprintf ppf "%d -> %s#\n" k v) m
let _ =
IntMap.empty
|> IntMap.add 4 "hello"
|> IntMap.add 2 "world"
|> Format.printf "%a" pp_map
You can print out a map using sexplib quite conveniently. Here's how you'd do it using Core.
open Core.Std
let map = Int.Map.of_alist_exn [1,"one"; 2,"two"; 3,"three"]
let () =
(<:sexp_of<string Int.Map.t>> map)
|> Sexp.to_string_hum
|> print_endline

Resources