on master help sign in
Add Obelisk.Backend.runBackend
ab03bdeRyan Trinkle
lib/backend/src/Obelisk/Backend.hs+12
@@ -15,6 +15,7 @@ module Obelisk.Backend
15 , runSnapWithCommandLineArgs
15 , runSnapWithCommandLineArgs
16 , serveDefaultObeliskApp
16 , serveDefaultObeliskApp
17 , prettifyOutput
17 , prettifyOutput
18+ , runBackend
18 ) where
19 ) where
19
20
20import Control.Monad.Except
21import Control.Monad.Except
@@ -163,3 +164,14 @@ blankLoader headHtml = el "html" $ do
163 el "body" $ do
164 el "body" $ do
164 --TODO: Hash the all.js path
165 --TODO: Hash the all.js path
165 elAttr "script" ("language" =: "javascript" <> "src" =: "ghcjs/all.js" <> "defer" =: "defer") blank
166 elAttr "script" ("language" =: "javascript" <> "src" =: "ghcjs/all.js" <> "defer" =: "defer") blank
167+
168+runBackend :: Backend fullRoute frontendRoute -> Frontend (R frontendRoute) -> IO ()
169+runBackend backend frontend = case checkEncoder $ _backend_routeEncoder backend of
170+ Left e -> fail $ "backend error:\n" <> T.unpack e
171+ Right validFullEncoder -> _backend_run backend $ \serveRoute -> do
172+ runSnapWithCommandLineArgs $ do
173+ getRouteWith validFullEncoder >>= \case
174+ Left e -> writeText e
175+ Right r -> case r of
176+ InL backendRoute :=> Identity a -> serveRoute $ backendRoute :/ a
177+ InR obeliskRoute :=> Identity a -> serveDefaultObeliskApp frontend $ obeliskRoute :/ a
lib/run/src/Obelisk/Run.hs+1
@@ -71,6 +71,7 @@ run
71run port backend frontend = do
71run port backend frontend = do
72 prettifyOutput
72 prettifyOutput
73 let handleBackendErr (e :: IOException) = hPutStrLn stderr $ "backend stopped; make a change to your code to reload - error " <> show e
73 let handleBackendErr (e :: IOException) = hPutStrLn stderr $ "backend stopped; make a change to your code to reload - error " <> show e
74+ --TODO: Use Obelisk.Backend.runBackend; this will require separating the checking and running phases
74 case checkEncoder $ _backend_routeEncoder backend of
75 case checkEncoder $ _backend_routeEncoder backend of
75 Left e -> hPutStrLn stderr $ "backend error:\n" <> T.unpack e
76 Left e -> hPutStrLn stderr $ "backend error:\n" <> T.unpack e
76 Right validFullEncoder -> do
77 Right validFullEncoder -> do