@@ -15,6 +15,7 @@ module Obelisk.Backend
15 , runSnapWithCommandLineArgs
15 , runSnapWithCommandLineArgs
16 , serveDefaultObeliskApp
16 , serveDefaultObeliskApp
17 , prettifyOutput
17 , prettifyOutput
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
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