Skip to content

Commit 4cad828

Browse files
OceanOakOceanOak
committed
wip: Extract sync service into separate binary
1 parent d7e6a21 commit 4cad828

File tree

15 files changed

+443
-360
lines changed

15 files changed

+443
-360
lines changed

‎backend/fsdark.sln‎

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -69,6 +69,8 @@ EndProject
6969
# CLI stuff
7070
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Cli", "src\Cli\Cli.fsproj", "{DF812CBE-894C-4C90-9EDC-4558983CCDEA}"
7171
EndProject
72+
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "SyncService", "src\SyncService\SyncService.fsproj", "{4566C879-38A7-42F5-8440-AC5DEBEFD723}"
73+
EndProject
7274
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "BuiltinCli", "src\BuiltinCli\BuiltinCli.fsproj", "{A44BDF6D-0D93-4AA4-9DFA-F48365A31B26}"
7375
EndProject
7476
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "BuiltinCliHost", "src\BuiltinCliHost\BuiltinCliHost.fsproj", "{B199C1DE-48A2-47B4-9672-BCCB7E4F8C78}"
@@ -195,6 +197,10 @@ Global
195197
{B199C1DE-48A2-47B4-9672-BCCB7E4F8C78}.Debug|Any CPU.Build.0 = Debug|Any CPU
196198
{B199C1DE-48A2-47B4-9672-BCCB7E4F8C78}.Release|Any CPU.ActiveCfg = Release|Any CPU
197199
{B199C1DE-48A2-47B4-9672-BCCB7E4F8C78}.Release|Any CPU.Build.0 = Release|Any CPU
200+
{4566C879-38A7-42F5-8440-AC5DEBEFD723}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
201+
{4566C879-38A7-42F5-8440-AC5DEBEFD723}.Debug|Any CPU.Build.0 = Debug|Any CPU
202+
{4566C879-38A7-42F5-8440-AC5DEBEFD723}.Release|Any CPU.ActiveCfg = Release|Any CPU
203+
{4566C879-38A7-42F5-8440-AC5DEBEFD723}.Release|Any CPU.Build.0 = Release|Any CPU
198204
{625B113A-D5DC-40A5-B833-4BA342AB4936}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
199205
{625B113A-D5DC-40A5-B833-4BA342AB4936}.Debug|Any CPU.Build.0 = Debug|Any CPU
200206
{625B113A-D5DC-40A5-B833-4BA342AB4936}.Release|Any CPU.ActiveCfg = Release|Any CPU
@@ -229,6 +235,7 @@ Global
229235
{5830D9BF-CA28-47B0-964F-343FAB28751B} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470}
230236
{4D8F42D9-28BA-4D96-A340-52B38E8F47DD} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470}
231237
{DF812CBE-894C-4C90-9EDC-4558983CCDEA} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470}
238+
{4566C879-38A7-42F5-8440-AC5DEBEFD723} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470}
232239
{FC9D3B85-2CD6-4A5C-B853-BCE770F76FC6} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470}
233240
{A44BDF6D-0D93-4AA4-9DFA-F48365A31B26} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470}
234241
{B6933551-A7A3-4A85-BEF4-43214ABB04DF} = {F84DCF8A-FC1A-4677-AF4D-616AD7DB3470}

‎backend/src/BuiltinCli/Libs/Process.fs‎

Lines changed: 45 additions & 41 deletions
Original file line numberDiff line numberDiff line change
@@ -15,13 +15,17 @@ let fns : List<BuiltInFn> =
1515
[ { name = fn "processSpawnBackground" 0
1616
typeParams = []
1717
parameters =
18-
[ Param.make "args" (TList TString) "Arguments to pass to the CLI" ]
18+
[ Param.make
19+
"exeName"
20+
TString
21+
"Name of executable (in same directory as current exe)"
22+
Param.make "args" (TList TString) "Arguments to pass to the executable" ]
1923
returnType = TypeReference.result TInt64 TString
2024
description =
21-
"Spawns the current CLI executable in the background with the given arguments. Returns the process ID (PID) on success."
25+
"Spawns a sibling executable in the background with the given arguments. Returns the process ID (PID) on success."
2226
fn =
2327
(function
24-
| _state, _, _, [ DList(_vtTODO, args) ] ->
28+
| _state, _, _, [ DString exeName; DList(_vtTODO, args) ] ->
2529
uply {
2630
try
2731
let argStrings =
@@ -31,33 +35,51 @@ let fns : List<BuiltInFn> =
3135
| DString s -> s
3236
| _ -> Exception.raiseInternal "Expected string arguments" [])
3337

34-
// Get the current executable path
38+
// Get executable path
3539
let currentExe =
3640
System.Diagnostics.Process.GetCurrentProcess().MainModule.FileName
37-
38-
let psi = System.Diagnostics.ProcessStartInfo()
39-
psi.FileName <- currentExe
40-
psi.UseShellExecute <- false
41-
psi.CreateNoWindow <- true
42-
// Redirect to prevent inheriting parent's streams
43-
psi.RedirectStandardOutput <- true
44-
psi.RedirectStandardError <- true
45-
psi.RedirectStandardInput <- true
46-
47-
// Add arguments
48-
for arg in argStrings do
49-
psi.ArgumentList.Add(arg)
50-
51-
let proc = System.Diagnostics.Process.Start(psi)
52-
53-
if isNull proc then
41+
let exeDir = System.IO.Path.GetDirectoryName(currentExe)
42+
let targetExe =
43+
if
44+
System.Runtime.InteropServices.RuntimeInformation.IsOSPlatform(
45+
System.Runtime.InteropServices.OSPlatform.Windows
46+
)
47+
then
48+
System.IO.Path.Combine(exeDir, exeName + ".exe")
49+
else
50+
System.IO.Path.Combine(exeDir, exeName)
51+
52+
if not (System.IO.File.Exists(targetExe)) then
5453
return
5554
Dval.resultError
5655
KTInt64
5756
KTString
58-
(DString "Failed to start background process")
57+
(DString $"Executable not found at: {targetExe}")
5958
else
60-
return Dval.resultOk KTInt64 KTString (DInt64(int64 proc.Id))
59+
let psi =
60+
System.Diagnostics.ProcessStartInfo(
61+
FileName = targetExe,
62+
UseShellExecute = false,
63+
CreateNoWindow = true,
64+
RedirectStandardOutput = true,
65+
RedirectStandardError = true,
66+
RedirectStandardInput = true
67+
)
68+
69+
// Add arguments
70+
for arg in argStrings do
71+
psi.ArgumentList.Add(arg)
72+
73+
let proc = System.Diagnostics.Process.Start(psi)
74+
75+
if isNull proc then
76+
return
77+
Dval.resultError
78+
KTInt64
79+
KTString
80+
(DString "Failed to start background process")
81+
else
82+
return Dval.resultOk KTInt64 KTString (DInt64(int64 proc.Id))
6183
with ex ->
6284
return
6385
Dval.resultError
@@ -71,24 +93,6 @@ let fns : List<BuiltInFn> =
7193
deprecated = NotDeprecated }
7294

7395

74-
{ name = fn "processGetPid" 0
75-
typeParams = []
76-
parameters = [ Param.make "unit" TUnit "" ]
77-
returnType = TInt64
78-
description = "Returns the current process ID (PID)."
79-
fn =
80-
(function
81-
| _, _, _, [ DUnit ] ->
82-
uply {
83-
let pid = System.Diagnostics.Process.GetCurrentProcess().Id
84-
return DInt64(int64 pid)
85-
}
86-
| _ -> incorrectArgs ())
87-
sqlSpec = NotYetImplemented
88-
previewable = Impure
89-
deprecated = NotDeprecated }
90-
91-
9296
{ name = fn "processIsRunning" 0
9397
typeParams = []
9498
parameters = [ Param.make "pid" TInt64 "Process ID to check" ]

‎backend/src/LibExecution/PackageIDs.fs‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -478,6 +478,10 @@ module Fn =
478478
let executeCliCommand =
479479
p [ "Cli" ] "executeCliCommand" "9b4aa7ca-82f4-4fc5-be9c-bdfb97ad4ac2"
480480

481+
module SyncServiceCli =
482+
let execute =
483+
p [ "Cli"; "SyncServiceCli" ] "execute" "c156daf1-b71b-4cde-bb04-2783f2a4abf4"
484+
481485
module Internal =
482486
let private p addl = p ("Internal" :: addl)
483487
module Test =

‎backend/src/SyncService/SyncService.fs‎

Lines changed: 99 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,99 @@
1+
module SyncService.Main
2+
3+
open System
4+
open System.Threading.Tasks
5+
open FSharp.Control.Tasks
6+
7+
open Prelude
8+
9+
module RT = LibExecution.RuntimeTypes
10+
module Dval = LibExecution.Dval
11+
module Exe = LibExecution.Execution
12+
module PackageIDs = LibExecution.PackageIDs
13+
module BuiltinCli = BuiltinCli.Builtin
14+
module BuiltinCliHost = BuiltinCliHost.Libs.Cli
15+
16+
let builtins : RT.Builtins =
17+
LibExecution.Builtin.combine
18+
[ BuiltinCliHost.builtinsToUse
19+
BuiltinCliHost.Builtin.builtins
20+
BuiltinCli.builtins ]
21+
[]
22+
23+
let state (packageManager : RT.PackageManager) =
24+
let program : RT.Program =
25+
{ canvasID = System.Guid.NewGuid()
26+
internalFnsAllowed = false
27+
dbs = Map.empty
28+
secrets = [] }
29+
30+
let notify
31+
(_state : RT.ExecutionState)
32+
(_vm : RT.VMState)
33+
(_msg : string)
34+
(_metadata : Metadata)
35+
=
36+
uply { return () }
37+
38+
let sendException
39+
(_ : RT.ExecutionState)
40+
(_ : RT.VMState)
41+
(metadata : Metadata)
42+
(exn : exn)
43+
=
44+
uply { printException "Internal error" metadata exn }
45+
46+
Exe.createState builtins packageManager Exe.noTracing sendException notify program
47+
48+
49+
let execute
50+
(packageManager : RT.PackageManager)
51+
(args : List<string>)
52+
: Task<RT.ExecutionResult> =
53+
task {
54+
let state = state packageManager
55+
let fnName = RT.FQFnName.fqPackage PackageIDs.Fn.SyncServiceCli.execute
56+
let args =
57+
args |> List.map RT.DString |> Dval.list RT.KTString |> NEList.singleton
58+
let! result = Exe.executeFunction state fnName [] args
59+
return result
60+
}
61+
62+
63+
[<EntryPoint>]
64+
let main (args : string[]) =
65+
try
66+
Cli.EmbeddedResources.extract ()
67+
68+
let packageManager = LibPackageManager.PackageManager.rt
69+
packageManager.init.Result
70+
71+
let result = execute packageManager (Array.toList args)
72+
let result = result.Result
73+
74+
NonBlockingConsole.wait ()
75+
76+
match result with
77+
| Error(rte, callStack) ->
78+
let state = state packageManager
79+
let errorCallStackStr =
80+
(LibExecution.Execution.callStackString state callStack).Result
81+
82+
match (LibExecution.Execution.runtimeErrorToString None state rte).Result with
83+
| Ok(RT.DString s) ->
84+
System.Console.Error.WriteLine $"Runtime Error:\n{s}\n\n{errorCallStackStr}"
85+
| Ok _otherVal ->
86+
System.Console.Error.WriteLine $"Runtime Error: {rte}\n{errorCallStackStr}"
87+
| Error _newErr ->
88+
System.Console.Error.WriteLine $"Runtime Error: {rte}\n{errorCallStackStr}"
89+
1
90+
91+
| Ok(RT.DInt64 i) -> (int i)
92+
| Ok dval ->
93+
let output = DvalReprDeveloper.toRepr dval
94+
System.Console.Error.WriteLine $"Error: expected int return (got {output})"
95+
1
96+
97+
with e ->
98+
System.Console.Error.WriteLine $"Error: {e.Message}\n{e.StackTrace}"
99+
1

‎backend/src/SyncService/SyncService.fsproj‎

Lines changed: 55 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,55 @@
1+
<?xml version="1.0" encoding="utf-8"?>
2+
<Project Sdk="Microsoft.NET.Sdk">
3+
<PropertyGroup>
4+
<OutputType>Exe</OutputType>
5+
<TargetFramework>net8.0</TargetFramework>
6+
<LangVersion>8.0</LangVersion>
7+
<IsTrimmable>true</IsTrimmable>
8+
<!-- Binary name -->
9+
<AssemblyName>dark-sync-service</AssemblyName>
10+
<!-- Output to same directory as Cli so they can find each other -->
11+
<BaseOutputPath>/home/dark/app/backend/Build/out/Cli</BaseOutputPath>
12+
<!-- Publishing configuration -->
13+
<IncludeNativeLibrariesForSelfExtract>true</IncludeNativeLibrariesForSelfExtract>
14+
<!-- Assembly linking - trim framework assemblies too -->
15+
<TrimMode>link</TrimMode>
16+
<!-- More aggressive linking settings -->
17+
<SuppressTrimAnalysisWarnings>true</SuppressTrimAnalysisWarnings>
18+
<EnableTrimAnalyzer>true</EnableTrimAnalyzer>
19+
<TrimmerRemoveSymbols>true</TrimmerRemoveSymbols>
20+
<!-- Additional aggressive settings -->
21+
<InvariantGlobalization>true</InvariantGlobalization>
22+
<IlcOptimizationPreference>Size</IlcOptimizationPreference>
23+
</PropertyGroup>
24+
<ItemGroup>
25+
<None Include="paket.references" />
26+
</ItemGroup>
27+
<ItemGroup>
28+
<ProjectReference Include="../LibExecution/LibExecution.fsproj" />
29+
<ProjectReference Include="../DvalReprDeveloper/DvalReprDeveloper.fsproj" />
30+
<ProjectReference Include="../LibPackageManager/LibPackageManager.fsproj" />
31+
<ProjectReference Include="../BuiltinCliHost/BuiltinCliHost.fsproj" />
32+
</ItemGroup>
33+
<ItemGroup>
34+
<Compile Include="../Cli/EmbeddedResources.fs">
35+
<Link>EmbeddedResources.fs</Link>
36+
</Compile>
37+
<Compile Include="SyncService.fs" />
38+
</ItemGroup>
39+
<ItemGroup Condition="'$(Configuration)' == 'Release'">
40+
<!-- Only embed resources in Release mode -->
41+
<EmbeddedResource Include="../../../rundir/data.db">
42+
<LogicalName>data.db</LogicalName>
43+
</EmbeddedResource>
44+
<EmbeddedResource Include="../Cli/README-to-embed.md">
45+
<LogicalName>README.md</LogicalName>
46+
</EmbeddedResource>
47+
</ItemGroup>
48+
49+
<!-- Fail the build if the database doesn't exist in Release mode -->
50+
<Target Name="CheckDatabaseExists" BeforeTargets="PrepareForBuild">
51+
<Error Condition="'$(Configuration)' == 'Release' And !Exists('../../../rundir/data.db')"
52+
Text="Database file (rundir/data.db) not found. The database must be created before building in Release mode." />
53+
</Target>
54+
<Import Project="..\..\.paket\Paket.Restore.targets" />
55+
</Project>

‎backend/src/SyncService/paket.references‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,2 @@
1+
FSharp.Core
2+
Ply

‎packages/darklang/cli/config.dark‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -65,7 +65,7 @@ let execute (state: Cli.AppState) (args: List<String>) : Cli.AppState =
6565
Stdlib.printLine "Common configuration keys:"
6666
Stdlib.printLine ""
6767
Stdlib.printLine " sync.default_instance - Default instance for sync service"
68-
Stdlib.printLine " sync.interval_seconds - Sync check interval (default: 30)"
68+
Stdlib.printLine " sync.interval_seconds - Sync check interval (default: 20)"
6969
Stdlib.printLine " sync.auto_start - Auto-start sync service (default: true)"
7070
Stdlib.printLine ""
7171
Stdlib.printLine "Use 'config get <key>' to read a value"
@@ -110,7 +110,7 @@ let help (_state: Cli.AppState) : Cli.AppState =
110110
""
111111
"Common keys:"
112112
" sync.default_instance - Which instance to sync with"
113-
" sync.interval_seconds - How often to check for changes (default: 30)"
113+
" sync.interval_seconds - How often to check for changes (default: 20)"
114114
" sync.auto_start - Start sync service automatically (default: true)" ]
115115
|> Stdlib.printLines
116116

‎packages/darklang/cli/core.dark‎

Lines changed: 16 additions & 36 deletions
Original file line numberDiff line numberDiff line change
@@ -74,7 +74,7 @@ module Registry =
7474
("help", "Show help for commands", ["commands"; "?"], Help.execute, Help.help, Help.complete)
7575
("branch", "Manage development branches", [], Packages.Branch.execute, Packages.Branch.help, Packages.Branch.complete)
7676
("instance", "Manage remote instances for syncing", [], Instances.execute, Instances.help, Instances.complete)
77-
("sync", "Sync with remote instance", [], Sync.execute, Sync.help, Sync.complete)
77+
("sync", "Info about the background sync service", [], Sync.execute, Sync.help, Sync.complete)
7878
("config", "Manage CLI configuration", [], Config.execute, Config.help, Config.complete)
7979
("install", "Install CLI globally", [], Installation.Install.execute, Installation.Install.help, Installation.Install.complete)
8080
("update", "Update CLI to latest version", ["upgrade"], Installation.Update.execute, Installation.Update.help, Installation.Update.complete)
@@ -462,40 +462,20 @@ let runInteractiveLoop (state: AppState) : Int64 =
462462
runInteractiveLoop newState
463463

464464

465-
/// Internal commands
466-
/// These are not visible to users and are only invoked programmatically
467-
module InternalCommands =
468-
let tryExecute (args: List<String>) : Stdlib.Option.Option<Int64> =
469-
match args with
470-
| ["sync-service-loop"] ->
471-
SyncServiceCommands.SyncServiceLoop.execute (initState ()) []
472-
Stdlib.Option.Option.Some 0L
473-
474-
| ["sync-service-loop"; intervalSecondsStr] ->
475-
SyncServiceCommands.SyncServiceLoop.execute (initState ()) [intervalSecondsStr]
476-
Stdlib.Option.Option.Some 0L
477-
478-
| _ -> Stdlib.Option.Option.None
479-
480-
481465
let executeCliCommand (args: List<String>) : Int64 =
482-
// First, check for internal commands
483-
match InternalCommands.tryExecute args with
484-
| Some exitCode -> exitCode
485-
| None ->
486-
let initialState = initState ()
487-
488-
match args with
489-
// If someone runs `dark` without args, start the interactive loop
490-
| [] ->
491-
// Auto-start sync service if not already running
492-
SyncService.autoStart ()
493-
494-
Stdlib.printLine (View.formatWelcome ())
495-
runInteractiveLoop initialState
496-
// Otherwise, just execute command, print result, and exit
497-
| _ ->
498-
let command = args |> Stdlib.String.join " "
499-
let finalState = Update.processInput initialState command
500-
0L
466+
let initialState = initState ()
467+
468+
match args with
469+
// If someone runs `dark` without args, start the interactive loop
470+
| [] ->
471+
// Auto-start sync service if not already running
472+
SyncService.autoStart ()
473+
474+
Stdlib.printLine (View.formatWelcome ())
475+
runInteractiveLoop initialState
476+
// Otherwise, just execute command, print result, and exit
477+
| _ ->
478+
let command = args |> Stdlib.String.join " "
479+
let finalState = Update.processInput initialState command
480+
0L
501481

0 commit comments

Comments
 (0)