I have a few types in F# like:
type ResourceRecordSet =
| Alias of Name : string *
Type : ResourceRecordType *
AliasTarget : AliasTarget
| Record of Name : string *
Type : ResourceRecordType *
ResourceRecords : List<string> * TTL : uint32
Using the type:
let r =
Record(
"domain.tld."
, SOA
, ["ns-583.awsdns-08.net.
awsdns-hostmaster.amazon.com.
1 7200 900 1209600 86400"]
, 900u
)
When I try to serialize it to JSON I get the following:
let rjson = JsonSerializer.Serialize(r)
sprintf "%A" rjson
Output:
"{"Case":"Record","Fields":["doman.tld.",{"Case":"SOA"},["ns-583.awsdns-08.net. awsdns-hostmaster.amazon.com. 1 7200 900 1209600 86400"],900]}"
Is there a way to control the serialization and produce the following instead:
{
"Name": "doman.tld.",
"ResourceRecords": [ {"Value": "ns-583.awsdns-08.net. awsdns-hostmaster.amazon.com. 1 7200 900 1209600 86400" }],
"TTL": 900,
"Type": "SOA"
}
To answer my own question, after reading up on the different libraries suggested by different people, Fleece seems like the most solid solution here.
First a simple example:
open System.Text.Json
open Fleece.SystemTextJson
open Fleece.SystemTextJson.Operators
open FSharpPlus
type AliasTarget =
{
DNSName : string
EvaluateTargetHealth : bool
HostedZoneId : string
}
static member ToJson (a: AliasTarget) =
jobj [
"DNSName" .= a.DNSName
"EvaluateTargetHealth" .= a.EvaluateTargetHealth
"HostedZoneId" .= a.HostedZoneId
]
static member OfJson json =
match json with
| JObject o ->
monad {
let! dnsName = o .# "DNSName"
let! evaluateTargetHealth = o .# "EvaluateTargetHealth"
let! hostedZoneId = o .# "HostedZoneId"
return {
DNSName = dnsName
EvaluateTargetHealth = evaluateTargetHealth
HostedZoneId = hostedZoneId
}
}
| x -> Decode.Fail.objExpected x
let outp = aliasTargetToJSON { DNSName = "dbrgct5gwrbsd.cloudfront.net."; EvaluateTargetHealth = false; HostedZoneId = "xxx"}
loggerBlog.LogInfo outp
let aliasJson = """{"DNSName":"dbrgct5gwrbsd.cloudfront.net.","EvaluateTargetHealth":false,"HostedZoneId":"xxx"}"""
let alias : AliasTarget ParseResult = parseJson aliasJson
loggerBlog.LogInfo (sprintf "%A" alias)
This prints:
2020-06-08T23:26:09 INFO [Website] {"DNSName":"dbrgct5gwrbsd.cloudfront.net.","EvaluateTargetHealth":false,"HostedZoneId":"xxx"}
2020-06-08T23:26:09 INFO [Website] Ok { DNSName = "dbrgct5gwrbsd.cloudfront.net."
EvaluateTargetHealth = false
HostedZoneId = "xxx" }
Both the serialization and deserialization works.
ADTs or discriminated unions can be implemented as well:
type Shape =
| Rectangle of width : float * length : float
| Circle of radius : float
| Prism of width : float * float * height : float
with
static member JsonObjCodec =
Rectangle <!> jreq "rectangle" (function Rectangle (x, y) -> Some (x, y) | _ -> None)
<|> ( Circle <!> jreq "radius" (function Circle x -> Some x | _ -> None) )
<|> ( Prism <!> jreq "prism" (function Prism (x, y, z) -> Some (x, y, z) | _ -> None) )
More here:
https://github.com/fsprojects/Fleece
Related
I am trying to make a simple Elm webapp that lets me add rectangles to an SVG canvas and drag them around. However, I am running into problems trying to programmatically differentiate the rectangle click handlers. The below code works fine for a single rectangle (mousedown on the shape and move around and it will drag correctly). However, every further rectangle generated somehow has its mousedown function also specifying the first rectangle.
This creates the rectangle with rectID and (I thought) would also create a unique partial function of customOnMouseDown with the rectID parameter of this rectangle.
NewRect rectId ->
let
newRect =
Rect (customOnMouseDown (String.fromInt rectId)) (String.fromInt rectId)
(rectId) 0 20 20
in
( { model |
rects = newRect :: model.rects
, count = model.count + 1}
, Cmd.none)
After trying several different formulations, I think my mental model of Elm's runtime is wrong, so I would like to not only know the correct way to do this sort of thing but also why this way isn't working, if possible.
Full code:
import Browser
import Browser.Events
import Html exposing (..)
import Html.Events
import Task
import Time
import Svg exposing (..)
import Svg.Attributes exposing (..)
import Svg.Events exposing (..)
import Random
import Json.Decode as D
-- MAIN
-- main =
main =
Browser.element
{ init = init
, view = view
, update = update
, subscriptions = subscriptions
}
-- MODEL
type alias Model =
{ drag : Maybe Drag
, pos : Position
, rects : List Rect
, selected : String
, count : Int
}
type alias Position =
{ x: Int
, y: Int
}
type alias Drag =
{ startPos : Position
, currentPos : Position
}
type alias Rect =
{ mouseDown : Html.Attribute Msg
, rectId : String
, x : Int
, y : Int
, width : Int
, height : Int
}
init : () -> (Model, Cmd Msg)
init _ =
( Model Nothing (Position 0 0) [] "" 0
, Cmd.none
)
-- UPDATE
type Msg
= Press Position String
| Release Position
| Move Position
| AddRect
| NewRect Int
update : Msg -> Model -> (Model, Cmd Msg)
update msg model =
case msg of
Press pos rectId ->
({model | drag = Just (Drag pos pos)
, selected = rectId
}
, Cmd.none)
Release pos ->
({ model | drag = Nothing, selected = ""}, Cmd.none)
Move pos ->
( { model |
rects =
case (getRect model.selected model.rects) of
Nothing -> model.rects
Just r ->
(Rect r.mouseDown r.rectId pos.x pos.y 20 20)::(dropRect r.rectId model.rects)
}
, Cmd.none )
AddRect ->
( model
, Random.generate NewRect (Random.int 1 1000)
)
NewRect rectId ->
let
newRect =
Rect (customOnMouseDown (String.fromInt rectId)) (String.fromInt rectId)
(rectId) 0 20 20
in
( { model |
rects = newRect :: model.rects
, count = model.count + 1}
, Cmd.none)
-- SUBSCRIPTIONS
subscriptions : Model -> Sub Msg
subscriptions model =
case model.drag of
Nothing ->
Sub.none
Just _ ->
Sub.batch [ Browser.Events.onMouseMove mouseMoveDecoder
, Browser.Events.onMouseUp mouseReleaseDecoder ]
mouseMoveDecoder : D.Decoder Msg
mouseMoveDecoder =
D.map Move mouseCoordDecoder
mouseReleaseDecoder : D.Decoder Msg
mouseReleaseDecoder =
D.map Release mouseCoordDecoder
mouseCoordDecoder : D.Decoder Position
mouseCoordDecoder =
D.map2 Position
(D.field "x" D.int)
(D.field "y" D.int)
-- VIEW
view : Model -> Html Msg
view model =
let
total_width = "1000"
total_height = "500"
in
div []
[ svg
[ width total_width
, height total_height
, viewBox ("0 0 " ++ total_width ++ total_height)
]
(renderShape model.rects)
, div [] [ div [] [ Html.text (String.fromInt model.pos.x) ]
, div [] [ Html.text (String.fromInt model.pos.y) ]
, div [] [ Html.text model.selected ]
, div [] [ Html.text (String.fromInt (List.length model.rects)) ]
, div [] [ (renderList (List.map .rectId model.rects)) ]
, button [ onClick AddRect ] [ Html.text "Rect" ] ]
]
renderList : List String -> Html msg
renderList lst =
ul []
(List.map (\l -> li [] [ Html.text l ]) lst)
customOnMouseDown : String -> (Html.Attribute Msg)
customOnMouseDown shapeIndex =
let
decoder =
D.oneOf
[ D.map2
Press
( D.map2
Position
( D.field "pageX" D.int)
( D.field "pageY" D.int)
)
(D.succeed ( shapeIndex ))
, D.succeed (Press ( Position 500 500 ) shapeIndex )
]
in
Html.Events.on "mousedown" decoder
extractRect : Rect -> Svg Msg
extractRect r =
rect [ r.mouseDown
, x (String.fromInt r.x)
, y (String.fromInt r.y)
, width (String.fromInt r.width)
, height (String.fromInt r.height)
]
[]
renderShape : List Rect -> List (Svg Msg)
renderShape lst =
List.map extractRect lst
rectIdMatch : String -> Rect -> Bool
rectIdMatch target rect = target == rect.rectId
getRect : String -> List Rect -> (Maybe Rect)
getRect target lst =
List.head (List.filter (rectIdMatch target) lst)
dropRect : String -> List Rect -> List Rect
dropRect target lst =
case lst of
[] -> []
[x] ->
if x.rectId == target then
[]
else
[]
x::xs ->
if x.rectId == target then
xs
else
x::(dropRect target xs)
Per glennsl https://ellie-app.com/76K6JmDJg4Fa1]1
Changing the JSON decoder seemed to fix the issue, although I'm not sure why
customOnMouseDown : String -> (Html.Attribute Msg)
customOnMouseDown shapeIndex =
let
decoder =
D.oneOf
[ D.map2
Press
( D.map2
Position
( D.field "pageX" D.int)
( D.field "pageY" D.int)
)
(D.succeed ( shapeIndex ))
, D.succeed (Press ( Position 500 500 ) shapeIndex )
]
in
Html.Events.on "mousedown" decode
module Dfs = struct
let rec dfslsts g paths final =
let l = PrimePath.removeDuplicates (PrimePath.extendPaths g paths)
in
let f elem =
if (List.mem "%d" (List.flatten final) = false) then (dfslsts g ["%d"] (List.flatten l)::final)
else final
in
List.iter f (Graph.nodes g)
end
Error: This expression has type string but an expression was expected of type int list
This error occurred when I called dfslsts function, which is recursive, inside the if condition.
The function dfslsts returns a list of lists.
If I try to replace the complex expression in if statement to
if (List.mem "%d" (List.flatten final) = false) then "%d"
else "%d"
then I get
Error: This expression has type 'a -> string
but an expression was expected of type 'a -> unit
Type string is not compatible with type unit
at List.iter line.
How do I solve this problem and are we allowed to call a recursive function inside the if expression.
This is the definition of my graph type:
module Graph = struct
exception NodeNotFound of int
type graph = {
nodes : int list;
edges : (int * int) list;
}
let makeGraph () =
{
nodes = [];
edges = [];
}
let rec isNodeOf g n = List.mem n g.nodes
let nodes g = g.nodes
let edges g = g.edges
let addNode g n =
let nodes = n::g.nodes and edges = g.edges in
{
nodes;
edges;
}
let addEdge g (n1, n2) =
if ((isNodeOf g n1) = false) then
raise (NodeNotFound n1)
else if ((isNodeOf g n2) = false) then
raise (NodeNotFound n2)
else
let nodes = g.nodes
and edges = (n1, n2) :: g.edges in
{
nodes;
edges;
}
let nextNodes g n =
let rec findSuccessors edges n =
match edges with
[] -> []
| (n1, n2) :: t ->
if n1 = n then n2::findSuccessors t n
else findSuccessors t n
in
findSuccessors g.edges n
let rec lastNode path =
match path with
[] -> raise (NodeNotFound 0)
| n :: [] -> n
| _ :: t -> lastNode t
end
module Paths = struct
let extendPath g path =
let n = (Graph.lastNode path) in
let nextNodes = Graph.nextNodes g n in
let rec loop path nodes =
match nodes with
[] -> []
| h :: t -> (List.append path [h]) :: (loop path t)
in
loop path nextNodes
let rec extendPaths g paths =
match paths with
[] -> []
| h :: t -> List.append (extendPath g h) (extendPaths g t)
(* Given a list lst, return a new list with all duplicate entries removed *)
let rec removeDuplicates lst =
match lst with
[]
| _ :: [] -> lst
| h :: t ->
let trimmed = removeDuplicates t in
if List.mem h trimmed then trimmed
else h :: trimmed
end
Any expression can be a recursive function call. There are no limitations like that. Your problem is that some types don't match.
I don't see any ints in this code, so I'm wondering where the compiler sees the requirement for an int list. It would help to see the type definition for your graphs.
As a side comment, you almost certainly have a precedence problem with this code:
dfslsts g ["%d"] (List.flatten l)::final
The function call to dfslsts has higher precedence that the list cons operator ::, so this is parsed as:
(dfslsts g ["%d"] (List.flatten l)) :: final
You probably need to parenthesize like this:
dfslsts g ["%d"] ((List.flatten l) :: final)
I have an maybe unusual question, but how does one match a function in F# using pattern matching?
Imagine the following:
I have multiple function signatures, which will be used multiple times, like:
binary function: int -> int -> int
unary function: int -> int
boolean function: int -> int -> bool
...
Now imagine the function evaluate, which itself takes a function f. The signature of f must be one of the listed above.
How do I match such a case?
I have tried the following things:
Test No.1 : Using delegates and Unions:
type UnaryFunction = delegate of int -> int
type BinaryFunction = delegate of (int -> int) -> int
type BooleanFunction = delegate of (int -> int) -> bool
type Functions =
| Unary of UnaryFunction
| Binary of BinaryFunction
| Boolean of BooleanFunction
// ...
let evaluate f = // signature: Functions -> string
match f with
| Unary u ->
let test_result = u.Invoke 3
sprintf "the result of the unary function is %d" test_result
| Binary b ->
let test_result = b.Invoke 315 42
sprintf "the result of the binary function is %d" test_result
| Boolean o ->
let test_result = o.Invoke 315 42
if test_result then "yeah" else "nope"
Test No.2 : Using type pattern matching and delegates:
type UnaryFunction = delegate of int -> int
type BinaryFunction = delegate of (int -> int) -> int
type BooleanFunction = delegate of (int -> int) -> bool
let evaluate f =
match f with
| ?: UnaryFunction as u ->
let test_result = u.Invoke 3
sprintf "the result of the unary function is %d" test_result
| ?: BinaryFunction as b ->
let test_result = b.Invoke 315 42
sprintf "the result of the binary function is %d" test_result
| ?: BooleanFunction as o ->
let test_result = o.Invoke 315 42
if test_result then "yeah" else "nope"
| _ -> "invalid function type"
The problem with these examples is, that delegates of ... will be matched instead of actual functions.
I would like to see somethink like this:
let evaluate f =
match f with
| ?: (int -> int) as u ->
let test_result = u 3
sprintf "the result of the unary function is %d" test_result
| ?: ((int -> int) -> int) as b ->
let test_result = b 315 42
sprintf "the result of the binary function is %d" test_result
| ?: ((int -> int) -> bool) as o ->
let test_result = o 315 42
if test_result then "yeah" else "nope"
| _ -> "invalid function type"
Does F# has a special syntax for function pattern matching?
And if not, why so? Am I missing something, or isn't it also important to be able to match functions just as anything else, as this is a functional language?
Instead of using delegates, just define the work using functions directly:
type UnaryFunction = int -> int
type BinaryFunction = int -> int -> int
type BooleanFunction = int -> int -> bool
type Functions =
| Unary of UnaryFunction
| Binary of BinaryFunction
| Boolean of BooleanFunction
// ...
let evaluate f = // signature: Functions -> string
match f with
| Unary u ->
let test_result = u 3
sprintf "the result of the unary function is %d" test_result
| Binary b ->
let test_result = b 315 42
sprintf "the result of the binary function is %d" test_result
| Boolean o ->
let test_result = o 315 42
if test_result then "yeah" else "nope"
Once you've done this, you can call them as needed (as below, showing FSI output):
> evaluate (Unary (fun x -> x + 3));;
val it : string = "the result of the unary function is 6"
> let someBinaryFunction x y = x * y;;
val someBinaryFunction : x:int -> y:int -> int
> Binary someBinaryFunction |> evaluate;;
val it : string = "the result of the binary function is 13230"
I do not know how to use Json.decode.
type alias Test =
{ a : Int
, b : Int
}
testDecoder =
object2 Test
("a" := int)
("b" := int)
main : Html
main =
let
t = "{\"a\":2, \"b\":2}"
d = decodeString testDecoder t
in
p [] [ text <| toString <| d ]
I want to get value of "a".
I do not know "Ok { a = 2, b = 2 }".
decodeString : Decoder a -> String -> Result String a
Since decodeString returns a Result String a, it could either be an error or success result. You have to do a case statement and look for Ok and Err, like so:
main : Html
main =
let
t = "{\"a\":2, \"b\":2}"
d = decodeString testDecoder t
myText =
case d of
Ok x -> toString x.a
Err msg -> msg
in
p [] [ text myText ]
Is there any way in F# how to get a name of a variable passed into a function?
Example:
let velocity = 5
let fn v = v.ParentName
let name = fn velocity // this would return "velocity" as a string
Thank you in advance
EDIT:
Why this code does not work? It is matched as value, so I can not retrieve the "variable" name.
type Test() =
let getName (e:Quotations.Expr) =
match e with
| Quotations.Patterns.PropertyGet (_, pi, _) -> pi.Name + " property"
| Quotations.Patterns.Value(a) -> failwith "Value matched"
| _ -> failwith "other matched"
member x.plot v = v |> getName |> printfn "%s"
let o = new Test()
let display () =
let variable = 5.
o.plot <# variable #>
let runTheCode fn = fn()
runTheCode display
For completing Marcelo's answer, yes you can use quotations for this task:
open Microsoft.FSharp.Quotations
open Microsoft.FSharp.Quotations.Patterns
let velocity = 5
let fn (e:Expr) =
match e with
| PropertyGet (e, pi, li) -> pi.Name
| _ -> failwith "not a let-bound value"
let name = fn <#velocity#>
printfn "%s" name
As you can see in the code, F# let-bound top definition values (functions or variables) are implemented as properties of a class.
I can't find anymore the link that shows how a piece of F# code could be rewritten in a functional way with C#. Seeing the code, it becomes obvious why you need a PropertyGet pattern.
Now if you want to evaluate the expression too, you will need to install F# powerpack and reference FSharp.PowerPack.Linq in your project.
It adds an EvalUntyped method on Expr class..
open Microsoft.FSharp.Linq.QuotationEvaluation
let velocity = 5
let fn (e:Expr) =
match e with
| PropertyGet (eo, pi, li) -> pi.Name, e.EvalUntyped
| _ -> failwith "not a let-bound value"
let name, value = fn <#velocity#>
printfn "%s %A" name value
If you need to do it for the method of an instance, here's how I would do it:
let velocity = 5
type Foo () =
member this.Bar (x:int) (y:single) = x * x + int y
let extractCallExprBody expr =
let rec aux (l, uexpr) =
match uexpr with
| Lambda (var, body) -> aux (var::l, body)
| _ -> uexpr
aux ([], expr)
let rec fn (e:Expr) =
match e with
| PropertyGet (e, pi, li) -> pi.Name
| Call (e, mi, li) -> mi.Name
| x -> extractCallExprBody x |> fn
| _ -> failwith "not a valid pattern"
let name = fn <#velocity#>
printfn "%s" name
let foo = new Foo()
let methodName = fn <#foo.Bar#>
printfn "%s" methodName
Just to come back on the code snippet showing usage of EvalUntyped, you can add an explicit type parameter for Expr and a downcast (:?>) if you want/need to keep things type-safe:
let fn (e:Expr<'T>) =
match e with
| PropertyGet (eo, pi, li) -> pi.Name, (e.EvalUntyped() :?> 'T)
| _ -> failwith "not a let-bound value"
let name, value = fn <#velocity#> //value has type int here
printfn "%s %d" name value
You might be able to achieve this with code quotations:
let name = fn <# velocity #>
The fn function will be passed an Expr object, which it must cast to Quotations.Var (which it will only be if you pass a single variable) and extract the Name instance member.
Based on the previous solutions I came out with a more generic solution where you can get the name of functions, lambdas, values, properties, methods, static methods, public fields, Union types:
open Microsoft.FSharp.Quotations
open Microsoft.FSharp.Quotations.Patterns
let cout (s:string)= System.Console.WriteLine (s)
let rec getName exprs =
let fixDeclaringType (dt:string) =
match dt with
| fsi when fsi.StartsWith("FSI_") -> "Fsi"
| _ -> dt
let toStr (xDeclType: System.Type) x = sprintf "%s.%s" (fixDeclaringType xDeclType.Name) x
match exprs with
| Patterns.Call(_, mi, _) ->
toStr mi.DeclaringType mi.Name
| Patterns.Lambda(_, expr) ->
getName expr
| Patterns.PropertyGet (e, pi, li) ->
toStr pi.DeclaringType pi.Name
| Patterns.FieldGet (_, fi) ->
toStr fi.DeclaringType fi.Name
| Patterns.NewUnionCase(uci, _) ->
toStr uci.DeclaringType uci.Name
| expresion -> "unknown_name"
let value = ""
let funcky a = a
let lambdy = fun(x) -> x*2
type WithStatic =
| A | B
with static member StaticMethod a = a
let someIP = System.Net.IPAddress.Parse("10.132.0.48")
getName <# value #> |> cout
getName <# funcky #> |> cout
getName <# lambdy #> |> cout
getName <# WithStatic.A #> |> cout
getName <# WithStatic.StaticMethod #> |> cout
getName <# someIP.MapToIPv4 #> |> cout
getName <# System.Net.IPAddress.Parse #> |> cout
getName <# System.Net.IPAddress.Broadcast #> |> cout