Strange behaviour when reflecting over F# Discriminated Union - reflection

The following code compiles and runs correctly:
type FooUnion = MyCase of int * string
FSharp.Reflection.FSharpType.GetUnionCases(typeof<FooUnion>)
|> Array.tryFind(fun a -> a.Name = "MyCase")
|> Option.map(fun d -> FSharp.Reflection.FSharpValue.MakeUnion(d, [| 1; "test" |]))
|> Option.bind(function | :? FooUnion as s -> Some s | _ -> None)
However, if I remove the fully qualified FSharp.Reflection and move it to an open statement, the code no longer compiles: -
open FSharp.Reflection
type FooUnion = MyCase of int * string
FSharpType.GetUnionCases(typeof<FooUnion>)
|> Array.tryFind(fun a -> a.Name = "MyCase")
|> Option.map(fun d -> FSharpValue.MakeUnion(d, [| 1; "test" |]))
|> Option.bind(function | :? FooUnion as s -> Some s | _ -> None)
with errors on the call to MakeUnion: -
No overloads match the method 'MakeUnion' [ within the VS IDE ]
error FS0001: This expression was expected to have type
int
but here has type
string [ within FSI if I execute the code manually ]

The FSharpValue type contains a single MakeUnion method:
static member MakeUnion : unionCase:Reflection.UnionCaseInfo * args:obj [] * ?bindingFlags:System.Reflection.BindingFlags -> obj
But the FSharp.Reflection namespace contains an extension methods with a slightly different signature.
The FSharp compiler only implicitly box the content of the args array when there is no overload, so opening the namespace require to change the code to:
FSharpValue.MakeUnion(d, [| box 1; box "test" |])
even if you prefix with the full namespace.

Related

Usecase of Variants in Purescript/Haskell

Can someone tell me what is the use case of purescript-variants or variants in general
The documentation is very well written but I can't find any real use case scenario for it. Can someone tell how we could use Variants in real world?
Variants are duals of records. While records are sort of extensible ad-hoc product types (consider data T = T Int String vs. type T = { i :: Int, s :: String }), variants can be seen as extensible ad-hoc sum types - e.g. data T = A Int | B String vs. Variant (a :: Int, b :: String)
For example, just as you can write a function that handles a partial record:
fullName :: forall r. { first :: String, last :: String | r } -> String
fullName r = r.first <> " " <> r.last
myFullName = fullName { first: "Fyodor", last: "Soikin", weight: "Too much" }
so too, you can write a function that handles a partial variant:
weight :: forall r. Variant (kilos :: Int, vague :: String | r) -> String
weight =
default "Unknown"
# on _kilos (\n -> show n <> " kg.")
# on _vague (\s -> "Kind of a " <> s)
myWeight = weight (inj _kilos 100) -- "100 kg."
alsoMyWeight = weight (inj _vague "buttload") -- "Kind of a buttload"
But these are, of course, toy examples. For a less toy example, I would imagine something that handles alternatives, but needs to be extensible. Perhaps something like a file parser:
data FileType a = Json | Xml
basicParser :: forall a. FileType a -> String -> Maybe a
basicParser t contents = case t of
Json -> parseJson contents
Xml -> parseXml contents
Say I'm ok using this parser in most case, but in some cases I'd also like to be able to parse YAML. What do I do? I can't "extend" the FileType sum type post-factum, the best I can do is aggregate it in a larger type:
data BetterFileType a = BasicType (FileType a) | Yaml
betterParser :: forall a. BetterFileType a -> String -> Maybe a
betterParser t contents = case t of
BasicType bt -> basicParser bt contents
Yaml -> parseYaml contents
And now whenever I call the "better parser", I have to wrap the file type awkwardly:
result = betterParser (BasicType Json) "[1,2,3]"
Worse: now every consumer has to know the hierarchy of BetterFileType -> FileType, they can't just say "json", they have to know to wrap it in BasicType. Awkward.
But if I used extensible variants for the file type, I could have flattened them nicely:
type FileType r = (json :: String, xml :: String | r)
basicParser :: forall a r. Variant (FileType r) -> Maybe a
basicParser = onMatch { json: parseJson, xml: parseXml } $ default Nothing
----
type BetterFileType r = (yaml :: String | FileType r)
betterParser :: forall a r. Variant (BetterFileType r) -> Maybe a
betterParser = onMatch { yaml: parseYaml } basicParser
Now I can use the naked variant names with either basicParser or betterParser, without knowing to wrap them or not:
r1 = betterParser $ inj _json "[1,2,3]"
r2 = betterParser $ inj _yaml "foo: [1,2,3]"

Pattern matching does not call function in F#

open System
[<EntryPoint>]
let main argv =
match argv with
| [| firstArg |] -> printfn "Your first arg is %s", firstArg
| [| |] -> failwith "You didn't pass an argument"
| _ -> failwith "You did something unusual"
0 // return an integer exit code
I wrote this to process the first argument to my F# console application. If I didn't pass an argument it fails with an exception saying "You didn't pass an argument". If I passed at least two arguments, it fails with an exception "You did something unusual". But, when I pass exactly one argument, it tells nothing. Why does not printfn work here?
The reason it didn't print anything here is because you've added an extra comma after the printf. That means the signature is a string -> unit function and string tuple. If you remove the comma then it will work.
A working solution would be
[<EntryPoint>]
let main argv =
match argv with
| [| firstArg |] -> printfn "Your first arg is %s" firstArg
| [| |] -> failwith "You didn't pass an argument"
| _ -> failwith "You did something unusual"
0 // return an integer exit code
You might have seen a compiler warning before running this which said warning FS0020: The result of this expression has type '(string -> unit) * string' and is implicitly ignored. Consider using 'ignore' to discard this value explicitly, e.g. 'expr |> ignore', or 'let' to bind the result to a name, e.g. 'let result = expr'

F#, FParsec, and Calling a Stream Parser Recursively, Second Take

Thank you for the replies to my first post and my second post on this project. This question is basically the same question as the first, but with my code updated according to the feedback received on those two questions. How do I call my parser recursively?
I'm scratching my head and staring blankly at the code. I've no idea where to go from here. That's when I turn to stackoverflow.
I've included in code comments the compile-time errors I'm receiving. One stumbling block may be my discriminated union. I've not worked with discriminated unions much, so I may be using mine incorrectly.
The example POST I'm working with, bits of which I've included in my previous two questions, consists of one boundary that includes a second post with a new boundary. That second post includes several additional parts separated by the second boundary. Each of those several additional parts is a new post consisting of headers and XML.
My goal in this project is to build a library to be used in our C# solution, with the library taking a stream and returning the POST parsed into headers and parts recursively. I really want F# to shine here.
namespace MultipartMIMEParser
open FParsec
open System.IO
type Header = { name : string
; value : string
; addl : (string * string) list option }
type Content = Content of string
| Post of Post list
and Post = { headers : Header list
; content : Content }
type UserState = { Boundary : string }
with static member Default = { Boundary="" }
module internal P =
let ($) f x = f x
let undefined = failwith "Undefined."
let ascii = System.Text.Encoding.ASCII
let str cs = System.String.Concat (cs:char list)
let makeHeader ((n,v),nvps) = { name=n; value=v; addl=nvps}
let runP p s = match runParserOnStream p UserState.Default "" s ascii with
| Success (r,_,_) -> r
| Failure (e,_,_) -> failwith (sprintf "%A" e)
let blankField = parray 2 newline
let delimited d e =
let pEnd = preturn () .>> e
let part = spaces
>>. (manyTill
$ noneOf d
$ (attempt (preturn () .>> pstring d)
<|> pEnd)) |>> str
in part .>>. part
let delimited3 firstDelimiter secondDelimiter thirdDelimiter endMarker =
delimited firstDelimiter endMarker
.>>. opt (many (delimited secondDelimiter endMarker
>>. delimited thirdDelimiter endMarker))
let isBoundary ((n:string),_) = n.ToLower() = "boundary"
let pHeader =
let includesBoundary (h:Header) = match h.addl with
| Some xs -> xs |> List.exists isBoundary
| None -> false
let setBoundary b = { Boundary=b }
in delimited3 ":" ";" "=" blankField
|>> makeHeader
>>= fun header stream -> if includesBoundary header
then
stream.UserState <- setBoundary (header.addl.Value
|> List.find isBoundary
|> snd)
Reply ()
else Reply ()
let pHeaders = manyTill pHeader $ attempt (preturn () .>> blankField)
let rec pContent (stream:CharStream<UserState>) =
match stream.UserState.Boundary with
| "" -> // Content is text.
let nl = System.Environment.NewLine
let unlines (ss:string list) = System.String.Join (nl,ss)
let line = restOfLine false
let lines = manyTill line $ attempt (preturn () .>> blankField)
in pipe2 pHeaders lines
$ fun h c -> { headers=h
; content=Content $ unlines c }
| _ -> // Content contains boundaries.
let b = "--" + stream.UserState.Boundary
// VS complains about pContent in the following line:
// Type mismatch. Expecting a
// Parser<'a,UserState>
// but given a
// CharStream<UserState> -> Parser<Post,UserState>
// The type 'Reply<'a>' does not match the type 'Parser<Post,UserState>'
let p = pipe2 pHeaders pContent $ fun h c -> { headers=h; content=c }
in skipString b
>>. manyTill p (attempt (preturn () .>> blankField))
// VS complains about Content.Post in the following line:
// Type mismatch. Expecting a
// Post list -> Post
// but given a
// Post list -> Content
// The type 'Post' does not match the type 'Content'
|>> Content.Post
// VS complains about pContent in the following line:
// Type mismatch. Expecting a
// Parser<'a,UserState>
// but given a
// CharStream<UserState> -> Parser<Post,UserState>
// The type 'Reply<'a>' does not match the type 'Parser<Post,UserState>'
let pStream = runP (pipe2 pHeaders pContent $ fun h c -> { headers=h; content=c })
type MParser (s:Stream) =
let r = P.pStream s
let findHeader name =
match r.headers |> List.tryFind (fun h -> h.name.ToLower() = name) with
| Some h -> h.value
| None -> ""
member p.Boundary =
let header = r.headers
|> List.tryFind (fun h -> match h.addl with
| Some xs -> xs |> List.exists P.isBoundary
| None -> false)
in match header with
| Some h -> h.addl.Value |> List.find P.isBoundary |> snd
| None -> ""
member p.ContentID = findHeader "content-id"
member p.ContentLocation = findHeader "content-location"
member p.ContentSubtype = findHeader "type"
member p.ContentTransferEncoding = findHeader "content-transfer-encoding"
member p.ContentType = findHeader "content-type"
member p.Content = r.content
member p.Headers = r.headers
member p.MessageID = findHeader "message-id"
member p.MimeVersion = findHeader "mime-version"
EDIT
In response to the feedback I've received thus far (thank you!), I made the following adjustments, receiving the errors annotated:
let rec pContent (stream:CharStream<UserState>) =
match stream.UserState.Boundary with
| "" -> // Content is text.
let nl = System.Environment.NewLine
let unlines (ss:string list) = System.String.Join (nl,ss)
let line = restOfLine false
let lines = manyTill line $ attempt (preturn () .>> blankField)
in pipe2 pHeaders lines
$ fun h c -> { headers=h
; content=Content $ unlines c }
| _ -> // Content contains boundaries.
let b = "--" + stream.UserState.Boundary
// The following complaint is about `pContent stream`:
// This expression was expected to have type
// Reply<'a>
// but here has type
// Parser<Post,UserState>
let p = pipe2 pHeaders (fun stream -> pContent stream) $ fun h c -> { headers=h; content=c }
in skipString b
>>. manyTill p (attempt (preturn () .>> blankField))
// VS complains about the line above:
// Type mismatch. Expecting a
// Parser<Post,UserState>
// but given a
// Parser<'a list,UserState>
// The type 'Post' does not match the type ''a list'
// See above complaint about `pContent stream`. Same complaint here.
let pStream = runP (pipe2 pHeaders (fun stream -> pContent stream) $ fun h c -> { headers=h; content=c })
I tried throwing in Reply ()s, but they just returned parsers, meaning c above became a Parser<...> rather than Content. That seemed to have been a step backwards, or at least in the wrong direction. I admit my ignorance, though, and welcome correction!
I can help with one of the errors.
F# generally binds arguments left to right, so you need to use either parentheses around the recursive calls to pContent or a pipe-backward operator <| to show that you want to evaluate the recursive call and bind the return value.
It's also worth noting that <| is the same as your $ operator.
Content.Post is not a constructor for a Post object. You need a function to accept a Post list and return a Post. (Does something from the List module do what you need?)
My first answer was completely wrong, but I'd thought I'd leave it up.
The types Post and Content are defined as:
type Content =
| Content of string
| Post of Post list
and Post =
{ headers : Header list
; content : Content }
Post is a Record, and Content is a Discriminated Union.
F# treats the cases for Discriminated Unions as a separate namespace from types. So Content is different from Content.Content, and Post is different from Content.Post. Because they are different, having the same identifier is confusing.
What is pContent supposed to be returning? If it's supposed to be returning the Discriminated Union Content, you need to wrap the Post record you are returning in the first case in the Content.Post case i.e.
$ fun h c -> Post [ { headers=h
; content=Content $ unlines c } ]
(F# is able to infer that 'Post' refers to Content.Post case, instead of the Post record type here.)

F#: Using object expression with discriminated union

I have a recursive function that contains a series of matches that either make the recursive call back to the function, or make a call to failwith.
This is basically a hybrid implementation of the recursive descent parser descibed in Don Syme's Expert F# book (page 180) and the parsing example shown here: http://fsharpforfunandprofit.com/posts/pattern-matching-command-line/
Here is a snippet of my own code.
let rec parseTokenListRec tokenList optionsSoFar =
match tokenList with
| [] -> optionsSoFar
| SOURCE::t ->
match t with
| VALUE x::tt -> parseTokenListRec (returnNonValueTail t) {optionsSoFar with Source = (returnConcatHeadValues t)}
| _ -> failwith "Expected a value after the source argument."
| REGISTRY::t ->
...
A full code listing can be found at http://fssnip.net/nU
The way the code is currently written, when the function has finished working its way through the tokenList, it will return the optionsSoFar record that has been compiled via the object expression {optionsSoFar with Source = (returnConcatHeadValues t)}, or it will throw an exception if an invalid argument is found.
I want to refactor this so that the function does not rely on an exception, but will always return a value of some sort that can be handled by the calling function. The idea I have is to return a discriminated union rather than a record.
This discriminated union would be something like
type Result =
|Success of Options
|Failure of string
The problem I had when I tried to refactor the code was that I couldn't figure out how to get the success value of the DU to initialize via an object expression. Is this possible?
The examples I've looked at on MSDN (http://msdn.microsoft.com/en-us/library/vstudio/dd233237(v=vs.100).aspx), fsharpforfunandprofit (http://fsharpforfunandprofit.com/posts/discriminated-unions/) and elsewhere haven't quite cleared this up for me.
I'm worried that I'm not making any sense here. I'm happy to clarify if needed.
If I understand it correctly, in you current solution, the type of optionsSoFar is Options. The code becomes trickier if you change the type of optionsSoFar to your newly defined Result.
However, I think you do not need to do that - you can keep optionsSoFar : Options and change the function to return Result. This works because you never need to call the function recursively after it fails:
let rec parseTokenListRec tokenList optionsSoFar =
match tokenList with
| [] -> Success optionsSoFar
| SOURCE::t ->
match t with
| VALUE x::tt ->
{optionsSoFar with Source = (returnConcatHeadValues t)}
|> parseTokenListRec (returnNonValueTail t)
| _ -> Failure "Expected a value after the source argument."
| REGISTRY::t -> ...
If you actually wanted to update Source in a Result value, then I'd probably write something like:
module Result =
let map f = function
| Success opt -> f opt
| Failure msg -> Failure msg
Then you could write a transformation as follows:
resultSoFar
|> Result.map (fun opts -> {opts with Source = returnConcatHeadValues t})
|> parseTokenListRec (returnNonValueTail t)

f# types' properties in inconsistent order and of slightly differing types

I'm trying to iterate through an array of objects and recursively print out each objects properties.
Here is my object model:
type firmIdentifier = {
firmId: int ;
firmName: string ;
}
type authorIdentifier = {
authorId: int ;
authorName: string ;
firm: firmIdentifier ;
}
type denormalizedSuggestedTradeRecommendations = {
id: int ;
ticker: string ;
direction: string ;
author: authorIdentifier ;
}
Here is how I am instantiating my objects:
let getMyIdeasIdeas = [|
{id=1; ticker="msfqt"; direction="buy";
author={authorId=0; authorName="john Smith"; firm={firmId=12; firmName="Firm1"}};};
{id=2; ticker="goog"; direction="sell";
author={authorId=1; authorName="Bill Jones"; firm={firmId=13; firmName="ABC Financial"}};};
{id=3; ticker="DFHF"; direction="buy";
author={authorId=2; authorName="Ron James"; firm={firmId=2; firmName="DEFFirm"}};}|]
And here is my algorithm to iterate, recurse and print:
let rec recurseObj (sb : StringBuilder) o=
let props : PropertyInfo [] = o.GetType().GetProperties()
sb.Append( o.GetType().ToString()) |> ignore
for x in props do
let getMethod = x.GetGetMethod()
let value = getMethod.Invoke(o, Array.empty)
ignore <|
match value with
| :? float | :? int | :? string | :? bool as f -> sb.Append(x.Name + ": " + f.ToString() + "," ) |> ignore
| _ -> recurseObj sb value
for x in getMyIdeas do
recurseObj sb x
sb.Append("\r\n") |> ignore
If you couldnt tell, I'm trying to create a csv file and am printing out the types for debugging purposes. The problem is, the first element comes through in the order you'd expect, but all subsequent elements come through with a slightly different (and confusing) ordering of the "child" properties like so:
RpcMethods+denormalizedSuggestedTradeRecommendationsid:
1,ticker: msfqt,direction:
buy,RpcMethods+authorIdentifierauthorId:
0,authorName: john
Smith,RpcMethods+firmIdentifierfirmId:
12,firmName: Firm1,
RpcMethods+denormalizedSuggestedTradeRecommendationsid:
2,ticker: goog,direction:
sell,RpcMethods+authorIdentifierauthorName:
Bill
Jones,RpcMethods+firmIdentifierfirmName:
ABC Financial,firmId: 13,authorId: 1,
RpcMethods+denormalizedSuggestedTradeRecommendationsid:
3,ticker: DFHF,direction:
buy,RpcMethods+authorIdentifierauthorName:
Ron
James,RpcMethods+firmIdentifierfirmName:
DEFFirm,firmId: 2,authorId: 2,
Any idea what is going on here?
Does adding this help?
for x in props |> Array.sortBy (fun p -> p.Name) do
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
In general, I think reflection returns entities (like attributes, methods, properties) in an unspecified order. So just pick a fixed sort order?
(Or did I misunderstand the issue?)
This is a reflection thing. You can't rely on the order of the properties using reflection. I need to sort using MetaTokens. I will post this solution when I get around to implementing it.

Resources