live update prototype
This commit is contained in:
Родитель
20c66e6a1a
Коммит
f3a591bfe4
|
@ -0,0 +1,8 @@
|
|||
<?xml version="1.0" encoding="utf-8"?>
|
||||
<configuration>
|
||||
<packageSources>
|
||||
<add key="NuGet official package source" value="https://api.nuget.org/v3/index.json" />
|
||||
<add key="myget.org" value="https://www.myget.org/F/oxyplot" />
|
||||
</packageSources>
|
||||
</configuration>
|
||||
|
|
@ -0,0 +1,17 @@
|
|||
// Auto-Generated by FAKE; do not edit
|
||||
namespace System
|
||||
open System.Reflection
|
||||
|
||||
[<assembly: AssemblyTitleAttribute("Elmish.XamarinForms.LiveUpdate")>]
|
||||
[<assembly: AssemblyProductAttribute("Elmish.XamarinForms.LiveUpdate")>]
|
||||
[<assembly: AssemblyDescriptionAttribute("F# Functional App Dev Framework Live Update")>]
|
||||
[<assembly: AssemblyVersionAttribute("0.12.10")>]
|
||||
[<assembly: AssemblyFileVersionAttribute("0.12.10")>]
|
||||
do ()
|
||||
|
||||
module internal AssemblyVersionInformation =
|
||||
let [<Literal>] AssemblyTitle = "Elmish.XamarinForms.LiveUpdate"
|
||||
let [<Literal>] AssemblyProduct = "Elmish.XamarinForms.LiveUpdate"
|
||||
let [<Literal>] AssemblyDescription = "F# Functional App Dev Framework Live Update"
|
||||
let [<Literal>] AssemblyVersion = "0.12.10"
|
||||
let [<Literal>] AssemblyFileVersion = "0.12.10"
|
|
@ -0,0 +1,20 @@
|
|||
<Project Sdk="Microsoft.NET.Sdk">
|
||||
<PropertyGroup>
|
||||
<TargetFramework>netstandard2.0</TargetFramework>
|
||||
<OtherFlags>/warnon:1182</OtherFlags>
|
||||
</PropertyGroup>
|
||||
<ItemGroup>
|
||||
<Compile Include="..\fscd\CodeModel.fs" Link="CodeModel.fs" />
|
||||
<Compile Include="..\fscd\Interpreter.fs" Link="Interpreter.fs" />
|
||||
<None Include="paket.template" />
|
||||
<Compile Include="AssemblyInfo.fs" />
|
||||
<Compile Include="LiveUpdate.fs" />
|
||||
</ItemGroup>
|
||||
<ItemGroup>
|
||||
<PackageReference Include="FSharp.Core" Version="4.5.0" />
|
||||
<PackageReference Include="Xamarin.Forms" Version="3.0.0.482510" />
|
||||
<PackageReference Include="FsPickler" Version="5.2.0" />
|
||||
<PackageReference Include="FsPickler.Json" Version="5.2.0" />
|
||||
<ProjectReference Include="..\Elmish.XamarinForms\Elmish.XamarinForms.fsproj" />
|
||||
</ItemGroup>
|
||||
</Project>
|
|
@ -0,0 +1,239 @@
|
|||
// Copyright 2018 Elmish.XamarinForms contributors. See LICENSE.md for license.
|
||||
namespace Elmish.XamarinForms
|
||||
|
||||
open System
|
||||
open System.Net
|
||||
open System.Net.Sockets
|
||||
open System.Net.NetworkInformation
|
||||
open System.IO
|
||||
open System.Text
|
||||
open Elmish.XamarinForms
|
||||
open Elmish.XamarinForms.DynamicViews
|
||||
open FSharp.Compiler.PortaCode.CodeModel
|
||||
open FSharp.Compiler.PortaCode.Interpreter
|
||||
|
||||
module Ports =
|
||||
let DefaultPort = 9867
|
||||
let BroadcasterPort = 8098
|
||||
let BroadcasterReceiverPort = 8099
|
||||
|
||||
|
||||
[<CLIMutable>]
|
||||
type UpdateResponse =
|
||||
{ Quacked: string }
|
||||
|
||||
[<CLIMutable>]
|
||||
type BroadcasterAddress =
|
||||
{ Address: string
|
||||
Port: int
|
||||
Interface : string }
|
||||
|
||||
[<CLIMutable>]
|
||||
type Broadcaster =
|
||||
{ DeviceName: string
|
||||
Addresses : BroadcasterAddress[]
|
||||
DeviceModel : string }
|
||||
|
||||
static member Start(?httpPort) =
|
||||
let broadcastEndpoint = new IPEndPoint(IPAddress.Broadcast, Ports.BroadcasterReceiverPort)
|
||||
|
||||
let httpPort = defaultArg httpPort Ports.DefaultPort
|
||||
let serializer = MBrace.FsPickler.Json.FsPickler.CreateJsonSerializer()
|
||||
do
|
||||
async {
|
||||
while true do
|
||||
let client = new UdpClient (Ports.BroadcasterPort, EnableBroadcast = true)
|
||||
let iips =
|
||||
[| for x in NetworkInterface.GetAllNetworkInterfaces () do
|
||||
if x.NetworkInterfaceType <> NetworkInterfaceType.Loopback &&
|
||||
not (x.Name.StartsWith ("pdp_ip", StringComparison.Ordinal)) &&
|
||||
x.OperationalStatus = OperationalStatus.Up then
|
||||
for y in x.GetIPProperties().UnicastAddresses do
|
||||
if y.Address.AddressFamily = AddressFamily.InterNetwork then
|
||||
yield { Address = y.Address.ToString ()
|
||||
Port = httpPort
|
||||
Interface = x.Name } |]
|
||||
let broadcast =
|
||||
{ DeviceName = "Device"
|
||||
DeviceModel = "Model"
|
||||
Addresses = iips }
|
||||
|
||||
for iip in iips do
|
||||
printfn "LiveUpdate: broadcasting address %s. Access via http://localhost:%d/ if you have run 'adb -d forward tcp:%d tcp:%d'" iip.Address httpPort httpPort httpPort
|
||||
|
||||
let json = serializer.PickleToString (broadcast)
|
||||
let bytes = System.Text.Encoding.UTF8.GetBytes (json)
|
||||
|
||||
try
|
||||
client.Send (bytes, bytes.Length, broadcastEndpoint) |> ignore
|
||||
with e ->
|
||||
printfn "LiveUpdate: error on broadcast: %A" e.Message
|
||||
do! Async.Sleep 5000 } |> Async.Start
|
||||
|
||||
|
||||
type HttpServer(?port) =
|
||||
let port = defaultArg port Ports.DefaultPort
|
||||
do Broadcaster.Start()
|
||||
member x.Run (switchD) =
|
||||
|
||||
let _syncCtxt = System.Threading.SynchronizationContext.Current
|
||||
async {
|
||||
// Run this on the host machine
|
||||
(*
|
||||
adb -d forward --list
|
||||
USB:
|
||||
adb -d forward tcp:9867 tcp:9867
|
||||
EMULATOR:
|
||||
adb -e forward tcp:9867 tcp:9867
|
||||
*)
|
||||
// netsh http add urlacl url=http://*:9867/ user=System.Environment.UserDomainName
|
||||
let url = sprintf "http://*:%d/" port
|
||||
let serializer = MBrace.FsPickler.Json.FsPickler.CreateJsonSerializer()
|
||||
|
||||
let listener = new HttpListener ()
|
||||
listener.Prefixes.Add (url)
|
||||
try
|
||||
listener.Start ()
|
||||
|
||||
while true do
|
||||
printfn "LiveUpdate: listening on url = %s" url
|
||||
let! c = listener.GetContextAsync () |> Async.AwaitTask
|
||||
let path = c.Request.Url.AbsolutePath
|
||||
printfn "LiveUpdate: got request, path = = %s" url
|
||||
use resp = c.Response
|
||||
try
|
||||
|
||||
let! (resString : string) =
|
||||
async {
|
||||
//if (path = "/switch") then
|
||||
// //let req = serializer.UnPickleOfString<UpdatePackage>(requestText)
|
||||
// let resp = switch ()
|
||||
// return serializer.PickleToString resp
|
||||
if (path = "/update") then
|
||||
let reader = new StreamReader (c.Request.InputStream, Encoding.UTF8)
|
||||
let! requestText = reader.ReadToEndAsync () |> Async.AwaitTask
|
||||
let req = serializer.UnPickleOfString<DFile>(requestText)
|
||||
let resp = switchD req
|
||||
return serializer.PickleToString resp
|
||||
else
|
||||
return """
|
||||
<html>
|
||||
<body>
|
||||
<p>Welcome to LiveUpdate web api. The valid API is:</p>
|
||||
<p> - PUT '<a href="/update">/update</a>'</p>
|
||||
<br />
|
||||
<p>To set up watcher for Android use:</p>
|
||||
<pre> adb -d forward tcp:PORT tcp:PORT (USB)</pre>
|
||||
<pre> adb -e forward tcp:PORT tcp:PORT (Emulator)</pre>
|
||||
<p> then</p>
|
||||
<pre> cd MyApp\MyApp</pre>
|
||||
<pre> %USERPROFILE%\.nuget\packages\Elmish.XamarinForms.LiveUpdate\0.13.0\tools\fscd.exe --watch --webhook:http://localhost:PORT/update -- @proj.args</pre>
|
||||
<p>where proj.args contains the compilation arguments for your project (you must currently create this manually)</p>
|
||||
</body>
|
||||
</html>"""
|
||||
|> fun s -> s.Replace("PORT", string port)
|
||||
}
|
||||
|
||||
printfn "LiveUpdate: setting response code to 200, response = %s" resString
|
||||
let bytes = Encoding.UTF8.GetBytes (resString)
|
||||
resp.StatusCode <- 200
|
||||
resp.ContentLength64 <- bytes.LongLength
|
||||
do! c.Response.OutputStream.WriteAsync (bytes, 0, bytes.Length) |> Async.AwaitTask
|
||||
|
||||
with ex ->
|
||||
let msg = "<html><body><pre>" + ex.ToString() + "</pre></body></html>"
|
||||
printfn "setting response code to 500, msg = %s" msg
|
||||
let bytes = Encoding.UTF8.GetBytes msg
|
||||
resp.StatusCode <- 500
|
||||
resp.ContentLength64 <- bytes.LongLength
|
||||
do! c.Response.OutputStream.WriteAsync (bytes, 0, bytes.Length) |> Async.AwaitTask
|
||||
with :? HttpListenerException as ex ->
|
||||
printfn "couldn't start listener %s" (ex.ToString())
|
||||
} |> Async.Start
|
||||
|
||||
|
||||
/// Program module - functions to manipulate program instances
|
||||
[<AutoOpen>]
|
||||
module Extensions =
|
||||
|
||||
|
||||
let rec tryFindEntityByName name (decls: DDecl[]) =
|
||||
decls |> Array.tryPick (function
|
||||
| DDeclEntity (entityDef, subDecls) -> if entityDef.Name = name then Some (entityDef, subDecls) else tryFindEntityByName name subDecls
|
||||
| _ -> None)
|
||||
|
||||
let rec tryFindMemberByName name (decls: DDecl[]) =
|
||||
decls |> Array.tryPick (function
|
||||
| DDeclEntity (_, ds) -> tryFindMemberByName name ds
|
||||
| DDeclMember (membDef, body) -> if membDef.Name = name then Some (membDef, body) else None
|
||||
| _ -> None)
|
||||
|
||||
/// Trace all the updates to the console
|
||||
type ProgramRunner<'model,'msg> with
|
||||
|
||||
member runner.EnableLiveUpdate() =
|
||||
|
||||
let interp = EvalContext()
|
||||
|
||||
let switchD (arg: DFile) =
|
||||
lock interp (fun () ->
|
||||
printfn "LiveUpdate: adding declarations...."
|
||||
interp.AddDecls arg.Code
|
||||
|
||||
printfn "LiveUpdate: evaluating decls in code package for side effects...."
|
||||
interp.EvalDecls (envEmpty, arg.Code)
|
||||
|
||||
let programOptD =
|
||||
match tryFindMemberByName "programLiveUpdate" arg.Code with
|
||||
| Some d -> Some d
|
||||
| None ->
|
||||
match tryFindMemberByName "program" arg.Code with
|
||||
| None -> None
|
||||
| Some d -> Some d
|
||||
|
||||
match programOptD with
|
||||
| None ->
|
||||
printfn "*** LiveUpdate failure:"
|
||||
printfn "*** [x] got code pacakge"
|
||||
printfn "*** FAIL: couldn't find declaration called 'program' or 'programLiveUpdate'"
|
||||
{ Quacked = "couldn't quack! No declaration called 'program' or 'programLiveUpdate'!" }
|
||||
|
||||
| Some (membDef, _) ->
|
||||
if membDef.Parameters.Length > 0 then
|
||||
printfn "*** LiveUpdate failure:"
|
||||
printfn "*** [x] got code pacakge"
|
||||
printfn "*** [x] found declaration called 'programLiveUpdate' or 'program'"
|
||||
printfn "*** FAIL: the declaration has parameters, it must be a single top-level value"
|
||||
{ Quacked = "couldn't quack! Found declaration called 'program' or 'programLiveUpdate' but the declaration has parameters!" }
|
||||
|
||||
else
|
||||
|
||||
printfn "LiveUpdate: evaluating 'program'...."
|
||||
let entity = interp.ResolveEntity(membDef.EnclosingEntity)
|
||||
let programObj = interp.GetExprDeclResult(entity, membDef.Name)
|
||||
match getVal programObj with
|
||||
|
||||
| :? Program<obj, obj, obj -> (obj -> unit) -> ViewElement> as programErased ->
|
||||
|
||||
// Stop the running program
|
||||
printfn "changing running program...."
|
||||
runner.ChangeProgram(programErased)
|
||||
printfn "*** LiveUpdate failure:"
|
||||
printfn "*** [x] got code pacakge"
|
||||
printfn "*** [x] found declaration called 'programLiveUpdate' or 'program'"
|
||||
printfn "*** [x] it had no parameters (good!)"
|
||||
printfn "*** [x] the declaration had the right type"
|
||||
printfn "*** [x] changed the running program"
|
||||
{ Quacked = "LiveUpdate quacked!" }
|
||||
|
||||
| p ->
|
||||
printfn "*** LiveUpdate failure:"
|
||||
printfn "*** [x] got code pacakge"
|
||||
printfn "*** [x] found declaration called 'programLiveUpdate' or 'program'"
|
||||
printfn "*** [x] it had no parameters (good!)"
|
||||
printfn "*** FAIL: the declaration had the wrong type '%A', expected 'Program<Model, Msg, Model -> (Msg-> unit) -> ViewElement>'" (p.GetType())
|
||||
{ Quacked = "LiveUpdate couldn't quack! types mismatch!" }
|
||||
)
|
||||
|
||||
let server = HttpServer()
|
||||
server.Run(switchD)
|
|
@ -0,0 +1,29 @@
|
|||
type file
|
||||
id Elmish.XamarinForms
|
||||
version 0.0
|
||||
authors Elmish.XamarinForms Contributors
|
||||
description
|
||||
F# bindings for using elmish in Xamarin.Forms
|
||||
tags
|
||||
Xamarin.Forms F# Elmish Elm
|
||||
projectUrl
|
||||
https://github.com/fsprojects/Elmish.XamarinForms
|
||||
licenseUrl
|
||||
https://github.com/fsprojects/Elmish.XamarinForms/blob/master/LICENSE.md
|
||||
requireLicenseAcceptance false
|
||||
files
|
||||
../build_output/Elmish.XamarinForms.LiveUpdate.dll ==> lib/netstandard2.0
|
||||
../build_output/tools/fscd.exe ==> tools
|
||||
../build_output/tools/FSharp.Core.dll ==> tools
|
||||
../build_output/tools/FSharp.Compiler.Service.dll ==> tools
|
||||
../build_output/tools/System.Collections.Immutable.dll ==> tools
|
||||
../build_output/tools/System.Reflection.Metadata.dll ==> tools
|
||||
../build_output/tools/FSharp.Core.resources.dll ==> tools
|
||||
../build_output/tools/FsPickler.dll ==> tools
|
||||
../build_output/tools/FsPickler.Json.dll ==> tools
|
||||
dependencies
|
||||
FSharp.Core >= LOCKEDVERSION-neutral
|
||||
Xamarin.Forms >= LOCKEDVERSION-neutral
|
||||
FsPickler >= LOCKEDVERSION-neutral
|
||||
FsPickler.Json >= LOCKEDVERSION-neutral
|
||||
Elmish.XamarinForms ~> CURRENTVERSION
|
|
@ -5,6 +5,8 @@ VisualStudioVersion = 15.0.27004.2006
|
|||
MinimumVisualStudioVersion = 10.0.40219.1
|
||||
Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "Elmish.XamarinForms", "Elmish.XamarinForms\Elmish.XamarinForms.fsproj", "{B459AFAD-BB5B-43C3-BD86-609E8DB3E3FD}"
|
||||
EndProject
|
||||
Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "Elmish.XamarinForms.LiveUpdate", "Elmish.XamarinForms.LiveUpdate\Elmish.XamarinForms.LiveUpdate.fsproj", "{B459AFAD-BB5B-43C3-BD86-609E8DB3E3F1}"
|
||||
EndProject
|
||||
Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "Elmish.XamarinForms.Maps", "extensions\Maps\Elmish.XamarinForms.Maps.fsproj", "{B459AFAD-BB5B-43C3-BD86-609E8DB3E3FE}"
|
||||
EndProject
|
||||
Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "Elmish.XamarinForms.SkiaSharp", "extensions\SkiaSharp\Elmish.XamarinForms.SkiaSharp.fsproj", "{B459AFAD-BB5B-43C3-BD86-609E8DB3E3FF}"
|
||||
|
@ -49,6 +51,10 @@ Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "CounterApp.iOS", "Samples\C
|
|||
EndProject
|
||||
Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "Generator", "Generator\Generator.fsproj", "{10DF5D2F-17FA-43DE-9549-B84E6CF26602}"
|
||||
EndProject
|
||||
Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "fscd", "fscd\fscd.fsproj", "{23640E46-E830-4AB7-9289-E527F6429435}"
|
||||
EndProject
|
||||
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "fscd.Tests", "fscd.Tests\fscd.Tests.fsproj", "{810EEB40-5042-4946-B695-5B13E9957807}"
|
||||
EndProject
|
||||
Global
|
||||
GlobalSection(SolutionConfigurationPlatforms) = preSolution
|
||||
Debug|Any CPU = Debug|Any CPU
|
||||
|
@ -77,6 +83,22 @@ Global
|
|||
{B459AFAD-BB5B-43C3-BD86-609E8DB3E3FD}.Release|iPhoneSimulator.Build.0 = Release|Any CPU
|
||||
{B459AFAD-BB5B-43C3-BD86-609E8DB3E3FD}.Release|x86.ActiveCfg = Release|Any CPU
|
||||
{B459AFAD-BB5B-43C3-BD86-609E8DB3E3FD}.Release|x86.Build.0 = Release|Any CPU
|
||||
{B459AFAD-BB5B-43C3-BD86-609E8DB3E3F1}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
|
||||
{B459AFAD-BB5B-43C3-BD86-609E8DB3E3F1}.Debug|Any CPU.Build.0 = Debug|Any CPU
|
||||
{B459AFAD-BB5B-43C3-BD86-609E8DB3E3F1}.Debug|iPhone.ActiveCfg = Debug|Any CPU
|
||||
{B459AFAD-BB5B-43C3-BD86-609E8DB3E3F1}.Debug|iPhone.Build.0 = Debug|Any CPU
|
||||
{B459AFAD-BB5B-43C3-BD86-609E8DB3E3F1}.Debug|iPhoneSimulator.ActiveCfg = Debug|Any CPU
|
||||
{B459AFAD-BB5B-43C3-BD86-609E8DB3E3F1}.Debug|iPhoneSimulator.Build.0 = Debug|Any CPU
|
||||
{B459AFAD-BB5B-43C3-BD86-609E8DB3E3F1}.Debug|x86.ActiveCfg = Debug|Any CPU
|
||||
{B459AFAD-BB5B-43C3-BD86-609E8DB3E3F1}.Debug|x86.Build.0 = Debug|Any CPU
|
||||
{B459AFAD-BB5B-43C3-BD86-609E8DB3E3F1}.Release|Any CPU.ActiveCfg = Release|Any CPU
|
||||
{B459AFAD-BB5B-43C3-BD86-609E8DB3E3F1}.Release|Any CPU.Build.0 = Release|Any CPU
|
||||
{B459AFAD-BB5B-43C3-BD86-609E8DB3E3F1}.Release|iPhone.ActiveCfg = Release|Any CPU
|
||||
{B459AFAD-BB5B-43C3-BD86-609E8DB3E3F1}.Release|iPhone.Build.0 = Release|Any CPU
|
||||
{B459AFAD-BB5B-43C3-BD86-609E8DB3E3F1}.Release|iPhoneSimulator.ActiveCfg = Release|Any CPU
|
||||
{B459AFAD-BB5B-43C3-BD86-609E8DB3E3F1}.Release|iPhoneSimulator.Build.0 = Release|Any CPU
|
||||
{B459AFAD-BB5B-43C3-BD86-609E8DB3E3F1}.Release|x86.ActiveCfg = Release|Any CPU
|
||||
{B459AFAD-BB5B-43C3-BD86-609E8DB3E3F1}.Release|x86.Build.0 = Release|Any CPU
|
||||
{B459AFAD-BB5B-43C3-BD86-609E8DB3E3FE}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
|
||||
{B459AFAD-BB5B-43C3-BD86-609E8DB3E3FE}.Debug|Any CPU.Build.0 = Debug|Any CPU
|
||||
{B459AFAD-BB5B-43C3-BD86-609E8DB3E3FE}.Debug|iPhone.ActiveCfg = Debug|Any CPU
|
||||
|
@ -345,6 +367,38 @@ Global
|
|||
{10DF5D2F-17FA-43DE-9549-B84E6CF26602}.Release|iPhoneSimulator.Build.0 = Release|Any CPU
|
||||
{10DF5D2F-17FA-43DE-9549-B84E6CF26602}.Release|x86.ActiveCfg = Release|Any CPU
|
||||
{10DF5D2F-17FA-43DE-9549-B84E6CF26602}.Release|x86.Build.0 = Release|Any CPU
|
||||
{23640E46-E830-4AB7-9289-E527F6429435}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
|
||||
{23640E46-E830-4AB7-9289-E527F6429435}.Debug|Any CPU.Build.0 = Debug|Any CPU
|
||||
{23640E46-E830-4AB7-9289-E527F6429435}.Debug|iPhone.ActiveCfg = Debug|Any CPU
|
||||
{23640E46-E830-4AB7-9289-E527F6429435}.Debug|iPhone.Build.0 = Debug|Any CPU
|
||||
{23640E46-E830-4AB7-9289-E527F6429435}.Debug|iPhoneSimulator.ActiveCfg = Debug|Any CPU
|
||||
{23640E46-E830-4AB7-9289-E527F6429435}.Debug|iPhoneSimulator.Build.0 = Debug|Any CPU
|
||||
{23640E46-E830-4AB7-9289-E527F6429435}.Debug|x86.ActiveCfg = Debug|Any CPU
|
||||
{23640E46-E830-4AB7-9289-E527F6429435}.Debug|x86.Build.0 = Debug|Any CPU
|
||||
{23640E46-E830-4AB7-9289-E527F6429435}.Release|Any CPU.ActiveCfg = Release|Any CPU
|
||||
{23640E46-E830-4AB7-9289-E527F6429435}.Release|Any CPU.Build.0 = Release|Any CPU
|
||||
{23640E46-E830-4AB7-9289-E527F6429435}.Release|iPhone.ActiveCfg = Release|Any CPU
|
||||
{23640E46-E830-4AB7-9289-E527F6429435}.Release|iPhone.Build.0 = Release|Any CPU
|
||||
{23640E46-E830-4AB7-9289-E527F6429435}.Release|iPhoneSimulator.ActiveCfg = Release|Any CPU
|
||||
{23640E46-E830-4AB7-9289-E527F6429435}.Release|iPhoneSimulator.Build.0 = Release|Any CPU
|
||||
{23640E46-E830-4AB7-9289-E527F6429435}.Release|x86.ActiveCfg = Release|Any CPU
|
||||
{23640E46-E830-4AB7-9289-E527F6429435}.Release|x86.Build.0 = Release|Any CPU
|
||||
{810EEB40-5042-4946-B695-5B13E9957807}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
|
||||
{810EEB40-5042-4946-B695-5B13E9957807}.Debug|Any CPU.Build.0 = Debug|Any CPU
|
||||
{810EEB40-5042-4946-B695-5B13E9957807}.Debug|iPhone.ActiveCfg = Debug|Any CPU
|
||||
{810EEB40-5042-4946-B695-5B13E9957807}.Debug|iPhone.Build.0 = Debug|Any CPU
|
||||
{810EEB40-5042-4946-B695-5B13E9957807}.Debug|iPhoneSimulator.ActiveCfg = Debug|Any CPU
|
||||
{810EEB40-5042-4946-B695-5B13E9957807}.Debug|iPhoneSimulator.Build.0 = Debug|Any CPU
|
||||
{810EEB40-5042-4946-B695-5B13E9957807}.Debug|x86.ActiveCfg = Debug|Any CPU
|
||||
{810EEB40-5042-4946-B695-5B13E9957807}.Debug|x86.Build.0 = Debug|Any CPU
|
||||
{810EEB40-5042-4946-B695-5B13E9957807}.Release|Any CPU.ActiveCfg = Release|Any CPU
|
||||
{810EEB40-5042-4946-B695-5B13E9957807}.Release|Any CPU.Build.0 = Release|Any CPU
|
||||
{810EEB40-5042-4946-B695-5B13E9957807}.Release|iPhone.ActiveCfg = Release|Any CPU
|
||||
{810EEB40-5042-4946-B695-5B13E9957807}.Release|iPhone.Build.0 = Release|Any CPU
|
||||
{810EEB40-5042-4946-B695-5B13E9957807}.Release|iPhoneSimulator.ActiveCfg = Release|Any CPU
|
||||
{810EEB40-5042-4946-B695-5B13E9957807}.Release|iPhoneSimulator.Build.0 = Release|Any CPU
|
||||
{810EEB40-5042-4946-B695-5B13E9957807}.Release|x86.ActiveCfg = Release|Any CPU
|
||||
{810EEB40-5042-4946-B695-5B13E9957807}.Release|x86.Build.0 = Release|Any CPU
|
||||
EndGlobalSection
|
||||
GlobalSection(SolutionProperties) = preSolution
|
||||
HideSolutionNode = FALSE
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
// Copyright 2018 Elmish.XamarinForms contributors. See LICENSE.md for license.
|
||||
// Copyright 2018 Elmish and Elmish.XamarinForms contributors. See LICENSE.md for license.
|
||||
namespace Elmish.XamarinForms
|
||||
|
||||
open System
|
||||
|
@ -17,9 +17,12 @@ module Values =
|
|||
type internal ProgramDispatch<'msg>() =
|
||||
static let mutable dispatchImpl = (fun (_msg: 'msg) -> failwith "do not call dispatch during initialization" : unit)
|
||||
|
||||
static let dispatch = id (fun msg -> dispatchImpl msg)
|
||||
static let dispatch =
|
||||
id (fun msg ->
|
||||
dispatchImpl msg)
|
||||
|
||||
static member Dispatch with get () = dispatch and set v = dispatchImpl <- v
|
||||
static member DispatchViaThunk = dispatch
|
||||
static member SetDispatchThunk v = dispatchImpl <- v
|
||||
|
||||
/// Program type captures various aspects of program behavior
|
||||
type Program<'model, 'msg, 'view> =
|
||||
|
@ -31,28 +34,30 @@ type Program<'model, 'msg, 'view> =
|
|||
onError : (string*exn) -> unit }
|
||||
|
||||
/// Starts the Elmish dispatch loop for the page with the given Elmish program
|
||||
type ProgramRunner<'model, 'msg>(app: Application, program: Program<'model, 'msg, _>) =
|
||||
type ProgramRunner<'model, 'msg>(app: Application, program: Program<'model, 'msg, 'model -> ('msg -> unit) -> ViewElement>) =
|
||||
|
||||
do Debug.WriteLine "run: computing initial model"
|
||||
|
||||
// Get the initial model
|
||||
let (initialModel,cmd) = program.init ()
|
||||
let mutable alternativeRunner : ProgramRunner<obj,obj> option = None
|
||||
|
||||
let mutable lastModel = initialModel
|
||||
let mutable lastViewDataOpt = None
|
||||
let dispatch = ProgramDispatch<'msg>.Dispatch
|
||||
let dispatch = ProgramDispatch<'msg>.DispatchViaThunk
|
||||
let mutable reset = (fun () -> ())
|
||||
|
||||
// If the view is dynamic, create the initial page
|
||||
let viewInfo, mainPage =
|
||||
let pageDescription : ViewElement = program.view initialModel dispatch
|
||||
let pageObj = pageDescription.Create()
|
||||
let pageElement : ViewElement = program.view initialModel dispatch
|
||||
let pageObj = pageElement.Create()
|
||||
let mainPage =
|
||||
match pageObj with
|
||||
| :? Page as page -> page
|
||||
| _ -> failwithf "Incorrect model type: expected a page but got a %O" (pageObj.GetType())
|
||||
app.MainPage <- mainPage
|
||||
//app.Properties.["model"] <- initialModel
|
||||
(pageDescription), mainPage
|
||||
pageElement, mainPage
|
||||
|
||||
// Start Elmish dispatch loop
|
||||
let rec processMsg msg =
|
||||
|
@ -76,21 +81,27 @@ type ProgramRunner<'model, 'msg>(app: Application, program: Program<'model, 'msg
|
|||
| None ->
|
||||
lastViewDataOpt <- Some viewInfo
|
||||
|
||||
| Some prevPageDescription ->
|
||||
let newPageDescription: ViewElement = program.view updatedModel dispatch
|
||||
if canReuseChild prevPageDescription newPageDescription then
|
||||
newPageDescription.UpdateIncremental (prevPageDescription, app.MainPage)
|
||||
| Some prevPageElement ->
|
||||
let newPageElement: ViewElement = program.view updatedModel dispatch
|
||||
if canReuseChild prevPageElement newPageElement then
|
||||
newPageElement.UpdateIncremental (prevPageElement, app.MainPage)
|
||||
else
|
||||
let pageObj = newPageDescription.Create()
|
||||
let pageObj = newPageElement.Create()
|
||||
match pageObj with
|
||||
| :? Page as page -> app.MainPage <- page
|
||||
| _ -> failwithf "Incorrect model type: expected a page but got a %O" (pageObj.GetType())
|
||||
|
||||
lastViewDataOpt <- Some newPageDescription
|
||||
lastViewDataOpt <- Some newPageElement
|
||||
|
||||
do
|
||||
// Set up the global dispatch function
|
||||
ProgramDispatch<'msg>.Dispatch <- (fun msg -> Device.BeginInvokeOnMainThread(fun () -> processMsg msg))
|
||||
ProgramDispatch<'msg>.SetDispatchThunk (fun msg ->
|
||||
Device.BeginInvokeOnMainThread(fun () ->
|
||||
processMsg msg))
|
||||
|
||||
reset <- (fun () ->
|
||||
Device.BeginInvokeOnMainThread(fun () ->
|
||||
updateView lastModel))
|
||||
|
||||
Debug.WriteLine "updating the initial view"
|
||||
|
||||
|
@ -103,14 +114,32 @@ type ProgramRunner<'model, 'msg>(app: Application, program: Program<'model, 'msg
|
|||
member __.InitialMainPage = mainPage
|
||||
|
||||
member __.CurrentModel = lastModel
|
||||
|
||||
member runner.ChangeProgram(newProgram: Program<obj, obj, obj -> (obj -> unit) -> ViewElement>) : unit =
|
||||
Device.BeginInvokeOnMainThread(fun () ->
|
||||
// TODO: transmogrify the model
|
||||
alternativeRunner <- Some (ProgramRunner<obj, obj>(app, newProgram))
|
||||
)
|
||||
|
||||
member __.ResetView() : unit =
|
||||
Device.BeginInvokeOnMainThread(fun () ->
|
||||
match alternativeRunner with
|
||||
| Some r -> r.ResetView()
|
||||
| None -> reset()
|
||||
)
|
||||
|
||||
/// Set the current model, e.g. on resume
|
||||
member __.SetCurrentModel(model, cmd: Cmd<_>) =
|
||||
Debug.WriteLine "updating the view after setting the model"
|
||||
lastModel <- model
|
||||
updateView model
|
||||
for sub in program.subscribe model @ cmd do
|
||||
sub dispatch
|
||||
Device.BeginInvokeOnMainThread(fun () ->
|
||||
match alternativeRunner with
|
||||
| Some _ -> failwith "SetCurrentModel: can't access runner after ChangeProgram has been called"
|
||||
| None ->
|
||||
Debug.WriteLine "updating the view after setting the model"
|
||||
lastModel <- model
|
||||
updateView model
|
||||
for sub in program.subscribe model @ cmd do
|
||||
sub dispatch
|
||||
)
|
||||
|
||||
/// Program module - functions to manipulate program instances
|
||||
[<RequireQualifiedAccess>]
|
||||
|
@ -157,6 +186,24 @@ module Program =
|
|||
init = traceInit
|
||||
update = traceUpdate }
|
||||
|
||||
|
||||
/// Trace all the updates to the console
|
||||
let withLiveReload (program: Program<'model, 'msg, 'view>) =
|
||||
let traceInit () =
|
||||
let initModel,cmd = program.init ()
|
||||
Console.WriteLine (sprintf "Initial model: %0A" initModel)
|
||||
initModel,cmd
|
||||
|
||||
let traceUpdate msg model =
|
||||
Console.WriteLine (sprintf "Message: %0A" msg)
|
||||
let newModel,cmd = program.update msg model
|
||||
Console.WriteLine (sprintf "Updated model: %0A" newModel)
|
||||
newModel,cmd
|
||||
|
||||
{ program with
|
||||
init = traceInit
|
||||
update = traceUpdate }
|
||||
|
||||
/// Trace all the messages as they update the model
|
||||
let withTrace trace (program: Program<'model, 'msg, 'view>) =
|
||||
{ program
|
||||
|
@ -175,11 +222,6 @@ module Program =
|
|||
let runWithDynamicView (app : Application) (program: Program<'model, 'msg, _>) =
|
||||
ProgramRunner(app, program)
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
/// Creates the view model for the given page and starts the Elmish dispatch loop for the matching program
|
||||
[<Obsolete("Please use Program.runWithDynamicView", true)>]
|
||||
let run app program = ProgramRunner(app,program)
|
||||
|
|
|
@ -1,4 +1,5 @@
|
|||
namespace Elmish.XamarinForms
|
||||
// Copyright 2018 Elmish.XamarinForms contributors. See LICENSE.md for license.
|
||||
namespace Elmish.XamarinForms
|
||||
|
||||
open System
|
||||
open System.Diagnostics
|
||||
|
|
|
@ -26,7 +26,7 @@ module StaticView =
|
|||
|
||||
let mutable lastModel = initialModel
|
||||
let mutable lastViewData = None
|
||||
let dispatch = ProgramDispatch<'msg>.Dispatch
|
||||
let dispatch = ProgramDispatch<'msg>.DispatchViaThunk
|
||||
|
||||
do Debug.WriteLine "run: computing static components of view"
|
||||
|
||||
|
@ -65,7 +65,7 @@ module StaticView =
|
|||
|
||||
do
|
||||
// Set up the global dispatch function
|
||||
ProgramDispatch<'msg>.Dispatch <- (fun msg -> Device.BeginInvokeOnMainThread(fun () -> processMsg msg))
|
||||
ProgramDispatch<'msg>.SetDispatchThunk (fun msg -> Device.BeginInvokeOnMainThread(fun () -> processMsg msg))
|
||||
|
||||
Debug.WriteLine "updating the initial view"
|
||||
|
||||
|
|
|
@ -1,3 +1,5 @@
|
|||
// Copyright 2018 Elmish.XamarinForms contributors. See LICENSE.md for license.
|
||||
|
||||
namespace Elmish.XamarinForms.DynamicViews
|
||||
|
||||
open System
|
||||
|
|
|
@ -1,3 +1,5 @@
|
|||
// Copyright 2018 Elmish.XamarinForms contributors. See LICENSE.md for license.
|
||||
|
||||
namespace Elmish.XamarinForms.DynamicViews
|
||||
|
||||
#nowarn "67" // cast always holds
|
||||
|
|
|
@ -1,4 +1,6 @@
|
|||
// dotnet build -c Release Generator\Generator.fsproj && dotnet Generator\bin\Release\netcoreapp2.0\Generator.dll Generator\Xamarin.Forms.Core.json Elmish.XamarinForms\Xamarin.Forms.Core.fs
|
||||
// Copyright 2018 Elmish.XamarinForms contributors. See LICENSE.md for license.
|
||||
|
||||
// dotnet build -c Release Generator\Generator.fsproj && dotnet Generator\bin\Release\netcoreapp2.0\Generator.dll Generator\Xamarin.Forms.Core.json Elmish.XamarinForms\Xamarin.Forms.Core.fs
|
||||
|
||||
module Generator
|
||||
|
||||
|
|
|
@ -671,4 +671,5 @@ type App () as app =
|
|||
let runner =
|
||||
Program.mkSimple App.init App.update App.view
|
||||
|> Program.withConsoleTrace
|
||||
//|> Program.withLiveReload app
|
||||
|> Program.runWithDynamicView app
|
||||
|
|
|
@ -18,8 +18,8 @@
|
|||
<MonoAndroidResourcePrefix>Resources</MonoAndroidResourcePrefix>
|
||||
<MonoAndroidAssetsPrefix>Assets</MonoAndroidAssetsPrefix>
|
||||
<AndroidUseLatestPlatformSdk>true</AndroidUseLatestPlatformSdk>
|
||||
<SelectedDevice>Google Pixel 2</SelectedDevice>
|
||||
<DefaultDevice>new_device</DefaultDevice>
|
||||
<SelectedDevice>emulator_pixel</SelectedDevice>
|
||||
<DefaultDevice>emulator_pixel</DefaultDevice>
|
||||
<Name>AllControls.Droid</Name>
|
||||
<AutoGenerateBindingRedirects>true</AutoGenerateBindingRedirects>
|
||||
</PropertyGroup>
|
||||
|
|
Разница между файлами не показана из-за своего большого размера
Загрузить разницу
|
@ -2,13 +2,13 @@
|
|||
namespace CounterApp
|
||||
|
||||
open System.Diagnostics
|
||||
open Elmish.XamarinForms
|
||||
open Elmish.XamarinForms
|
||||
open Elmish.XamarinForms.DynamicViews
|
||||
open Xamarin.Forms
|
||||
|
||||
module App =
|
||||
type Model =
|
||||
{ Count : int
|
||||
{ Count : int
|
||||
Step : int
|
||||
TimerOn: bool }
|
||||
|
||||
|
@ -20,11 +20,11 @@ module App =
|
|||
| TimerToggled of bool
|
||||
| TimedTick
|
||||
|
||||
let initModel = { Count = 0; Step = 1; TimerOn=false }
|
||||
let initModel () = { Count = 0; Step = 1; TimerOn=false }
|
||||
|
||||
let init () = initModel, Cmd.none
|
||||
let init () = initModel () , Cmd.none
|
||||
|
||||
let timerCmd =
|
||||
let timerCmd () =
|
||||
async { do! Async.Sleep 200
|
||||
return TimedTick }
|
||||
|> Cmd.ofAsyncMsg
|
||||
|
@ -35,41 +35,46 @@ module App =
|
|||
| Decrement -> { model with Count = model.Count - model.Step }, Cmd.none
|
||||
| Reset -> init ()
|
||||
| SetStep n -> { model with Step = n }, Cmd.none
|
||||
| TimerToggled on -> { model with TimerOn = on }, (if on then timerCmd else Cmd.none)
|
||||
| TimedTick -> if model.TimerOn then { model with Count = model.Count + model.Step }, timerCmd else model, Cmd.none
|
||||
| TimerToggled on -> { model with TimerOn = on }, (if on then timerCmd() else Cmd.none)
|
||||
| TimedTick -> if model.TimerOn then { model with Count = model.Count + model.Step }, timerCmd() else model, Cmd.none
|
||||
|
||||
let view (model: Model) dispatch =
|
||||
let view (model: Model) dispatch =
|
||||
Xaml.ContentPage(
|
||||
content=Xaml.StackLayout(padding=20.0,
|
||||
content=Xaml.StackLayout(padding=30.0,verticalOptions = LayoutOptions.Center,
|
||||
children=[
|
||||
yield
|
||||
Xaml.StackLayout(padding=20.0, verticalOptions=LayoutOptions.Center,
|
||||
children=[
|
||||
Xaml.Label(text= sprintf "%d" model.Count, horizontalOptions=LayoutOptions.Center, fontSize = "Large")
|
||||
Xaml.Button(text="Increment", command= fixf (fun () -> dispatch Increment))
|
||||
Xaml.Button(text="Decrement", command= fixf (fun () -> dispatch Decrement))
|
||||
Xaml.StackLayout(padding=20.0, orientation=StackOrientation.Horizontal, horizontalOptions=LayoutOptions.Center,
|
||||
children = [ Xaml.Label(text="Timer")
|
||||
Xaml.Switch(isToggled=model.TimerOn, toggled=fixf(fun on -> dispatch (TimerToggled on.Value))) ])
|
||||
Xaml.Slider(minimum=0.0, maximum=10.0, value= double model.Step, valueChanged=fixf(fun args -> dispatch (SetStep (int (args.NewValue + 0.5)))))
|
||||
Xaml.Label(text=sprintf "Step size: %d" model.Step, horizontalOptions=LayoutOptions.Center)
|
||||
])
|
||||
// If you want the button to disappear when in the initial condition then use this:
|
||||
//if model <> initModel then
|
||||
yield Xaml.Button(text="Reset", horizontalOptions=LayoutOptions.Center, command=fixf(fun () -> dispatch Reset), canExecute = (model <> initModel))
|
||||
]))
|
||||
yield Xaml.Label(text= sprintf "%d" model.Count, horizontalOptions=LayoutOptions.Center, fontSize = "Large")
|
||||
yield Xaml.Button(text="Increment", command= (fun () -> dispatch Increment))
|
||||
yield Xaml.Button(text="Decrement", command= (fun () -> dispatch Decrement))
|
||||
yield Xaml.StackLayout(padding=20.0, orientation=StackOrientation.Horizontal, horizontalOptions=LayoutOptions.Center,
|
||||
children = [ Xaml.Label(text="Timer")
|
||||
Xaml.Switch(isToggled=model.TimerOn, toggled=(fun on -> dispatch (TimerToggled on.Value))) ])
|
||||
yield Xaml.Slider(minimum=0.0, maximum=10.0, value= double model.Step, valueChanged=(fun args -> dispatch (SetStep (int (args.NewValue + 0.5)))))
|
||||
yield Xaml.Label(text=sprintf "Step size: %d" model.Step, horizontalOptions=LayoutOptions.Center)
|
||||
//if model <> initModel () then
|
||||
yield Xaml.Button(text="Reset", horizontalOptions=LayoutOptions.Center, command=fixf(fun () -> dispatch Reset), canExecute = (model <> initModel () ))
|
||||
]))
|
||||
|
||||
let program =
|
||||
Program.mkProgram init update view
|
||||
|> Program.withConsoleTrace
|
||||
|
||||
#if TESTEVAL
|
||||
let testInit = fst (init ())
|
||||
let testView = view testInit (fun _ -> ())
|
||||
#endif
|
||||
|
||||
type CounterApp () as app =
|
||||
inherit Application ()
|
||||
|
||||
let program = Program.mkProgram App.init App.update App.view
|
||||
let runner =
|
||||
program
|
||||
#if DEBUG
|
||||
|> Program.withConsoleTrace
|
||||
#endif
|
||||
|> Program.runWithDynamicView app
|
||||
let runner = App.program |> Program.runWithDynamicView app
|
||||
|
||||
#if DEBUG && !TESTEVAL
|
||||
do runner.EnableLiveUpdate ()
|
||||
#endif
|
||||
|
||||
|
||||
(*
|
||||
#if !NO_SAVE_MODEL_WITH_JSON
|
||||
let modelId = "model"
|
||||
let serializer = MBrace.FsPickler.Json.FsPickler.CreateJsonSerializer()
|
||||
|
@ -100,3 +105,4 @@ type CounterApp () as app =
|
|||
override this.OnStart() = this.OnResume()
|
||||
|
||||
#endif
|
||||
*)
|
||||
|
|
|
@ -9,6 +9,7 @@
|
|||
</ItemGroup>
|
||||
<ItemGroup>
|
||||
<ProjectReference Include="..\..\..\Elmish.XamarinForms\Elmish.XamarinForms.fsproj" />
|
||||
<ProjectReference Include="..\..\..\Elmish.XamarinForms.LiveUpdate\Elmish.XamarinForms.LiveUpdate.fsproj" />
|
||||
<PackageReference Include="FSharp.Core" Version="4.5.0" />
|
||||
<PackageReference Include="FsPickler" Version="5.2.0" />
|
||||
<PackageReference Include="FsPickler.Json" Version="5.2.0" />
|
||||
|
|
|
@ -0,0 +1,147 @@
|
|||
-o:obj\Debug\netstandard2.0\CounterApp.dll
|
||||
-g
|
||||
--debug:portable
|
||||
--noframework
|
||||
--define:TRACE
|
||||
--define:DEBUG
|
||||
--define:NETSTANDARD2_0
|
||||
--define:TESTEVAL
|
||||
--optimize-
|
||||
-r:C:\GitHub\dsyme\Elmish.XamarinForms\Elmish.XamarinForms\bin\Debug\netstandard2.0\Elmish.XamarinForms.dll
|
||||
-r:C:\GitHub\dsyme\Elmish.XamarinForms\Elmish.XamarinForms.LiveUpdate\bin\Debug\netstandard2.0\Elmish.XamarinForms.LiveUpdate.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\fsharp.core\4.5.0\lib\netstandard1.6\FSharp.Core.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\fspickler\5.2.0\lib\netstandard2.0\FsPickler.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\fspickler.json\5.2.0\lib\netstandard2.0\FsPickler.Json.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\microsoft.csharp\4.3.0\ref\netstandard1.0\Microsoft.CSharp.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\Microsoft.Win32.Primitives.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\mscorlib.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\netstandard.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\newtonsoft.json\10.0.1\lib\netstandard1.3\Newtonsoft.Json.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.AppContext.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Collections.Concurrent.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Collections.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Collections.NonGeneric.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Collections.Specialized.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.ComponentModel.Composition.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.ComponentModel.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.ComponentModel.EventBasedAsync.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.ComponentModel.Primitives.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.ComponentModel.TypeConverter.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Console.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Core.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Data.Common.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Data.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Diagnostics.Contracts.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Diagnostics.Debug.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Diagnostics.FileVersionInfo.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Diagnostics.Process.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Diagnostics.StackTrace.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Diagnostics.TextWriterTraceListener.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Diagnostics.Tools.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Diagnostics.TraceSource.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Diagnostics.Tracing.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Drawing.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Drawing.Primitives.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Dynamic.Runtime.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Globalization.Calendars.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Globalization.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Globalization.Extensions.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.IO.Compression.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.IO.Compression.FileSystem.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.IO.Compression.ZipFile.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.IO.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.IO.FileSystem.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.IO.FileSystem.DriveInfo.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.IO.FileSystem.Primitives.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.IO.FileSystem.Watcher.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.IO.IsolatedStorage.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.IO.MemoryMappedFiles.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.IO.Pipes.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.IO.UnmanagedMemoryStream.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Linq.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Linq.Expressions.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Linq.Parallel.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Linq.Queryable.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Net.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Net.Http.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Net.NameResolution.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Net.NetworkInformation.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Net.Ping.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Net.Primitives.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Net.Requests.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Net.Security.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Net.Sockets.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Net.WebHeaderCollection.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Net.WebSockets.Client.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Net.WebSockets.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Numerics.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.ObjectModel.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Reflection.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\system.reflection.emit.ilgeneration\4.3.0\ref\netstandard1.0\System.Reflection.Emit.ILGeneration.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\system.reflection.emit.lightweight\4.3.0\ref\netstandard1.0\System.Reflection.Emit.Lightweight.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Reflection.Extensions.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Reflection.Primitives.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Resources.Reader.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Resources.ResourceManager.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Resources.Writer.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Runtime.CompilerServices.VisualC.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Runtime.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Runtime.Extensions.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Runtime.Handles.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Runtime.InteropServices.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Runtime.InteropServices.RuntimeInformation.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Runtime.Numerics.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Runtime.Serialization.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Runtime.Serialization.Formatters.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Runtime.Serialization.Json.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Runtime.Serialization.Primitives.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Runtime.Serialization.Xml.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Security.Claims.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Security.Cryptography.Algorithms.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Security.Cryptography.Csp.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Security.Cryptography.Encoding.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Security.Cryptography.Primitives.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Security.Cryptography.X509Certificates.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Security.Principal.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Security.SecureString.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.ServiceModel.Web.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Text.Encoding.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Text.Encoding.Extensions.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Text.RegularExpressions.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Threading.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Threading.Overlapped.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Threading.Tasks.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Threading.Tasks.Parallel.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Threading.Thread.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Threading.ThreadPool.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Threading.Timer.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Transactions.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.ValueTuple.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Web.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Windows.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Xml.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Xml.Linq.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Xml.ReaderWriter.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Xml.Serialization.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Xml.XDocument.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Xml.XmlDocument.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Xml.XmlSerializer.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Xml.XPath.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Xml.XPath.XDocument.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\xamarin.forms\3.0.0.482510\lib\netstandard2.0\Xamarin.Forms.Core.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\xamarin.forms\3.0.0.482510\lib\netstandard2.0\Xamarin.Forms.Platform.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\xamarin.forms\3.0.0.482510\lib\netstandard2.0\Xamarin.Forms.Xaml.dll
|
||||
--target:library
|
||||
--warn:3
|
||||
--warnaserror:76
|
||||
--preferreduilang:en-US
|
||||
--fullpaths
|
||||
--flaterrors
|
||||
--highentropyva-
|
||||
--targetprofile:netstandard
|
||||
--simpleresolution
|
||||
--nocopyfsharpcore
|
||||
CounterApp.fs
|
||||
AssemblyInfo.fs
|
||||
C:\Users\dsyme\AppData\Local\Temp\.NETStandard,Version=v2.0.AssemblyAttributes.fs
|
|
@ -20,6 +20,7 @@
|
|||
<AndroidUseLatestPlatformSdk>true</AndroidUseLatestPlatformSdk>
|
||||
<SelectedDevice>Google Pixel 2</SelectedDevice>
|
||||
<AutoGenerateBindingRedirects>true</AutoGenerateBindingRedirects>
|
||||
<DefaultDevice>emulator_pixel</DefaultDevice>
|
||||
</PropertyGroup>
|
||||
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Debug|AnyCPU' ">
|
||||
<DebugSymbols>true</DebugSymbols>
|
||||
|
@ -43,6 +44,7 @@
|
|||
<AndroidManagedSymbols>true</AndroidManagedSymbols>
|
||||
<AndroidUseSharedRuntime>false</AndroidUseSharedRuntime>
|
||||
<GenerateTailCalls>true</GenerateTailCalls>
|
||||
<AndroidLinkMode>None</AndroidLinkMode>
|
||||
<PlatformTarget>
|
||||
</PlatformTarget>
|
||||
</PropertyGroup>
|
||||
|
@ -75,6 +77,11 @@
|
|||
<None Include="Assets\AboutAssets.txt" />
|
||||
</ItemGroup>
|
||||
<ItemGroup>
|
||||
<ProjectReference Include="..\..\..\Elmish.XamarinForms.LiveUpdate\Elmish.XamarinForms.LiveUpdate.fsproj">
|
||||
<Name>Elmish.XamarinForms.LiveUpdate</Name>
|
||||
<Project>{b459afad-bb5b-43c3-bd86-609e8db3e3f1}</Project>
|
||||
<Private>True</Private>
|
||||
</ProjectReference>
|
||||
<ProjectReference Include="..\..\..\Elmish.XamarinForms\Elmish.XamarinForms.fsproj">
|
||||
<Name>Elmish.XamarinForms</Name>
|
||||
<Project>{b459afad-bb5b-43c3-bd86-609e8db3e3fd}</Project>
|
||||
|
|
|
@ -1,6 +1,8 @@
|
|||
<?xml version="1.0" encoding="utf-8"?>
|
||||
<manifest xmlns:android="http://schemas.android.com/apk/res/android" android:versionCode="1" android:versionName="1.0" package="com.companyname.CounterApp">
|
||||
<uses-sdk android:minSdkVersion="15" />
|
||||
<application android:label="CounterApp">
|
||||
</application>
|
||||
</manifest>
|
||||
<manifest xmlns:android="http://schemas.android.com/apk/res/android" android:versionCode="1" android:versionName="1.0" package="com.companyname.CounterApp" android:installLocation="internalOnly">
|
||||
<uses-sdk android:minSdkVersion="10" />
|
||||
<uses-permission android:name="android.permission.INTERNET" />
|
||||
<uses-permission android:name="android.permission.ACCESS_NETWORK_STATE" />
|
||||
<uses-permission android:name="android.permission.CHANGE_NETWORK_STATE" />
|
||||
<application android:label="CounterApp"></application>
|
||||
</manifest>
|
|
@ -124,6 +124,11 @@
|
|||
</Reference>
|
||||
</ItemGroup>
|
||||
<ItemGroup>
|
||||
<ProjectReference Include="..\..\..\Elmish.XamarinForms.LiveUpdate\Elmish.XamarinForms.LiveUpdate.fsproj">
|
||||
<Name>Elmish.XamarinForms.LiveUpdate</Name>
|
||||
<Project>{b459afad-bb5b-43c3-bd86-609e8db3e3f1}</Project>
|
||||
<Private>True</Private>
|
||||
</ProjectReference>
|
||||
<ProjectReference Include="..\..\..\Elmish.XamarinForms\Elmish.XamarinForms.fsproj">
|
||||
<Name>Elmish.XamarinForms</Name>
|
||||
<Project>{b459afad-bb5b-43c3-bd86-609e8db3e3fd}</Project>
|
||||
|
|
Разница между файлами не показана из-за своего большого размера
Загрузить разницу
Разница между файлами не показана из-за своего большого размера
Загрузить разницу
|
@ -179,6 +179,24 @@
|
|||
<Reference Include="FSharp.Core">
|
||||
<HintPath>../../../packages/androidapp/FSharp.Core/lib/netstandard1.6/FSharp.Core.dll</HintPath>
|
||||
</Reference>
|
||||
<Reference Include="FsPickler">
|
||||
<HintPath>..\..\..\packages\neutral\FsPickler\lib\netstandard2.0\FsPickler.dll</HintPath>
|
||||
</Reference>
|
||||
<Reference Include="FsPickler">
|
||||
<HintPath>..\..\..\packages\neutral\FsPickler\lib\netstandard2.0\FsPickler.dll</HintPath>
|
||||
</Reference>
|
||||
<Reference Include="FsPickler.Json">
|
||||
<HintPath>..\..\..\packages\neutral\FsPickler.Json\lib\netstandard2.0\FsPickler.Json.dll</HintPath>
|
||||
</Reference>
|
||||
<Reference Include="Microsoft.CSharp" />
|
||||
<Reference Include="Newtonsoft.Json">
|
||||
<HintPath>..\..\..\packages\neutral\Newtonsoft.Json\lib\netstandard1.3\Newtonsoft.Json.dll</HintPath>
|
||||
</Reference>
|
||||
<ProjectReference Include="..\..\..\Elmish.XamarinForms.LiveUpdate\Elmish.XamarinForms.LiveUpdate.fsproj">
|
||||
<Name>Elmish.XamarinForms.LiveUpdate</Name>
|
||||
<Project>{b459afad-bb5b-43c3-bd86-609e8db3e3f1}</Project>
|
||||
<Private>True</Private>
|
||||
</ProjectReference>
|
||||
<ProjectReference Include="..\TicTacToe\TicTacToe.fsproj">
|
||||
<Project>{AE045D79-7FF3-45F3-BFD0-305542A1C728}</Project>
|
||||
<Name>TicTacToe</Name>
|
||||
|
|
|
@ -11,6 +11,7 @@ type Player =
|
|||
| X
|
||||
| O
|
||||
member p.Swap = match p with X -> O | O -> X
|
||||
member p.Name = match p with X -> "X" | Y -> "Y"
|
||||
|
||||
/// Represents the game state contents of a single cell
|
||||
type GameCell =
|
||||
|
@ -47,6 +48,9 @@ type Model =
|
|||
|
||||
/// The state of play on the board
|
||||
Board: Board
|
||||
|
||||
/// The state of play on the board
|
||||
GameScore: (int * int)
|
||||
|
||||
/// The model occasionally includes things related to the view. In this case,
|
||||
/// we track the desired visual size of the board, to ensure a square, in response to
|
||||
|
@ -71,6 +75,7 @@ module App =
|
|||
let init () =
|
||||
{ NextUp = X
|
||||
Board = initialBoard
|
||||
GameScore = (0,0)
|
||||
VisualBoardSize = None }
|
||||
|
||||
/// Check if there are any more moves available in the game
|
||||
|
@ -108,8 +113,8 @@ module App =
|
|||
/// Get a message to show the current game result
|
||||
let getMessage model =
|
||||
match getGameResult model with
|
||||
| StillPlaying -> sprintf "%O's turn" model.NextUp
|
||||
| Win p -> sprintf "%O wins!" p
|
||||
| StillPlaying -> sprintf "%s's turn" model.NextUp.Name
|
||||
| Win p -> sprintf "%s wins!" p.Name
|
||||
| Draw -> "It is a draw!"
|
||||
|
||||
/// The 'update' function to update the model
|
||||
|
@ -129,8 +134,14 @@ module App =
|
|||
if result <> StillPlaying then
|
||||
gameOver (getMessage newModel)
|
||||
|
||||
let newModel2 =
|
||||
let (x,y) = newModel.GameScore
|
||||
match result with
|
||||
| Win p -> { newModel with GameScore = (if p = X then (x+1, y) else (x, y+1)) }
|
||||
| _ -> newModel
|
||||
|
||||
// Return the new model.
|
||||
newModel
|
||||
newModel2
|
||||
|
||||
/// A helper used in the 'view' function to get the name
|
||||
/// of the Xaml resource for the image for a player
|
||||
|
@ -178,30 +189,47 @@ module App =
|
|||
?widthRequest = model.VisualBoardSize,
|
||||
?heightRequest = model.VisualBoardSize).GridRow(0)
|
||||
|
||||
Xaml.Label(text=getMessage model, margin=10.0, textColor=Color.Black, horizontalTextAlignment=TextAlignment.Center, fontSize="Large").GridRow(1)
|
||||
Xaml.Label(text=getMessage model, margin=10.0, textColor=Color.Black,
|
||||
horizontalOptions=LayoutOptions.Center,
|
||||
verticalOptions=LayoutOptions.Center,
|
||||
horizontalTextAlignment=TextAlignment.Center, verticalTextAlignment=TextAlignment.Center, fontSize="Large").GridRow(1)
|
||||
|
||||
Xaml.Button(command=(fun () -> dispatch Restart), text="Restart game", backgroundColor=Color.LightBlue, textColor=Color.Black, fontSize="Large").GridRow(2)
|
||||
]),
|
||||
|
||||
// This requests a square board based on the width we get allocated on the device
|
||||
onSizeAllocated=(fun (width, height) ->
|
||||
if model.VisualBoardSize.IsNone then
|
||||
match model.VisualBoardSize with
|
||||
| None ->
|
||||
let sz = min width height - 80.0
|
||||
dispatch (SetVisualBoardSize sz)))])
|
||||
dispatch (SetVisualBoardSize sz)
|
||||
| Some _ ->
|
||||
() ))])
|
||||
|
||||
// Display a modal message giving the game result. This is doing a UI
|
||||
// action in the model update, which is ok for modal messages. We factor
|
||||
// this dependency out to allow unit testing of the 'update' function.
|
||||
|
||||
let gameOver msg =
|
||||
Application.Current.MainPage.DisplayAlert("Game over", msg, "OK") |> ignore
|
||||
|
||||
let program =
|
||||
Program.mkSimple init (update gameOver) view
|
||||
|> Program.withConsoleTrace
|
||||
|
||||
#if TESTEVAL
|
||||
let testInit = init ()
|
||||
let testView = view testInit (fun _ -> ())
|
||||
#endif
|
||||
|
||||
/// Stitch the model, update and view content into a single app.
|
||||
type App() as app =
|
||||
inherit Application()
|
||||
|
||||
// Display a modal message giving the game result. This is doing a UI
|
||||
// action in the model update, which is ok for modal messages. We factor
|
||||
// this dependency out to allow unit testing of the 'update' function.
|
||||
let gameOver msg =
|
||||
Application.Current.MainPage.DisplayAlert("Game over", msg, "OK") |> ignore
|
||||
|
||||
let runner =
|
||||
Program.mkSimple App.init (App.update gameOver) App.view
|
||||
#if DEBUG
|
||||
|> Program.withConsoleTrace
|
||||
#endif
|
||||
App.program
|
||||
|> Program.runWithDynamicView app
|
||||
|
||||
#if DEBUG && !TESTEVAL
|
||||
do runner.EnableLiveUpdate ()
|
||||
#endif
|
||||
|
|
|
@ -9,7 +9,10 @@
|
|||
</ItemGroup>
|
||||
<ItemGroup>
|
||||
<PackageReference Include="FSharp.Core" Version="4.5.0" />
|
||||
<PackageReference Include="FsPickler" Version="5.2.0" />
|
||||
<PackageReference Include="FsPickler.Json" Version="5.2.0" />
|
||||
<PackageReference Include="Xamarin.Forms" Version="3.0.0.482510" />
|
||||
<ProjectReference Include="..\..\..\Elmish.XamarinForms.LiveUpdate\Elmish.XamarinForms.LiveUpdate.fsproj" />
|
||||
<ProjectReference Include="..\..\..\Elmish.XamarinForms\Elmish.XamarinForms.fsproj" />
|
||||
</ItemGroup>
|
||||
</Project>
|
|
@ -0,0 +1,147 @@
|
|||
-o:obj\Debug\netstandard2.0\TicTacToe.dll
|
||||
-g
|
||||
--debug:portable
|
||||
--noframework
|
||||
--define:TESTEVAL
|
||||
--define:TRACE
|
||||
--define:DEBUG
|
||||
--define:NETSTANDARD2_0
|
||||
--optimize-
|
||||
-r:C:\GitHub\dsyme\Elmish.XamarinForms\Elmish.XamarinForms\bin\Debug\netstandard2.0\Elmish.XamarinForms.dll
|
||||
-r:C:\GitHub\dsyme\Elmish.XamarinForms\Elmish.XamarinForms.LiveUpdate\bin\Debug\netstandard2.0\Elmish.XamarinForms.LiveUpdate.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\fsharp.core\4.5.0\lib\netstandard1.6\FSharp.Core.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\fspickler\5.2.0\lib\netstandard2.0\FsPickler.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\fspickler.json\5.2.0\lib\netstandard2.0\FsPickler.Json.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\microsoft.csharp\4.3.0\ref\netstandard1.0\Microsoft.CSharp.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\Microsoft.Win32.Primitives.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\mscorlib.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\netstandard.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\newtonsoft.json\10.0.1\lib\netstandard1.3\Newtonsoft.Json.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.AppContext.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Collections.Concurrent.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Collections.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Collections.NonGeneric.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Collections.Specialized.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.ComponentModel.Composition.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.ComponentModel.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.ComponentModel.EventBasedAsync.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.ComponentModel.Primitives.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.ComponentModel.TypeConverter.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Console.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Core.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Data.Common.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Data.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Diagnostics.Contracts.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Diagnostics.Debug.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Diagnostics.FileVersionInfo.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Diagnostics.Process.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Diagnostics.StackTrace.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Diagnostics.TextWriterTraceListener.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Diagnostics.Tools.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Diagnostics.TraceSource.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Diagnostics.Tracing.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Drawing.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Drawing.Primitives.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Dynamic.Runtime.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Globalization.Calendars.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Globalization.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Globalization.Extensions.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.IO.Compression.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.IO.Compression.FileSystem.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.IO.Compression.ZipFile.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.IO.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.IO.FileSystem.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.IO.FileSystem.DriveInfo.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.IO.FileSystem.Primitives.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.IO.FileSystem.Watcher.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.IO.IsolatedStorage.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.IO.MemoryMappedFiles.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.IO.Pipes.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.IO.UnmanagedMemoryStream.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Linq.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Linq.Expressions.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Linq.Parallel.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Linq.Queryable.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Net.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Net.Http.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Net.NameResolution.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Net.NetworkInformation.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Net.Ping.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Net.Primitives.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Net.Requests.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Net.Security.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Net.Sockets.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Net.WebHeaderCollection.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Net.WebSockets.Client.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Net.WebSockets.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Numerics.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.ObjectModel.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Reflection.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\system.reflection.emit.ilgeneration\4.3.0\ref\netstandard1.0\System.Reflection.Emit.ILGeneration.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\system.reflection.emit.lightweight\4.3.0\ref\netstandard1.0\System.Reflection.Emit.Lightweight.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Reflection.Extensions.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Reflection.Primitives.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Resources.Reader.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Resources.ResourceManager.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Resources.Writer.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Runtime.CompilerServices.VisualC.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Runtime.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Runtime.Extensions.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Runtime.Handles.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Runtime.InteropServices.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Runtime.InteropServices.RuntimeInformation.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Runtime.Numerics.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Runtime.Serialization.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Runtime.Serialization.Formatters.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Runtime.Serialization.Json.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Runtime.Serialization.Primitives.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Runtime.Serialization.Xml.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Security.Claims.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Security.Cryptography.Algorithms.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Security.Cryptography.Csp.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Security.Cryptography.Encoding.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Security.Cryptography.Primitives.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Security.Cryptography.X509Certificates.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Security.Principal.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Security.SecureString.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.ServiceModel.Web.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Text.Encoding.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Text.Encoding.Extensions.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Text.RegularExpressions.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Threading.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Threading.Overlapped.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Threading.Tasks.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Threading.Tasks.Parallel.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Threading.Thread.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Threading.ThreadPool.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Threading.Timer.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Transactions.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.ValueTuple.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Web.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Windows.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Xml.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Xml.Linq.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Xml.ReaderWriter.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Xml.Serialization.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Xml.XDocument.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Xml.XmlDocument.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Xml.XmlSerializer.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Xml.XPath.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\netstandard.library\2.0.1\build\netstandard2.0\ref\System.Xml.XPath.XDocument.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\xamarin.forms\3.0.0.482510\lib\netstandard2.0\Xamarin.Forms.Core.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\xamarin.forms\3.0.0.482510\lib\netstandard2.0\Xamarin.Forms.Platform.dll
|
||||
-r:C:\Users\dsyme\.nuget\packages\xamarin.forms\3.0.0.482510\lib\netstandard2.0\Xamarin.Forms.Xaml.dll
|
||||
--target:library
|
||||
--warn:3
|
||||
--warnaserror:76
|
||||
--preferreduilang:en-US
|
||||
--fullpaths
|
||||
--flaterrors
|
||||
--highentropyva-
|
||||
--targetprofile:netstandard
|
||||
--simpleresolution
|
||||
--nocopyfsharpcore
|
||||
TicTacToe.fs
|
||||
AssemblyInfo.fs
|
||||
C:\Users\dsyme\AppData\Local\Temp\.NETStandard,Version=v2.0.AssemblyAttributes.fs
|
49
build.fsx
49
build.fsx
|
@ -7,26 +7,28 @@ open System.IO
|
|||
open Fake.AssemblyInfoFile
|
||||
open Fake.ReleaseNotesHelper
|
||||
|
||||
let buildDir = "./build_output"
|
||||
let buildDir nuget = if nuget then "./build_output" else "./build_output/tools"
|
||||
let release = LoadReleaseNotes "RELEASE_NOTES.md"
|
||||
|
||||
let projects =
|
||||
[ ("Elmish.XamarinForms/Elmish.XamarinForms.fsproj", "Elmish.XamarinForms", "F# Functional App Dev Framework")
|
||||
("extensions/Maps/Elmish.XamarinForms.Maps.fsproj", "Elmish.XamarinForms.Maps", "Elmish.XamarinForms extension for Xamarin.Forms.Maps")
|
||||
("extensions/SkiaSharp/Elmish.XamarinForms.SkiaSharp.fsproj", "Elmish.XamarinForms.SkiaSharp", "Elmish.XamarinForms extension for SkiaSharp")
|
||||
("extensions/OxyPlot/Elmish.XamarinForms.OxyPlot.fsproj", "Elmish.XamarinForms.OxyPlot", "Elmish.XamarinForms extension for OxyPlot") ]
|
||||
[ ("Elmish.XamarinForms/Elmish.XamarinForms.fsproj", "Elmish.XamarinForms", "F# Functional App Dev Framework", true)
|
||||
("extensions/Maps/Elmish.XamarinForms.Maps.fsproj", "Elmish.XamarinForms.Maps", "Elmish.XamarinForms extension for Xamarin.Forms.Maps", true)
|
||||
("extensions/SkiaSharp/Elmish.XamarinForms.SkiaSharp.fsproj", "Elmish.XamarinForms.SkiaSharp", "Elmish.XamarinForms extension for SkiaSharp", true)
|
||||
("extensions/OxyPlot/Elmish.XamarinForms.OxyPlot.fsproj", "Elmish.XamarinForms.OxyPlot", "Elmish.XamarinForms extension for OxyPlot", true)
|
||||
("fscd/fscd.fsproj", "fscd", "F# Compiler Daemon", false)
|
||||
("Elmish.XamarinForms.LiveUpdate/Elmish.XamarinForms.LiveUpdate.fsproj", "Elmish.XamarinForms.LiveUpdate", "F# Functional App Dev Framework Live Update", true) ]
|
||||
|
||||
Target "Build" (fun _ ->
|
||||
|
||||
// needed or else 'project.assets.json' not found'
|
||||
for (projFile, _project, _summary) in projects do
|
||||
for (projFile, _project, _summary, _nuget) in projects do
|
||||
DotNetCli.Restore (fun p -> { p with Project = projFile })
|
||||
|
||||
for (projFile, _project, _summary) in projects do
|
||||
!! projFile |> MSBuildRelease buildDir "Restore" |> Log "LibraryRestore-Output: "
|
||||
for (projFile, _project, _summary, nuget) in projects do
|
||||
!! projFile |> MSBuildRelease (buildDir nuget) "Restore" |> Log "LibraryRestore-Output: "
|
||||
|
||||
for (projFile, _project, _summary) in projects do
|
||||
!! projFile |> MSBuildRelease buildDir "Build" |> Log "LibraryBuild-Output: "
|
||||
for (projFile, _project, _summary, nuget) in projects do
|
||||
!! projFile |> MSBuildRelease (buildDir nuget) "Build" |> Log "LibraryBuild-Output: "
|
||||
)
|
||||
|
||||
Target "BuildSamples" (fun _ ->
|
||||
|
@ -46,13 +48,13 @@ Target "BuildSamples" (fun _ ->
|
|||
)
|
||||
|
||||
Target "Clean" (fun _ ->
|
||||
CleanDir buildDir
|
||||
CleanDir (buildDir true)
|
||||
)
|
||||
|
||||
// Generate assembly info files with the right version & up-to-date information
|
||||
Target "AssemblyInfo" (fun _ ->
|
||||
|
||||
for (projFile, projName, summary) in projects do
|
||||
for (projFile, projName, summary, _nuget) in projects do
|
||||
let projFolder = Path.GetDirectoryName(projFile)
|
||||
let projDetails =
|
||||
[ Attribute.Title projName
|
||||
|
@ -66,14 +68,15 @@ Target "AssemblyInfo" (fun _ ->
|
|||
|
||||
// Build a NuGet package
|
||||
Target "LibraryNuGet" (fun _ ->
|
||||
for (projFile, _projName, _summary) in projects do
|
||||
let projFolder = Path.GetDirectoryName(projFile)
|
||||
Paket.Pack(fun p ->
|
||||
{ p with
|
||||
OutputPath = buildDir + "/"
|
||||
TemplateFile = projFolder + "/paket.template"
|
||||
Version = release.NugetVersion
|
||||
ReleaseNotes = toLines release.Notes})
|
||||
for (projFile, _projName, _summary, nuget) in projects do
|
||||
if nuget then
|
||||
let projFolder = Path.GetDirectoryName(projFile)
|
||||
Paket.Pack(fun p ->
|
||||
{ p with
|
||||
OutputPath = buildDir nuget + "/"
|
||||
TemplateFile = projFolder + "/paket.template"
|
||||
Version = release.NugetVersion
|
||||
ReleaseNotes = toLines release.Notes})
|
||||
)
|
||||
|
||||
// Build a NuGet package
|
||||
|
@ -82,7 +85,7 @@ Target "TemplatesNuGet" (fun _ ->
|
|||
NuGetHelper.NuGetPack (fun p ->
|
||||
{ p with
|
||||
WorkingDir = "templates"
|
||||
OutputPath = buildDir + "/"
|
||||
OutputPath = buildDir true + "/"
|
||||
Version = release.NugetVersion
|
||||
ReleaseNotes = toLines release.Notes}) @"templates/Elmish.XamarinForms.Templates.nuspec"
|
||||
)
|
||||
|
@ -93,14 +96,14 @@ let exec exe args =
|
|||
Target "TestTemplatesNuGet" (fun _ ->
|
||||
|
||||
// Globally install the templates from the template nuget package we just built
|
||||
DotNetCli.RunCommand id ("new -i " + buildDir + "/Elmish.XamarinForms.Templates." + release.NugetVersion + ".nupkg")
|
||||
DotNetCli.RunCommand id ("new -i " + buildDir true + "/Elmish.XamarinForms.Templates." + release.NugetVersion + ".nupkg")
|
||||
|
||||
let testAppName = "testapp2" + string (abs (hash System.DateTime.Now.Ticks) % 100)
|
||||
// Instantiate the template. TODO: additional parameters and variations
|
||||
CleanDir testAppName
|
||||
DotNetCli.RunCommand id (sprintf "new elmish-forms-app -n %s -lang F#" testAppName)
|
||||
|
||||
let pkgs = Path.GetFullPath(buildDir)
|
||||
let pkgs = Path.GetFullPath(buildDir true)
|
||||
// When restoring, using the build_output as a package source to pick up the package we just compiled
|
||||
DotNetCli.RunCommand id (sprintf "restore %s/%s/%s.fsproj --source https://api.nuget.org/v3/index.json --source %s" testAppName testAppName testAppName pkgs)
|
||||
|
||||
|
|
|
@ -15,4 +15,5 @@
|
|||
* [Extensions: OxyPlot (charting)](views-oxyplot.html)
|
||||
* [Models](models.html)
|
||||
* [Update and Messages](update.html)
|
||||
* [Tools](tools.html)
|
||||
* [Further Resources](index.html#further-resources)
|
||||
|
|
|
@ -3,4 +3,5 @@
|
|||
* [Views](views.html)
|
||||
* [Models](models.html)
|
||||
* [Update and Messages](update.html)
|
||||
* [Tools](tools.html)
|
||||
* [Further Resources](index.html#further-resources)
|
||||
|
|
|
@ -0,0 +1,122 @@
|
|||
Elmish.XamarinForms Guide
|
||||
=======
|
||||
|
||||
{% include_relative contents.md %}
|
||||
|
||||
Experimental Live Update
|
||||
------
|
||||
|
||||
There is a prototype LiveUpdate mechanism available. The aim of this is primarily to enable modifying the `view` function in order
|
||||
to see the effect of adjusting of visual options.
|
||||
|
||||
Some manual set-up is required. The following assumes your app is called `SqueakyApp`:
|
||||
|
||||
1. Add a reference to nuget package `Elmish.XamarinForms.LiveUpdate` to all projects in your app. Do a clean build.
|
||||
|
||||
2. Add the code in the `#if` section below in `SqueakyApp\SqueakyApp\SqueayApp.fs`:
|
||||
|
||||
type App () =
|
||||
inherit Application()
|
||||
....
|
||||
#if DEBUG
|
||||
do runner.EnableLiveUpdate ()
|
||||
#endif
|
||||
|
||||
3. In your core project directory (e.g. `SqueakyApp\SqueakyApp`), create `proj.args` containing the project options used to compile the core of your app. It should look something like [this](https://github.com/dsyme/Elmish.XamarinForms/blob/c2a93b2aa6fb728c038a907844ea04a7127c7381/Samples/CounterApp/CounterApp/out.args).
|
||||
|
||||
dotnet build -v:n SqueayApp.fsproj > proj.args
|
||||
<manually edit `proj.args` to contain only the compilation arguments>
|
||||
|
||||
4. If running on Android, forward requests from localhost to the Android Debug Bridge:
|
||||
|
||||
USB:
|
||||
adb -d forward tcp:9867 tcp:9867
|
||||
EMULATOR:
|
||||
adb -e forward tcp:9867 tcp:9867
|
||||
|
||||
5. Launch your app in Debug mode (you can use Release mode but must set Linking options to `None` rather than `SDK Assemblies`)
|
||||
|
||||
6. Run the following from your core project directory (e.g. `SqueakyApp\SqueakyApp`)
|
||||
|
||||
Windows:
|
||||
|
||||
%USERPROFILE%\.nuget\packages\Elmish.XamarinForms.LiveUpdate\0.13.0\tools\fscd.exe --watch --webhook:http://localhost:9867/update -- @proj.args
|
||||
|
||||
Unix and OSX (untested):
|
||||
|
||||
mono ~/.nuget/packages/Elmish.XamarinForms.LiveUpdate/0.13.0/tools/fscd.exe --watch --webhook:http://localhost:9867/update -- @proj.args
|
||||
|
||||
Now, whenever you save a file in your core project directory, the `fscd.exe` daemon will attempt to recompile your changed file and
|
||||
send a representation of its contents to your app via a PUT request. The app then deserializes this representation and
|
||||
adds the declarations to an F# interpreter. This interpreter will make some reflective calls into the existing libraries on device.
|
||||
|
||||
To take effect, your code must have a single declaration in some module called `programLiveUpdate` or `program` taking no arguments. For example:
|
||||
|
||||
```fsharp
|
||||
module App =
|
||||
...
|
||||
let init() = ...
|
||||
|
||||
let update model msg = ...
|
||||
|
||||
let view model dispatch = ...
|
||||
|
||||
let program = Program.mkProgram init update view
|
||||
```
|
||||
|
||||
If a declaration like this is found the `program` object replaces the currently running Elmish program and the view is updated.
|
||||
The model state of the app is re-initialized.
|
||||
|
||||
### Known limitations:
|
||||
|
||||
1. The F# interpreter used on-device has some incompletnesses and behavioural differences:
|
||||
|
||||
1. Object expressions may not be intepreted
|
||||
2. Implementations of ToString() and other overrides will be ignored
|
||||
3. Some other F# constructs are not supported (e.g. address-of operations)
|
||||
|
||||
You can move generally move problematic constructs to a utility library, which will then be executed as compiled code.
|
||||
|
||||
2. Changes to the resources in a project (e.g. images) require a rebuild
|
||||
|
||||
3. Changes to Android and iOS require a rebuild
|
||||
|
||||
4. You may need to mock any platform-specific helpers you pass through, e.g.
|
||||
|
||||
module App =
|
||||
...
|
||||
let init() = ...
|
||||
|
||||
let update (helper1, helper2) model msg = ...
|
||||
|
||||
let view model dispatch = ...
|
||||
|
||||
#if DEBUG
|
||||
// The fake program, used when LiveUpdate is activated and a program change has been made
|
||||
module AppLiveUpdate =
|
||||
open App
|
||||
|
||||
let mockHelper1 () = ...
|
||||
|
||||
let mockHelper2 () = ...
|
||||
|
||||
let programLiveUpdate = Program.mkProgram init (update (mockHelper1, mockHelper2)) view
|
||||
#endif
|
||||
|
||||
type App (helper1, helper2) =
|
||||
inherit Application()
|
||||
....
|
||||
|
||||
// The real program, used when LiveUpdate is not activated or a program change has not been made
|
||||
let program = Program.mkProgram App.init (App.update (helper1, helper2)) App.view
|
||||
|
||||
6. There may be issues running on networks with network policy restrictions
|
||||
|
||||
### Troubleshooting
|
||||
|
||||
The LiveUpdate mechanism is very experimental.
|
||||
- Debug output is printed to console by `fscd.exe`
|
||||
- Debug output is printed to app-output by the on-device web server
|
||||
|
||||
Please contribute documentation, updates and fixes to make the experience simpler.
|
||||
|
|
@ -1,3 +1,4 @@
|
|||
// Copyright 2018 Elmish.XamarinForms contributors. See LICENSE.md for license.
|
||||
namespace Elmish.XamarinForms.DynamicViews
|
||||
|
||||
[<AutoOpen>]
|
||||
|
|
|
@ -1,3 +1,4 @@
|
|||
// Copyright 2018 Elmish.XamarinForms contributors. See LICENSE.md for license.
|
||||
namespace Elmish.XamarinForms.DynamicViews
|
||||
|
||||
[<AutoOpen>]
|
||||
|
|
|
@ -1,3 +1,4 @@
|
|||
// Copyright 2018 Elmish.XamarinForms contributors. See LICENSE.md for license.
|
||||
namespace Elmish.XamarinForms.DynamicViews
|
||||
|
||||
[<AutoOpen>]
|
||||
|
|
|
@ -0,0 +1,79 @@
|
|||
// Copyright 2018 Elmish.XamarinForms contributors. See LICENSE.md for license.
|
||||
|
||||
module FSharp.Compiler.PortaCode.CodeModel
|
||||
|
||||
|
||||
/// A representation of resolved F# expressions that can be serialized
|
||||
type DExpr =
|
||||
| Value of DLocalRef
|
||||
| ThisValue of DType
|
||||
| BaseValue of DType
|
||||
| Application of DExpr * DType[] * DExpr[]
|
||||
| Lambda of DType * DType * DLocalDef * DExpr
|
||||
| TypeLambda of DGenericParameterDef[] * DExpr
|
||||
| Quote of DExpr
|
||||
| IfThenElse of DExpr * DExpr * DExpr
|
||||
| DecisionTree of DExpr * (DLocalDef[] * DExpr)[]
|
||||
| DecisionTreeSuccess of int * DExpr[]
|
||||
| Call of DExpr option * DMemberRef * DType[] * DType[] * DExpr[]
|
||||
| NewObject of DMemberRef * DType[] * DExpr[]
|
||||
| LetRec of ( DLocalDef * DExpr)[] * DExpr
|
||||
| Let of (DLocalDef * DExpr) * DExpr
|
||||
| NewRecord of DType * DExpr[]
|
||||
| ObjectExpr of DType * DExpr * DObjectExprOverrideDef[] * (DType * DObjectExprOverrideDef[])[]
|
||||
| FSharpFieldGet of DExpr option * DType * DFieldRef
|
||||
| FSharpFieldSet of DExpr option * DType * DFieldRef * DExpr
|
||||
| NewUnionCase of DType * DUnionCaseRef * DExpr[]
|
||||
| UnionCaseGet of DExpr * DType * DUnionCaseRef * DFieldRef
|
||||
| UnionCaseSet of DExpr * DType * DUnionCaseRef * DFieldRef * DExpr
|
||||
| UnionCaseTag of DExpr * DType
|
||||
| UnionCaseTest of DExpr * DType * DUnionCaseRef
|
||||
//| TraitCall of DType[] * string * Ast.MemberFlags * DType[] * DType[] * DExpr[]
|
||||
| NewTuple of DType * DExpr[]
|
||||
| TupleGet of DType * int * DExpr
|
||||
| Coerce of DType * DExpr
|
||||
| NewArray of DType * DExpr[]
|
||||
| TypeTest of DType * DExpr
|
||||
| AddressSet of DExpr * DExpr
|
||||
| ValueSet of DLocalRef * DExpr
|
||||
| Unused
|
||||
| DefaultValue of DType
|
||||
| Const of obj * DType
|
||||
| AddressOf of DExpr
|
||||
| Sequential of DExpr * DExpr
|
||||
| FastIntegerForLoop of DExpr * DExpr * DExpr * bool
|
||||
| WhileLoop of DExpr * DExpr
|
||||
| TryFinally of DExpr * DExpr
|
||||
| TryWith of DExpr * DLocalDef * DExpr * DLocalDef * DExpr
|
||||
| NewDelegate of DType * DExpr
|
||||
| ILFieldGet of DExpr option * DType * string
|
||||
| ILFieldSet of DExpr option * DType * string * DExpr
|
||||
| ILAsm of string * DType[] * DExpr[]
|
||||
and DType =
|
||||
| DNamedType of DEntityRef * DType[]
|
||||
| DFunctionType of DType * DType
|
||||
| DTupleType of bool * DType[]
|
||||
| DArrayType of int * DType
|
||||
| DVariableType of string
|
||||
and DLocalDef =
|
||||
{ Name: string; IsMutable: bool; Type: DType }
|
||||
and DMemberDef =
|
||||
{ EnclosingEntity: DEntityRef; Name: string; GenericParameters: DGenericParameterDef[]; IsInstance: bool; Parameters: DLocalDef[]; ReturnType: DType }
|
||||
member x.Ref = DMemberRef (x.EnclosingEntity, x.Name, x.GenericParameters.Length, (x.Parameters |> Array.map (fun p -> p.Type)), x.ReturnType)
|
||||
and DGenericParameterDef = { Name: string }
|
||||
and DEntityDef = { Name: string; GenericParameters: DGenericParameterDef[]; UnionCases: string[] }
|
||||
and DEntityRef = DEntityRef of string
|
||||
and DMemberRef = DMemberRef of DEntityRef * string * int * DType[] * DType
|
||||
and DLocalRef = DLocalRef of name: string * isThisValue: bool * isMutable: bool
|
||||
and DFieldRef = DFieldRef of int * string
|
||||
and DUnionCaseRef = DUnionCaseRef of string
|
||||
and DObjectExprOverrideDef = { Name: string; GenericParameters: DGenericParameterDef[]; Parameters: DLocalDef[]; Body: DExpr }
|
||||
|
||||
type DDecl =
|
||||
| DDeclEntity of DEntityDef * DDecl[]
|
||||
| DDeclMember of DMemberDef * DExpr
|
||||
| InitAction of DExpr
|
||||
|
||||
type DFile =
|
||||
{ Code: DDecl[] }
|
||||
|
|
@ -0,0 +1,183 @@
|
|||
// Copyright 2018 Elmish.XamarinForms contributors. See LICENSE.md for license.
|
||||
module FSharp.Compiler.PortaCode.FromCompilerService
|
||||
|
||||
open FSharp.Compiler.PortaCode.CodeModel
|
||||
open System.Collections.Generic
|
||||
open Microsoft.FSharp.Compiler.SourceCodeServices
|
||||
|
||||
let map2 f g (a,b) = (f a, g b)
|
||||
|
||||
module List =
|
||||
let mapToArray f arr = arr |> Array.ofList |> Array.map f
|
||||
|
||||
module Seq =
|
||||
let mapToArray f arr = arr |> Array.ofSeq |> Array.map f
|
||||
|
||||
let rec convExpr (e:FSharpExpr) : DExpr =
|
||||
match e with
|
||||
| BasicPatterns.AddressOf(lvalueExpr) -> DExpr.AddressOf(convExpr lvalueExpr)
|
||||
| BasicPatterns.AddressSet(lvalueExpr, rvalueExpr) -> DExpr.AddressSet(convExpr lvalueExpr, convExpr rvalueExpr)
|
||||
// FCS TODO: fix FCS quirk with IsNone and IsSome on the option type
|
||||
| BasicPatterns.Application( BasicPatterns.Call(Some obj, memberOrFunc, tyargs1, tyargs2, [ ]), typeArgs, [ arg ]) when memberOrFunc.CompiledName = "get_IsNone" ->
|
||||
let objExprR = convExpr obj
|
||||
let mrefR = convMemberRef memberOrFunc
|
||||
let typeArgs1R = convTypes tyargs1
|
||||
let typeArgs2R = convTypes tyargs2
|
||||
DExpr.Call(None, mrefR, typeArgs1R, typeArgs2R, [| objExprR |])
|
||||
| BasicPatterns.Application(funcExpr, typeArgs, argExprs) -> DExpr.Application(convExpr funcExpr, convTypes typeArgs, convExprs argExprs)
|
||||
| BasicPatterns.Call(objExprOpt, memberOrFunc, typeArgs1, typeArgs2, argExprs) ->
|
||||
let objExprOptR = convExprOpt objExprOpt
|
||||
let mrefR = convMemberRef memberOrFunc
|
||||
let typeArgs1R = convTypes typeArgs1
|
||||
let typeArgs2R = convTypes typeArgs2
|
||||
let argExprsR = convExprs argExprs
|
||||
match objExprOptR with
|
||||
// FCS TODO: Fix quirk with extension members so this isn't needed
|
||||
| Some objExprR when memberOrFunc.IsExtensionMember || not memberOrFunc.IsInstanceMemberInCompiledCode ->
|
||||
DExpr.Call(None, mrefR, typeArgs1R, typeArgs2R, Array.append [| objExprR |] argExprsR)
|
||||
| _ ->
|
||||
DExpr.Call(objExprOptR, mrefR, typeArgs1R, typeArgs2R, argExprsR)
|
||||
| BasicPatterns.Coerce(targetType, inpExpr) -> DExpr.Coerce(convType targetType, convExpr inpExpr)
|
||||
| BasicPatterns.FastIntegerForLoop(startExpr, limitExpr, consumeExpr, isUp) -> DExpr.FastIntegerForLoop(convExpr startExpr, convExpr limitExpr, convExpr consumeExpr, isUp)
|
||||
| BasicPatterns.ILAsm(asmCode, typeArgs, argExprs) -> DExpr.ILAsm(asmCode, convTypes typeArgs, convExprs argExprs)
|
||||
| BasicPatterns.ILFieldGet (objExprOpt, fieldType, fieldName) -> DExpr.ILFieldGet(convExprOpt objExprOpt, convType fieldType, fieldName)
|
||||
| BasicPatterns.ILFieldSet (objExprOpt, fieldType, fieldName, valueExpr) -> DExpr.ILFieldSet (convExprOpt objExprOpt, convType fieldType, fieldName, convExpr valueExpr)
|
||||
| BasicPatterns.IfThenElse (guardExpr, thenExpr, elseExpr) -> DExpr.IfThenElse (convExpr guardExpr, convExpr thenExpr, convExpr elseExpr)
|
||||
| BasicPatterns.Lambda(lambdaVar, bodyExpr) -> DExpr.Lambda(convType lambdaVar.FullType, convType bodyExpr.Type, convLocalDef lambdaVar, convExpr bodyExpr)
|
||||
| BasicPatterns.Let((bindingVar, bindingExpr), bodyExpr) -> DExpr.Let((convLocalDef bindingVar, convExpr bindingExpr), convExpr bodyExpr)
|
||||
| BasicPatterns.LetRec(recursiveBindings, bodyExpr) -> DExpr.LetRec(List.mapToArray (map2 convLocalDef convExpr) recursiveBindings, convExpr bodyExpr)
|
||||
| BasicPatterns.NewArray(arrayType, argExprs) -> DExpr.NewArray(convType arrayType, convExprs argExprs)
|
||||
| BasicPatterns.NewDelegate(delegateType, delegateBodyExpr) -> DExpr.NewDelegate(convType delegateType, convExpr delegateBodyExpr)
|
||||
| BasicPatterns.NewObject(objCtor, typeArgs, argExprs) -> DExpr.NewObject(convMemberRef objCtor, convTypes typeArgs, convExprs argExprs)
|
||||
| BasicPatterns.NewRecord(recordType, argExprs) -> DExpr.NewRecord(convType recordType, convExprs argExprs)
|
||||
| BasicPatterns.NewTuple(tupleType, argExprs) -> DExpr.NewTuple(convType tupleType, convExprs argExprs)
|
||||
| BasicPatterns.NewUnionCase(unionType, unionCase, argExprs) -> DExpr.NewUnionCase(convType unionType, convUnionCase unionCase, convExprs argExprs)
|
||||
| BasicPatterns.Quote(quotedExpr) -> DExpr.Quote(convExpr quotedExpr)
|
||||
| BasicPatterns.FSharpFieldGet(objExprOpt, recordOrClassType, fieldInfo) -> DExpr.FSharpFieldGet(convExprOpt objExprOpt, convType recordOrClassType, convFieldRef fieldInfo)
|
||||
| BasicPatterns.FSharpFieldSet(objExprOpt, recordOrClassType, fieldInfo, argExpr) -> DExpr.FSharpFieldSet(convExprOpt objExprOpt, convType recordOrClassType, convFieldRef fieldInfo, convExpr argExpr)
|
||||
| BasicPatterns.Sequential(firstExpr, secondExpr) -> DExpr.Sequential(convExpr firstExpr, convExpr secondExpr)
|
||||
| BasicPatterns.TryFinally(bodyExpr, finalizeExpr) -> DExpr.TryFinally(convExpr bodyExpr, convExpr finalizeExpr)
|
||||
| BasicPatterns.TryWith(bodyExpr, filterVar, filterExpr, catchVar, catchExpr) -> DExpr.TryWith(convExpr bodyExpr, convLocalDef filterVar, convExpr filterExpr, convLocalDef catchVar, convExpr catchExpr)
|
||||
| BasicPatterns.TupleGet(tupleType, tupleElemIndex, tupleExpr) -> DExpr.TupleGet(convType tupleType, tupleElemIndex, convExpr tupleExpr)
|
||||
| BasicPatterns.DecisionTree(decisionExpr, decisionTargets) -> DExpr.DecisionTree(convExpr decisionExpr, List.mapToArray (map2 (List.mapToArray convLocalDef) convExpr) decisionTargets)
|
||||
| BasicPatterns.DecisionTreeSuccess (decisionTargetIdx, decisionTargetExprs) -> DExpr.DecisionTreeSuccess (decisionTargetIdx, convExprs decisionTargetExprs)
|
||||
| BasicPatterns.TypeLambda(genericParams, bodyExpr) -> DExpr.TypeLambda(Array.map convGenericParamDef (Array.ofList genericParams), convExpr bodyExpr)
|
||||
| BasicPatterns.TypeTest(ty, inpExpr) -> DExpr.TypeTest(convType ty, convExpr inpExpr)
|
||||
| BasicPatterns.UnionCaseSet(unionExpr, unionType, unionCase, unionCaseField, valueExpr) -> DExpr.UnionCaseSet(convExpr unionExpr, convType unionType, convUnionCase unionCase, convUnionCaseField unionCase unionCaseField, convExpr valueExpr)
|
||||
| BasicPatterns.UnionCaseGet(unionExpr, unionType, unionCase, unionCaseField) -> DExpr.UnionCaseGet(convExpr unionExpr, convType unionType, convUnionCase unionCase, convUnionCaseField unionCase unionCaseField)
|
||||
| BasicPatterns.UnionCaseTest(unionExpr, unionType, unionCase) -> DExpr.UnionCaseTest(convExpr unionExpr, convType unionType, convUnionCase unionCase)
|
||||
| BasicPatterns.UnionCaseTag(unionExpr, unionType) -> DExpr.UnionCaseTag(convExpr unionExpr, convType unionType)
|
||||
| BasicPatterns.ObjectExpr(objType, baseCallExpr, overrides, interfaceImplementations) -> DExpr.ObjectExpr(convType objType, convExpr baseCallExpr, Array.map convObjMemberDef (Array.ofList overrides), Array.map (map2 convType (Array.ofList >> Array.map convObjMemberDef)) (Array.ofList interfaceImplementations))
|
||||
//| BasicPatterns.TraitCall(sourceTypes, traitName, typeArgs, typeInstantiation, argTypes, argExprs) -> DExpr.TraitCall(sourceTypes, traitName, typeArgs, typeInstantiation, argTypes, argExprs)
|
||||
| BasicPatterns.ValueSet(valToSet, valueExpr) -> DExpr.ValueSet(convLocalRef valToSet, convExpr valueExpr)
|
||||
| BasicPatterns.WhileLoop(guardExpr, bodyExpr) -> DExpr.WhileLoop(convExpr guardExpr, convExpr bodyExpr)
|
||||
| BasicPatterns.BaseValue baseType -> DExpr.BaseValue (convType baseType)
|
||||
| BasicPatterns.DefaultValue defaultType -> DExpr.DefaultValue (convType defaultType)
|
||||
| BasicPatterns.ThisValue thisType -> DExpr.ThisValue (convType thisType)
|
||||
| BasicPatterns.Const(constValueObj, constType) -> DExpr.Const (constValueObj, convType constType)
|
||||
| BasicPatterns.Value(valueToGet) -> DExpr.Value(convLocalRef valueToGet)
|
||||
| _ -> failwith (sprintf "unrecognized %+A" e)
|
||||
|
||||
and convExprs exprs =
|
||||
Array.map convExpr (Array.ofList exprs)
|
||||
|
||||
and convExprOpt exprs =
|
||||
Option.map convExpr exprs
|
||||
|
||||
and convObjArg f objOpt =
|
||||
Option.map convExpr objOpt
|
||||
|
||||
and convObjMemberDef (memb: FSharpObjectExprOverride) : DObjectExprOverrideDef =
|
||||
{ //Signature: DAbstractSignature
|
||||
GenericParameters = convGenericParamDefs memb.GenericParameters
|
||||
Name = memb.Signature.Name
|
||||
Parameters = memb.CurriedParameterGroups |> convParamDefs2
|
||||
Body = convExpr memb.Body }
|
||||
|
||||
and convFieldRef (field: FSharpField) : DFieldRef =
|
||||
match field.DeclaringEntity.FSharpFields |> Seq.tryFindIndex (fun field2 -> field2.Name = field.Name) with
|
||||
| Some index -> DFieldRef (index, field.Name)
|
||||
| None -> failwithf "couldn't find field %s in type %A" field.Name field.DeclaringEntity
|
||||
|
||||
and convUnionCase (ucase: FSharpUnionCase) : DUnionCaseRef =
|
||||
DUnionCaseRef (ucase.CompiledName)
|
||||
|
||||
and convUnionCaseField (ucase: FSharpUnionCase) (field: FSharpField) : DFieldRef =
|
||||
match ucase.UnionCaseFields |> Seq.tryFindIndex (fun field2 -> field2.Name = field.Name) with
|
||||
| Some index -> DFieldRef (index, field.Name)
|
||||
| None -> failwithf "couldn't find field %s in type %A" field.Name field.DeclaringEntity
|
||||
|
||||
and convLocalDef (memb: FSharpMemberOrFunctionOrValue) : DLocalDef =
|
||||
{ Name = memb.CompiledName; IsMutable = memb.IsMutable; Type = convType memb.FullType }
|
||||
|
||||
and convLocalRef (value: FSharpMemberOrFunctionOrValue) : DLocalRef =
|
||||
DLocalRef (value.CompiledName, (value.IsMemberThisValue || value.IsConstructorThisValue || value.IsBaseValue), value.IsMutable)
|
||||
|
||||
and convMemberDef (memb: FSharpMemberOrFunctionOrValue) : DMemberDef =
|
||||
assert (memb.IsMember || memb.IsModuleValueOrMember)
|
||||
{ EnclosingEntity = convEntityRef memb.DeclaringEntity.Value
|
||||
Name = memb.CompiledName
|
||||
GenericParameters = convGenericParamDefs memb.GenericParameters
|
||||
Parameters = convParamDefs memb.CurriedParameterGroups
|
||||
ReturnType = convReturnType memb
|
||||
IsInstance = memb.IsInstanceMemberInCompiledCode }
|
||||
|
||||
and convMemberRef (memb: FSharpMemberOrFunctionOrValue) =
|
||||
if not (memb.IsMember || memb.IsModuleValueOrMember) then failwith "can't convert non-member ref"
|
||||
let paramTypesR = convParamTypes memb.CurriedParameterGroups
|
||||
if memb.IsExtensionMember && memb.ApparentEnclosingEntity.GenericParameters.Count > 0 then failwithf "NYI: extension of generic type, needs FCS support: %A" memb
|
||||
let paramTypesR = if memb.IsExtensionMember then Array.append [| DNamedType (convEntityRef memb.ApparentEnclosingEntity, [| |]) |] paramTypesR else paramTypesR
|
||||
DMemberRef (convEntityRef memb.DeclaringEntity.Value, memb.CompiledName, memb.GenericParameters.Count, paramTypesR, convReturnType memb)
|
||||
|
||||
and convParamTypes (parameters: IList<IList<FSharpParameter>>) =
|
||||
parameters |> Seq.concat |> Array.ofSeq |> Array.map (fun p -> p.Type) |> convTypes
|
||||
|
||||
and convParamDefs (parameters: IList<IList<FSharpParameter>>) =
|
||||
parameters |> Seq.concat |> Array.ofSeq |> Array.map (fun p -> { Name = p.DisplayName; IsMutable = false; Type = convType p.Type })
|
||||
|
||||
and convParamDefs2 (parameters: FSharpMemberOrFunctionOrValue list list) =
|
||||
parameters |> Seq.concat |> Array.ofSeq |> Array.map (fun p -> { Name = p.DisplayName; IsMutable = false; Type = convType p.FullType })
|
||||
|
||||
and convReturnType (memb: FSharpMemberOrFunctionOrValue) =
|
||||
convType memb.ReturnParameter.Type
|
||||
|
||||
and convEntityDef (entity: FSharpEntity) : DEntityDef =
|
||||
if entity.IsNamespace then failwith "convEntityDef: can't convert a namespace"
|
||||
if entity.IsArrayType then failwith "convEntityDef: can't convert an array"
|
||||
if entity.IsFSharpAbbreviation then failwith "convEntityDef: can't convert a type abbreviation"
|
||||
{ Name = entity.QualifiedName
|
||||
GenericParameters = convGenericParamDefs entity.GenericParameters
|
||||
UnionCases = entity.UnionCases |> Seq.mapToArray (fun uc -> uc.Name) }
|
||||
|
||||
and convEntityRef (entity: FSharpEntity) : DEntityRef =
|
||||
if entity.IsNamespace then failwith "convEntityRef: can't convert a namespace"
|
||||
if entity.IsArrayType then failwith "convEntityRef: can't convert an array"
|
||||
if entity.IsFSharpAbbreviation then failwith "convEntityRef: can't convert a type abbreviation"
|
||||
DEntityRef entity.QualifiedName
|
||||
|
||||
and convType (typ: FSharpType) =
|
||||
if typ.IsAbbreviation then convType typ.AbbreviatedType
|
||||
elif typ.IsFunctionType then DFunctionType (convType typ.GenericArguments.[0], convType typ.GenericArguments.[1])
|
||||
elif typ.IsTupleType then DTupleType (false, convTypes typ.GenericArguments)
|
||||
elif typ.IsStructTupleType then DTupleType (true, convTypes typ.GenericArguments)
|
||||
elif typ.IsGenericParameter then DVariableType typ.GenericParameter.Name
|
||||
elif typ.TypeDefinition.IsArrayType then DArrayType (typ.TypeDefinition.ArrayRank, convType typ.GenericArguments.[0])
|
||||
else DNamedType (convEntityRef typ.TypeDefinition, convTypes typ.GenericArguments)
|
||||
and convTypes (typs: seq<FSharpType>) = typs |> Seq.toArray |> Array.map convType
|
||||
and convGenericParamDef (gp: FSharpGenericParameter) : DGenericParameterDef = { Name = gp.Name }
|
||||
and convGenericParamDefs (gps: seq<FSharpGenericParameter>) = gps |> Seq.toArray |> Array.map convGenericParamDef
|
||||
|
||||
let rec convDecl d =
|
||||
[| match d with
|
||||
| FSharpImplementationFileDeclaration.Entity (e, subDecls) ->
|
||||
if e.IsFSharpAbbreviation then ()
|
||||
elif e.IsNamespace then yield! convDecls subDecls
|
||||
elif e.IsArrayType then ()
|
||||
else yield DDeclEntity (convEntityDef e, convDecls subDecls)
|
||||
| FSharpImplementationFileDeclaration.MemberOrFunctionOrValue(v, vs, e) ->
|
||||
yield DDeclMember (convMemberDef v, convExpr e)
|
||||
| FSharpImplementationFileDeclaration.InitAction(e) ->
|
||||
yield DDecl.InitAction (convExpr e) |]
|
||||
and convDecls decls =
|
||||
decls |> Array.ofList |> Array.collect convDecl
|
||||
|
|
@ -0,0 +1,807 @@
|
|||
// Copyright 2018 Elmish.XamarinForms contributors. See LICENSE.md for license.
|
||||
module FSharp.Compiler.PortaCode.Interpreter
|
||||
|
||||
open System
|
||||
open System.Reflection
|
||||
open System.Collections.Generic
|
||||
open FSharp.Compiler.PortaCode.CodeModel
|
||||
|
||||
type ResolvedEntity =
|
||||
| REntity of Type
|
||||
| UEntity of DEntityDef
|
||||
|
||||
and ResolvedType =
|
||||
| RType of Type
|
||||
| UNamedType of DEntityDef * Type[]
|
||||
|
||||
and ResolvedTypes =
|
||||
| RTypes of Type[]
|
||||
| UTypes of ResolvedType[]
|
||||
|
||||
and ResolvedMember =
|
||||
| RPrim_float
|
||||
| RPrim_float32
|
||||
| RPrim_double
|
||||
| RPrim_single
|
||||
| RPrim_int32
|
||||
| RPrim_int16
|
||||
| RPrim_int64
|
||||
| RPrim_byte
|
||||
| RPrim_uint16
|
||||
| RPrim_uint32
|
||||
| RPrim_uint64
|
||||
| RPrim_decimal
|
||||
| RPrim_unativeint
|
||||
| RPrim_nativeint
|
||||
| RPrim_char
|
||||
| RPrim_neg
|
||||
| RPrim_pos
|
||||
| RPrim_minus
|
||||
| RPrim_divide
|
||||
| RPrim_mod
|
||||
| RPrim_shiftleft
|
||||
| RPrim_shiftright
|
||||
| RPrim_land
|
||||
| RPrim_lor
|
||||
| RPrim_lxor
|
||||
| RPrim_lneg
|
||||
| RMethod of System.Reflection.MemberInfo
|
||||
| UMember of Value
|
||||
|
||||
and ResolvedUnionCase =
|
||||
| RUnionCase of FSharp.Reflection.UnionCaseInfo * (obj -> int) * (obj[] -> obj) * (obj -> obj[])
|
||||
| UUnionCase of int * string
|
||||
|
||||
and ResolvedField =
|
||||
| RField of MemberInfo
|
||||
| UField of int * ResolvedType * string
|
||||
|
||||
and [<Struct>] Value = Value of obj
|
||||
and RecordValue = RecordValue of obj[]
|
||||
and UnionValue = UnionValue of int * string * obj[]
|
||||
and MethodLambdaValue = MethodLambdaValue of (Type[] * obj[] -> obj)
|
||||
|
||||
let getVal (Value v) = v
|
||||
let bindAll = BindingFlags.Public ||| BindingFlags.NonPublic ||| BindingFlags.Instance ||| BindingFlags.Static
|
||||
let (|RTypeOrObj|) xR = match xR with RType xV -> xV | _ -> typeof<obj>
|
||||
let (|RTypesOrObj|) xR = match xR with RTypes xV -> xV | UTypes us -> Array.map (|RTypeOrObj|) us
|
||||
|
||||
type Env =
|
||||
{ Vals: Map<string, Value>
|
||||
Types: Map<string,Type>
|
||||
Targets: (DLocalDef[] * DExpr)[]}
|
||||
|
||||
let envEmpty =
|
||||
{ Vals = Map.empty; Types = Map.empty; Targets = Array.empty }
|
||||
|
||||
let bindByName (env: Env) varName value =
|
||||
{ env with Vals = env.Vals.Add(varName, value) }
|
||||
|
||||
let bind (env: Env) (var: DLocalDef) value =
|
||||
let value2 =
|
||||
if var.IsMutable then
|
||||
Value (ref (getVal value))
|
||||
else
|
||||
value
|
||||
bindByName env var.Name value2
|
||||
|
||||
let bindty (env: Env) (var : DGenericParameterDef) value =
|
||||
{ env with Types = env.Types.Add(var.Name, value) }
|
||||
|
||||
let inline binOp (argsV: obj[]) i8 i16 i32 i64 u8 u16 u32 u64 f32 f64 d =
|
||||
match argsV.[0] with
|
||||
| (:? int32 as v1) -> match argsV.[1] with (:? int32 as v2) -> Value (box (i32 v1 v2)) | _ -> failwith "type match: operator"
|
||||
| (:? double as v1) -> match argsV.[1] with (:? double as v2) -> Value (box (f64 v1 v2)) | _ -> failwith "type match: operator"
|
||||
| (:? single as v1) -> match argsV.[1] with (:? single as v2) -> Value (box (f32 v1 v2)) | _ -> failwith "type match: operator"
|
||||
| (:? int64 as v1) -> match argsV.[1] with (:? int64 as v2) -> Value (box (i64 v1 v2)) | _ -> failwith "type match: operator"
|
||||
| (:? int16 as v1) -> match argsV.[1] with (:? int16 as v2) -> Value (box (i16 v1 v2)) | _ -> failwith "type match: operator"
|
||||
| (:? sbyte as v1) -> match argsV.[1] with (:? sbyte as v2) -> Value (box (i8 v1 v2)) | _ -> failwith "type match: operator"
|
||||
| (:? uint32 as v1) -> match argsV.[1] with (:? uint32 as v2) -> Value (box (u32 v1 v2)) | _ -> failwith "type match: operator"
|
||||
| (:? uint64 as v1) -> match argsV.[1] with (:? uint64 as v2) -> Value (box (u64 v1 v2)) | _ -> failwith "type match: operator"
|
||||
| (:? uint16 as v1) -> match argsV.[1] with (:? uint16 as v2) -> Value (box (u16 v1 v2)) | _ -> failwith "type match: operator"
|
||||
| (:? byte as v1) -> match argsV.[1] with (:? byte as v2) -> Value (box (u8 v1 v2)) | _ -> failwith "type match: operator"
|
||||
| (:? decimal as v1) -> match argsV.[1] with (:? decimal as v2) -> Value (box (d v1 v2)) | _ -> failwith "type match: operator"
|
||||
| _ -> failwith "a construct used a type instantiation of an F# operator that is not yet supported in intepreted F# code"
|
||||
|
||||
let inline shiftOp (argsV: obj[]) i8 i16 i32 i64 u8 u16 u32 u64 =
|
||||
match argsV.[0] with
|
||||
| (:? int32 as v1) -> match argsV.[1] with (:? int32 as v2) -> Value (box (i32 v1 v2)) | _ -> failwith "type match: operator"
|
||||
| (:? int64 as v1) -> match argsV.[1] with (:? int32 as v2) -> Value (box (i64 v1 v2)) | _ -> failwith "type match: operator"
|
||||
| (:? int16 as v1) -> match argsV.[1] with (:? int32 as v2) -> Value (box (i16 v1 v2)) | _ -> failwith "type match: operator"
|
||||
| (:? sbyte as v1) -> match argsV.[1] with (:? int32 as v2) -> Value (box (i8 v1 v2)) | _ -> failwith "type match: operator"
|
||||
| (:? uint32 as v1) -> match argsV.[1] with (:? int32 as v2) -> Value (box (u32 v1 v2)) | _ -> failwith "type match: operator"
|
||||
| (:? uint64 as v1) -> match argsV.[1] with (:? int32 as v2) -> Value (box (u64 v1 v2)) | _ -> failwith "type match: operator"
|
||||
| (:? uint16 as v1) -> match argsV.[1] with (:? int32 as v2) -> Value (box (u16 v1 v2)) | _ -> failwith "type match: operator"
|
||||
| (:? byte as v1) -> match argsV.[1] with (:? int32 as v2) -> Value (box (u8 v1 v2)) | _ -> failwith "type match: operator"
|
||||
| _ -> failwith "a construct used a type instantiation of an F# operator that is not yet supported in intepreted F# code"
|
||||
|
||||
let inline logicBinOp (argsV: obj[]) i8 i16 i32 i64 u8 u16 u32 u64 =
|
||||
match argsV.[0] with
|
||||
| (:? int32 as v1) -> match argsV.[1] with (:? int32 as v2) -> Value (box (i32 v1 v2)) | _ -> failwith "type match: operator"
|
||||
| (:? int64 as v1) -> match argsV.[1] with (:? int64 as v2) -> Value (box (i64 v1 v2)) | _ -> failwith "type match: operator"
|
||||
| (:? int16 as v1) -> match argsV.[1] with (:? int16 as v2) -> Value (box (i16 v1 v2)) | _ -> failwith "type match: operator"
|
||||
| (:? sbyte as v1) -> match argsV.[1] with (:? sbyte as v2) -> Value (box (i8 v1 v2)) | _ -> failwith "type match: operator"
|
||||
| (:? uint32 as v1) -> match argsV.[1] with (:? uint32 as v2) -> Value (box (u32 v1 v2)) | _ -> failwith "type match: operator"
|
||||
| (:? uint64 as v1) -> match argsV.[1] with (:? uint64 as v2) -> Value (box (u64 v1 v2)) | _ -> failwith "type match: operator"
|
||||
| (:? uint16 as v1) -> match argsV.[1] with (:? uint16 as v2) -> Value (box (u16 v1 v2)) | _ -> failwith "type match: operator"
|
||||
| (:? byte as v1) -> match argsV.[1] with (:? byte as v2) -> Value (box (u8 v1 v2)) | _ -> failwith "type match: operator"
|
||||
| _ -> failwith "a construct used a type instantiation of an F# operator that is not yet supported in intepreted F# code"
|
||||
|
||||
let inline logicUnOp (argsV: obj[]) i8 i16 i32 i64 u8 u16 u32 u64 =
|
||||
match argsV.[0] with
|
||||
| (:? int32 as v1) -> Value (box (i32 v1))
|
||||
| (:? int64 as v1) -> Value (box (i64 v1))
|
||||
| (:? int16 as v1) -> Value (box (i16 v1))
|
||||
| (:? sbyte as v1) -> Value (box (i8 v1))
|
||||
| (:? uint32 as v1) -> Value (box (u32 v1))
|
||||
| (:? uint64 as v1) -> Value (box (u64 v1))
|
||||
| (:? uint16 as v1) -> Value (box (u16 v1))
|
||||
| (:? byte as v1) -> Value (box (u8 v1))
|
||||
| _ -> failwith "a construct used a type instantiation of an F# operator that is not yet supported in intepreted F# code"
|
||||
|
||||
type EvalContext () =
|
||||
let members = Dictionary<(ResolvedEntity * string * ResolvedTypes),Value>(HashIdentity.Structural)
|
||||
let entityResolutions = Dictionary<DEntityRef,ResolvedEntity>(HashIdentity.Structural)
|
||||
//let unionCaseResolutions = Dictionary<(DType * DUnionCaseRef),ResolvedUnionCase>(HashIdentity.Structural)
|
||||
//let fieldResolutions = Dictionary<(DType * DFieldRef),ResolvedField>(HashIdentity.Structural)
|
||||
//let methodResolutions = Dictionary<DMemberRef,ResolvedMember>(HashIdentity.Structural)
|
||||
let methinfoof q = match q with Quotations.DerivedPatterns.Lambdas(_, Quotations.Patterns.Call(_,minfo,_)) -> minfo.GetGenericMethodDefinition() | _ -> failwith "unexpected"
|
||||
let op_double = methinfoof <@ double @>
|
||||
let op_single = methinfoof <@ single @>
|
||||
let op_float = methinfoof <@ float @>
|
||||
let op_float32 = methinfoof <@ float32 @>
|
||||
let op_int32 = methinfoof <@ int32 @>
|
||||
let op_int = methinfoof <@ int @>
|
||||
let op_int16 = methinfoof <@ int16 @>
|
||||
let op_int64 = methinfoof <@ int64 @>
|
||||
let op_byte = methinfoof <@ byte @>
|
||||
let op_uint16 = methinfoof <@ uint16 @>
|
||||
let op_uint32 = methinfoof <@ uint32 @>
|
||||
let op_uint64 = methinfoof <@ uint64 @>
|
||||
let op_decimal = methinfoof <@ decimal @>
|
||||
let op_unativeint = methinfoof <@ unativeint @>
|
||||
let op_nativeint = methinfoof <@ nativeint @>
|
||||
let op_char = methinfoof <@ char @>
|
||||
let op_neg = methinfoof <@ (~-) @>
|
||||
let op_pos = methinfoof <@ (~+) @>
|
||||
let op_minus = methinfoof <@ (-) @>
|
||||
let op_divide = methinfoof <@ (/) @>
|
||||
let op_mod = methinfoof <@ (%) @>
|
||||
let op_shiftleft = methinfoof <@ (<<<) @>
|
||||
let op_shiftright = methinfoof <@ (>>>) @>
|
||||
let op_land = methinfoof <@ (&&&) @>
|
||||
let op_lor = methinfoof <@ (|||) @>
|
||||
let op_lxor = methinfoof <@ (^^^) @>
|
||||
let op_lneg = methinfoof <@ (~~~) @>
|
||||
(*
|
||||
TODO: + Checked versions of operators
|
||||
TODO:
|
||||
let inline absImpl (x: ^T) : ^T =
|
||||
let inline acosImpl(x: ^T) : ^T =
|
||||
let inline asinImpl(x: ^T) : ^T =
|
||||
let inline atanImpl(x: ^T) : ^T =
|
||||
let inline atan2Impl(x: ^T) (y: ^T) : 'U =
|
||||
let inline ceilImpl(x: ^T) : ^T =
|
||||
let inline expImpl(x: ^T) : ^T =
|
||||
let inline floorImpl (x: ^T) : ^T =
|
||||
let inline truncateImpl (x: ^T) : ^T =
|
||||
let inline roundImpl (x: ^T) : ^T =
|
||||
let inline signImpl (x: ^T) : int =
|
||||
let inline logImpl(x: ^T) : ^T =
|
||||
let inline log10Impl(x: ^T) : ^T =
|
||||
let inline sqrtImpl(x: ^T) : ^U =
|
||||
let inline cosImpl(x: ^T) : ^T =
|
||||
let inline coshImpl(x: ^T) : ^T =
|
||||
let inline sinImpl(x: ^T) : ^T =
|
||||
let inline sinhImpl(x: ^T) : ^T =
|
||||
let inline tanImpl(x: ^T) : ^T =
|
||||
let inline tanhImpl(x: ^T) : ^T =
|
||||
let inline powImpl (x: ^T) (y: ^U) : ^T =
|
||||
*)
|
||||
|
||||
member ctxt.ResolveEntity(entityRef) =
|
||||
match entityResolutions.TryGetValue(entityRef) with
|
||||
| true, v -> v
|
||||
| _ ->
|
||||
let (DEntityRef typeName) = entityRef
|
||||
let res =
|
||||
match System.Type.GetType(typeName) with
|
||||
| null -> failwithf "couldn't resolve type %A" typeName
|
||||
| t -> REntity t
|
||||
entityResolutions.Add(entityRef, res)
|
||||
res
|
||||
|
||||
member ctxt.ResolveTypes(env, tys: DType[]) =
|
||||
let res = tys |> Array.map (fun ty -> ctxt.ResolveType (env, ty))
|
||||
if res |> Array.forall (function RType _ -> true | _ -> false) then
|
||||
RTypes (res |> Array.map (function RType x -> x | _ -> failwith "unreachable"))
|
||||
else
|
||||
UTypes res
|
||||
|
||||
member ctxt.ResolveType(env, ty: DType) =
|
||||
match ty with
|
||||
| DArrayType(1, elemType) ->
|
||||
match ctxt.ResolveType (env, elemType) with
|
||||
| RTypeOrObj t -> RType (t.MakeArrayType())
|
||||
| DArrayType(n, elemType) ->
|
||||
match ctxt.ResolveType (env, elemType) with
|
||||
| RTypeOrObj t -> RType (t.MakeArrayType(n))
|
||||
| DNamedType((DEntityRef nm as n), argTypes) ->
|
||||
// TODO: FCS quirk this is a hack to do with the fact that float<1> is being reported as a type by FCS and PortaCode
|
||||
if nm.StartsWith "Microsoft.FSharp.Core.float`1" then
|
||||
RType typeof<float>
|
||||
elif nm.StartsWith "Microsoft.FSharp.Core.decimal`1" then
|
||||
RType typeof<decimal>
|
||||
elif nm.StartsWith "Microsoft.FSharp.Core.float32`1" then
|
||||
RType typeof<float32>
|
||||
elif nm.StartsWith "Microsoft.FSharp.Core.int32`1" then
|
||||
RType typeof<int32>
|
||||
else
|
||||
let (RTypesOrObj argTypesR) = ctxt.ResolveTypes (env, argTypes)
|
||||
match ctxt.ResolveEntity n, argTypesR with
|
||||
| REntity e, [| |] -> RType e
|
||||
| REntity e, tys -> RType (e.MakeGenericType(tys))
|
||||
| UEntity u1, u2 -> UNamedType (u1, u2)
|
||||
| DFunctionType (t1, t2) ->
|
||||
let (RTypeOrObj t1R) = ctxt.ResolveType (env, t1)
|
||||
let (RTypeOrObj t2R) = ctxt.ResolveType (env, t2)
|
||||
RType (typedefof<int -> int>.MakeGenericType(t1R, t2R))
|
||||
| DTupleType(isStruct, argTypes) ->
|
||||
let (RTypesOrObj tys) = ctxt.ResolveTypes (env, argTypes)
|
||||
RType (if isStruct then failwith "struct tuple NYI" (* FSharp.Reflection.FSharpType.MakeStructTupleType(Array.ofList tys) *) else FSharp.Reflection.FSharpType.MakeTupleType(tys))
|
||||
| DVariableType v ->
|
||||
match env.Types.TryGetValue v with
|
||||
| true, res -> RType res
|
||||
| _ ->
|
||||
printfn "variable type %s not found" v
|
||||
RType typeof<obj>
|
||||
|
||||
member ctxt.ResolveUnionCase(unionType, unionCaseRef) =
|
||||
let (DUnionCaseRef unionCaseName) = unionCaseRef
|
||||
// TODO: create formal type environment
|
||||
let env = envEmpty
|
||||
let unionTypeR = ctxt.ResolveType (env, unionType)
|
||||
|
||||
match unionTypeR with
|
||||
| RType unionTypeV ->
|
||||
let ucases = Reflection.FSharpType.GetUnionCases(unionTypeV, bindAll)
|
||||
let ucase = ucases |> Array.find (fun uc -> uc.Name = unionCaseName)
|
||||
let make = Reflection.FSharpValue.PreComputeUnionConstructor(ucase, bindAll)
|
||||
let tag = Reflection.FSharpValue.PreComputeUnionTagReader(unionTypeV, bindAll)
|
||||
let get = Reflection.FSharpValue.PreComputeUnionReader(ucase, bindAll)
|
||||
RUnionCase (ucase, tag, make, get)
|
||||
| UNamedType (unionTypeDef, _) ->
|
||||
let tag = unionTypeDef.UnionCases |> Array.findIndex (fun x -> x = unionCaseName)
|
||||
UUnionCase (tag, unionCaseName)
|
||||
|
||||
member ctxt.ResolveField(classOrRecordType,fieldRef) =
|
||||
let (DFieldRef (index, fieldName)) = fieldRef
|
||||
// TODO: create formal type environment
|
||||
let env = envEmpty
|
||||
let classOrRecordTypeR = ctxt.ResolveType(env, classOrRecordType)
|
||||
|
||||
match classOrRecordTypeR with
|
||||
| RType classOrRecordTypeV ->
|
||||
match classOrRecordTypeV.GetField(fieldName, bindAll) with
|
||||
| null ->
|
||||
match classOrRecordTypeV.GetProperty(fieldName, bindAll) with
|
||||
| null -> failwithf "couldn't find field %s in type %A" fieldName classOrRecordType
|
||||
| pinfo -> RField pinfo
|
||||
| finfo -> RField finfo
|
||||
| ty ->
|
||||
UField (index, ty, fieldName)
|
||||
|
||||
member ctxt.ResolveILField(fieldType, fieldName) =
|
||||
// TODO: create formal type environment
|
||||
let env = envEmpty
|
||||
let fieldTypeR = ctxt.ResolveType (env, fieldType)
|
||||
|
||||
match fieldTypeR with
|
||||
| RType classOrRecordTypeV ->
|
||||
let field = classOrRecordTypeV.GetField(fieldName, bindAll)
|
||||
RField field
|
||||
| _ty ->
|
||||
failwithf "unexpected resolve of ILField %s in interpreted type %A" fieldName fieldType
|
||||
|
||||
member ctxt.MakeRMethod(m: MethodInfo) =
|
||||
if m = op_float then RPrim_float
|
||||
elif m = op_float32 then RPrim_float32
|
||||
elif m = op_double then RPrim_double
|
||||
elif m = op_single then RPrim_single
|
||||
elif m = op_int32 then RPrim_int32
|
||||
elif m = op_int then RPrim_int32
|
||||
elif m = op_byte then RPrim_byte
|
||||
elif m = op_int16 then RPrim_int16
|
||||
elif m = op_int64 then RPrim_int64
|
||||
elif m = op_uint16 then RPrim_uint16
|
||||
elif m = op_uint32 then RPrim_uint32
|
||||
elif m = op_uint64 then RPrim_uint64
|
||||
elif m = op_decimal then RPrim_decimal
|
||||
elif m = op_unativeint then RPrim_unativeint
|
||||
elif m = op_nativeint then RPrim_nativeint
|
||||
elif m = op_char then RPrim_char
|
||||
elif m = op_neg then RPrim_neg
|
||||
elif m = op_pos then RPrim_pos
|
||||
elif m = op_minus then RPrim_minus
|
||||
elif m = op_divide then RPrim_divide
|
||||
elif m = op_mod then RPrim_mod
|
||||
elif m = op_shiftleft then RPrim_shiftleft
|
||||
elif m = op_shiftright then RPrim_shiftright
|
||||
elif m = op_land then RPrim_land
|
||||
elif m = op_lor then RPrim_lor
|
||||
elif m = op_lxor then RPrim_lxor
|
||||
elif m = op_lneg then RPrim_lneg
|
||||
else RMethod m
|
||||
|
||||
member ctxt.InterpMethod(env, eR, nm, paramTys) =
|
||||
let paramTysR = ctxt.ResolveTypes (env, paramTys)
|
||||
let key = (eR, nm, paramTysR)
|
||||
if not (members.ContainsKey(key)) then failwithf "No member found for key %A" key
|
||||
let minfo = members.[key]
|
||||
UMember minfo
|
||||
|
||||
member ctxt.ResolveMethod(v: DMemberRef) =
|
||||
// TODO: create formal type environment
|
||||
let env = envEmpty
|
||||
let (DMemberRef(entity, nm, genericParams, paramTys, _retTy)) = v
|
||||
match ctxt.ResolveEntity entity with
|
||||
| REntity entityType as eR ->
|
||||
let n = paramTys.Length
|
||||
if nm = ".ctor" || nm = ".cctor" then
|
||||
match entityType.GetConstructors(bindAll) |> Array.filter (fun m -> m.Name = nm && m.GetParameters().Length = n) with
|
||||
| [| cinfo |] -> RMethod cinfo
|
||||
| _res ->
|
||||
// TODO: create formal type environment
|
||||
let (RTypesOrObj paramTysV) = ctxt.ResolveTypes (env, paramTys)
|
||||
match entityType.GetConstructor(bindAll, null, paramTysV, null) with
|
||||
| null -> ctxt.InterpMethod(env, eR, nm, paramTys)
|
||||
| cinfo -> RMethod cinfo
|
||||
else
|
||||
match entityType.GetMethods(bindAll) |> Array.filter (fun m -> m.Name = nm && m.GetParameters().Length = n) with
|
||||
| [| minfo |] -> ctxt.MakeRMethod minfo
|
||||
| [| |] when n = 0 && genericParams = 0 ->
|
||||
// TODO: cleanup FCS and portacode so names of properties are never used
|
||||
match entityType.GetProperty(nm, bindAll) with
|
||||
| null -> ctxt.InterpMethod(env, eR, nm, paramTys)
|
||||
| pinfo -> ctxt.MakeRMethod pinfo.GetMethod
|
||||
| _res ->
|
||||
// TODO: create formal type environment
|
||||
let (RTypesOrObj paramTysV) = ctxt.ResolveTypes (env, paramTys)
|
||||
match entityType.GetMethod(nm, bindAll, null, paramTysV, null) with
|
||||
| null -> ctxt.InterpMethod(env, eR, nm, paramTys)
|
||||
| minfo -> RMethod minfo
|
||||
| eR ->
|
||||
ctxt.InterpMethod(env, eR, nm, paramTys)
|
||||
|
||||
member ctxt.AddDecls(decls: DDecl[]) =
|
||||
|
||||
// TODO: create formal type environment
|
||||
let env = envEmpty
|
||||
for decl in decls do
|
||||
match decl with
|
||||
| DDeclEntity (entityDef, subDecls) ->
|
||||
let entityName = entityDef.Name
|
||||
// Override any existing resolution
|
||||
entityResolutions.[DEntityRef entityName] <- UEntity entityDef
|
||||
ctxt.AddDecls(subDecls)
|
||||
| DDeclMember (membDef, _body) when membDef.Parameters.Length = 0 && membDef.GenericParameters.Length = 0 -> ()
|
||||
| DDeclMember (membDef, body) ->
|
||||
let ty = ctxt.ResolveEntity(membDef.EnclosingEntity)
|
||||
let paramTypes = membDef.Parameters |> Array.map (fun p -> p.Type)
|
||||
let paramTypesR = ctxt.ResolveTypes(env, paramTypes)
|
||||
let thunk = ctxt.EvalMethodLambda (envEmpty, membDef.IsInstance, membDef.GenericParameters, membDef.Parameters, body)
|
||||
members.Add((ty, membDef.Name, paramTypesR), Value thunk)
|
||||
| _ -> ()
|
||||
|
||||
member ctxt.EvalMethodLambda(env, isInstance, typeParameters, parameters: DLocalDef[], body) =
|
||||
MethodLambdaValue
|
||||
(FuncConvert.FromFunc<Type[] * obj[],obj>(fun (tyargs, args) ->
|
||||
if parameters.Length + (if isInstance then 1 else 0) <> args.Length then failwithf "arg/parameter mismatch for method with arguments %A" parameters
|
||||
let env = if isInstance then bindByName env "$this" (Value args.[0]) else env
|
||||
let env = (env, parameters, (if isInstance then args.[1..] else args)) |||> Array.fold2 (fun env p a -> bind env p (Value a))
|
||||
let env = (env, typeParameters, tyargs) |||> Array.fold2 (fun env p a -> bindty env p a)
|
||||
box (ctxt.EvalExpr(env, body) |> getVal)))
|
||||
|
||||
member ctxt.EvalDecls(env, decls: DDecl[]) =
|
||||
for d in decls do
|
||||
match d with
|
||||
| DDeclEntity (_e, subDecls) -> ctxt.EvalDecls(env, subDecls)
|
||||
| DDeclMember (membDef, body) when membDef.Parameters.Length = 0 && membDef.GenericParameters.Length = 0 ->
|
||||
let ty = ctxt.ResolveEntity(membDef.EnclosingEntity)
|
||||
let res = ctxt.EvalExpr (env, body)
|
||||
members.Add ((ty, membDef.Name, RTypes [| |]), res)
|
||||
| DDeclMember _->
|
||||
()
|
||||
| DDecl.InitAction expr ->
|
||||
ctxt.EvalExpr (env, expr) |> ignore
|
||||
|
||||
member ctxt.GetExprDeclResult(ty, memberName) =
|
||||
members.[(ty, memberName, RTypes [| |])]
|
||||
|
||||
member ctxt.EvalExpr(env, expr: DExpr) : Value =
|
||||
match expr with
|
||||
| DExpr.Application(funcExpr, typeArgs, argExprs) -> ctxt.EvalApplication(env, funcExpr, typeArgs, argExprs)
|
||||
| DExpr.Call(objExprOpt, memberOrFunc, typeArgs1, typeArgs2, argExprs) -> ctxt.EvalCall(env, objExprOpt, memberOrFunc, typeArgs1, typeArgs2, argExprs)
|
||||
| DExpr.Coerce(_targetType, inpExpr) -> ctxt.EvalExpr(env, inpExpr)
|
||||
| DExpr.Lambda(domainTy, rangeTy, lambdaVar, bodyExpr) -> ctxt.EvalLambda(env, domainTy, rangeTy, lambdaVar, bodyExpr)
|
||||
| DExpr.Let((bindingVar, bindingExpr), bodyExpr) -> ctxt.EvalLet(env, (bindingVar, bindingExpr), bodyExpr)
|
||||
| DExpr.NewObject(objCtor, typeArgs, argExprs) -> ctxt.EvalNewObject(env, objCtor, typeArgs, argExprs)
|
||||
| DExpr.NewRecord(recordType, argExprs) -> ctxt.EvalNewRecord(env, recordType, argExprs)
|
||||
| DExpr.NewUnionCase(unionType, unionCase, argExprs) -> ctxt.EvalNewUnionCase(env, unionType, unionCase, argExprs)
|
||||
| DExpr.FSharpFieldGet(objExprOpt, recordOrClassType, fieldInfo) -> ctxt.EvalFieldGet(env, objExprOpt, recordOrClassType, fieldInfo)
|
||||
| DExpr.ILFieldGet(objExprOpt, fieldType, fieldName) -> ctxt.EvalILFieldGet(env, objExprOpt, fieldType, fieldName)
|
||||
| DExpr.NewTuple(tupleType, argExprs) -> ctxt.EvalNewTuple(env, tupleType, argExprs)
|
||||
| DExpr.DecisionTree(decisionExpr, decisionTargets) -> ctxt.EvalDecisionTree(env, decisionExpr, decisionTargets)
|
||||
| DExpr.DecisionTreeSuccess(decisionTargetIdx, decisionTargetExprs) -> ctxt.EvalDecisionTreeSuccess(env, decisionTargetIdx, decisionTargetExprs)
|
||||
| DExpr.Sequential(firstExpr, secondExpr) -> ctxt.EvalSequential(env, firstExpr, secondExpr)
|
||||
| DExpr.NewArray(arrayType, argExprs) -> ctxt.EvalNewArray(env, arrayType, argExprs)
|
||||
| DExpr.IfThenElse (guardExpr, thenExpr, elseExpr) -> ctxt.EvalIfThenElse (env, guardExpr, thenExpr, elseExpr)
|
||||
| DExpr.TryFinally(bodyExpr, finallyExpr) -> ctxt.EvalTryFinally(env, bodyExpr, finallyExpr)
|
||||
| DExpr.TupleGet(_tupleType, tupleElemIndex, tupleExpr) -> ctxt.EvalTupleGet(env, tupleElemIndex, tupleExpr)
|
||||
| DExpr.TryWith(bodyExpr, filterVar, filterExpr, catchVar, catchExpr) -> ctxt.EvalTryWith(env, bodyExpr, filterVar, filterExpr, catchVar, catchExpr)
|
||||
| DExpr.WhileLoop(guardExpr, bodyExpr) -> ctxt.EvalWhileLoop(env, guardExpr, bodyExpr)
|
||||
| DExpr.UnionCaseTest(unionExpr, unionType, unionCase) -> ctxt.EvalUnionCaseTest(env, unionExpr, unionType, unionCase)
|
||||
| DExpr.UnionCaseGet(unionExpr, unionType, unionCase, unionCaseField) -> ctxt.EvalUnionCaseGet(env, unionExpr, unionType, unionCase, unionCaseField)
|
||||
| DExpr.UnionCaseTag(unionExpr, unionType) -> ctxt.EvalUnionCaseTag(env, unionExpr, unionType)
|
||||
(*
|
||||
// TODO:
|
||||
| DExpr.AddressOf(lvalueExpr) -> ctxt.EvalAddressOf(convExpr lvalueExpr)
|
||||
| DExpr.AddressSet(lvalueExpr, rvalueExpr) -> ctxt.EvalAddressSet(convExpr lvalueExpr, convExpr rvalueExpr)
|
||||
| DExpr.FastIntegerForLoop(startExpr, limitExpr, consumeExpr, isUp) -> ctxt.EvalFastIntegerForLoop(convExpr startExpr, convExpr limitExpr, convExpr consumeExpr, isUp)
|
||||
| DExpr.LetRec(recursiveBindings, bodyExpr) -> ctxt.EvalLetRec(List.map (map2 convValue convExpr) recursiveBindings, convExpr bodyExpr)
|
||||
| DExpr.NewDelegate(delegateType, delegateBodyExpr) -> ctxt.EvalNewDelegate(convType delegateType, convExpr delegateBodyExpr)
|
||||
| DExpr.Quote(quotedExpr) -> ctxt.EvalQuote(convExpr quotedExpr)
|
||||
| DExpr.FSharpFieldSet(objExprOpt, recordOrClassType, fieldInfo, argExpr) -> ctxt.EvalFSharpFieldSet(convExprOpt objExprOpt, convType recordOrClassType, convField fieldInfo, convExpr argExpr)
|
||||
| DExpr.TypeLambda(genericParams, bodyExpr) -> ctxt.EvalTypeLambda(List.map convGenericParam genericParams, convExpr bodyExpr)
|
||||
| DExpr.TypeTest(ty, inpExpr) -> ctxt.EvalTypeTest(convType ty, convExpr inpExpr)
|
||||
| DExpr.ObjectExpr(objType, baseCallExpr, overrides, interfaceImplementations) -> ctxt.EvalObjectExpr(convType objType, convExpr baseCallExpr, List.map convObjMember overrides, List.map (map2 convType (List.map convObjMember)) interfaceImplementations)
|
||||
| DExpr.DefaultValue defaultType -> ctxt.EvalDefaultValue (convType defaultType)
|
||||
|
||||
//| DExpr.TraitCall(sourceTypes, traitName, typeArgs, typeInstantiation, argTypes, argExprs) -> ctxt.EvalTraitCall(sourceTypes, traitName, typeArgs, typeInstantiation, argTypes, argExprs)
|
||||
| DExpr.UnionCaseSet(unionExpr, unionType, unionCase, unionCaseField, valueExpr) -> ctxt.EvalUnionCaseSet(convExpr unionExpr, convType unionType, convUnionCase unionCase, convField unionCaseField, convExpr valueExpr)
|
||||
| DExpr.ILAsm(asmCode, typeArgs, argExprs) -> ctxt.EvalILAsm(asmCode, convTypes typeArgs, convExprs argExprs)
|
||||
| DExpr.ILFieldSet (objExprOpt, fieldType, fieldName, valueExpr) -> ctxt.EvalILFieldSet (convExprOpt objExprOpt, convType fieldType, fieldName, convExpr valueExpr)
|
||||
*)
|
||||
| DExpr.BaseValue _thisType
|
||||
| DExpr.ThisValue _thisType ->
|
||||
match env.Vals.TryGetValue "$this" with
|
||||
| true, res -> res
|
||||
| _ -> failwithf "didn't find this value in the environment"
|
||||
|
||||
| DExpr.Value(DLocalRef (v, isThisValue, isMutable)) ->
|
||||
if isThisValue then
|
||||
match env.Vals.TryGetValue "$this" with
|
||||
| true, res -> res
|
||||
| _ -> failwithf "didn't find this value in the environment"
|
||||
elif isMutable then
|
||||
match env.Vals.TryGetValue v with
|
||||
| true, Value (:? ref<obj> as rv) -> Value rv.Value
|
||||
| _ -> failwithf "didn't find mutable value in the environment"
|
||||
else
|
||||
match env.Vals.TryGetValue v with
|
||||
| true, res -> res
|
||||
| _ -> failwithf "didn't find value '%s' in the environment" v
|
||||
|
||||
| DExpr.ValueSet(DLocalRef (valToSet, _, _), valueExpr) ->
|
||||
let valueExprV : obj = ctxt.EvalExpr(env, valueExpr) |> getVal
|
||||
match env.Vals.TryGetValue valToSet with
|
||||
| true, Value (:? ref<obj> as rv) ->
|
||||
rv := valueExprV
|
||||
Value null
|
||||
| _ -> failwithf "didn't find mutable value in the environment"
|
||||
|
||||
| DExpr.Const(constValueObj, _constType) ->
|
||||
Value constValueObj
|
||||
| _ -> failwithf "unrecognized %+A" expr
|
||||
|
||||
member ctxt.EvalExprs(env, argExprs) =
|
||||
let argsV = argExprs |> Array.map (fun argExpr -> ctxt.EvalExpr(env, argExpr))
|
||||
argsV |> Array.map getVal
|
||||
|
||||
member ctxt.EvalExprOpt(env, objExprOpt) =
|
||||
let objValOpt = objExprOpt |> Option.map (fun objExpr -> ctxt.EvalExpr(env, objExpr))
|
||||
objValOpt |> Option.map getVal |> Option.toObj
|
||||
|
||||
member ctxt.EvalNewObject(env, objCtor, typeArgs, argExprs) =
|
||||
let argsV = ctxt.EvalExprs(env, argExprs)
|
||||
let typeArgsR = ctxt.ResolveTypes (env, typeArgs)
|
||||
let methR = ctxt.ResolveMethod objCtor
|
||||
|
||||
match methR, typeArgsR with
|
||||
| RMethod (:? ConstructorInfo as cinfo), RTypesOrObj typeArgsV ->
|
||||
let icinfo =
|
||||
if cinfo.DeclaringType.IsGenericType then
|
||||
let tinfo = cinfo.DeclaringType.MakeGenericType(typeArgsV)
|
||||
tinfo.GetConstructors(bindAll) |> Array.find (fun cinfo2 -> cinfo2.MetadataToken = cinfo.MetadataToken)
|
||||
else cinfo
|
||||
try icinfo.Invoke(argsV) |> Value
|
||||
with :? TargetInvocationException as e ->
|
||||
raise e.InnerException
|
||||
|
||||
| UMember (Value (:? MethodLambdaValue as fM )), RTypesOrObj typeArgsV ->
|
||||
let (MethodLambdaValue f) = fM
|
||||
f (typeArgsV, argsV) |> Value
|
||||
| _ ->
|
||||
failwithf "unexpected constructor %A at types %A" methR typeArgsR
|
||||
|
||||
member ctxt.EvalApplication(env, funcExpr, _typeArgs, argExprs) =
|
||||
let funcV = ctxt.EvalExpr(env, funcExpr)
|
||||
let argsV = ctxt.EvalExprs(env, argExprs)
|
||||
ctxt.EvalApplicationOfArg(env, funcV, argsV)
|
||||
|
||||
member ctxt.EvalApplicationOfArg(env, funcV, argsV) =
|
||||
match getVal funcV, argsV with
|
||||
| :? (obj -> obj) as f, [| obj |] -> f obj |> Value
|
||||
| f, _ ->
|
||||
if argsV.Length = 0 then
|
||||
failwithf "unexpected empty arguments in application of %A" f
|
||||
else
|
||||
let t = f.GetType()
|
||||
let i = t.GetMethod("Invoke")
|
||||
let res =
|
||||
try i.Invoke(f, [| argsV.[0] |]) |> Value
|
||||
with :? TargetInvocationException as e ->
|
||||
raise e.InnerException
|
||||
if argsV.Length > 1 then
|
||||
ctxt.EvalApplicationOfArg(env, res, argsV.[1..])
|
||||
else
|
||||
res
|
||||
|
||||
member ctxt.EvalLet(env, (bindingVar, bindingExpr), bodyExpr) =
|
||||
let bindingExprV = ctxt.EvalExpr(env, bindingExpr)
|
||||
let env = bind env bindingVar bindingExprV
|
||||
ctxt.EvalExpr (env, bodyExpr)
|
||||
|
||||
member ctxt.EvalCall(env, objExprOpt, memberOrFunc, typeArgs1, typeArgs2, argExprs) =
|
||||
let objOptV = ctxt.EvalExprOpt (env, objExprOpt)
|
||||
let argsV = ctxt.EvalExprs (env, argExprs)
|
||||
let methR = ctxt.ResolveMethod memberOrFunc
|
||||
|
||||
// These primitives don't have dynamic invocation implementations
|
||||
match methR with
|
||||
| RPrim_float -> Value (Convert.ToDouble argsV.[0])
|
||||
| RPrim_double -> Value (Convert.ToDouble argsV.[0])
|
||||
| RPrim_single -> Value (Convert.ToSingle argsV.[0])
|
||||
| RPrim_int32 -> Value (Convert.ToInt32 argsV.[0])
|
||||
| RPrim_int16 -> Value (Convert.ToInt16 argsV.[0])
|
||||
| RPrim_int64 -> Value (Convert.ToInt64 argsV.[0])
|
||||
| RPrim_byte -> Value (Convert.ToByte argsV.[0])
|
||||
| RPrim_uint16 -> Value (Convert.ToUInt16 argsV.[0])
|
||||
| RPrim_uint32 -> Value (Convert.ToUInt32 argsV.[0])
|
||||
| RPrim_uint64 -> Value (Convert.ToUInt64 argsV.[0])
|
||||
| RPrim_decimal -> Value (Convert.ToDecimal argsV.[0])
|
||||
//| RPrim_unativeint -> Value (Convert.ToUIntPtr argsV.[0])
|
||||
//| RPrim_nativeint -> Value (Convert.ToIntPtr argsV.[0])
|
||||
| RPrim_char -> Value (Convert.ToChar argsV.[0])
|
||||
| RPrim_neg -> Value (match argsV.[0] with :? int32 as v -> -v | _ -> failwith "nyi:neg")
|
||||
| RPrim_pos -> Value argsV.[0]
|
||||
| RPrim_minus -> binOp argsV (-) (-) (-) (-) (-) (-) (-) (-) (-) (-) (-)
|
||||
| RPrim_divide -> binOp argsV (/) (/) (/) (/) (/) (/) (/) (/) (/) (/) (/)
|
||||
| RPrim_mod -> binOp argsV (%) (%) (%) (%) (%) (%) (%) (%) (%) (%) (%)
|
||||
| RPrim_shiftleft -> shiftOp argsV (<<<) (<<<) (<<<) (<<<) (<<<) (<<<) (<<<) (<<<)
|
||||
| RPrim_shiftright -> shiftOp argsV (>>>) (>>>) (>>>) (>>>) (>>>) (>>>) (>>>) (>>>)
|
||||
| RPrim_land -> logicBinOp argsV (&&&) (&&&) (&&&) (&&&) (&&&) (&&&) (&&&) (&&&)
|
||||
| RPrim_lor -> logicBinOp argsV (|||) (|||) (|||) (|||) (|||) (|||) (|||) (|||)
|
||||
| RPrim_lxor -> logicBinOp argsV (^^^) (^^^) (^^^) (^^^) (^^^) (^^^) (^^^) (^^^)
|
||||
| RPrim_lneg -> logicUnOp argsV (~~~) (~~~) (~~~) (~~~) (~~~) (~~~) (~~~) (~~~)
|
||||
| _ ->
|
||||
|
||||
let typeArgs1R = ctxt.ResolveTypes (env, typeArgs1)
|
||||
let typeArgs2R = ctxt.ResolveTypes (env, typeArgs2)
|
||||
|
||||
match methR, typeArgs1R, typeArgs2R with
|
||||
| RMethod (:? MethodInfo as minfo), RTypesOrObj typeArgs1V, RTypesOrObj typeArgs2V ->
|
||||
let iminfo =
|
||||
if minfo.DeclaringType.IsGenericType then
|
||||
let cinfo = minfo.DeclaringType.MakeGenericType(typeArgs1V)
|
||||
match cinfo.GetMethods(bindAll) |> Array.tryFind (fun m -> m.MetadataToken = minfo.MetadataToken) with
|
||||
| Some minfo2 ->
|
||||
if minfo.IsGenericMethod then
|
||||
minfo2.MakeGenericMethod (typeArgs2V)
|
||||
else
|
||||
minfo2
|
||||
| None ->
|
||||
failwithf "didn't find a matching method for %A with the right token" minfo
|
||||
elif minfo.IsGenericMethod then
|
||||
minfo.MakeGenericMethod(typeArgs2V)
|
||||
else minfo
|
||||
try iminfo.Invoke(objOptV, argsV) |> Value
|
||||
with :? TargetInvocationException as e ->
|
||||
raise e.InnerException
|
||||
|
||||
| RMethod (:? ConstructorInfo as cinfo), RTypesOrObj _typeArgs1V, RTypesOrObj _typeArgs2V ->
|
||||
try cinfo.Invoke(argsV) |> Value
|
||||
with :? TargetInvocationException as e ->
|
||||
raise e.InnerException
|
||||
|
||||
| UMember (Value (:? MethodLambdaValue as fM )), RTypesOrObj typeArgs1V, RTypesOrObj typeArgs2V ->
|
||||
let (MethodLambdaValue f) = fM
|
||||
let callArgsV = (match objOptV with null -> argsV | objV -> Array.append [| objV |] argsV)
|
||||
let callTypeArgsV = Array.append typeArgs1V typeArgs2V
|
||||
f (callTypeArgsV, callArgsV) |> Value
|
||||
|
||||
| UMember (Value v), RTypes [| |], RTypes [| |] when argExprs.Length = 0 ->
|
||||
v |> Value
|
||||
|
||||
| _ ->
|
||||
failwithf "unexpected member %A at types %A %A" methR typeArgs1R typeArgs2R
|
||||
|
||||
member ctxt.EvalFieldGet(env, objExprOpt, recordOrClassType, fieldInfo) =
|
||||
let objOptV = ctxt.EvalExprOpt(env, objExprOpt)
|
||||
let fieldR = ctxt.ResolveField (recordOrClassType, fieldInfo)
|
||||
|
||||
match fieldR with
|
||||
| RField (:? FieldInfo as finfo) -> finfo.GetValue(objOptV) |> Value
|
||||
| RField (:? PropertyInfo as pinfo) -> pinfo.GetValue(objOptV) |> Value
|
||||
| RField _ -> failwith "unexpected field resolution"
|
||||
| UField (i, _ty, nm) ->
|
||||
match objOptV with
|
||||
| :? RecordValue as recdV ->
|
||||
let (RecordValue argsV) = recdV
|
||||
argsV.[i] |> Value
|
||||
| _ -> failwithf "unexpected kind of interpreted value %A while getting field %s" objOptV nm
|
||||
|
||||
member ctxt.EvalILFieldGet(env, objExprOpt, recordOrClassType, fieldInfo) =
|
||||
let objOptV = ctxt.EvalExprOpt(env, objExprOpt)
|
||||
let fieldR = ctxt.ResolveILField (recordOrClassType, fieldInfo)
|
||||
|
||||
match fieldR with
|
||||
| RField (:? FieldInfo as finfo) -> finfo.GetValue(objOptV) |> Value
|
||||
| RField (:? PropertyInfo as pinfo) -> pinfo.GetValue(objOptV) |> Value
|
||||
| RField _ -> failwith "unexpected field resolution"
|
||||
| UField (_i, _ty, nm) -> failwithf "unexpected ILFieldGet %s in interpreted type %A" nm recordOrClassType
|
||||
|
||||
member ctxt.EvalLambda(env, domainType, rangeType, lambdaVar, bodyExpr) =
|
||||
let domainTypeR = ctxt.ResolveType (env, domainType)
|
||||
let rangeTypeR = ctxt.ResolveType (env, rangeType)
|
||||
match domainTypeR, rangeTypeR with
|
||||
| RTypeOrObj domainTypeV, RTypeOrObj rangeTypeV ->
|
||||
let funcTypeV = typedefof<int -> int>.MakeGenericType(domainTypeV, rangeTypeV)
|
||||
FSharp.Reflection.FSharpValue.MakeFunction(funcTypeV, (fun (arg: obj) ->
|
||||
let env = bind env lambdaVar (Value arg)
|
||||
ctxt.EvalExpr(env, bodyExpr) |> getVal)) |> box |> Value
|
||||
|
||||
member ctxt.EvalNewArray(env, arrayType, argExprs) =
|
||||
let arrayTypeR = ctxt.ResolveType (env, arrayType)
|
||||
let argsV = ctxt.EvalExprs(env, argExprs)
|
||||
|
||||
match arrayTypeR with
|
||||
| RType arrayTypeV ->
|
||||
let arr = Array.CreateInstance(arrayTypeV, argsV.Length)
|
||||
argsV |> Array.iteri (fun i argV -> arr.SetValue(argV, i))
|
||||
Value arr
|
||||
| _ ->
|
||||
failwithf "unexpected failure to resolve array type %A" arrayType
|
||||
|
||||
member ctxt.EvalNewRecord(env, recordType, argExprs) =
|
||||
let recordTypeR = ctxt.ResolveType (env, recordType)
|
||||
let argsV = ctxt.EvalExprs(env, argExprs)
|
||||
|
||||
match recordTypeR with
|
||||
| RType recordTypeV ->
|
||||
Reflection.FSharpValue.MakeRecord(recordTypeV, argsV, bindAll) |> Value
|
||||
| _ ->
|
||||
let recdV = RecordValue argsV
|
||||
Value recdV
|
||||
|
||||
member ctxt.EvalNewUnionCase(env, unionType, unionCase, argExprs) =
|
||||
let unionCaseR = ctxt.ResolveUnionCase (unionType, unionCase)
|
||||
let argsV = ctxt.EvalExprs (env, argExprs)
|
||||
|
||||
match unionCaseR with
|
||||
| RUnionCase (_ucase, _tag, make, _get) -> make argsV |> Value
|
||||
| UUnionCase (tag, unionCaseName) ->
|
||||
let unionV = UnionValue(tag, unionCaseName, argsV)
|
||||
unionV |> box |> Value
|
||||
|
||||
member ctxt.EvalNewTuple(env, tupleType, argExprs) =
|
||||
let tupleTypeR = ctxt.ResolveType (env, tupleType)
|
||||
let argsV = ctxt.EvalExprs (env, argExprs)
|
||||
|
||||
match tupleTypeR with
|
||||
| RType t -> Reflection.FSharpValue.MakeTuple(argsV, t) |> Value
|
||||
| _ -> failwith "unresolve tuple type"
|
||||
|
||||
member ctxt.EvalDecisionTree(env, decisionExpr, decisionTargets) =
|
||||
let env = { env with Targets = decisionTargets }
|
||||
ctxt.EvalExpr (env, decisionExpr)
|
||||
|
||||
member ctxt.EvalDecisionTreeSuccess(env, decisionTargetIdx, decisionTargetExprs) =
|
||||
let (locals, expr) = env.Targets.[decisionTargetIdx]
|
||||
let env = (env, locals, decisionTargetExprs) |||> Array.fold2 (fun env p a -> bind env p (Value a))
|
||||
ctxt.EvalExpr (env, expr)
|
||||
|
||||
member ctxt.EvalSequential(env, firstExpr, secondExpr) =
|
||||
let _ = ctxt.EvalExpr (env, firstExpr)
|
||||
ctxt.EvalExpr (env, secondExpr)
|
||||
|
||||
member ctxt.EvalIfThenElse(env, guardExpr, thenExpr, elseExpr) =
|
||||
if ctxt.EvalBool(env, guardExpr) then
|
||||
ctxt.EvalExpr (env, thenExpr)
|
||||
else
|
||||
ctxt.EvalExpr (env, elseExpr)
|
||||
|
||||
member ctxt.EvalBool(env, expr) =
|
||||
match ctxt.EvalExpr (env, expr) |> getVal with
|
||||
| :? bool as v -> v
|
||||
| _ -> failwith "unexpected result type from bool expr"
|
||||
|
||||
member ctxt.EvalTryFinally(env, bodyExpr, finallyExpr) =
|
||||
try
|
||||
ctxt.EvalExpr (env, bodyExpr)
|
||||
finally
|
||||
ctxt.EvalExpr (env, finallyExpr) |> ignore
|
||||
|
||||
member ctxt.EvalTryWith(env, bodyExpr, filterVar, filterExpr, catchVar, catchExpr) =
|
||||
try
|
||||
ctxt.EvalExpr (env, bodyExpr)
|
||||
with e when ctxt.EvalBool (bind env filterVar (Value e), filterExpr) ->
|
||||
ctxt.EvalExpr (bind env catchVar (Value e), catchExpr)
|
||||
|
||||
member ctxt.EvalTupleGet(env, tupleElemIndex, tupleExpr) =
|
||||
let tupleExprV = ctxt.EvalExpr(env, tupleExpr) |> getVal
|
||||
Reflection.FSharpValue.GetTupleField(tupleExprV, tupleElemIndex) |> Value
|
||||
|
||||
member ctxt.EvalWhileLoop(env, guardExpr, bodyExpr) =
|
||||
if ctxt.EvalBool(env, guardExpr) then
|
||||
ctxt.EvalExpr (env, bodyExpr) |> ignore
|
||||
ctxt.EvalWhileLoop(env, guardExpr, bodyExpr)
|
||||
else
|
||||
Value (box ())
|
||||
|
||||
member ctxt.EvalUnionCaseTest(env, unionExpr, unionType, unionCase) =
|
||||
let unionCaseR = ctxt.ResolveUnionCase (unionType, unionCase)
|
||||
let unionV : obj = ctxt.EvalExpr (env, unionExpr) |> getVal
|
||||
|
||||
let res =
|
||||
match unionCaseR with
|
||||
| RUnionCase (ucase, tag, _make, _get) -> (tag unionV = ucase.Tag)
|
||||
| UUnionCase (tag, _unionCaseName) ->
|
||||
match unionV with
|
||||
| :? UnionValue as p ->
|
||||
let (UnionValue(tag2, _nm, _fields)) = p
|
||||
tag = tag2
|
||||
| _ -> failwithf "unexpected value '%A' in EvalUnionCaseTest" unionV
|
||||
Value (box res)
|
||||
|
||||
member ctxt.EvalUnionCaseGet(env, unionExpr, unionType, unionCase, unionCaseField) =
|
||||
let unionCaseR = ctxt.ResolveUnionCase (unionType, unionCase)
|
||||
let unionCaseFieldR = ctxt.ResolveField (unionType, unionCaseField)
|
||||
let unionV : obj = ctxt.EvalExpr (env, unionExpr) |> getVal
|
||||
|
||||
let res =
|
||||
match unionCaseR with
|
||||
| RUnionCase _ ->
|
||||
match unionCaseFieldR with
|
||||
| RField (:? FieldInfo as finfo) -> finfo.GetValue(unionV)
|
||||
| RField (:? PropertyInfo as pinfo) -> pinfo.GetValue(unionV)
|
||||
| _ -> failwithf "unexpected field resolution %A in EvalUnionCaseGet" unionCaseFieldR
|
||||
| UUnionCase (_tag, _unionCaseName) ->
|
||||
match unionV with
|
||||
| :? UnionValue as unionV ->
|
||||
let (UnionValue(_tag, _unionCaseName, fields)) = unionV
|
||||
match unionCaseFieldR with
|
||||
| UField (index, _, _) ->
|
||||
fields.[index]
|
||||
| RField _ ->
|
||||
failwithf "unexpected field resolution %A in EvalUnionCaseGet" unionCaseFieldR
|
||||
| _ -> failwithf "unexpected value '%A' in EvalUnionCaseGet" unionV
|
||||
Value (box res)
|
||||
|
||||
member ctxt.EvalUnionCaseTag(env, unionExpr, unionType) =
|
||||
let unionTypeR = ctxt.ResolveType (env, unionType)
|
||||
let unionV : obj = ctxt.EvalExpr (env, unionExpr) |> getVal
|
||||
|
||||
let res =
|
||||
match unionTypeR with
|
||||
| RType unionTypeV ->
|
||||
let tag = Reflection.FSharpValue.PreComputeUnionTagReader(unionTypeV, bindAll)
|
||||
tag unionV
|
||||
| _ ->
|
||||
match unionV with
|
||||
| :? (int * string * obj[]) as p ->
|
||||
let (tag, _nm, _fields) = p
|
||||
tag
|
||||
| _ -> failwithf "unexpected value '%A' in EvalUnionCaseTag" unionV
|
||||
Value (box res)
|
||||
|
|
@ -0,0 +1,208 @@
|
|||
// Copyright 2018 Elmish.XamarinForms contributors. See LICENSE.md for license.
|
||||
|
||||
// cd C:\GitHub\dsyme\Elmish.XamarinForms\Samples\CounterApp\CounterApp
|
||||
// adb -d forward tcp:9867 tcp:9867
|
||||
// dotnet run --project ..\..\..\fscd\fscd.fsproj -- --eval @out.args
|
||||
// dotnet run --project ..\..\..\fscd\fscd.fsproj -- --watch --webhook:http://localhost:9867/update @out.args
|
||||
|
||||
|
||||
module fscd.Driver
|
||||
|
||||
open FSharp.Compiler.PortaCode.CodeModel
|
||||
open FSharp.Compiler.PortaCode.Interpreter
|
||||
open FSharp.Compiler.PortaCode.FromCompilerService
|
||||
open System
|
||||
open System.IO
|
||||
open System.Collections.Generic
|
||||
open Microsoft.FSharp.Compiler.SourceCodeServices
|
||||
open System.Net
|
||||
|
||||
#if TEST
|
||||
module MockForms =
|
||||
open Xamarin.Forms
|
||||
open Xamarin.Forms.Internals
|
||||
type MockPlatformServices() =
|
||||
interface IPlatformServices with
|
||||
member __. GetMD5Hash(input) = raise (NotImplementedException())
|
||||
member __.GetNamedSize(size, targetElement, useOldSizes) = 10.0
|
||||
member __.OpenUriAction(uri) = raise (NotImplementedException())
|
||||
member __.IsInvokeRequired = false
|
||||
member __.get_RuntimePlatform() = Unchecked.defaultof<_>
|
||||
member __.BeginInvokeOnMainThread(action: Action) = action.Invoke()
|
||||
member __.CreateTicker() = raise (NotImplementedException())
|
||||
member __.StartTimer(interval, callback) = raise (NotImplementedException())
|
||||
member __.GetStreamAsync(uri, cancellationToken) = raise (NotImplementedException())
|
||||
member __.GetAssemblies() = raise (NotImplementedException())
|
||||
member __.GetUserStoreForApplication() = raise (NotImplementedException())
|
||||
member __.QuitApplication() = raise (NotImplementedException())
|
||||
|
||||
type MockDeserializer() =
|
||||
interface IDeserializer with
|
||||
member __.DeserializePropertiesAsync() = raise (NotImplementedException())
|
||||
member __.SerializePropertiesAsync(properties: IDictionary<string, obj>) = raise (NotImplementedException())
|
||||
|
||||
type MockResourcesProvider() =
|
||||
interface ISystemResourcesProvider with
|
||||
member __.GetSystemResources() = raise (NotImplementedException())
|
||||
|
||||
type MockDeviceInfo() =
|
||||
inherit DeviceInfo()
|
||||
override __.PixelScreenSize = raise (NotImplementedException())
|
||||
override __.ScaledScreenSize = raise (NotImplementedException())
|
||||
override __.ScalingFactor = raise (NotImplementedException())
|
||||
|
||||
let Init() =
|
||||
Device.Info <- new MockDeviceInfo()
|
||||
Device.PlatformServices <- new MockPlatformServices()
|
||||
DependencyService.Register<MockResourcesProvider>()
|
||||
DependencyService.Register<MockDeserializer>()
|
||||
#endif
|
||||
|
||||
let checker = FSharpChecker.Create(keepAssemblyContents = true)
|
||||
|
||||
#if !TEST
|
||||
[<EntryPoint>]
|
||||
#endif
|
||||
let main (argv: string[]) =
|
||||
try
|
||||
printfn "hello! argv = %A" argv
|
||||
#if TEST
|
||||
MockForms.Init()
|
||||
#endif
|
||||
let mutable eval = false
|
||||
let mutable watch = false
|
||||
let mutable webhook = None
|
||||
let args =
|
||||
let mutable haveDashes = false
|
||||
|
||||
[| for arg in argv do
|
||||
if arg.StartsWith("@") then
|
||||
for line in File.ReadAllLines(arg.[1..]) do
|
||||
if not (String.IsNullOrWhiteSpace line) then
|
||||
yield line
|
||||
elif arg = "--" then haveDashes <- true
|
||||
elif arg = "--watch" then watch <- true
|
||||
elif arg = "--eval" then eval <- true
|
||||
elif arg.StartsWith "--webhook:" then webhook <- Some arg.["--webhook:".Length ..]
|
||||
else yield arg |]
|
||||
|
||||
for arg in args do
|
||||
printfn "arg %s" arg
|
||||
let sourceFiles, otherFlags = args |> Array.partition (fun arg -> arg.EndsWith(".fs") || arg.EndsWith(".fsi") || arg.EndsWith(".fsx"))
|
||||
let sourceFiles = sourceFiles |> Array.map Path.GetFullPath
|
||||
|
||||
printfn "curr = %s" Environment.CurrentDirectory
|
||||
let options = checker.GetProjectOptionsFromCommandLineArgs("tmp.fsproj", otherFlags)
|
||||
let options = { options with SourceFiles = sourceFiles }
|
||||
printfn "options = %A" options
|
||||
|
||||
let rec checkFile count sourceFile =
|
||||
try
|
||||
let _, checkResults = checker.ParseAndCheckFileInProject(sourceFile, 0, File.ReadAllText(sourceFile), options) |> Async.RunSynchronously
|
||||
match checkResults with
|
||||
| FSharpCheckFileAnswer.Aborted ->
|
||||
printfn "aborted"
|
||||
Result.Error ()
|
||||
| FSharpCheckFileAnswer.Succeeded res ->
|
||||
let mutable hasErrors = false
|
||||
for error in res.Errors do
|
||||
printfn "%s" (error.ToString())
|
||||
if error.Severity = FSharpErrorSeverity.Error then
|
||||
hasErrors <- true
|
||||
if hasErrors then
|
||||
Result.Error ()
|
||||
else
|
||||
Result.Ok res.ImplementationFile
|
||||
with
|
||||
| :? System.IO.IOException when count = 0 -> System.Threading.Thread.Sleep 500; checkFile 1 sourceFile
|
||||
| exn ->
|
||||
printfn "%s" (exn.ToString())
|
||||
Result.Error ()
|
||||
|
||||
let convFile (i: FSharpImplementationFileContents) =
|
||||
//(i.QualifiedName, i.FileName
|
||||
{ Code = convDecls i.Declarations }
|
||||
|
||||
let jsonFile (i: FSharpImplementationFileContents) =
|
||||
let data = convFile i
|
||||
let serializer = MBrace.FsPickler.Json.FsPickler.CreateJsonSerializer( (* indent=true *) )
|
||||
let json = serializer.PickleToString(data)
|
||||
json
|
||||
|
||||
|
||||
if watch then
|
||||
let watchers =
|
||||
[ for sourceFile in sourceFiles do
|
||||
let path = Path.GetDirectoryName(sourceFile)
|
||||
let fileName = Path.GetFileName(sourceFile)
|
||||
printfn "fscd: WATCHING %s in %s" fileName path
|
||||
let watcher = new FileSystemWatcher(path, fileName)
|
||||
watcher.NotifyFilter <- NotifyFilters.Attributes ||| NotifyFilters.CreationTime ||| NotifyFilters.FileName ||| NotifyFilters.LastAccess ||| NotifyFilters.LastWrite ||| NotifyFilters.Size ||| NotifyFilters.Security;
|
||||
let changed = (fun (ev: FileSystemEventArgs) ->
|
||||
printfn "fscd: CHANGE DETECTED for %s, COMPILING...." sourceFile
|
||||
match checkFile 0 ev.FullPath with
|
||||
| Result.Error () ->
|
||||
printfn "fscd: ERRORS for %s" sourceFile
|
||||
| Result.Ok iopt ->
|
||||
printfn "fscd: COMPILED %s" sourceFile
|
||||
match iopt with
|
||||
| None -> ()
|
||||
| Some i ->
|
||||
printfn "fscd: GOT PortaCode for %s" sourceFile
|
||||
let json = jsonFile i
|
||||
printfn "fscd: GOT JSON for %s, length = %d" sourceFile json.Length
|
||||
match webhook with
|
||||
| Some hook ->
|
||||
try
|
||||
use webClient = new WebClient()
|
||||
printfn "fscd: SENDING TO WEBHOOK... " // : <<<%s>>>... --> %s" json.[0 .. min (json.Length - 1) 100] hook
|
||||
let resp = webClient.UploadString(hook,"Put",json)
|
||||
printfn "fscd: RESP FROM WEBHOOK: %s" resp
|
||||
with err ->
|
||||
printfn "fscd: ERROR SENDING TO WEBHOOK: %A" (err.ToString())
|
||||
|
||||
| None ->
|
||||
())
|
||||
watcher.Changed.Add changed
|
||||
//watcher.Created.Add changed
|
||||
//watcher.Deleted.Add changed
|
||||
yield watcher ]
|
||||
|
||||
for watcher in watchers do
|
||||
watcher.EnableRaisingEvents <- true
|
||||
|
||||
printfn "Waiting for changes..."
|
||||
System.Console.ReadLine() |> ignore
|
||||
for watcher in watchers do
|
||||
watcher.EnableRaisingEvents <- true
|
||||
|
||||
else
|
||||
let fileContents =
|
||||
[| for sourceFile in sourceFiles do
|
||||
match checkFile 0 sourceFile with
|
||||
| Result.Error _ -> failwith "errors"
|
||||
| Result.Ok iopt ->
|
||||
match iopt with
|
||||
| None -> () // signature file
|
||||
| Some i -> yield i |]
|
||||
|
||||
printfn "#ImplementationFiles = %d" fileContents.Length
|
||||
|
||||
if eval then
|
||||
let ctxt = EvalContext()
|
||||
let fileConvContents = [| for i in fileContents -> convFile i |]
|
||||
for ds in fileConvContents do
|
||||
ctxt.AddDecls(ds.Code)
|
||||
for ds in fileConvContents do
|
||||
//printfn "eval %A" a
|
||||
ctxt.EvalDecls (envEmpty, ds.Code)
|
||||
|
||||
else
|
||||
let fileConvContents = [| for i in fileContents -> jsonFile i |]
|
||||
|
||||
printfn "%A" fileConvContents
|
||||
0
|
||||
|
||||
with e ->
|
||||
printfn "Error: %s" (e.ToString())
|
||||
1
|
|
@ -0,0 +1,22 @@
|
|||
<Project Sdk="Microsoft.NET.Sdk">
|
||||
|
||||
<PropertyGroup>
|
||||
<OutputType>Exe</OutputType>
|
||||
<TargetFramework>net472</TargetFramework>
|
||||
</PropertyGroup>
|
||||
|
||||
<ItemGroup>
|
||||
<Compile Include="CodeModel.fs" />
|
||||
<Compile Include="Interpreter.fs" />
|
||||
<Compile Include="FromCompilerService.fs" />
|
||||
<Compile Include="fscd.fs" />
|
||||
</ItemGroup>
|
||||
|
||||
<ItemGroup>
|
||||
<PackageReference Include="FSharp.Compiler.Service" Version="23.0.3" />
|
||||
<PackageReference Include="FsPickler" Version="5.2.0" />
|
||||
<PackageReference Include="FsPickler.Json" Version="5.2.0" />
|
||||
<PackageReference Update="FSharp.Core" Version="4.5.0" />
|
||||
</ItemGroup>
|
||||
|
||||
</Project>
|
|
@ -58,4 +58,4 @@ group macos
|
|||
framework: xamarinmac20
|
||||
source https://www.nuget.org/api/v2
|
||||
nuget FSharp.Core 4.5.0
|
||||
nuget Xamarin.Forms 3.0.0.482510
|
||||
nuget Xamarin.Forms 3.0.0.482510
|
||||
|
|
|
@ -59,10 +59,11 @@ module App =
|
|||
yield Xaml.Button(text="Reset", horizontalOptions=LayoutOptions.Center, command=fixf(fun () -> dispatch Reset), canExecute = (model <> initModel))
|
||||
]))
|
||||
|
||||
let program = Program.mkProgram App.init App.update App.view
|
||||
|
||||
type App () as app =
|
||||
inherit Application ()
|
||||
|
||||
let program = Program.mkProgram App.init App.update App.view
|
||||
let runner =
|
||||
program
|
||||
#if DEBUG
|
||||
|
|
Загрузка…
Ссылка в новой задаче