{-# LANGUAGE TypeApplications #-}

-- | A very simple site with two routes, and HTML rendered using Blaze DSL
module Ema.Example.Ex02_Basic where

import Control.Concurrent (threadDelay)
import qualified Data.LVar as LVar
import Ema (Ema (..))
import qualified Ema
import qualified Ema.CLI
import qualified Ema.CLI as 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 (Int -> Route -> ShowS
[Route] -> ShowS
Route -> String
(Int -> Route -> ShowS)
-> (Route -> String) -> ([Route] -> ShowS) -> Show Route
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Route] -> ShowS
$cshowList :: [Route] -> ShowS
show :: Route -> String
$cshow :: Route -> String
showsPrec :: Int -> Route -> ShowS
$cshowsPrec :: Int -> Route -> ShowS
Show, Int -> Route
Route -> Int
Route -> [Route]
Route -> Route
Route -> Route -> [Route]
Route -> Route -> Route -> [Route]
(Route -> Route)
-> (Route -> Route)
-> (Int -> Route)
-> (Route -> Int)
-> (Route -> [Route])
-> (Route -> Route -> [Route])
-> (Route -> Route -> [Route])
-> (Route -> Route -> Route -> [Route])
-> Enum Route
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Route -> Route -> Route -> [Route]
$cenumFromThenTo :: Route -> Route -> Route -> [Route]
enumFromTo :: Route -> Route -> [Route]
$cenumFromTo :: Route -> Route -> [Route]
enumFromThen :: Route -> Route -> [Route]
$cenumFromThen :: Route -> Route -> [Route]
enumFrom :: Route -> [Route]
$cenumFrom :: Route -> [Route]
fromEnum :: Route -> Int
$cfromEnum :: Route -> Int
toEnum :: Int -> Route
$ctoEnum :: Int -> Route
pred :: Route -> Route
$cpred :: Route -> Route
succ :: Route -> Route
$csucc :: Route -> Route
Enum, Route
Route -> Route -> Bounded Route
forall a. a -> a -> Bounded a
maxBound :: Route
$cmaxBound :: Route
minBound :: Route
$cminBound :: Route
Bounded)

newtype Model = Model {Model -> Text
unModel :: Text}

instance Ema Model Route where
  encodeRoute :: Model -> Route -> String
encodeRoute Model
_model =
    \case
      Route
Index -> String
"index.html"
      Route
About -> String
"about.html"
  decodeRoute :: Model -> String -> Maybe Route
decodeRoute Model
_model = \case
    String
"index.html" -> Route -> Maybe Route
forall a. a -> Maybe a
Just Route
Index
    String
"about.html" -> Route -> Maybe Route
forall a. a -> Maybe a
Just Route
About
    String
_ -> Maybe Route
forall a. Maybe a
Nothing

main :: IO ()
main :: IO ()
main = do
  (Action -> Model -> Route -> Asset LByteString)
-> (forall (m :: * -> *).
    (MonadIO m, MonadUnliftIO m, MonadLoggerIO m) =>
    Action -> LVar Model -> m ())
-> IO ()
forall model route.
(Ema model route, Show route) =>
(Action -> model -> route -> Asset LByteString)
-> (forall (m :: * -> *).
    (MonadIO m, MonadUnliftIO m, MonadLoggerIO m) =>
    Action -> LVar model -> m ())
-> IO ()
Ema.runEma (\Action
act Model
m -> Format -> LByteString -> Asset LByteString
forall a. Format -> a -> Asset a
Ema.AssetGenerated Format
Ema.Html (LByteString -> Asset LByteString)
-> (Route -> LByteString) -> Route -> Asset LByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Action -> Model -> Route -> LByteString
render Action
act Model
m) ((forall (m :: * -> *).
  (MonadIO m, MonadUnliftIO m, MonadLoggerIO m) =>
  Action -> LVar Model -> m ())
 -> IO ())
-> (forall (m :: * -> *).
    (MonadIO m, MonadUnliftIO m, MonadLoggerIO m) =>
    Action -> LVar Model -> m ())
-> IO ()
forall a b. (a -> b) -> a -> b
$ \Action
act LVar Model
model -> do
    LVar Model -> Model -> m ()
forall (m :: * -> *) a. MonadIO m => LVar a -> a -> m ()
LVar.set LVar Model
model (Model -> m ()) -> Model -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Model
Model Text
"Hello World. "
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Action
act Action -> Action -> Bool
forall a. Eq a => a -> a -> Bool
== Action
CLI.Run) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
      IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
threadDelay Int
forall a. Bounded a => a
maxBound

render :: Ema.CLI.Action -> Model -> Route -> LByteString
render :: Action -> Model -> Route -> LByteString
render Action
emaAction Model
model Route
r =
  Action -> Html -> Html -> LByteString
Tailwind.layout Action
emaAction (Html -> Html
H.title Html
"Basic site" Html -> Html -> Html
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Html
H.base Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.href AttributeValue
"/") (Html -> LByteString) -> Html -> LByteString
forall a b. (a -> b) -> a -> b
$
    Html -> Html
H.div (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"container mx-auto" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
      Html -> Html
H.div (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"mt-8 p-2 text-center" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ do
        case Route
r of
          Route
Index -> do
            Text -> Html
forall a. ToMarkup a => a -> Html
H.toHtml (Model -> Text
unModel Model
model)
            Html
"You are on the index page. "
            Route -> Html -> Html
forall r. Ema Model r => r -> Html -> Html
routeElem Route
About Html
"Go to About"
          Route
About -> do
            Html
"You are on the about page. "
            Route -> Html -> Html
forall r. Ema Model r => r -> Html -> Html
routeElem Route
Index Html
"Go to Index"
  where
    routeElem :: r -> Html -> Html
routeElem r
r' Html
w =
      Html -> Html
H.a (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"text-red-500 hover:underline" (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! r -> Attribute
forall r. Ema Model r => r -> Attribute
routeHref r
r' (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ Html
w
    routeHref :: r -> Attribute
routeHref r
r' =
      AttributeValue -> Attribute
A.href (String -> AttributeValue
forall a. IsString a => String -> a
fromString (String -> AttributeValue)
-> (Text -> String) -> Text -> AttributeValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
forall a. ToString a => a -> String
toString (Text -> AttributeValue) -> Text -> AttributeValue
forall a b. (a -> b) -> a -> b
$ Model -> r -> Text
forall r model. Ema model r => model -> r -> Text
Ema.routeUrl Model
model r
r')