Copyright | (c) 2024 Sean Hess |
---|---|
License | BSD3 |
Maintainer | Sean Hess <seanhess@gmail.com> |
Stability | experimental |
Portability | portable |
Safe Haskell | Safe-Inferred |
Language | GHC2021 |
Create fully interactive HTML applications with type-safe serverside Haskell. Inspired by HTMX, Elm, and Phoenix LiveView
Synopsis
- liveApp :: (ByteString -> ByteString) -> Eff '[Hyperbole, Server, IOE] Response -> Application
- run :: Port -> Application -> IO ()
- page :: Hyperbole :> es => Page es Response -> Eff es Response
- basicDocument :: Text -> ByteString -> ByteString
- routeRequest :: (Hyperbole :> es, Route route) => (route -> Eff es Response) -> Eff es Response
- class Route a
- routeUrl :: Route a => a -> Url
- route :: Route a => a -> Mod -> View c () -> View c ()
- data Page es a
- load :: Hyperbole :> es => Eff es (View () ()) -> Page es Response
- handle :: forall id es. (Hyperbole :> es, HyperView id) => (id -> Action id -> Eff es (View id ())) -> Page es ()
- class (Param id, Param (Action id)) => HyperView id where
- hyper :: forall id ctx. HyperView id => id -> View id () -> View ctx ()
- button :: HyperView id => Action id -> Mod -> View id () -> View id ()
- dropdown :: HyperView id => (opt -> Action id) -> (opt -> Bool) -> Mod -> View (Option opt id (Action id)) () -> View id ()
- option :: (HyperView id, Eq opt) => opt -> View (Option opt id (Action id)) () -> View (Option opt id (Action id)) ()
- data Option opt id action
- onRequest :: View id () -> View id () -> View id ()
- onLoad :: HyperView id => Action id -> DelayMs -> View id () -> View id ()
- type DelayMs = Int
- class FormField a
- form :: forall id. HyperView id => Action id -> Validation -> Mod -> View (FormFields id) () -> View id ()
- field :: forall a id. FormField a => Mod -> Mod -> View (Input id a) () -> View (FormFields id) ()
- label :: Text -> View (Input id a) ()
- input :: InputType -> Mod -> View (Input id a) ()
- submit :: Mod -> View (FormFields id) () -> View (FormFields id) ()
- placeholder :: Text -> Mod
- data InputType
- formField :: forall a es. (FormField a, Hyperbole :> es) => Eff es a
- newtype Validation = Validation [(Text, Text)]
- validate :: forall a. FormField a => Bool -> Text -> Maybe (Text, Text)
- validation :: [Maybe (Text, Text)] -> Validation
- invalidText :: forall a id. FormField a => View (Input id a) ()
- data Hyperbole :: Effect
- reqParam :: (Hyperbole :> es, FromHttpApiData a) => Text -> Eff es a
- reqParams :: Hyperbole :> es => Eff es Query
- request :: Hyperbole :> es => Eff es Request
- lookupParam :: ByteString -> Query -> Maybe Text
- formData :: Hyperbole :> es => Eff es Form
- notFound :: Hyperbole :> es => Eff es a
- redirect :: Hyperbole :> es => Url -> Eff es a
- respondEarly :: (Hyperbole :> es, HyperView id) => id -> View id () -> Eff es ()
- session :: (Hyperbole :> es, FromHttpApiData a) => Text -> Eff es (Maybe a)
- setSession :: (Hyperbole :> es, ToHttpApiData a) => Text -> a -> Eff es ()
- clearSession :: Hyperbole :> es => Text -> Eff es ()
- target :: HyperView id => id -> View id () -> View a ()
- view :: Hyperbole :> es => View () () -> Eff es Response
- class Param a where
- toParam :: a -> Text
- parseParam :: Text -> Maybe a
- data Response
- module Web.Hyperbole.View
- module Web.Hyperbole.Embed
- class (e :: Effect) :> (es :: [Effect])
- data Eff (es :: [Effect]) a
- type Application = Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived
- class Generic a
Introduction
Single Page Applications (SPAs) require the programmer to write two programs: a Javascript client and a Server, which both must conform to a common API
Hyperbole allows us instead to write a single Haskell program which runs exclusively on the server. All user interactions are sent to the server for processing, and a sub-section of the page is updated with the resulting HTML.
There are frameworks that support this in different ways, including HTMX, Phoenix LiveView, and others. Hyperbole has the following advantages
- 100% Haskell
- Type safe views, actions, routes, and forms
- Elegant interface with little boilerplate
- VirtualDOM updates over sockets, fallback to HTTP
- Easy to use
Like HTMX, Hyperbole extends the capability of UI elements, but it uses Haskell's type-system to prevent common errors and provide default functionality. Specifically, a page has multiple update targets called HyperView
s. These are automatically targeted by any UI element that triggers an action inside them. You can only trigger existing actions that match that HyperView
Like Phoenix LiveView, it upgrades the page to a WebSocket connection and uses VirtualDOM for live updates
Like Elm, it relies on an update function to handle
actions, but greatly simplifies the Elm Architecture by handling state with extensible effects. form
s are easy to use with minimal boilerplate
Depends heavily on the following frameworks
Hello World
Hyperbole applications run via Warp and WAI
They are divided into top-level Page
s. We use load
to handle the initial page load
main = dorun
3000 $ doliveApp
(basicDocument
"Example") (page
messagePage) messagePage = doload
$ do pure $ doel
bold
"Message Page" messageView "Hello World" messageView m = do el_ "Message:" el_ (text m)
Interactivity
Embed HyperView
s to add type-safe interactivity to subsections of a Page
.
To do this, first we connect a view id type to the actions it supports
data Message = Message deriving (Generic,Param
) data MessageAction = Louder Text deriving (Generic,Param
) instanceHyperView
Message where type Action Message = MessageAction
Next we add a handle
r for our view type. It performs side effects, and returns a new view of the same type
message :: Message -> MessageAction -> Eff es (View Message ()) message _ (Louder m) = do -- side effects let new = m <> "!" pure $ messageView new
We update our parent page view to make the messageView interactive using hyper
, and add our handle
r to the Page
messagePage = dohandle
messageload
$ do pure $ doel
bold
"Message Page"hyper
Message $ messageView "Hello World"
Finally, let's add a button
to our view. When clicked, Hyperbole will run the message
handler, and update our view, leaving the page header untouched
messageView :: Text ->View
Message () messageView m = doel_
mbutton
(Louder m) id "Change Message"
Independent Updates
Multiple views update independently, as long as they have different values for their View Id. Add an Int identifier to Message
data Message = Message Int
deriving (Generic, Param
)
We can embed multiple HyperViews on the same page with different ids. Each button will update its view independently
messagePage = dohandle
messageload
$ do pure $ doel
bold "Message Page"hyper
(Message 1) $ messageView "Hello"hyper
(Message 2) $ messageView "World"
Examples
The example directory contains an app with pages demonstrating different features
Run an Application
liveApp :: (ByteString -> ByteString) -> Eff '[Hyperbole, Server, IOE] Response -> Application Source #
Turn one or more Page
s into a Wai Application. Respond using both HTTP and WebSockets
main = do run 3000 $ do liveApp (basicDocument "Example") $ do page mainPage
run :: Port -> Application -> IO () #
Run an Application
on the given port.
This calls runSettings
with defaultSettings
.
basicDocument :: Text -> ByteString -> ByteString Source #
wrap HTML fragments in a simple document with a custom title and include required embeds
liveApp
(basicDocument "App Title") (routeRequest
router)
You may want to specify a custom document function instead:
myDocument :: ByteString -> ByteString myDocument content = [i|<html> <head> <title>#{title}</title> <script type="text/javascript">#{scriptEmbed}</script> <style type type="text/css">#{cssResetEmbed}</style> </head> <body>#{content}</body> </html>|]
Type-Safe Routes
routeRequest :: (Hyperbole :> es, Route route) => (route -> Eff es Response) -> Eff es Response Source #
Route URL patterns to different pages
import Page.Messages qualified as Messages import Page.Users qualified as Users data AppRoute = Main | Messages | Users UserId deriving (Eq, Generic,Route
) router :: (Hyperbole
:> es) => AppRoute ->Eff
esResponse
router Messages =page
Messages.page router (Users uid) =page
$ Users.page uid router Main = doview
$ doel_
"click a link below to visit a page"route
Messages id "Messages" main = dorun
3000 $ doliveApp
(basicDocument
"Example") (routeRequest router)
Derive this class to use a sum type as a route. Constructors and Selectors map intuitively to url patterns
data AppRoute = HomePage | Users | User Int deriving (Generic, Route) / -> HomePage /users/ -> Users /user/100 -> User 100
route :: Route a => a -> Mod -> View c () -> View c () Source #
A hyperlink to another route
>>>
route (User 100) id "View User"
<a href="/user/100">View User</a>
Pages
Page
Hyperbole applications are divided into Pages. Each Page must load
the whole page , and handle
each type of HyperView
myPage :: (Hyperbole
:> es) =>Page
esResponse
myPage = dohandle
messagesload
pageView pageView = do el_ "My Page"hyper
(Message 1) $ messageView "Starting Message"
load :: Hyperbole :> es => Eff es (View () ()) -> Page es Response Source #
The load handler is run when the page is first loaded. Run any side effects needed, then return a view of the full page
myPage :: (Hyperbole :> es) => UserId -> Page es Response
myPage userId = do
load
$ do
user <- loadUserFromDatabase userId
pure $ userPageView user
handle :: forall id es. (Hyperbole :> es, HyperView id) => (id -> Action id -> Eff es (View id ())) -> Page es () Source #
A handler is run when an action for that HyperView
is triggered. Run any side effects needed, then return a view of the corresponding type
myPage :: (Hyperbole
:> es) =>Page
esResponse
myPage = dohandle
messagesload
pageView messages :: (Hyperbole
:> es, MessageDatabase) => Message -> MessageAction ->Eff
es (View
Message ()) messages (Message mid) ClearMessage = do deleteMessageSideEffect mid pure $ messageView "" messages (Message mid) (Louder m) = do let new = m <> "!" saveMessageSideEffect mid new pure $ messageView new
HyperView
class (Param id, Param (Action id)) => HyperView id Source #
HyperViews are interactive subsections of a Page
Create an instance with a unique view id type and a sum type describing the actions the HyperView supports. The View Id can contain context (a database id, for example)
data Message = Message Int deriving (Generic,Param
) data MessageAction = Louder Text | ClearMessage deriving (Generic,Param
) instance HyperView Message where type Action Message = MessageAction
Instances
(HyperView id, Param id) => HyperView (FormFields id) Source # | |
Defined in Web.Hyperbole.Forms type Action (FormFields id) Source # |
hyper :: forall id ctx. HyperView id => id -> View id () -> View ctx () Source #
Embed HyperViews into the page, or nest them into other views
myPage :: (Hyperbole
:> es) =>Page
esResponse
myPage = dohandle
messagesload
$ do pure $ doel_
"My Page"hyper
(Message 1) $ messageView "Hello World"hyper
(Message 2) $ do messageView "Another Message"hyper
OtherView otherView
Views can only trigger actions that match their HyperView
messageView :: Text -> View Message () messageView m = do el_ (text m) button (Louder m) Louder otherView :: View OtherView () otherView = do -- Type Error! button (Louder "Hi") id Louder
Interactive Elements
Buttons
button :: HyperView id => Action id -> Mod -> View id () -> View id () Source #
<button> HTML tag which sends the action when pressed
button SomeAction (border 1) "Click Me"
Dropdowns
dropdown :: HyperView id => (opt -> Action id) -> (opt -> Bool) -> Mod -> View (Option opt id (Action id)) () -> View id () Source #
Type-safe dropdown. Sends (opt -> Action id) when selected. The selection predicate (opt -> Bool) controls which option is selected. See Example.Contacts
data ContactsAction = Reload (Maybe Filter) | Delete Int deriving (Generic, Param) allContactsView :: Maybe Filter -> View Contacts () allContactsView fil = do row (gap 10) $ do el (pad 10) "Filter: " dropdown Reload (== fil) id $ do option Nothing "" option (Just Active) "Active!" option (Just Inactive) Inactive ...
option :: (HyperView id, Eq opt) => opt -> View (Option opt id (Action id)) () -> View (Option opt id (Action id)) () Source #
Events
Type-Safe Forms
Painless forms with type-checked field names, and support for validation. See Example.Forms
Form Fields are identified by a type
data User = User Text deriving (Generic, FormField) data Age = Age Int deriving (Generic, FormField)
Form View
form :: forall id. HyperView id => Action id -> Validation -> Mod -> View (FormFields id) () -> View id () Source #
Type-safe <form>. Calls (Action id) on submit
userForm ::Validation
->View
FormView () userForm v = do form Signup v id $ do el Style.h1 "Sign Up"field
@User id Style.invalid $ dolabel
"Username"input
Username (placeholder
"username") el_invalidText
field
@Age id Style.invalid $ dolabel
"Age"input
Number (placeholder
"age" . value "0") el_invalidText
submit
(border 1) "Submit"
field :: forall a id. FormField a => Mod -> Mod -> View (Input id a) () -> View (FormFields id) () Source #
submit :: Mod -> View (FormFields id) () -> View (FormFields id) () Source #
placeholder :: Text -> Mod Source #
Choose one for input
s to give the browser autocomplete hints
Handlers
Validation
newtype Validation Source #
Validation results for a form
validateUser :: User -> Age -> Validation validateUser (User u) (Age a) = validation [validate
@Age (a < 20) "User must be at least 20 years old" ,validate
@User (T.elem ' ' u) "Username must not contain spaces" ,validate
@User (T.length u < 4) "Username must be at least 4 chars" ] formAction :: (Hyperbole
:> es,UserDB
:> es) => FormView -> FormAction ->Eff
es (View
FormView ()) formAction _ SignUp = do a <-formField
@Age u <-formField
@User case validateUser u a ofValidation
[] -> successView errs -> userForm v
@
Validation [(Text, Text)] |
Instances
Monoid Validation Source # | |
Defined in Web.Hyperbole.Forms mempty :: Validation # mappend :: Validation -> Validation -> Validation # mconcat :: [Validation] -> Validation # | |
Semigroup Validation Source # | |
Defined in Web.Hyperbole.Forms (<>) :: Validation -> Validation -> Validation # sconcat :: NonEmpty Validation -> Validation # stimes :: Integral b => b -> Validation -> Validation # |
validate :: forall a. FormField a => Bool -> Text -> Maybe (Text, Text) Source #
specify a check for a Validation
validation :: [Maybe (Text, Text)] -> Validation Source #
Create a Validation
from list of validators
invalidText :: forall a id. FormField a => View (Input id a) () Source #
Display any validation error for the FormField
from the Validation
passed to form
field
@User id Style.invalid $ dolabel
"Username"input
Username (placeholder
"username") el_invalidText
Hyperbole Effect
data Hyperbole :: Effect Source #
In any load
or handle
, you can use this Effect to get extra request information or control the response manually.
For most Page
s, you won't need to use this effect directly. Use custom Route
s for request info, and return View
s to respond
Instances
type DispatchOf Hyperbole Source # | |
Defined in Web.Hyperbole.Effect |
Request Info
reqParams :: Hyperbole :> es => Eff es Query Source #
Return the entire Query
myPage ::Page
esResponse
myPage = doload
$ do q <- reqParams caselookupParam
"token" q of Nothing -> pure $ errorView "Missing Token in Query String" Just t -> do sideEffectUsingToken token pure myPageView
lookupParam :: ByteString -> Query -> Maybe Text Source #
Lookup the query param in the Query
formData :: Hyperbole :> es => Eff es Form Source #
Return the request body as a Web.FormUrlEncoded.Form
Prefer using Type-Safe Form
s when possible
Response
notFound :: Hyperbole :> es => Eff es a Source #
Respond immediately with 404 Not Found
userLoad :: (Hyperbole :> es, Users :> es) => UserId -> Eff es User userLoad uid = do mu <- send (LoadUser uid) maybe notFound pure mu myPage :: (Hyperbole :> es, Users :> es) => Eff es View myPage = do load $ do u <- userLoad 100 -- skipped if user = Nothing pure $ userView u
respondEarly :: (Hyperbole :> es, HyperView id) => id -> View id () -> Eff es () Source #
Respond with the given view, and stop execution
Sessions
session :: (Hyperbole :> es, FromHttpApiData a) => Text -> Eff es (Maybe a) Source #
Lookup a session variable by keyword
load $ do tok <- session "token" ...
setSession :: (Hyperbole :> es, ToHttpApiData a) => Text -> a -> Eff es () Source #
Set a session variable by keyword
load $ do t <- reqParam "token" setSession "token" t ...
Advanced
target :: HyperView id => id -> View id () -> View a () Source #
Trigger actions for another view. They will update the view specified
otherView :: View OtherView () otherView = do el_ "This is not a message view" button OtherAction id "Do Something" target (Message 2) $ do el_ "Now we can trigger a MessageAction which will update our Message HyperView, not this one" button ClearMessage id "Clear Message #2"
Types that can be serialized. HyperView
requires this for both its view id and action
data Message = Message Int deriving (Generic, Param)
Nothing
parseParam :: Text -> Maybe a Source #
Instances
Param Text Source # | |
Param Integer Source # | |
Param () Source # | |
Defined in Web.Hyperbole.HyperView | |
Param Float Source # | |
Param Int Source # | |
Param id => Param (FormFields id) Source # | |
Defined in Web.Hyperbole.Forms toParam :: FormFields id -> Text Source # parseParam :: Text -> Maybe (FormFields id) Source # | |
Param a => Param (Maybe a) Source # | |
Exports
Web.View
Hyperbole is tightly integrated with Web.View for HTML generation
module Web.Hyperbole.View
Embeds
Embedded CSS and Javascript to include in your document function. See basicDocument
module Web.Hyperbole.Embed
Effectful
Hyperbole is tighly integrated with Effectful for extensible effects. It is used to implement the Hyperbole
and Server
effects.
- See Effectful.Dispatch.Dynamic for an example of how to create a custom effect
- See Example.Counter for an example of how to compose an existing effect
class (e :: Effect) :> (es :: [Effect]) #
A constraint that requires that a particular effect e
is a member of the
type-level list es
. This is used to parameterize an Eff
computation over an arbitrary list of effects, so long as e
is somewhere
in the list.
For example, a computation that only needs access to a mutable value of type
Integer
would have the following type:
State
Integer
:>
es =>Eff
es ()
Instances
(TypeError (('Text "There is no handler for '" ':<>: 'ShowType e) ':<>: 'Text "' in the context") :: Constraint) => e :> ('[] :: [Effect]) | |
Defined in Effectful.Internal.Effect reifyIndex :: Int # | |
e :> (e ': es) | |
Defined in Effectful.Internal.Effect reifyIndex :: Int # | |
e :> es => e :> (x ': es) | |
Defined in Effectful.Internal.Effect reifyIndex :: Int # |
The Eff
monad provides the implementation of a computation that performs
an arbitrary set of effects. In
, Eff
es aes
is a type-level list that
contains all the effects that the computation may perform. For example, a
computation that produces an Integer
by consuming a String
from the
global environment and acting upon a single mutable value of type Bool
would have the following type:
(Reader
String
:>
es,State
Bool
:>
es) =>Eff
esInteger
Abstracting over the list of effects with (:>)
:
- Allows the computation to be used in functions that may perform other effects.
- Allows the effects to be handled in any order.
Instances
IOE :> es => MonadBaseControl IO (Eff es) | Instance included for compatibility with existing code. Usage of Note: the unlifting strategy for |
IOE :> es => MonadBase IO (Eff es) | Instance included for compatibility with existing code. Usage of |
Defined in Effectful.Internal.Monad | |
Fail :> es => MonadFail (Eff es) | |
Defined in Effectful.Internal.Monad | |
MonadFix (Eff es) | |
Defined in Effectful.Internal.Monad | |
IOE :> es => MonadIO (Eff es) | |
Defined in Effectful.Internal.Monad | |
NonDet :> es => Alternative (Eff es) | Since: effectful-core-2.2.0.0 |
Applicative (Eff es) | |
Functor (Eff es) | |
Monad (Eff es) | |
NonDet :> es => MonadPlus (Eff es) | Since: effectful-core-2.2.0.0 |
MonadCatch (Eff es) | |
Defined in Effectful.Internal.Monad | |
MonadMask (Eff es) | |
Defined in Effectful.Internal.Monad mask :: HasCallStack => ((forall a. Eff es a -> Eff es a) -> Eff es b) -> Eff es b # uninterruptibleMask :: HasCallStack => ((forall a. Eff es a -> Eff es a) -> Eff es b) -> Eff es b # generalBracket :: HasCallStack => Eff es a -> (a -> ExitCase b -> Eff es c) -> (a -> Eff es b) -> Eff es (b, c) # | |
MonadThrow (Eff es) | |
Defined in Effectful.Internal.Monad throwM :: (HasCallStack, Exception e) => e -> Eff es a # | |
Prim :> es => PrimMonad (Eff es) | |
IOE :> es => MonadUnliftIO (Eff es) | Instance included for compatibility with existing code. Usage of Note: the unlifting strategy for |
Defined in Effectful.Internal.Monad | |
Monoid a => Monoid (Eff es a) | |
Semigroup a => Semigroup (Eff es a) | |
type PrimState (Eff es) | |
Defined in Effectful.Internal.Monad | |
type StM (Eff es) a | |
Defined in Effectful.Internal.Monad |
Other
type Application = Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived #
The WAI application.
Note that, since WAI 3.0, this type is structured in continuation passing
style to allow for proper safe resource handling. This was handled in the
past via other means (e.g., ResourceT
). As a demonstration:
app :: Application app req respond = bracket_ (putStrLn "Allocating scarce resource") (putStrLn "Cleaning up") (respond $ responseLBS status200 [] "Hello World")
Representable types of kind *
.
This class is derivable in GHC with the DeriveGeneric
flag on.
A Generic
instance must satisfy the following laws:
from
.to
≡id
to
.from
≡id