I very much enjoy creating web apps using Servant to serve HTML generated by HTMX and Lucid. JavaScript is used very sparingly.
These libraries work super well together, and results in a very lightweight application. But most importantly, it’s a lot of fun.
Here’s a look of how parts of a larger hobby project of mine looks like, that highlights each library:
Subset of API:
data ShoppingApi as = ShoppingApi
{ shoppingPageEP :: as :- Get '[HTML] ShoppingPage,
productListEP :: as :- "produkter" :> ReqBody '[FormUrlEncoded] Search :> Post '[HTML] ProductSearchList,
addProductEP :: as :- "lagg-till" :> ReqBody '[JSON] Willys.Product :> Post '[HTML] [ShoppingItem],
toggleProductEP :: as :- "toggla" :> ReqBody '[JSON] Willys.Product :> Post '[HTML] NoContent,
removeCheckedEP :: as :- "ta-bort" :> Delete '[HTML] [ShoppingItem],
removeAllEP :: as :- "ta-bort-alla" :> Delete '[HTML] [ShoppingItem],
sseEP :: as :- "sse" :> StreamGet NoFraming EventStream EventSource
}
deriving (Generic)
Since I’m trained in React, a “component” (HTML content only needs an instance if it’s going to be the body of a response, otherwise it’s just a function):
instance ToHtml ProductSearchList where
toHtmlRaw = toHtml
toHtml (ProductSearchList attributes products rubric listId) =
fieldset_ [class_ "products", id_ listId] $ do
legend_ (toHtml rubric)
mapM_
( \p -> div_ ([class_ "product-container", title_ p.name] <> (attributes p)) $ do
img_ [class_ "product", src_ p.image.url]
div_ [class_ "product-details"] $ do
span_ [class_ "product-name"] $ toHtml p.name
span_ [class_ "product-promo"] $ toHtml $ Willys.getPrice p
span_ [class_ "product-save"] $ toHtml $ fromMaybe "" $ Willys.getSavePrice p
)
products
and here’s a typical endpoint:
removeExpenseH :: UUID -> Handler NoContent
removeExpenseH uuid = do
res <- liftIO $ BS.readFile transactionsFile
case eitherDecodeStrict res of
Right ts -> do
let newTs = filter (\t -> case t of ExpenseTransaction exp -> exp.id /= uuid; _ -> True) ts
liftIO $ LBS.writeFile transactionsFile (encode newTs)
hxRedirect "/split"
Left err -> liftIO (print err) >> throwError err500