git.iko.soy/rowtype-yoga/psfp
on 4e7334b help sign in
rowtype-yoga/psfp/server/src/PscIdeClient.purs
203 lines 7.0 kB history raw
1module PscIdeClient where
3import Prelude
5import Control.Monad.Rec.Class (untilJust)
6import Data.Array (foldMap)
7import Data.Array as Array
8import Data.Array.NonEmpty as NEA
9import Data.Either (Either(..))
10import Data.Foldable (for_, intercalate)
11import Data.Int (fromString)
12import Data.Map (Map)
13import Data.Maybe (Maybe(..), fromMaybe)
14import Data.Newtype (class Newtype, un, unwrap)
15import Data.Posix.Signal (Signal(..))
16import Data.Semigroup.Foldable (intercalateMap)
17import Data.String as Str
18import Data.String.Utils (lines)
19import Data.Time.Duration (Milliseconds(..), Seconds(..), fromDuration)
20import Data.Traversable (for)
21import Data.UUID as UUID
22import Debug.Trace (spy)
23import Effect (Effect)
24import Effect.Aff (Aff, Canceler(..), Fiber, delay, effectCanceler, launchAff, launchAff_, makeAff, nonCanceler)
25import Effect.Aff.Class (liftAff)
26import Effect.Class (class MonadEffect, liftEffect)
27import Effect.Class.Console (info, log, logShow)
28import Effect.Class.Console as Console
29import Effect.Exception (Error, throw)
30import Effect.Ref (Ref)
31import Effect.Ref as Ref
32import Foreign (renderForeignError, unsafeToForeign)
33import JobQueue (EnqueueResult(..), JobId(..), NewJob(..), Queue, ResourcePool(..))
34import JobQueue as Q
35import Middleware.JsonBodyParser (jsonBodyParser)
36import Node.Buffer as Buf
37import Node.ChildProcess (ChildProcess, defaultExecOptions)
38import Node.ChildProcess as CP
39import Node.Encoding (Encoding(..))
40import Node.Express.Handler (HandlerM(..), Handler)
41import Node.Express.Middleware.Static (static)
42import Node.Express.Request (getBody')
43import Node.FS.Aff (readTextFile, writeTextFile)
44import Node.HTTP (Server)
45import Node.Net.Socket (Socket)
46import Node.Net.Socket as Socket
47import Node.OS (numCpus)
48import Node.Process (lookupEnv)
49import Playground.Playground (Folder(..))
50import Shared.Models.Body (CompileResult)
51import Simple.JSON (readJSON, writeJSON)
53type BuildCommand
54 = { command ∷ String
55 , params ∷
56 { file ∷ String
57 }
58 }
60buildCommand ∷ BuildCommand
61buildCommand =
62 { "command": "rebuild"
63 , "params": { "file": "/Users/mark/code/psfp/playground/src/Main.purs" }
64 }
66closeSocketCanceller :: Socket -> Canceler
67closeSocketCanceller s =
68 effectCanceler $
69 unlessM
70 (Socket.destroyed s) do
71 -- Socket.end s (pure unit)
72 log $ "Destroying socket..."
73 Socket.destroy s Nothing
75createConnectionTCP ∷ Int -> Aff Socket
76createConnectionTCP port =
77 makeAff \callback -> do
78 socket <- Socket.createConnectionTCP port "localhost" mempty
79 Socket.onReady socket (callback (Right socket))
80 pure $ closeSocketCanceller socket
82splitter :: Ref String -> String -> Effect (Array String)
83splitter chunkRef str = case NEA.fromArray splitAtNewlines of
84 Nothing -> pure []
85 Just newChunks -> do
86 chunk <- Ref.read chunkRef
87 let
88 { init, last } = NEA.unsnoc newChunks
89 newTail = Array.drop 1 init
90 oldChunkAndNewFirst = NEA.head newChunks <> chunk
91 Ref.write last chunkRef
92 pure (Array.cons oldChunkAndNewFirst newTail)
93 where
94 splitAtNewlines = Str.split (Str.Pattern "\n") str
96writeString :: String -> Socket -> Aff Unit
97writeString str socket =
98 makeAff \callback -> do
99 void $ Socket.writeString socket str UTF8 (callback (Right unit))
100 pure $ closeSocketCanceller socket
102onError :: (Error -> Effect Unit) -> Socket -> Effect Unit
103onError = flip Socket.onError
105onData ∷ Socket -> (String -> Effect Unit) -> Effect Unit
106onData socket callback = do
107 chunkRef <- Ref.new ""
108 Socket.onData socket case _ of
109 Left buffer -> do
110 response <- Buf.toString UTF8 buffer
111 results <- splitter chunkRef response
112 for_ results callback
113 Right response -> do
114 results <- splitter chunkRef response
115 for_ results callback
117startIdeServer :: Folder -> Int -> Aff ChildProcess
118startIdeServer folder port =
119 spawnProcess folder ("npx purs ide server -p " <> show port)
121restartIdeServer :: _ -> _ -> _ -> Aff Unit
122restartIdeServer folder port processRef = do
123 cp <- Ref.read processRef # liftEffect
124 CP.kill SIGKILL cp # liftEffect
125 newCp <- startIdeServer folder port
126 Ref.write newCp processRef # liftEffect
128spawnProcess :: Folder -> String -> Aff ChildProcess
129spawnProcess folder command =
130 makeAff \callback -> do
131 let
132 options = CP.defaultExecOptions { cwd = Just (un Folder folder) }
133 childProcess <- CP.exec command options mempty
134 callback (Right childProcess)
135 pure $ effectCanceler ((log $ "Killing " <> show (CP.pid childProcess)) *> CP.kill SIGKILL childProcess)
137newtype PscIdeConnection = PscIdeConnection
138 { serverProcess :: ChildProcess
139 , socket :: Socket
140 , port :: Int
141 , folder :: Folder
142 , answersRef :: Ref (Array CompileResult)
143 }
145derive instance ntPscIdeConnection :: Newtype PscIdeConnection _
146instance eqPscIdeConnection :: Eq PscIdeConnection where
147 eq c1 c2 = (unwrap c1).port == (unwrap c2).port
149compileCode :: String -> PscIdeConnection -> Aff CompileResult
150compileCode code conn@(PscIdeConnection { serverProcess, socket, port, folder, answersRef }) = do
151 saveMainFile folder code
152 writeString (writeJSON buildCommand <> "\n") socket
153 untilJust do
154 delay (50.0 # Milliseconds)
155 popOldestAnswer conn # liftEffect
157saveMainFile ∷ Folder -> String -> Aff Unit
158saveMainFile folder code = writeTextFile UTF8 (un Folder folder <> "/src/Main.purs") code
160popOldestAnswer :: PscIdeConnection -> Effect (Maybe CompileResult)
161popOldestAnswer (PscIdeConnection { answersRef }) = do
162 result <- Ref.read answersRef <#> Array.head
163 Ref.modify_ (Array.drop 1) answersRef
164 pure result
166getFolder :: PscIdeConnection -> Folder
167getFolder (PscIdeConnection { folder }) = folder
169mkConnection :: Folder -> Int -> Aff PscIdeConnection
170mkConnection folder port = do
171 serverProcess <- startIdeServer folder port
172 delay (2.0 # Seconds # fromDuration)
173 socket <- createConnectionTCP port
174 answersRef <- Ref.new [] # liftEffect
175 onData socket (parseAndAppend answersRef) # liftEffect
176 pure $ PscIdeConnection
177 { serverProcess, socket, port, folder, answersRef }
178 -- onClose ???
180 where
181 parseAndAppend :: _ -> String -> Effect Unit
182 parseAndAppend answersRef string =
183 case readJSON (spy "shit" string) of
184 Left errs -> log $ intercalate "\n" (errs <#> renderForeignError)
185 Right more -> Ref.modify_ (_ <> [more]) answersRef
189-- testRun ∷ Effect Unit
190-- testRun = do
191-- socket <- Socket.createConnectionTCP 14189 "localhost" mempty
192-- Socket.onReady socket do
193-- log "Ready"
194-- log $ "Sending " <> writeJSON buildCommand
195-- void $ Socket.writeString socket (writeJSON buildCommand <> "\n") UTF8 mempty
196-- Socket.onData socket (onData socket)
197-- where
198-- onData socket = case _ of
199-- Left buffer -> do
200-- bufferString <- Buffer.toString UTF8 buffer
201-- logShow { _message: "Converted to a `String`", bufferString }
202-- Right string -> do
203-- logShow { _message: "Received some data", string }