Safe Haskell | Safe-Inferred |
---|---|
Language | GHC2021 |
Synopsis
- type Mod = Attributes -> Attributes
- data View context a
- data Align = Center
- newtype HexColor = HexColor Text
- class ToColor a where
- colorValue :: a -> HexColor
- colorName :: a -> Text
- data Sides a
- data Media
- data Ms
- data PxRem
- data Length
- data TransitionProperty
- data Url = Url {}
- data TableColumn c dt
- data TableHead a
- text :: Text -> View c ()
- space :: View c ()
- link :: Url -> Mod -> View c () -> View c ()
- even :: Mod -> Mod
- truncate :: Mod
- odd :: Mod -> Mod
- value :: Text -> Mod
- pad :: Sides Length -> Mod
- style :: Text -> View c ()
- layout :: Mod -> View c () -> View c ()
- name :: Text -> Mod
- hover :: Mod -> Mod
- raw :: Text -> View c ()
- row :: Mod -> View c () -> View c ()
- col :: Mod -> View c () -> View c ()
- table :: Mod -> [dt] -> Eff '[Writer [TableColumn c dt]] () -> View c ()
- cssResetLink :: Text
- width :: Length -> Mod
- height :: Length -> Mod
- minWidth :: Length -> Mod
- minHeight :: Length -> Mod
- gap :: Length -> Mod
- fontSize :: Length -> Mod
- flexRow :: Mod
- flexCol :: Mod
- shadow :: Mod
- rounded :: Length -> Mod
- bg :: ToColor c => c -> Mod
- color :: ToColor c => c -> Mod
- bold :: Mod
- hide :: Mod
- opacity :: Float -> Mod
- border :: Sides PxRem -> Mod
- borderColor :: ToColor c => c -> Mod
- pointer :: Mod
- transition :: Ms -> TransitionProperty -> Mod
- textAlign :: Align -> Mod
- active :: Mod -> Mod
- media :: Media -> Mod -> Mod
- parent :: Text -> Mod -> Mod
- pathUrl :: [Segment] -> Url
- cleanSegment :: Segment -> Segment
- pathSegments :: Text -> [Segment]
- url :: Text -> Url
- renderUrl :: Url -> Text
- context :: View context context
- addContext :: context -> View context () -> View c ()
- tag :: Text -> Mod -> View c () -> View c ()
- att :: Name -> AttValue -> Mod
- renderText :: View () () -> Text
- renderLazyText :: View () () -> Text
- renderLazyByteString :: View () () -> ByteString
- el :: Mod -> View c () -> View c ()
- el_ :: View c () -> View c ()
- none :: View c ()
- pre :: Mod -> Text -> View c ()
- script :: Text -> View c ()
- stylesheet :: Text -> View c ()
- tcol :: forall dt c. View (TableHead c) () -> (dt -> View dt ()) -> Eff '[Writer [TableColumn c dt]] ()
- th :: Mod -> View c () -> View (TableHead c) ()
- td :: Mod -> View () () -> View dt ()
- root :: Mod
- grow :: Mod
- collapse :: Mod
- scroll :: Mod
- nav :: Mod -> View c () -> View c ()
Documentation
type Mod = Attributes -> Attributes #
Element functions expect a Mod function as their first argument that adds attributes and classes.
userEmail :: User -> View c () userEmail user = input (fontSize 16 . active) (text user.email) where active = isActive user then bold else id
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 table
for an example
Instances
Applicative (View context) | |
Defined in Web.View.View | |
Functor (View context) | |
Monad (View context) | |
IsString (View context ()) | |
Defined in Web.View.View fromString :: String -> View context () # |
Instances
Show Align | |
ToClassName Align | |
Defined in Web.View.Types toClassName :: Align -> Text # | |
ToStyleValue Align | |
Defined in Web.View.Types toStyleValue :: Align -> StyleValue # |
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 | |
Defined in Web.View.Types fromString :: String -> HexColor # | |
ToColor HexColor | |
Defined in Web.View.Types | |
ToStyleValue HexColor | |
Defined in Web.View.Types toStyleValue :: HexColor -> StyleValue # |
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"
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)
Media allows for responsive designs that change based on characteristics of the window. See Layout Example
Milliseconds, used for transitions
Instances
Num Ms | |
Show Ms | |
ToClassName Ms | |
Defined in Web.View.Types toClassName :: Ms -> Text # | |
ToStyleValue Ms | |
Defined in Web.View.Types toStyleValue :: Ms -> StyleValue # |
Instances
Enum PxRem | |
Num PxRem | |
Integral PxRem | |
Real PxRem | |
Defined in Web.View.Types toRational :: PxRem -> Rational # | |
Show PxRem | |
Eq PxRem | |
Ord PxRem | |
ToClassName PxRem | |
Defined in Web.View.Types toClassName :: PxRem -> Text # | |
ToStyleValue PxRem | |
Defined in Web.View.Types toStyleValue :: PxRem -> StyleValue # |
PxRem PxRem | 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 |
Pct Float |
Instances
Num Length | |
Show Length | |
ToClassName Length | |
Defined in Web.View.Types toClassName :: Length -> Text # | |
ToStyleValue Length | |
Defined in Web.View.Types toStyleValue :: Length -> StyleValue # |
data TransitionProperty #
Instances
Show TransitionProperty | |
Defined in Web.View.Style showsPrec :: Int -> TransitionProperty -> ShowS # show :: TransitionProperty -> String # showList :: [TransitionProperty] -> ShowS # |
Instances
data TableColumn c dt #
Add text to a view. Not required for string literals
el_ $ do "Hello: " text user.name
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"
layout :: Mod -> View c () -> View c () #
We can intuitively create layouts with combindations of row
, col
, 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
Apply when hovering over an element
el (bg Primary . hover (bg PrimaryLight)) "Hover"
Embed static, unescaped HTML or SVG. Take care not to use raw
with user-generated content.
spinner = raw "<svg>...</svg>"
row :: Mod -> View c () -> View c () #
Lay out children in a row
row id $ do el_ "Left" space el_ "Right"
col :: Mod -> View c () -> View c () #
Lay out children in a column.
col grow $ do el_ "Top" space el_ "Bottom"
table :: Mod -> [dt] -> Eff '[Writer [TableColumn c dt]] () -> View c () #
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
cssResetLink :: Text #
Alternatively, the reset is available on a CDN
import Data.String.Interpolate (i) toDocument :: ByteString -> ByteString toDocument cnt = [i|<html> <head> <link rel="stylesheet" href="#{cssResetLink}"> </head> <body>#{cnt}</body> </html>|]
border :: Sides PxRem -> Mod #
Set a border around the element
el (border 1) "all sides" el (border (X 1)) "only left and right"
borderColor :: ToColor c => c -> Mod #
Set a border color. See ToColor
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"
transition :: Ms -> TransitionProperty -> Mod #
Animate changes to the given property
el (transition 100 (Height 400)) "Tall" el (transition 100 (Height 100)) "Small"
media :: Media -> Mod -> Mod #
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"
parent :: Text -> Mod -> Mod #
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"
cleanSegment :: Segment -> Segment #
pathSegments :: Text -> [Segment] #
addContext :: context -> View context () -> View c () #
tag :: Text -> Mod -> View c () -> View c () #
Create a new element constructor
aside :: Mod -> View c () -> View c () aside = tag "aside"
att :: Name -> AttValue -> Mod #
Set an attribute, replacing existing value
hlink :: Text -> View c () -> View c () hlink url content = tag "a" (att "href" url) content
renderText :: View () () -> Text #
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 #
renderLazyByteString :: View () () -> ByteString #
stylesheet :: Text -> View c () #
tcol :: forall dt c. View (TableHead c) () -> (dt -> View dt ()) -> Eff '[Writer [TableColumn c dt]] () #
Allow items to become smaller than their contents. This is not the opposite of grow!