{-# 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 Data.Some (Some (..))
import Ema (Ema (..))
import qualified Ema
import qualified Ema.CLI
import qualified Ema.CLI as CLI
import qualified Ema.Helper.Blaze as EB
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
  IO (Either () (DSum Action Identity)) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Either () (DSum Action Identity)) -> IO ())
-> IO (Either () (DSum Action Identity)) -> IO ()
forall a b. (a -> b) -> a -> b
$
    (Some Action -> Model -> Route -> Asset LByteString)
-> (forall (m :: * -> *).
    (MonadIO m, MonadUnliftIO m, MonadLoggerIO m) =>
    Some Action -> LVar Model -> m ())
-> IO (Either () (DSum Action Identity))
forall model route b.
(Ema model route, Show route) =>
(Some Action -> model -> route -> Asset LByteString)
-> (forall (m :: * -> *).
    (MonadIO m, MonadUnliftIO m, MonadLoggerIO m) =>
    Some Action -> LVar model -> m b)
-> IO (Either b (DSum Action Identity))
Ema.runEma (\Some 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
. Some Action -> Model -> Route -> LByteString
render Some Action
act Model
m) ((forall (m :: * -> *).
  (MonadIO m, MonadUnliftIO m, MonadLoggerIO m) =>
  Some Action -> LVar Model -> m ())
 -> IO (Either () (DSum Action Identity)))
-> (forall (m :: * -> *).
    (MonadIO m, MonadUnliftIO m, MonadLoggerIO m) =>
    Some Action -> LVar Model -> m ())
-> IO (Either () (DSum Action Identity))
forall a b. (a -> b) -> a -> b
$ \Some 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 (Some Action -> Bool
CLI.isLiveServer Some Action
act) (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 :: Some Ema.CLI.Action -> Model -> Route -> LByteString
render :: Some Action -> Model -> Route -> LByteString
render Some Action
emaAction Model
model Route
r =
  Some Action -> Html -> Html -> LByteString
EB.twindLayout Some 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')