git.iko.soy/rowtype-yoga/psfp
on master help sign in
rowtype-yoga/psfp/server/src/PscIdeClient.purs
167 lines 5.7 kB history raw
1module PscIdeClient where
3import Prelude
4import Data.Argonaut.Encode
5import Data.Argonaut.Core
6import Data.Either (Either(..), either)
7import Data.Maybe (Maybe(..))
8import Data.Newtype (class Newtype, un, unwrap)
9import Data.Posix.Signal (Signal(..))
10import Data.String.Utils (endsWith)
11import Effect.Aff (Aff, Canceler, effectCanceler, makeAff)
12import Effect.Class (liftEffect)
13import Effect.Class.Console (log)
14import Effect.Ref (Ref)
15import Effect.Ref as Ref
16import Node.Buffer as Buf
17import Node.ChildProcess (ChildProcess, StdIOBehaviour(..))
18import Node.ChildProcess as CP
19import Node.Encoding (Encoding(..))
20import Node.FS.Aff (writeTextFile)
21import Node.Net.Socket (Socket)
22import Node.Net.Socket as Socket
23import Playground.Playground (Folder(..))
25type BuildCommand =
26 { command ∷ String
27 , params ∷
28 { file ∷ String
29 }
30 }
32loadCommand ∷
33 { command ∷ String
34 }
35loadCommand =
36 { command: "load"
37 }
39buildCommand ∷ BuildCommand
40buildCommand =
41 { "command": "rebuild"
42 , "params": { "file": "src/Main.purs" }
43 }
45closeSocketCanceller ∷ Socket -> Canceler
46closeSocketCanceller s =
47 effectCanceler
48 $ unlessM
49 (Socket.destroyed s) do
50 log $ "Destroying socket..."
51 Socket.destroy s Nothing
53startIdeServer ∷ Folder -> Int -> Aff ChildProcess
54startIdeServer folder port = do
55 log $ "Spawning ide server " <> infoString
56 cp <- spawnProcess folder "purs" [ "ide", "server", "-p", show port, "--editor-mode", "--no-watch" ]
57 log $ "Spawned ide server " <> infoString
58 -- building once
59 { error, stderr, stdout } <- execCommand folder "spago build"
60 stderrStr <- liftEffect $ Buf.toString UTF8 stderr
61 log $ "Built: " <> infoString <> " " <> stderrStr
62 log $ "Loading modules: " <> infoString
63 loadPscIde folder port
64 pure cp
65 where
66 infoString =
67 " in folder "
68 <> un Folder folder
69 <> " on port "
70 <> show port
72execCommand ∷ Folder -> String -> Aff CP.ExecResult
73execCommand folder command =
74 makeAff \callback -> do
75 let options = CP.defaultExecOptions { cwd = Just (un Folder folder) }
76 childProcess <- CP.exec command options (callback <<< Right)
77 pure $ effectCanceler do
78 log $ "Killing " <> show (CP.pid childProcess)
79 CP.kill SIGKILL childProcess
81restartIdeServer ∷ Folder -> Int -> Ref ChildProcess -> Aff Unit
82restartIdeServer folder port processRef = do
83 cp <- Ref.read processRef # liftEffect
84 CP.kill SIGKILL cp # liftEffect
85 newCp <- startIdeServer folder port
86 Ref.write newCp processRef # liftEffect
88spawnProcess ∷ Folder -> String -> Array String -> Aff ChildProcess
89spawnProcess folder command args =
90 makeAff \callback -> do
91 let options = CP.defaultSpawnOptions { cwd = Just (un Folder folder), stdio = Just <$> [ Ignore, Ignore, Ignore ] }
92 childProcess <- CP.spawn command args options
93 callback (Right childProcess)
94 pure $ effectCanceler do
95 log $ "Killing " <> show (CP.pid childProcess)
96 CP.kill SIGKILL childProcess
98newtype PscIdeConnection = PscIdeConnection
99 { serverProcessRef ∷ Ref ChildProcess
100 , port ∷ Int
101 , folder ∷ Folder
102 }
104derive instance ntPscIdeConnection ∷ Newtype PscIdeConnection _
106instance eqPscIdeConnection ∷ Eq PscIdeConnection where
107 eq c1 c2 = (unwrap c1).port == (unwrap c2).port
109saveMainFile ∷ Folder -> String -> Aff Unit
110saveMainFile folder code = writeTextFile UTF8 (un Folder folder <> "/src/Main.purs") code
112getFolder ∷ PscIdeConnection -> Folder
113getFolder (PscIdeConnection { folder }) = folder
115loadPscIde ∷ Folder -> Int -> Aff Unit
116loadPscIde folder port = do
117 makeAff \affCb -> do
118 socket <- Socket.createConnectionTCP port "127.0.0.1" mempty
119 -- maybe timeout?
120 Socket.onError socket (affCb <<< Left)
121 void
122 $ Socket.writeString socket ((stringify <<< encodeJson) loadCommand <> "\n") UTF8 (affCb (Right unit))
123 liftEffect
124 $ Socket.onClose socket case _ of
125 true -> mempty -- should be covered in onError
126 false -> do
127 affCb (Right unit)
128 let command = (stringify <<< encodeJson) buildCommand <> "\n"
129 Socket.onReady socket (void $ Socket.writeString socket command UTF8 mempty)
130 pure (closeSocketCanceller socket)
132compileCode ∷ String -> PscIdeConnection -> Aff String
133compileCode code (PscIdeConnection { port, folder, serverProcessRef }) = do
134 serverProcess <- Ref.read serverProcessRef # liftEffect
135 saveMainFile folder code
136 makeAff \affCb -> do
137 log $ "Compiling on " <> show port
138 socket <- Socket.createConnectionTCP port "127.0.0.1" mempty
139 -- Socket.onError socket (affCb <<< Left)
140 resultRef <- Ref.new ""
141 Socket.onData socket \dataFromServer -> do
142 log $ "Data on port " <> show port
143 str <- dataFromServer # either (Buf.toString UTF8) pure
144 newStr <- resultRef # Ref.modify (_ <> str)
145 when (newStr # endsWith "\n") do
146 log $ "Enough data on " <> show port <> " ending socket\n"
147 void $ Socket.endString socket "" UTF8 mempty
148 affCb (Right newStr)
149 let command = (stringify <<< encodeJson) buildCommand
150 Socket.onReady socket do
151 log $ "Socket " <> show port <> " ready"
152 void $ Socket.writeString socket (command <> "\n") UTF8 mempty
153 pure (closeSocketCanceller socket)
155mkConnection ∷ Folder -> Int -> Aff PscIdeConnection
156mkConnection folder port = do
157 serverProcess <- startIdeServer folder port
158 serverProcessRef <- Ref.new serverProcess # liftEffect
159 liftEffect
160 $ CP.onError serverProcess \e ->
161 log $ "Server process on port " <> show port <> " got error " <> show e
162 pure
163 $ PscIdeConnection
164 { serverProcessRef
165 , port
166 , folder
167 }