mirror of
https://github.com/srid/ema.git
synced 2024-11-25 20:12:20 +03:00
Add basic example
This commit is contained in:
parent
7ce9eead08
commit
c0bc0da02a
2
.ghcid
2
.ghcid
@ -1 +1 @@
|
||||
--warnings -T Ema.Example.Ex02_Clock.main
|
||||
--warnings -T Ema.Example.Ex03_Clock.main
|
||||
|
@ -2,9 +2,10 @@
|
||||
|
||||
## Unreleased
|
||||
|
||||
- Helpers.Tailwind: add overflow-y-scroll to body
|
||||
- Remove Ex03_Documentation.hs (moved to separate repo, `ema-docs`)
|
||||
- Add `Ord` instance to `Slug`
|
||||
- Helpers.Tailwind: add overflow-y-scroll to body
|
||||
- Add Ex03_Basic.hs example
|
||||
|
||||
## 0.1.0.0 -- 2021-04-26
|
||||
|
||||
|
@ -111,7 +111,8 @@ library
|
||||
if flag(with-examples)
|
||||
exposed-modules:
|
||||
Ema.Example.Ex01_HelloWorld
|
||||
Ema.Example.Ex02_Clock
|
||||
Ema.Example.Ex02_Basic
|
||||
Ema.Example.Ex03_Clock
|
||||
|
||||
hs-source-dirs: src
|
||||
default-language: Haskell2010
|
||||
|
60
src/Ema/Example/Ex02_Basic.hs
Normal file
60
src/Ema/Example/Ex02_Basic.hs
Normal file
@ -0,0 +1,60 @@
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||
|
||||
-- | A very simple site with routes, but based on dynamically changing values
|
||||
--
|
||||
-- The current time is computed in the server every second, and the resultant
|
||||
-- generated HTML is automatically updated on the browser. This is only a demo;
|
||||
-- usually we render HTML based on files on disk or something accessible outside
|
||||
-- of the browser. More advanced examples will demonstrate that.
|
||||
module Ema.Example.Ex02_Basic where
|
||||
|
||||
import Control.Concurrent (threadDelay)
|
||||
import qualified Data.LVar as LVar
|
||||
import Ema (Ema (..), routeUrl, runEma)
|
||||
import qualified Ema.CLI
|
||||
import qualified Ema.Helper.Tailwind as Tailwind
|
||||
import Text.Blaze.Html5 ((!))
|
||||
import qualified Text.Blaze.Html5 as H
|
||||
import qualified Text.Blaze.Html5.Attributes as A
|
||||
|
||||
data Route
|
||||
= Index
|
||||
| About
|
||||
deriving (Show, Enum, Bounded)
|
||||
|
||||
instance Ema () Route where
|
||||
encodeRoute = \case
|
||||
Index -> mempty
|
||||
About -> one "about"
|
||||
decodeRoute = \case
|
||||
[] -> Just Index
|
||||
["about"] -> Just About
|
||||
_ -> Nothing
|
||||
staticRoutes _ =
|
||||
[minBound .. maxBound]
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
runEma render $ \model ->
|
||||
forever $ do
|
||||
LVar.set model ()
|
||||
liftIO $ threadDelay maxBound
|
||||
|
||||
render :: Ema.CLI.Action -> () -> Route -> LByteString
|
||||
render emaAction () r =
|
||||
Tailwind.layout emaAction (H.title "Basic site") $
|
||||
H.div ! A.class_ "container mx-auto" $ do
|
||||
H.div ! A.class_ "mt-8 p-2 text-center" $ do
|
||||
case r of
|
||||
Index -> do
|
||||
"You are on the index page. "
|
||||
routeElem About "Go to About"
|
||||
About -> do
|
||||
"You are on the about page. "
|
||||
routeElem Index "Go to Index"
|
||||
where
|
||||
routeElem r' w =
|
||||
H.a ! A.class_ "text-red-500 hover:underline" ! routeHref r' $ w
|
||||
routeHref r' =
|
||||
A.href (fromString . toString $ routeUrl r')
|
@ -7,7 +7,7 @@
|
||||
-- generated HTML is automatically updated on the browser. This is only a demo;
|
||||
-- usually we render HTML based on files on disk or something accessible outside
|
||||
-- of the browser. More advanced examples will demonstrate that.
|
||||
module Ema.Example.Ex02_Clock where
|
||||
module Ema.Example.Ex03_Clock where
|
||||
|
||||
import Control.Concurrent (threadDelay)
|
||||
import qualified Data.LVar as LVar
|
@ -76,10 +76,10 @@ runServerWithWebSocketHotReload port model render = do
|
||||
-- to switch to a new route.
|
||||
liftIO $ do
|
||||
race (LVar.listenNext model subId) (runLoggingT askClientForRoute logger) >>= \res -> flip runLoggingT logger $ case res of
|
||||
Left newHtml -> do
|
||||
Left newModel -> do
|
||||
-- The page the user is currently viewing has changed. Send
|
||||
-- the new HTML to them.
|
||||
sendRouteHtmlToClient watchingRoute newHtml
|
||||
sendRouteHtmlToClient watchingRoute newModel
|
||||
lift loop
|
||||
Right nextRoute -> do
|
||||
-- The user clicked on a route link; send them the HTML for
|
||||
|
Loading…
Reference in New Issue
Block a user