git.iko.soy/rowtype-yoga/psfp
on 4321e4c help sign in
rowtype-yoga/psfp/server/src/PscIdeClient.purs
169 lines 5.6 kB history raw
1module PscIdeClient where
3import Prelude
5import Data.Either (Either(..), either)
6import Data.Maybe (Maybe(..))
7import Data.Newtype (class Newtype, un, unwrap)
8import Data.Posix.Signal (Signal(..))
9import Data.String.Utils (endsWith)
10import Effect.Aff (Aff, Canceler, effectCanceler, makeAff)
11import Effect.Class (liftEffect)
12import Effect.Class.Console (log)
13import Effect.Ref (Ref)
14import Effect.Ref as Ref
15import Node.Buffer as Buf
16import Node.ChildProcess (ChildProcess, StdIOBehaviour(..))
17import Node.ChildProcess as CP
18import Node.Encoding (Encoding(..))
19import Node.FS.Aff (writeTextFile)
20import Node.Net.Socket (Socket)
21import Node.Net.Socket as Socket
22import Playground.Playground (Folder(..))
23import Simple.JSON (writeJSON)
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 "npx" [ "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 "npx spago build"
60 stderrStr <- liftEffect $ Buf.toString UTF8 stderr
61 log $ "Built: " <> 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
76 options = CP.defaultExecOptions { cwd = Just (un Folder folder) }
77 childProcess <- CP.exec command options (callback <<< Right)
78 pure $ effectCanceler ((log $ "Killing " <> show (CP.pid childProcess)) *> CP.kill SIGKILL childProcess)
80restartIdeServer ∷ Folder -> Int -> Ref ChildProcess -> Aff Unit
81restartIdeServer folder port processRef = do
82 cp <- Ref.read processRef # liftEffect
83 CP.kill SIGKILL cp # liftEffect
84 newCp <- startIdeServer folder port
85 Ref.write newCp processRef # liftEffect
87spawnProcess ∷ Folder -> String -> Array String -> Aff ChildProcess
88spawnProcess folder command args =
89 makeAff \callback -> do
90 let
91 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
95 $ (log $ "Killing " <> show (CP.pid childProcess))
96 *> CP.kill SIGKILL childProcess
98newtype PscIdeConnection
99 = PscIdeConnection
100 { serverProcessRef ∷ Ref ChildProcess
101 , port ∷ Int
102 , folder ∷ Folder
103 }
105derive 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 "localhost" mempty
119 -- maybe timeout?
120 Socket.onError socket (affCb <<< Left)
121 void
122 $ Socket.writeString socket (writeJSON 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
129 command = writeJSON buildCommand <> "\n"
130 Socket.onReady socket (void $ Socket.writeString socket command UTF8 mempty)
131 pure (closeSocketCanceller socket)
133compileCode ∷ String -> PscIdeConnection -> Aff String
134compileCode code (PscIdeConnection { port, folder, serverProcessRef }) = do
135 serverProcess <- Ref.read serverProcessRef # liftEffect
136 saveMainFile folder code
137 makeAff \affCb -> do
138 log $ "Compiling on " <> show port
139 socket <- Socket.createConnectionTCP port "localhost" mempty
140 -- Socket.onError socket (affCb <<< Left)
141 resultRef <- Ref.new ""
142 Socket.onData socket \dataFromServer -> do
143 log $ "Data on port " <> show port
144 str <- dataFromServer # either (Buf.toString UTF8) pure
145 newStr <- resultRef # Ref.modify (_ <> str)
146 when (newStr # endsWith "\n") do
147 log $ "Enough data on " <> show port <> " ending socket\n"
148 void $ Socket.endString socket "" UTF8 mempty
149 affCb (Right newStr)
150 let
151 command = writeJSON buildCommand
152 Socket.onReady socket do
153 log $ "Socket " <> show port <> " ready"
154 void $ Socket.writeString socket (command <> "\n") UTF8 mempty
155 pure (closeSocketCanceller socket)
157mkConnection ∷ Folder -> Int -> Aff PscIdeConnection
158mkConnection folder port = do
159 serverProcess <- startIdeServer folder port
160 serverProcessRef <- Ref.new serverProcess # liftEffect
161 liftEffect
162 $ CP.onError serverProcess \e ->
163 log $ "Server process on port " <> show port <> " got error " <> show e
164 pure
165 $ PscIdeConnection
166 { serverProcessRef
167 , port
168 , folder
169 }