Skip to content

Commit 849dad9

Browse files
supermariosupermario
authored
Merge pull request #46 from lamdera/pit-localdev
Add support for LocalDev.elm modules
2 parents c2799a7 + 160a00d commit 849dad9

File tree

14 files changed

+138
-102
lines changed

14 files changed

+138
-102
lines changed

‎builder/src/Elm/Outline.hs

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -202,7 +202,7 @@ read root shouldCheckLamdera =
202202
then Left Exit.OutlineNoPkgCore
203203
else Right outline
204204

205-
App (AppOutline _ srcDirs direct indirect _ _)
205+
App (AppOutline version srcDirs@(NE.List srcHead srcTail) direct indirect testDirect testIndirect)
206206
| Map.notMember Pkg.core direct ->
207207
return $ Left Exit.OutlineNoAppCore
208208

@@ -219,8 +219,9 @@ read root shouldCheckLamdera =
219219
do maybeDups <- detectDuplicates root (NE.toList srcDirs)
220220
case maybeDups of
221221
Nothing ->
222+
let newSrcDirs = NE.List srcHead (AbsoluteSrcDir (Lamdera.lamderaCache root) : srcTail) in
222223
Lamdera.alternativeImplementationPassthrough (Lamdera.Checks.runChecks root shouldCheckLamdera direct) $
223-
return $ Right outline
224+
return $ Right (App (AppOutline version newSrcDirs direct indirect testDirect testIndirect))
224225

225226
Just (canonicalDir, (dir1,dir2)) ->
226227
return $ Left (Exit.OutlineHasDuplicateSrcDirs canonicalDir dir1 dir2)

‎extra/Lamdera/CLI/Live.hs

Lines changed: 58 additions & 64 deletions
Original file line numberDiff line numberDiff line change
@@ -11,31 +11,27 @@ import qualified Data.ByteString as BS
1111
import qualified Data.ByteString.Lazy as BSL
1212
import qualified Data.Text as T
1313
import qualified Data.Text.Lazy as TL
14-
import qualified Data.Text.IO as T
15-
import qualified Data.Text.Encoding as T
16-
import qualified Data.Text.Lazy.Encoding as TL
17-
import qualified Data.Text.Lazy.Builder as TLB
14+
import qualified Data.Text.Encoding as TE
15+
import qualified Data.Text.Lazy.Encoding as TLE
1816
import qualified Data.Map as Map
1917
import qualified Data.HashMap.Strict as HashMap
2018
import qualified Data.List as List
19+
import Data.Maybe (fromMaybe)
2120
import GHC.Word (Word64)
2221

2322
import qualified System.Directory as Dir
24-
import System.FilePath as FP
23+
import System.FilePath ((</>), takeExtension)
2524
import Control.Applicative ((<|>))
2625
import Control.Arrow ((***))
27-
import Control.Concurrent.STM (atomically, newTVarIO, readTVar, writeTVar, TVar)
28-
import Control.Exception (finally, throw)
29-
import Language.Haskell.TH (runIO)
26+
import Control.Concurrent.STM (atomically, newTVarIO, readTVar, readTVarIO, writeTVar, TVar)
27+
import Control.Exception (finally)
28+
import qualified Language.Haskell.TH as TH
3029
import Data.FileEmbed (bsToExp)
3130
import qualified Data.Aeson.Encoding as A
3231

3332
import Snap.Core hiding (path, headers)
34-
import qualified Data.CaseInsensitive as CI (original, mk)
35-
import qualified Data.Bifunctor (first)
33+
import qualified Data.CaseInsensitive as CI
3634

37-
import qualified Develop.Generate.Help as Generate
38-
import qualified Develop.StaticFiles as StaticFiles
3935
import qualified Json.Decode as D
4036
import qualified Json.Encode as E
4137
import qualified Json.String
@@ -45,19 +41,15 @@ import Lamdera
4541
import qualified Data.UUID as UUID
4642
import qualified Data.UUID.V4 as UUID
4743
import BroadcastChan
48-
import Control.Timeout
49-
import Data.Time.Clock (getCurrentTime, diffUTCTime)
50-
import qualified Network.WebSockets as WS
44+
import Control.Timeout (timeout)
5145
import qualified Network.WebSockets.Snap as WS
5246
import SocketServer
53-
import Data.Word (Word8)
54-
import System.Process
5547

56-
import System.Entropy
48+
import System.Entropy (getEntropy)
5749
import Snap.Util.FileServe (
58-
getSafePath, serveDirectoryWith, defaultDirectoryConfig, defaultMimeTypes, mimeTypes, MimeMap, DirectoryConfig
50+
getSafePath, serveDirectoryWith, defaultDirectoryConfig, defaultMimeTypes, mimeTypes, DirectoryConfig
5951
)
60-
import Control.Monad (guard, void)
52+
import Control.Monad (guard)
6153

6254
import qualified Lamdera.CLI.Check
6355
import qualified Lamdera.Relative
@@ -91,7 +83,7 @@ withEnd (mClients, mLeader, mChan, beState) io = do
9183
let
9284
end = do
9385
debug "[backendSt] 🧠"
94-
text <- atomically $ readTVar beState
86+
text <- readTVarIO beState
9587
bePath <- lamderaBackendDevSnapshotPath
9688
writeUtf8 bePath text
9789

@@ -133,10 +125,7 @@ serveUnmatchedUrlsToIndex root serveElm =
133125

134126
prepareLocalDev :: FilePath -> IO FilePath
135127
prepareLocalDev root = do
136-
overrideM <- Lamdera.Relative.readFile "extra/LocalDev/LocalDev.elm"
137-
let
138-
cache = lamderaCache root
139-
harnessPath = cache </> "LocalDev.elm"
128+
overrideM <- Lamdera.Relative.readDir TE.decodeUtf8 "extra/LocalDev/runtime-src"
140129

141130
-- This needs to be moved to an on-demand action, as it has to query production and
142131
-- thus isn't appropriate to run on every single recompile
@@ -145,22 +134,23 @@ prepareLocalDev root = do
145134

146135
rpcExists <- doesFileExist $ root </> "src" </> "RPC.elm"
147136

148-
case overrideM of
149-
Just override -> do
150-
writeIfDifferent harnessPath
151-
(override
152-
& replaceVersionMarker
153-
& replaceRpcMarker rpcExists
154-
)
137+
let
138+
cache = lamderaCache root
139+
harnessPath = "LocalDev.elm"
140+
141+
patchedContent path content =
142+
if path == harnessPath
143+
then content & replaceVersionMarker & replaceRpcMarker rpcExists
144+
else content
145+
146+
processFile (path, content) =
147+
writeIfDifferent (cache </> path) $ patchedContent path content
148+
149+
files = fromMaybe lamderaLocalDevDir overrideM
155150

156-
Nothing ->
157-
writeIfDifferent harnessPath
158-
(lamderaLocalDev
159-
& replaceVersionMarker
160-
& replaceRpcMarker rpcExists
161-
)
151+
mapM_ processFile files
162152

163-
pure harnessPath
153+
pure $ cache </> harnessPath
164154

165155

166156
replaceVersionMarker :: Text -> Text
@@ -205,9 +195,13 @@ replaceRpcMarker shouldReplace localdev =
205195
\ {-}"
206196

207197

208-
lamderaLocalDev :: Text
209-
lamderaLocalDev =
210-
T.decodeUtf8 $(bsToExp =<< runIO (Lamdera.Relative.readByteString "extra/LocalDev/LocalDev.elm"))
198+
lamderaLocalDevDir :: [(FilePath, Text)]
199+
lamderaLocalDevDir =
200+
$(do
201+
bsPairs <- TH.runIO (Lamdera.Relative.readDir id "extra/LocalDev/runtime-src")
202+
let toTuple (fp, bs) = [| (fp, TE.decodeUtf8 $(bsToExp bs)) |]
203+
TH.ListE <$> mapM toTuple (fromMaybe [] bsPairs)
204+
)
211205

212206

213207
refreshClients (mClients, mLeader, mChan, beState) =
@@ -229,10 +223,10 @@ serveWebsocket root (mClients, mLeader, mChan, beState) =
229223
let cookie = Cookie "sid" newSid Nothing Nothing Nothing False False
230224
modifyResponse $ addResponseCookie cookie
231225

232-
pure $ T.decodeUtf8 $ newSid
226+
pure $ TE.decodeUtf8 $ newSid
233227

234228
Just sid_ ->
235-
pure $ T.decodeUtf8 $ cookieValue sid_
229+
pure $ TE.decodeUtf8 $ cookieValue sid_
236230

237231
case mKey of
238232
Just key -> do
@@ -252,14 +246,14 @@ serveWebsocket root (mClients, mLeader, mChan, beState) =
252246
onlyWhen leaderChanged $ do
253247
sendToLeader mClients mLeader (\leader -> do
254248
-- Tell the new leader about the backend state they need
255-
atomically $ readTVar beState
249+
readTVarIO beState
256250
)
257251
-- Tell everyone about the new leader (also causes actual leader to go active as leader)
258252
broadcastLeader mClients mLeader
259253

260254
SocketServer.broadcastImpl mClients $ "{\"t\":\"c\",\"s\":\"" <> sessionId <> "\",\"c\":\"" <> clientId <> "\"}"
261255

262-
leader <- atomically $ readTVar mLeader
256+
leader <- readTVarIO mLeader
263257
case leader of
264258
Just leaderId ->
265259
pure $ Just $ "{\"t\":\"s\",\"c\":\"" <> clientId <> "\",\"l\":\"" <> leaderId <> "\"}"
@@ -308,7 +302,7 @@ serveWebsocket root (mClients, mLeader, mChan, beState) =
308302
SocketServer.broadcastImpl mClients text
309303

310304
WS.runWebSocketsSnap $
311-
SocketServer.socketHandler mClients mLeader beState onJoined onReceive (T.decodeUtf8 key) sessionId
305+
SocketServer.socketHandler mClients mLeader beState onJoined onReceive (TE.decodeUtf8 key) sessionId
312306

313307
Nothing ->
314308
error404 "missing sec-websocket-key header"
@@ -399,9 +393,9 @@ serveExperimentalWrite root path = do
399393
Just "image/jpeg" -> Lamdera.writeBinary fullpath rbody
400394

401395
_ ->
402-
writeIfDifferent fullpath (TL.toStrict $ TL.decodeUtf8 rbody)
396+
writeIfDifferent fullpath (TL.toStrict $ TLE.decodeUtf8 rbody)
403397

404-
jsonResponse $ B.byteString $ "{ written: '" <> T.encodeUtf8 (T.pack fullpath) <> "'}"
398+
jsonResponse $ B.byteString $ "{ written: '" <> TE.encodeUtf8 (T.pack fullpath) <> "'}"
405399

406400

407401
serveExperimentalList :: FilePath -> Text -> Snap ()
@@ -543,10 +537,10 @@ serveRpc (mClients, mLeader, mChan, beState) port = do
543537
let cookie = Cookie "sid" newSid Nothing Nothing Nothing False False
544538
modifyResponse $ addResponseCookie cookie
545539

546-
pure $ T.decodeUtf8 $ newSid
540+
pure $ TE.decodeUtf8 $ newSid
547541

548542
Just sid_ ->
549-
pure $ T.decodeUtf8 $ cookieValue sid_
543+
pure $ TE.decodeUtf8 $ cookieValue sid_
550544

551545
onlyWhen (mEndpoint == Nothing) $ error500 "no endpoint present"
552546

@@ -570,10 +564,10 @@ serveRpc (mClients, mLeader, mChan, beState) port = do
570564
-- Unfortunately the JSON string encoding logic is hidden inside Data.Aeson.Encoding.Internal
571565
-- so off we go with all the silly format hops
572566
escapeJsonString :: Text -> Text
573-
escapeJsonString t = A.text t & A.encodingToLazyByteString & BSL.toStrict & T.decodeUtf8
567+
escapeJsonString t = A.text t & A.encodingToLazyByteString & BSL.toStrict & TE.decodeUtf8
574568

575569
escapedBody =
576-
rbody & TL.decodeUtf8 & TL.toStrict & escapeText
570+
rbody & TLE.decodeUtf8 & TL.toStrict & escapeText
577571

578572
escapeText :: Text -> E.Value
579573
escapeText t =
@@ -588,14 +582,14 @@ serveRpc (mClients, mLeader, mChan, beState) port = do
588582
E.object
589583
[ ("t", E.string "q")
590584
, ("s", E.text sid)
591-
, ("e", E.text $ T.decodeUtf8 endpoint)
585+
, ("e", E.text $ TE.decodeUtf8 endpoint)
592586
, ("r", E.text reqId)
593587
, ("h", E.String $ Ext.Common.textToBuilder $ encodeToText requestHeadersJson)
594588
, value
595589
]
596590
& encodeToText
597591

598-
encodeToText encoder = encoder & E.encode & B.toLazyByteString & BSL.toStrict & T.decodeUtf8
592+
encodeToText encoder = encoder & E.encode & B.toLazyByteString & BSL.toStrict & TE.decodeUtf8
599593

600594
requestPayload =
601595
case contentType of
@@ -619,14 +613,14 @@ serveRpc (mClients, mLeader, mChan, beState) port = do
619613
values =
620614
case vals of
621615
[] -> "null"
622-
val:[] -> T.concat ["\"", (T.decodeUtf8 val & escapeJsonString), "\""]
616+
val:[] -> T.concat ["\"", (TE.decodeUtf8 val & escapeJsonString), "\""]
623617
_ ->
624618
vals
625-
& fmap (\v -> T.concat ["\"", (T.decodeUtf8 v & escapeJsonString), "\""])
619+
& fmap (\v -> T.concat ["\"", (TE.decodeUtf8 v & escapeJsonString), "\""])
626620
& T.intercalate ","
627621
& (\v -> T.concat ["[", v, "]"])
628622
in
629-
T.concat ["\"", T.decodeUtf8 key, "\":", values]
623+
T.concat ["\"", TE.decodeUtf8 key, "\":", values]
630624
)
631625
& (\v -> T.concat ["{", (v & T.intercalate ","), "}"])
632626
in
@@ -648,7 +642,7 @@ serveRpc (mClients, mLeader, mChan, beState) port = do
648642
| otherwise -> loopRead
649643
Nothing -> loopRead
650644

651-
leader <- liftIO $ atomically $ readTVar mLeader
645+
leader <- liftIO $ readTVarIO mLeader
652646
case leader of
653647
Just leaderId -> do
654648
liftIO $ sendToLeader mClients mLeader (\leader_ -> pure requestPayload)
@@ -672,12 +666,12 @@ serveRpc (mClients, mLeader, mChan, beState) port = do
672666
])
673667

674668
decodeResult =
675-
D.fromByteString decoder (T.encodeUtf8 chanText)
669+
D.fromByteString decoder (TE.encodeUtf8 chanText)
676670

677671
case decodeResult of
678672
Right (statusCode, statusText, headers, (bodyType, bodyEncoded)) -> do
679673

680-
let response = TL.toStrict $ TL.decodeUtf8 $ B.toLazyByteString bodyEncoded
674+
let response = TL.toStrict $ TLE.decodeUtf8 $ B.toLazyByteString bodyEncoded
681675
debugT $ "RPC:↙️ response:" <> response
682676
debug $ show (statusCode, statusText)
683677
onlyWhen (bodyType == "i") (modifyResponse $ setContentType "application/octet-stream")
@@ -694,12 +688,12 @@ serveRpc (mClients, mLeader, mChan, beState) port = do
694688

695689
Left jsonProblem -> do
696690
debugT $ "😢 rpc response decoding failed: " <> show_ jsonProblem <> "\n" <> chanText
697-
writeBuilder $ B.byteString $ "rpc response decoding failed for " <> T.encodeUtf8 chanText
691+
writeBuilder $ B.byteString $ "rpc response decoding failed for " <> TE.encodeUtf8 chanText
698692

699693

700694
Nothing -> do
701695
debugT $ "⏰ RPC timed out for:" <> requestPayload
702-
writeBuilder $ B.byteString $ T.encodeUtf8 $ "error:timeout:" <> show_ seconds <> "s"
696+
writeBuilder $ B.byteString $ TE.encodeUtf8 $ "error:timeout:" <> show_ seconds <> "s"
703697

704698

705699
Nothing -> do
@@ -721,7 +715,7 @@ _10MB =
721715
logger :: BS.ByteString -> IO ()
722716
logger =
723717
(\bs ->
724-
atomicPutStrLn $ T.unpack $ T.decodeUtf8 bs
718+
atomicPutStrLn $ T.unpack $ TE.decodeUtf8 bs
725719
)
726720

727721
jsonResponse :: B.Builder -> Snap ()

0 commit comments

Comments
 (0)