srid/ema
1
1
Fork 0
mirror of https://github.com/srid/ema.git synced 2024-11-29 09:25:14 +03:00
Code Issues Projects Releases Wiki Activity

Allow decodeRoute to take the model

Browse Source
This commit is contained in:
Sridhar Ratnakumar 2021-04-25 15:15:18 -04:00
parent bb59a31e27
commit 55b7a34c94
5 changed files with 22 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
docs/guide/routes.md
View File

@ -17,7 +17,7 @@ class Ema MyModel Route where
Index -> [] -- An empty slug represents the index route: index.html
About -> ["about"]
-- Convert back the browser URL, represented as a list of slugs, to our route
decodeRoute = \case
decodeRoute _model = \case
[] -> Just Index
["about"] -> Just About
_ -> Nothing

17
src/Ema/Class.hs
View File

@ -8,13 +8,22 @@ import Ema.Route.Slug (Slug)
-- | Enrich a model to work with Ema
class Ema model route | route -> model where
-- How to convert URLs to/from routes
-- | Convert a route to URL slugs
encodeRoute :: route -> [Slug]
decodeRoute :: [Slug] -> Maybe route
-- | Interpret the given URL slugs into a @route@
--
-- This function accepts a @model@ because more than one slug path may map to
-- a route, and that choice could depend on the current model value (alias
-- table, for instance). In most cases, the @model@ argument will be ignore.
--
-- NOTE: This function is used only the dev server. But you may invoke it in
-- the render function in order to validate the links in the generated HTML.
decodeRoute :: model -> [Slug] -> Maybe route
-- | Routes to use when generating the static site
--
-- This is never used by the dev server.
-- NOTE: This function is used only during static site generation.
staticRoutes :: model -> [route]
-- | List of (top-level) filepaths to serve as static assets
@ -26,7 +35,7 @@ class Ema model route | route -> model where
-- | The unit model is useful when using Ema in pure fashion (see @Ema.runEmaPure@) with a single route (index.html) only.
instance Ema () () where
encodeRoute () = []
decodeRoute = \case
decodeRoute () = \case
[] -> Just ()
_ -> Nothing
staticRoutes () = one ()

2
src/Ema/Example/Ex02_Clock.hs
View File

@ -29,7 +29,7 @@ instance Ema UTCTime Route where
encodeRoute = \case
Index -> mempty
OnlyTime -> one "time"
decodeRoute = \case
decodeRoute _ = \case
[] -> Just Index
["time"] -> Just OnlyTime
_ -> Nothing

2
src/Ema/Example/Ex03_Documentation.hs
View File

@ -78,7 +78,7 @@ instance Ema Sources SourcePath where
encodeRoute = \case
Tagged ("index" :| []) -> mempty
Tagged paths -> toList . fmap (fromString . toString) $ paths
decodeRoute = \case
decodeRoute _ = \case
(nonEmpty -> Nothing) ->
pure $ Tagged $ one "index"
(nonEmpty -> Just slugs) -> do

10
src/Ema/Server.hs
View File

@ -40,10 +40,11 @@ runServerWithWebSocketHotReload port model render = do
log "ws:connected"
let askClientForRoute = do
msg :: Text <- WS.receiveData conn
v <- LVar.get model
pure $
msg
& pathInfoFromWsMsg
& routeFromPathInfo
& routeFromPathInfo v
& fromMaybe (error "invalid route from ws")
loop = do
-- Notice that we @askClientForRoute@ in succession twice here.
@ -86,7 +87,8 @@ runServerWithWebSocketHotReload port model render = do
foldl1' (Static.<|>) $ Static.hasPrefix <$> assets
in Static.staticPolicy assetPolicy
httpApp req f = do
let mr = routeFromPathInfo (Wai.pathInfo req)
v <- LVar.get model
let mr = routeFromPathInfo v (Wai.pathInfo req)
putStrLn $ "[http] " <> show mr
(status, v) <- case mr of
Nothing ->
@ -104,8 +106,8 @@ runServerWithWebSocketHotReload port model render = do
"<html><head><meta charset=\"UTF-8\"></head><body><h1>Ema App threw an exception</h1><pre style=\"border: 1px solid; padding: 1em 1em 1em 1em;\">"
<> show @Text err
<> "</pre><p>Once you fix your code this page will automatically update.</body>"
routeFromPathInfo =
decodeRoute @model . fmap (fromString . toString)
routeFromPathInfo v =
decodeRoute v . fmap (fromString . toString)
unsafeCatch :: Exception e => a -> (e -> a) -> a
unsafeCatch x f = unsafePerformIO $ catch (seq x $ pure x) (pure . f)