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