Skip to content

Instantly share code, notes, and snippets.

@Decoherence
Last active May 16, 2023 01:45
Show Gist options
  • Star 1 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save Decoherence/a3d7a2d7ca025cd5fa0a to your computer and use it in GitHub Desktop.
Save Decoherence/a3d7a2d7ca025cd5fa0a to your computer and use it in GitHub Desktop.
Haskell: Simple REST example. Process request, retrieve data from PostgreSQL backend, and respond with programmatically-generated HTML.
{-# LANGUAGE OverloadedStrings #-}
import Control.Applicative
import Control.Monad
import Control.Monad.Trans
import Data.Monoid
import Data.Text
import Database.PostgreSQL.Simple
import Database.PostgreSQL.Simple.FromRow
import Lucid
import Web.Scotty
data Beer = Beer
{ id' :: Int
, name :: Text
, description :: Text
} deriving (Show)
instance FromRow Beer where
fromRow = Beer <$> field <*> field <*> field
main :: IO ()
main = scotty 3000 $ do
get "/" $ lucid homePage
get "/beers" $ do
bs <- liftIO beerList
lucid bs
-- | Simple homepage
homePage :: Html ()
homePage = h1_ "Lucid Demo" <> h2_ "Pretty sweet, eh?"
-- | Helper function to use Lucid-generated HTML alongside Scotty
lucid :: Html a -> ActionM ()
lucid h = do
setHeader "Content-Type" "text/html"
raw . renderBS $ h
-- | Get a list of all Beers in the database
getAllBeers :: IO [Beer]
getAllBeers = do
conn <- connectPostgreSQL "dbname='testing'"
res <- query_ conn "select * from beers"
return res
-- | Insert a new Beer into the database
insertBeer :: Beer -> IO ()
insertBeer (Beer id' name desc) = do
conn <- connectPostgreSQL "dbname='testing'"
row <- execute conn "insert into beers values (?,?,?)" (id', name, desc)
return ()
-- | Return a bulleted list of beer names
beerList :: IO (Html ())
beerList = do
beers <- getAllBeers
return $ h2_ "Beer List:" <> ul_ (mapM_ (li_ . toHtml . name) beers)
-- | Retrieve a single beer by ID
sweetwater :: IO Text
sweetwater = do
conn <- connectPostgreSQL "dbname='testing'"
[Only i] <- query_ conn "select name from beers where id=1"
return i
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment