Rename examples

.ghcid

@@ -1 +1 @@
---warnings -T "Ema.Example.SimpleSite.main"
+--warnings -T "Ema.Example.Ex02_Clock.main"

README.md

@@ -18,7 +18,7 @@ main = do
 
 ## Hacking
 
-Open in VSCode, and run the build task.
+Open in VSCode, and run the build task. This runs the clock example; change `./.ghcid` to run a different example.
 
 ## TODO
 

ema.cabal

@@ -73,8 +73,9 @@ library
   other-modules:
     Ema.App
     Ema.Changing
-    Ema.Example.HelloWorld
-    Ema.Example.SimpleSite
+    Ema.Example.Ex01_HelloWorld
+    Ema.Example.Ex02_Clock
+    Ema.Example.Ex03_NeuronSite
     Ema.Layout
     Ema.Route
     Ema.Route.Slug

src/Ema/Example/Ex01_HelloWorld.hs

@@ -4,7 +4,7 @@
 --
 -- A site with one route (index) that displays content generated from pure
 -- values.
-module Ema.Example.HelloWorld where
+module Ema.Example.Ex01_HelloWorld where
 
 import Ema.App (runEmaPure)
 

src/Ema/Example/Ex02_Clock.hs

@@ -0,0 +1,79 @@
+{-# LANGUAGE TypeApplications #-}
+
+-- | 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_Clock where
+
+import Control.Concurrent (threadDelay)
+import Control.Concurrent.Async (race_)
+import Data.List ((!!))
+import Data.Time
+  ( UTCTime,
+    defaultTimeLocale,
+    formatTime,
+    getCurrentTime,
+  )
+import Ema.App (Ema (Ema), runEma)
+import qualified Ema.Changing as Changing
+import qualified Ema.Layout as Layout
+import Ema.Route (IsRoute (..))
+import Text.Blaze.Html5 ((!))
+import qualified Text.Blaze.Html5 as H
+import qualified Text.Blaze.Html5.Attributes as A
+
+data Route
+  = Index
+  | OnlyTime
+  deriving (Show)
+
+instance IsRoute Route where
+  toSlug = \case
+    Index -> mempty
+    OnlyTime -> one "time"
+  fromSlug = \case
+    [] -> Just Index
+    ["time"] -> Just OnlyTime
+    _ -> Nothing
+
+changeTime :: Changing.Changing UTCTime -> IO ()
+changeTime model = do
+  forever $ do
+    threadDelay $ 1 * 1000000
+    Changing.set model =<< getCurrentTime
+
+main :: IO ()
+main = do
+  model <- Changing.new =<< getCurrentTime
+  race_
+    (changeTime model)
+    (runEma $ Ema model render)
+  where
+    render (now :: UTCTime) r =
+      Layout.tailwindSite (H.title "Clock") $
+        H.div ! A.class_ "container mx-auto" $ do
+          H.div ! A.class_ "border-t-1 p-2 text-center" $ do
+            "The current time is: "
+            H.pre ! A.class_ "text-6xl font-bold mt-2" $ do
+              H.span ! A.class_ ("text-" <> randomColor now <> "-500") $ do
+                let fmt = case r of
+                      Index -> "%Y/%m/%d %H:%M:%S"
+                      OnlyTime -> "%H:%M:%S"
+                H.toMarkup $ formatTime defaultTimeLocale fmt now
+          H.div ! A.class_ "mt-4 text-center" $ do
+            case r of
+              Index -> do
+                routeElem OnlyTime "Hide day?"
+              OnlyTime -> do
+                routeElem Index "Show day?"
+    routeElem r w =
+      H.a ! A.class_ "text-xl text-purple-500 hover:underline" ! routeHref r $ w
+    routeHref r =
+      A.href (fromString . toString $ routeUrl r)
+    randomColor t =
+      let epochSecs = fromMaybe 0 . readMaybe @Int $ formatTime defaultTimeLocale "%s" t
+          colors = ["green", "gray", "purple", "red", "blue", "yellow", "black", "pink"]
+       in colors !! mod epochSecs (length colors)

src/Ema/Example/Ex03_NeuronSite.hs

@@ -1,7 +1,7 @@
 {-# LANGUAGE TypeApplications #-}
 
 -- | An advanced example demonstrating how to build something like neuron
-module Ema.Example.NeuronSite where
+module Ema.Example.Ex03_NeuronSite where
 
 {-
 type Zk = Map FilePath ()

src/Ema/Example/SimpleSite.hs

@@ -1,73 +0,0 @@
-{-# LANGUAGE TypeApplications #-}
-
--- | A very simple site with routes, but based on dynamically changing values
--- (current time, in this example)
-module Ema.Example.SimpleSite where
-
-import Control.Concurrent (threadDelay)
-import Control.Concurrent.Async (race_)
-import Data.List ((!!))
-import Data.Time
-  ( UTCTime,
-    defaultTimeLocale,
-    formatTime,
-    getCurrentTime,
-  )
-import Ema.App (Ema (Ema), runEma)
-import qualified Ema.Changing as Changing
-import qualified Ema.Layout as Layout
-import Ema.Route (IsRoute (..))
-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)
-
-instance IsRoute Route where
-  toSlug = \case
-    Index -> mempty
-    About -> one "about"
-  fromSlug = \case
-    [] -> Just Index
-    ["about"] -> Just About
-    _ -> Nothing
-
-timeC :: IO (Changing.Changing UTCTime, IO ())
-timeC = do
-  currentTime <- Changing.new =<< getCurrentTime
-  let run =
-        forever $ do
-          threadDelay $ 1 * 1000000
-          Changing.set currentTime =<< getCurrentTime
-  pure (currentTime, run)
-
-main :: IO ()
-main = do
-  (model, runTimeC) <- timeC
-  race_ runTimeC (runEma $ Ema model render)
-  where
-    render now r =
-      Layout.tailwindSite (H.title "Simple Site") $
-        H.div ! A.class_ "container mx-auto" $ do
-          H.header ! A.class_ "text-4xl font-bold border-b-1" $ "Simple Site"
-          case r of
-            Index -> do
-              routeElem About "About this site"
-            About -> do
-              H.p "Just a simple site showing time"
-          H.div ! A.class_ "border-t-1 p-2 text-center" $ do
-            "The current time is: "
-            H.pre ! A.class_ "text-4xl" $ do
-              H.span ! A.class_ ("text-" <> randomColor now <> "-500") $
-                H.toMarkup $ formatTime defaultTimeLocale "%Y/%m/%d %H:%M:%S" now
-    routeElem r w =
-      H.a ! A.class_ "text-xl text-purple-500 hover:underline" ! routeHref r $ w
-    routeHref r =
-      A.href (fromString . toString $ routeUrl r)
-    randomColor t =
-      let epochSecs = fromMaybe 0 . readMaybe @Int $ formatTime defaultTimeLocale "%s" t
-          colors = ["green", "purple", "red", "blue"]
-       in colors !! mod epochSecs (length colors)