Copyright | (c) 2023 Sean Hess |
---|---|
License | BSD3 |
Maintainer | Sean Hess <seanhess@gmail.com> |
Stability | experimental |
Portability | portable |
Safe Haskell | None |
Language | GHC2021 |
Web.View
Description
Type-safe HTML and CSS with intuitive layout and composable styles. Inspired by Tailwindcss and Elm-UI
Synopsis
- renderText :: View () () -> Text
- renderLazyText :: View () () -> Text
- renderLazyByteString :: View () () -> ByteString
- module Web.View.Reset
- data View context a
- type Mod context = Attributes context -> Attributes context
- el :: Mod c -> View c () -> View c ()
- el_ :: View c () -> View c ()
- layout :: Mod c -> View c () -> View c ()
- root :: Mod c
- col :: Mod c -> View c () -> View c ()
- row :: Mod c -> View c () -> View c ()
- space :: View c ()
- nav :: Mod c -> View c () -> View c ()
- stack :: Mod c -> Layer c () -> View c ()
- data Layer c a
- layer :: Mod c -> View c () -> Layer c ()
- popup :: Sides Length -> Mod c
- scroll :: Mod c
- grow :: Mod c
- flexRow :: Mod c
- flexCol :: Mod c
- hide :: Mod c
- truncate :: Mod c
- text :: Text -> View c ()
- raw :: Text -> View c ()
- none :: View c ()
- pre :: Mod c -> Text -> View c ()
- code :: Mod c -> Text -> View c ()
- form :: Mod c -> View c () -> View c ()
- input :: Mod c -> View c ()
- name :: Text -> Mod c
- value :: Text -> Mod c
- label :: Mod c -> View c () -> View c ()
- link :: Url -> Mod c -> View c () -> View c ()
- button :: Mod c -> View c () -> View c ()
- ol :: Mod c -> ListItem c () -> View c ()
- ul :: Mod c -> ListItem c () -> View c ()
- li :: Mod c -> View c () -> ListItem c ()
- table :: Mod c -> [dt] -> Eff '[Writer [TableColumn c dt]] () -> View c ()
- tcol :: forall dt c. View (TableHead c) () -> (dt -> View dt ()) -> Eff '[Writer [TableColumn c dt]] ()
- th :: Mod c -> View c () -> View (TableHead c) ()
- td :: Mod () -> View () () -> View dt ()
- data TableHead a
- data TableColumn c dt
- script :: Text -> View c ()
- style :: Text -> View c ()
- stylesheet :: Text -> View c ()
- width :: Length -> Mod c
- height :: Length -> Mod c
- minWidth :: Length -> Mod c
- minHeight :: Length -> Mod c
- pad :: Sides Length -> Mod c
- gap :: Length -> Mod c
- opacity :: Float -> Mod c
- shadow :: (Style Shadow a, ToClassName a) => a -> Mod c
- data Shadow
- data Inner = Inner
- rounded :: Length -> Mod c
- fontSize :: Length -> Mod c
- color :: ToColor clr => clr -> Mod ctx
- bg :: ToColor clr => clr -> Mod ctx
- bold :: Mod c
- italic :: Mod c
- underline :: Mod c
- border :: Sides PxRem -> Mod c
- borderColor :: ToColor clr => clr -> Mod ctx
- pointer :: Mod c
- position :: Position -> Mod c
- data Position
- zIndex :: Int -> Mod c
- offset :: Sides Length -> Mod c
- textAlign :: Align -> Mod c
- data Align
- list :: (ToClassName a, Style ListType a) => a -> Mod c
- data ListType
- display :: (Style Display a, ToClassName a) => a -> Mod c
- data Display = Block
- transition :: Ms -> TransitionProperty -> Mod c
- data TransitionProperty
- data Ms
- hover :: Mod c -> Mod c
- active :: Mod c -> Mod c
- even :: Mod c -> Mod c
- odd :: Mod c -> Mod c
- media :: Media -> Mod c -> Mod c
- data Media
- parent :: Text -> Mod c -> Mod c
- context :: View context context
- addContext :: context -> View context () -> View c ()
- tag :: Text -> Mod c -> View c () -> View c ()
- att :: Name -> AttValue -> Mod c
- data Sides a
- data PxRem
- data Length
- class ToColor a where
- colorValue :: a -> HexColor
- colorName :: a -> Text
- newtype HexColor = HexColor Text
- data None = None
- data Attributes (c :: k)
- module Web.View.Types.Url
- type Query = [QueryItem]
How to use this library
Create styled View
s using composable Haskell functions
myView :: View ctx () myView = col (gap 10) $ do el (bold . fontSize 32) "My page" button (border 1) "Click Me"
This represents an HTML fragment with embedded CSS definitions
<style type='text/css'> .bold { font-weight:bold } .brd-1 { border:1px; border-style:solid } .col { display:flex; flex-direction:column } .fs-32 { font-size:2.0rem } .gap-10 { gap:0.625rem } </style> <div class='col gap-10'> <div class='bold fs-32'>My page</div> <button class='brd-1'>Click Me</button> </div>
Leverage the full power of Haskell functions for reuse, instead of relying on CSS.
header = bold h1 = header . fontSize 32 h2 = header . fontSize 24 page = gap 10 myView = col page $ do el h1 "My Page" ...
This approach is inspired by Tailwindcss' Utility Classes
Rendering View
s
renderText :: View () () -> Text Source #
Renders a View
as HTML with embedded CSS class definitions
>>>
renderText $ el bold "Hello"
<style type='text/css'>.bold { font-weight:bold }</style> <div class='bold'>Hello</div>
renderLazyText :: View () () -> Text Source #
renderLazyByteString :: View () () -> ByteString Source #
Full HTML Documents
Create a full HTML document by embedding the view and cssResetEmbed
import Data.String.Interpolate (i) import Web.View toDocument :: Text -> Text toDocument content = [i|<html> <title>My Website</title> <head><style type="text/css">#{cssResetEmbed}</style></head> <body>#{content}</body> </html>|] myDocument :: Text myDocument = toDocument $ renderText myView
module Web.View.Reset
Views
Views are HTML fragments that carry all CSS
used by any child element.
view :: View c () view = col (pad 10 . gap 10) $ do el bold "Hello" el_ "World"
They can also have a context which can be used to create type-safe or context-aware elements. See context
or table
for an example
Instances
Applicative (View context) Source # | |
Functor (View context) Source # | |
Monad (View context) Source # | |
IsString (View context ()) Source # | |
Defined in Web.View.View Methods fromString :: String -> View context () # |
Mods
type Mod context = Attributes context -> Attributes context Source #
Element functions expect a modifier function as their first argument. These can add attributes and classes. Combine multiple Mod
s with (.
)
userEmail :: User -> View c () userEmail user = input (fontSize 16 . active) (text user.email) where active = isActive user then bold else id
If you don't want to specify any attributes, you can use id
plainView :: View c () plainView = el id "No styles"
Elements
Layout
layout :: Mod c -> View c () -> View c () Source #
We can intuitively create layouts with combinations of row
, col
, stack
, grow
, and space
Wrap main content in layout
to allow the view to consume vertical screen space
holygrail ::View
c () holygrail =layout
id $ dorow
section "Top Bar"row
grow
$ docol
section "Left Sidebar"col
(section .grow
) "Main Content"col
section "Right Sidebar"row
section "Bottom Bar" where section =border
1
col :: Mod c -> View c () -> View c () Source #
Lay out children in a column.
col grow $ do el_ "Top" space el_ "Bottom"
row :: Mod c -> View c () -> View c () Source #
Lay out children in a row
row id $ do el_ "Left" space el_ "Right"
stack :: Mod c -> Layer c () -> View c () Source #
Stack children on top of each other. Each child has the full width. See popup
stack id $ do layer id "Background" layer (bg Black . opacity 0.5) "Overlay"
layer :: Mod c -> View c () -> Layer c () Source #
A normal layer contributes to the size of the parent. See stack
popup :: Sides Length -> Mod c Source #
This layer
is not included in the stack
size, and covers content outside of it. If used outside of stack, the popup is offset from the entire page.
stack id $ do layer id $ input (value "Autocomplete Box") layer (popup (TRBL 50 0 0 0)) $ do el_ "Item 1" el_ "Item 2" el_ "Item 3" el_ "This is covered by the menu"
Content
text :: Text -> View c () Source #
Add text to a view. Not required for string literals
el_ $ do "Hello: " text user.name
raw :: Text -> View c () Source #
Embed static, unescaped HTML or SVG. Take care not to use raw
with user-generated content.
spinner = raw "<svg>...</svg>"
Inputs
Lists
ol :: Mod c -> ListItem c () -> View c () Source #
List elements do not include any inherent styling but are useful for accessibility. See list
.
ol id $ do let nums = list Decimal li nums "one" li nums "two" li nums "three"
Tables
table :: Mod c -> [dt] -> Eff '[Writer [TableColumn c dt]] () -> View c () Source #
Create a type safe data table by specifying columns
usersTable :: [User] -> View c () usersTable us = do table id us $ do tcol (th hd "Name") $ \u -> td cell $ text u.name tcol (th hd "Email") $ \u -> td cell $ text u.email where hd = cell . bold cell = pad 4 . border 1
tcol :: forall dt c. View (TableHead c) () -> (dt -> View dt ()) -> Eff '[Writer [TableColumn c dt]] () Source #
data TableColumn c dt Source #
Document Metadata
stylesheet :: Text -> View c () Source #
CSS Modifiers
minWidth :: Length -> Mod c Source #
Allow width to grow to contents but not shrink any smaller than value
minHeight :: Length -> Mod c Source #
Allow height to grow to contents but not shrink any smaller than value
pad :: Sides Length -> Mod c Source #
Space surrounding the children of the element
To create even spacing around and between all elements:
col (pad 10 . gap 10) $ do el_ "one" el_ "two" el_ "three"
shadow :: (Style Shadow a, ToClassName a) => a -> Mod c Source #
Add a drop shadow to an element
input (shadow Inner) "Inset Shadow" button (shadow ()) "Click Me"
Instances
Style Shadow Inner Source # | |
Defined in Web.View.Style Methods styleValue :: Inner -> StyleValue Source # | |
Style Shadow None Source # | |
Defined in Web.View.Style Methods styleValue :: None -> StyleValue Source # | |
Style Shadow () Source # | |
Defined in Web.View.Style Methods styleValue :: () -> StyleValue Source # |
Constructors
Inner |
Instances
Show Inner Source # | |
ToClassName Inner Source # | |
Defined in Web.View.Style Methods toClassName :: Inner -> ClassName Source # | |
Style Shadow Inner Source # | |
Defined in Web.View.Style Methods styleValue :: Inner -> StyleValue Source # |
border :: Sides PxRem -> Mod c Source #
Set a border around the element
el (border 1) "all sides" el (border (X 1)) "only left and right"
Use a button-like cursor when hovering over the element
Button-like elements:
btn = pointer . bg Primary . hover (bg PrimaryLight) options = row id $ do el btn "Login" el btn "Sign Up"
Instances
Show Position Source # | |
ToClassName Position Source # | |
Defined in Web.View.Style Methods toClassName :: Position -> ClassName Source # | |
ToStyleValue Position Source # | |
Defined in Web.View.Style Methods toStyleValue :: Position -> StyleValue Source # |
Constructors
AlignCenter | |
AlignLeft | |
AlignRight | |
AlignJustify |
Instances
Show Align Source # | |
ToClassName Align Source # | |
Defined in Web.View.Types Methods toClassName :: Align -> ClassName Source # | |
ToStyleValue Align Source # | |
Defined in Web.View.Types Methods toStyleValue :: Align -> StyleValue Source # |
list :: (ToClassName a, Style ListType a) => a -> Mod c Source #
Set the list style of an item
ol id $ do li (list Decimal) "First" li (list Decimal) "Second" li (list Decimal) "Third"
Instances
Show ListType Source # | |
ToClassName ListType Source # | |
Defined in Web.View.Style Methods toClassName :: ListType -> ClassName Source # | |
ToStyleValue ListType Source # | |
Defined in Web.View.Style Methods toStyleValue :: ListType -> StyleValue Source # | |
Style ListType ListType Source # | |
Defined in Web.View.Style Methods styleValue :: ListType -> StyleValue Source # | |
Style ListType None Source # | |
Defined in Web.View.Style Methods styleValue :: None -> StyleValue Source # |
display :: (Style Display a, ToClassName a) => a -> Mod c Source #
Set container display
el (display None) HIDDEN
Constructors
Block |
Instances
Show Display Source # | |
ToClassName Display Source # | |
Defined in Web.View.Style Methods toClassName :: Display -> ClassName Source # | |
ToStyleValue Display Source # | |
Defined in Web.View.Style Methods toStyleValue :: Display -> StyleValue Source # | |
Style Display Display Source # | |
Defined in Web.View.Style Methods styleValue :: Display -> StyleValue Source # | |
Style Display None Source # | |
Defined in Web.View.Style Methods styleValue :: None -> StyleValue Source # |
transition :: Ms -> TransitionProperty -> Mod c Source #
Animate changes to the given property
el (transition 100 (Height 400)) "Tall" el (transition 100 (Height 100)) "Small"
data TransitionProperty Source #
Instances
Show TransitionProperty Source # | |
Defined in Web.View.Style Methods showsPrec :: Int -> TransitionProperty -> ShowS # show :: TransitionProperty -> String # showList :: [TransitionProperty] -> ShowS # |
Milliseconds, used for transitions
Instances
Num Ms Source # | |
Show Ms Source # | |
ToClassName Ms Source # | |
Defined in Web.View.Types Methods toClassName :: Ms -> ClassName Source # | |
ToStyleValue Ms Source # | |
Defined in Web.View.Types Methods toStyleValue :: Ms -> StyleValue Source # |
Selector States
hover :: Mod c -> Mod c Source #
Apply when hovering over an element
el (bg Primary . hover (bg PrimaryLight)) "Hover"
media :: Media -> Mod c -> Mod c Source #
Apply when the Media matches the current window. This allows for responsive designs
el (width 100 . media (MinWidth 800) (width 400)) "Big if window > 800"
Media allows for responsive designs that change based on characteristics of the window. See Layout Example
parent :: Text -> Mod c -> Mod c Source #
Apply when the element is somewhere inside an anscestor.
For example, the HTMX library applies an "htmx-request" class to the body when a request is pending. We can use this to create a loading indicator
el (pad 10) $ do el (parent "htmx-request" flexRow . hide) "Loading..." el (parent "htmx-request" hide . flexRow) "Normal Content"
View Context
context :: View context context Source #
Views have a Reader
built-in for convienient access to static data, and to add type-safety to view functions. See 'Web.View.Element.ListItem and https://hackage.haskell.org/package/hyperbole/docs/Web-Hyperbole.html
numberView :: View Int () numberView = do num <- context el_ $ do "Number: " text (pack $ show num)
addContext :: context -> View context () -> View c () Source #
Creating New Elements and Modifiers
tag :: Text -> Mod c -> View c () -> View c () Source #
Create a new element constructor with the given tag name
aside :: Mod c -> View c () -> View c () aside = tag "aside"
att :: Name -> AttValue -> Mod c Source #
Set an attribute, replacing existing value
hlink :: Text -> View c () -> View c () hlink url content = tag "a" (att "href" url) content
Types
Options for styles that support specifying various sides. This has a "fake" Num instance to support literals
border 5 border (X 2) border (TRBL 0 5 0 0)
Px, converted to Rem. Allows for the user to change the document font size and have the app scale accordingly. But allows the programmer to code in pixels to match a design
Instances
Enum PxRem Source # | |
Num PxRem Source # | |
Integral PxRem Source # | |
Real PxRem Source # | |
Defined in Web.View.Types Methods toRational :: PxRem -> Rational # | |
Show PxRem Source # | |
Eq PxRem Source # | |
Ord PxRem Source # | |
ToClassName PxRem Source # | |
Defined in Web.View.Types Methods toClassName :: PxRem -> ClassName Source # | |
ToStyleValue PxRem Source # | |
Defined in Web.View.Types Methods toStyleValue :: PxRem -> StyleValue Source # |
Instances
Num Length Source # | |
Show Length Source # | |
ToClassName Length Source # | |
Defined in Web.View.Types Methods toClassName :: Length -> ClassName Source # | |
ToStyleValue Length Source # | |
Defined in Web.View.Types Methods toStyleValue :: Length -> StyleValue Source # |
class ToColor a where Source #
ToColor allows you to create a type containing your application's colors:
data AppColor = White | Primary | Dark instance ToColor AppColor where colorValue White = "#FFF" colorValue Dark = "#333" colorValue Primary = "#00F" hello :: View c () hello = el (bg Primary . color White) "Hello"
Minimal complete definition
Methods
colorValue :: a -> HexColor Source #
Hexidecimal Color. Can be specified with or without the leading #
. Recommended to use an AppColor type instead of manually using hex colors. See ToColor
Instances
IsString HexColor Source # | |
Defined in Web.View.Types Methods fromString :: String -> HexColor # | |
Show HexColor Source # | |
ToClassName HexColor Source # | |
Defined in Web.View.Types Methods toClassName :: HexColor -> ClassName Source # | |
ToColor HexColor Source # | |
ToStyleValue HexColor Source # | |
Defined in Web.View.Types Methods toStyleValue :: HexColor -> StyleValue Source # |
Constructors
None |
Instances
Show None Source # | |
ToClassName None Source # | |
Defined in Web.View.Types Methods toClassName :: None -> ClassName Source # | |
ToStyleValue None Source # | |
Defined in Web.View.Types Methods toStyleValue :: None -> StyleValue Source # | |
Style Display None Source # | |
Defined in Web.View.Style Methods styleValue :: None -> StyleValue Source # | |
Style ListType None Source # | |
Defined in Web.View.Style Methods styleValue :: None -> StyleValue Source # | |
Style Shadow None Source # | |
Defined in Web.View.Style Methods styleValue :: None -> StyleValue Source # |
data Attributes (c :: k) Source #
The Attributes for an Element
. Classes are merged and managed separately from the other attributes.
Instances
Monoid (Attributes c) Source # | |
Defined in Web.View.Types Methods mempty :: Attributes c # mappend :: Attributes c -> Attributes c -> Attributes c # mconcat :: [Attributes c] -> Attributes c # | |
Semigroup (Attributes c) Source # | |
Defined in Web.View.Types Methods (<>) :: Attributes c -> Attributes c -> Attributes c # sconcat :: NonEmpty (Attributes c) -> Attributes c # stimes :: Integral b => b -> Attributes c -> Attributes c # | |
Show (Attributes c) Source # | |
Defined in Web.View.Types Methods showsPrec :: Int -> Attributes c -> ShowS # show :: Attributes c -> String # showList :: [Attributes c] -> ShowS # | |
Eq (Attributes c) Source # | |
Defined in Web.View.Types |
Url
module Web.View.Types.Url