web-view (empty) → 0.2.0
raw patch · 14 files changed
+1796/−0 lines, 14 filesdep +basedep +bytestringdep +casing
Dependencies added: base, bytestring, casing, containers, effectful, file-embed, http-api-data, http-types, string-interpolate, text, wai, warp, web-view
Files
- CHANGELOG.md +5/−0
- LICENSE +30/−0
- README.md +87/−0
- example/Main.hs +130/−0
- src/Web/View.hs +172/−0
- src/Web/View/Element.hs +159/−0
- src/Web/View/Layout.hs +114/−0
- src/Web/View/Render.hs +196/−0
- src/Web/View/Reset.hs +41/−0
- src/Web/View/Style.hs +378/−0
- src/Web/View/Types.hs +243/−0
- src/Web/View/View.hs +123/−0
- test/Tests.hs +4/−0
- web-view.cabal +114/−0
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for lucid-ui++## 0.1.0.0 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2023, Sean Hess++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Sean Hess nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,87 @@+Web View+============++Type-safe HTML and CSS with intuitive layout and composable styles. Inspired by Tailwindcss and Elm-UI++[][hackage]++### Write Haskell instead of CSS++Type-safe utility functions to style html++```haskell+myPage = col (gap 10) $ do+ el (bold . fontSize 32) "My page"+ button (border 1) "Click Me"+```++Re-use styles as Haskell functions instead of naming CSS classes.++```haskell+header = bold+h1 = header . fontSize 32+h2 = header . fontSize 24+page = gap 10++myPage = col page $ do+ el h1 "My Page"+ ...+```++This approach is inspired by Tailwindcss' [Utility Classes](https://tailwindcss.com/docs/utility-first)++### Intuitive Layouts++Easily create layouts with `row`, `col`, `grow`, and `space`++```haskell+holygrail :: View c ()+holygrail = layout id $ do+ row section "Top Bar"+ row grow $ do+ col section "Left Sidebar"+ col section "Main Content"+ col section "Right Sidebar"+ row section "Bottom Bar"+ where section = 'border' 1+```++### Embedded CSS++Views track which styles are used in any child node, and automatically embed all CSS when rendered. ++ >>> renderText $ el bold "Hello"+ + <style type='text/css'>.bold { font-weight:bold }</style>+ <div class='bold'>Hello</div>+++### Stateful Styles++We can apply styles when certain states apply. For example, to change the background on hover:++```haskell+button (bg Primary . hover (bg PrimaryLight)) "Hover Me"+```++Media states allow us to create responsive designs++```haskell+el (width 100 . media (MinWidth 800) (width 400))+ "Big if window > 800"+```+++Learn More+----------++View Documentation on [Hackage][hackage]+* https://hackage.haskell.org/package/web-view-0.2.0++View on Github+* https://github.com/seanhess/web-view++View [Examples](https://github.com/seanhess/web-view/blob/main/example/Main.hs)+++[hackage]: https://hackage.haskell.org/package/web-view-0.2.0
+ example/Main.hs view
@@ -0,0 +1,130 @@+{-# LANGUAGE QuasiQuotes #-}++module Main where++import Data.String.Interpolate (i)+import Data.Text as T (Text, filter, toLower)+import Network.HTTP.Types (status200, status404)+import Network.Wai+import Network.Wai.Handler.Warp as Warp+import Web.View+++main :: IO ()+main = do+ putStrLn "Starting on http://localhost:3010/"+ Warp.run 3010 app+++simple :: View c ()+simple = col (gap 10) $ do+ el (bold . fontSize 32) "My page"+ button (border 1) "Click Me"+++responsive :: View c ()+responsive = do+ layout (big flexRow) $ do+ nav (gap 10 . pad 20 . bg Primary . color White . small topbar . big sidebar) $ do+ el bold "SIDEBAR"+ el_ "One"+ el_ "Two"+ el_ "Three"++ col (scroll . grow . pad 20 . gap 20 . bg White) $ do+ el (bold . fontSize 24) "Make the window smaller"+ el_ "This demonstrates how to create a responsive design. Resize the window under 800px wide and the nav bar will switch to a top bar"++ col (color Gray . gap 20) $ do+ el_ "Sed ut perspiciatis unde omnis iste natus error sit voluptatem accusantium doloremque laudantium, totam rem aperiam, eaque ipsa quae ab illo inventore veritatis et quasi architecto beatae vitae dicta sunt explicabo. Nemo enim ipsam voluptatem quia voluptas sit aspernatur aut odit aut fugit, sed quia consequuntur magni dolores eos qui ratione voluptatem sequi nesciunt. Neque porro quisquam est, qui dolorem ipsum quia dolor sit amet, consectetur, adipisci velit, sed quia non numquam eius modi tempora incidunt ut labore et dolore magnam aliquam quaerat voluptatem. Ut enim ad minima veniam, quis nostrum exercitationem ullam corporis suscipit laboriosam, nisi ut aliquid ex ea commodi consequatur? Quis autem vel eum iure reprehenderit qui in ea voluptate velit esse quam nihil molestiae consequatur, vel illum qui dolorem eum fugiat quo voluptas nulla pariatur?"+ el_ "Sed ut perspiciatis unde omnis iste natus error sit voluptatem accusantium doloremque laudantium, totam rem aperiam, eaque ipsa quae ab illo inventore veritatis et quasi architecto beatae vitae dicta sunt explicabo. Nemo enim ipsam voluptatem quia voluptas sit aspernatur aut odit aut fugit, sed quia consequuntur magni dolores eos qui ratione voluptatem sequi nesciunt. Neque porro quisquam est, qui dolorem ipsum quia dolor sit amet, consectetur, adipisci velit, sed quia non numquam eius modi tempora incidunt ut labore et dolore magnam aliquam quaerat voluptatem. Ut enim ad minima veniam, quis nostrum exercitationem ullam corporis suscipit laboriosam, nisi ut aliquid ex ea commodi consequatur? Quis autem vel eum iure reprehenderit qui in ea voluptate velit esse quam nihil molestiae consequatur, vel illum qui dolorem eum fugiat quo voluptas nulla pariatur?"+ el_ "Sed ut perspiciatis unde omnis iste natus error sit voluptatem accusantium doloremque laudantium, totam rem aperiam, eaque ipsa quae ab illo inventore veritatis et quasi architecto beatae vitae dicta sunt explicabo. Nemo enim ipsam voluptatem quia voluptas sit aspernatur aut odit aut fugit, sed quia consequuntur magni dolores eos qui ratione voluptatem sequi nesciunt. Neque porro quisquam est, qui dolorem ipsum quia dolor sit amet, consectetur, adipisci velit, sed quia non numquam eius modi tempora incidunt ut labore et dolore magnam aliquam quaerat voluptatem. Ut enim ad minima veniam, quis nostrum exercitationem ullam corporis suscipit laboriosam, nisi ut aliquid ex ea commodi consequatur? Quis autem vel eum iure reprehenderit qui in ea voluptate velit esse quam nihil molestiae consequatur, vel illum qui dolorem eum fugiat quo voluptas nulla pariatur?"+ el_ "Sed ut perspiciatis unde omnis iste natus error sit voluptatem accusantium doloremque laudantium, totam rem aperiam, eaque ipsa quae ab illo inventore veritatis et quasi architecto beatae vitae dicta sunt explicabo. Nemo enim ipsam voluptatem quia voluptas sit aspernatur aut odit aut fugit, sed quia consequuntur magni dolores eos qui ratione voluptatem sequi nesciunt. Neque porro quisquam est, qui dolorem ipsum quia dolor sit amet, consectetur, adipisci velit, sed quia non numquam eius modi tempora incidunt ut labore et dolore magnam aliquam quaerat voluptatem. Ut enim ad minima veniam, quis nostrum exercitationem ullam corporis suscipit laboriosam, nisi ut aliquid ex ea commodi consequatur? Quis autem vel eum iure reprehenderit qui in ea voluptate velit esse quam nihil molestiae consequatur, vel illum qui dolorem eum fugiat quo voluptas nulla pariatur?"+ el_ "Sed ut perspiciatis unde omnis iste natus error sit voluptatem accusantium doloremque laudantium, totam rem aperiam, eaque ipsa quae ab illo inventore veritatis et quasi architecto beatae vitae dicta sunt explicabo. Nemo enim ipsam voluptatem quia voluptas sit aspernatur aut odit aut fugit, sed quia consequuntur magni dolores eos qui ratione voluptatem sequi nesciunt. Neque porro quisquam est, qui dolorem ipsum quia dolor sit amet, consectetur, adipisci velit, sed quia non numquam eius modi tempora incidunt ut labore et dolore magnam aliquam quaerat voluptatem. Ut enim ad minima veniam, quis nostrum exercitationem ullam corporis suscipit laboriosam, nisi ut aliquid ex ea commodi consequatur? Quis autem vel eum iure reprehenderit qui in ea voluptate velit esse quam nihil molestiae consequatur, vel illum qui dolorem eum fugiat quo voluptas nulla pariatur?"+ el_ "Sed ut erspiciatis unde omnis iste natus error sit voluptatem accusantium doloremque laudantium, totam rem aperiam, eaque ipsa quae ab illo inventore veritatis et quasi architecto beatae vitae dicta sunt explicabo. Nemo enim ipsam voluptatem quia voluptas sit aspernatur aut odit aut fugit, sed quia consequuntur magni dolores eos qui ratione voluptatem sequi nesciunt. Neque porro quisquam est, qui dolorem ipsum quia dolor sit amet, consectetur, adipisci velit, sed quia non numquam eius modi tempora incidunt ut labore et dolore magnam aliquam quaerat voluptatem. Ut enim ad minima veniam, quis nostrum exercitationem ullam corporis suscipit laboriosam, nisi ut aliquid ex ea commodi consequatur? Quis autem vel eum iure reprehenderit qui in ea voluptate velit esse quam nihil molestiae consequatur, vel illum qui dolorem eum fugiat quo voluptas nulla pariatur?"+ el_ "Sed ut perspiciatis unde omnis iste natus error sit voluptatem accusantium doloremque laudantium, totam rem aperiam, eaque ipsa quae ab illo inventore veritatis et quasi architecto beatae vitae dicta sunt explicabo. Nemo enim ipsam voluptatem quia voluptas sit aspernatur aut odit aut fugit, sed quia consequuntur magni dolores eos qui ratione voluptatem sequi nesciunt. Neque porro quisquam est, qui dolorem ipsum quia dolor sit amet, consectetur, adipisci velit, sed quia non numquam eius modi tempora incidunt ut labore et dolore magnam aliquam quaerat voluptatem. Ut enim ad minima veniam, quis nostrum exercitationem ullam corporis suscipit laboriosam, nisi ut aliquid ex ea commodi consequatur? Quis autem vel eum iure reprehenderit qui in ea voluptate velit esse quam nihil molestiae consequatur, vel illum qui dolorem eum fugiat quo voluptas nulla pariatur?"+ where+ sidebar = width 250 . flexCol+ topbar = height 100 . flexRow+ big = media (MinWidth 800)+ small = media (MaxWidth 800)+++holygrail :: View c ()+holygrail = layout id $ do+ row (bg Primary) "Top Bar"+ row grow $ do+ col (bg Secondary) "Left Sidebar"+ col grow $ do+ text "Content Upper Left"+ space+ row id $ do+ space+ text "Content Bottom Right"+ col (bg Secondary) "Right Sidebar"+ row (bg Primary) "Bottom Bar"+++examples :: View c ()+examples = col (pad 20 . gap 15) $ do+ el (bold . fontSize 24) "Layout"+ link "Responsive"+ link "Holy Grail"+ where+ link :: Text -> View c ()+ link n = tag "a" (att "href" (url n) . color Primary) (text n)+ url = toLower . T.filter (/= ' ')+++app :: Application+app req respond = do+ case pathInfo req of+ [] -> view examples+ ["simple"] -> view simple+ ["responsive"] -> view responsive+ ["holygrail"] -> view holygrail+ _ -> notFound+ where+ html h =+ respond $ responseLBS status200 [("Content-Type", "text/html; charset=utf-8")] h++ notFound =+ respond $ responseLBS status404 [("Content-Type", "text/plain; charset=utf-8")] "Not Found"++ view v =+ html $ document $ renderLazyByteString v++ document cnt =+ [i|<html>+ <head><style type="text/css">#{cssResetEmbed}</style></head>+ <body>#{cnt}</body>+ </html>|]+++data AppColor+ = White+ | Light+ | Gray+ | Dark+ | Success+ | Error+ | Warning+ | Primary+ | PrimaryLight+ | Secondary+ | SecondaryLight+ deriving (Show)+++instance ToColor AppColor where+ colorValue White = "#FFF"+ colorValue Light = "#F2F2F3"+ colorValue Gray = "#888"+ colorValue Dark = "#2E3842" -- "#232C41"+ colorValue Primary = "#2C74BB"+ colorValue PrimaryLight = "#3281cf"+ colorValue Success = "#D5E6DE"+ colorValue Error = "#F3D8DA"+ colorValue Warning = "#FDF3D1"+ colorValue Secondary = "#5CADDB"+ colorValue SecondaryLight = "#8CFDAB"
+ src/Web/View.hs view
@@ -0,0 +1,172 @@+{- |+Module: Web.View+Copyright: (c) 2023 Sean Hess+License: BSD3+Maintainer: Sean Hess <seanhess@gmail.com>+Stability: experimental+Portability: portable++Type-safe HTML and CSS with intuitive layout and composable styles. Inspired by Tailwindcss and Elm-UI+-}+module Web.View+ ( -- * How to use this library+ -- $use++ -- ** Rendering 'View's+ renderText+ , renderLazyText+ , renderLazyByteString++ -- ** Full HTML Documents+ -- $documents+ , module Web.View.Reset++ -- * Views+ , View++ -- ** Mods+ , Mod++ -- * Elements+ , el+ , el_++ -- ** Layout+ , layout+ , root+ , col+ , row+ , grow+ , space+ , collapse+ , scroll+ , nav++ -- ** Content+ , text+ , raw+ , none+ , pre++ -- ** Inputs+ , form+ , input+ , name+ , value+ , label+ , button++ -- ** Tables+ , table+ , tcol+ , th+ , td++ -- ** Document Metadata+ , script+ , style+ , stylesheet++ -- * CSS Modifiers+ , width+ , height+ , minWidth+ , minHeight+ , flexRow+ , flexCol+ , pad+ , gap+ , hide+ , shadow+ , rounded+ , fontSize+ , color+ , bg+ , bold+ , border+ , borderColor+ , pointer+ , transition+ , textAlign++ -- ** Selector States+ , hover+ , active+ , even+ , odd+ , media+ , parent++ -- * View Context+ , context+ , addContext++ -- * Creating New Elements and Modifiers+ , tag+ , att++ -- * Types+ , Sides (..)+ , Media (..)+ , PxRem+ , Url (..)+ , TransitionProperty (..)+ , Ms+ , ToColor (..)+ , HexColor (..)+ ) where++import Web.View.Element+import Web.View.Layout+import Web.View.Render+import Web.View.Reset+import Web.View.Style+import Web.View.Types+import Web.View.View+import Prelude hiding (even, head, odd)+++{- $use++Create styled `View's using composable Haskell functions++> myView :: View c ()+> 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>+-}+++{- $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+-}
+ src/Web/View/Element.hs view
@@ -0,0 +1,159 @@+{-# LANGUAGE DataKinds #-}++module Web.View.Element where++import Control.Monad (forM_)+import Data.Function ((&))+import Data.Text (Text)+import Effectful+import Effectful.Writer.Static.Local+import Web.View.Style+import Web.View.Types+import Web.View.View+++{- | A basic element++> el (bold . pad 10) "Hello"+-}+el :: Mod -> View c () -> View c ()+el = tag "div"+++{- | A basic element, with no modifiers++> el_ "Hello"+-}+el_ :: View c () -> View c ()+el_ = tag "div" id+++{- | Add text to a view. Not required for string literals++> el_ $ do+> "Hello: "+> text user.name+-}+text :: Text -> View c ()+text t = viewAddContent $ Text t+++{- | Embed static, unescaped HTML or SVG. Take care not to use 'raw' with user-generated content.++> spinner = raw "<svg>...</svg>"+-}+raw :: Text -> View c ()+raw t = viewAddContent $ Raw t+++{- | Do not show any content++> if isVisible+> then content+> else none+-}+none :: View c ()+none = pure ()+++pre :: Mod -> Text -> View c ()+pre f t = tag "pre" f (text t)+++-- * Inputs+++form :: Mod -> View c () -> View c ()+form f = tag "form" (f . flexCol)+++input :: Mod -> View c ()+input m = tag "input" (m . att "type" "text") none+++name :: Text -> Mod+name = att "name"+++value :: Text -> Mod+value = att "value"+++label :: Mod -> View c () -> View c ()+label = tag "label"+++button :: Mod -> View c () -> View c ()+button = tag "button"+++-- * Document Metadata+++script :: Text -> View c ()+script src = tag "script" (att "type" "text/javascript" . att "src" src) none+++style :: Text -> View c ()+style cnt = tag "style" (att "type" "text/css") (text $ "\n" <> cnt <> "\n")+++stylesheet :: Text -> View c ()+stylesheet href = tag "link" (att "rel" "stylesheet" . att "href" href) none+++-- * Tables+++{- | 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+-}+table :: Mod -> [dt] -> Eff '[Writer [TableColumn c dt]] () -> View c ()+table f dts wcs = do+ c <- context+ let cols = runPureEff . execWriter $ wcs+ tag "table" borderCollapse $ do+ tag "thead" id $ do+ tag "tr" f $ do+ forM_ cols $ \tc -> do+ addContext (TableHead c) tc.headCell+ tag "tbody" id $ do+ forM_ dts $ \dt -> do+ tag "tr" f $ do+ forM_ cols $ \tc -> do+ addContext dt $ tc.dataCell dt+ where+ borderCollapse :: Mod+ borderCollapse = addClass $ cls "brd-cl" & prop @Text "border-collapse" "collapse"+++tcol :: forall dt c. View (TableHead c) () -> (dt -> View dt ()) -> Eff '[Writer [TableColumn c dt]] ()+tcol hd view = do+ tell ([TableColumn hd view] :: [TableColumn c dt])+++th :: Mod -> View c () -> View (TableHead c) ()+th f cnt = do+ TableHead c <- context+ addContext c $ tag "th" f cnt+++td :: Mod -> View () () -> View dt ()+td f c = addContext () $ tag "td" f c+++newtype TableHead a = TableHead a+++data TableColumn c dt = TableColumn+ { headCell :: View (TableHead c) ()+ , dataCell :: dt -> View dt ()+ }
+ src/Web/View/Layout.hs view
@@ -0,0 +1,114 @@+module Web.View.Layout where++import Data.Function+import Data.Text+import Web.View.Element+import Web.View.Style+import Web.View.Types+import Web.View.View (View, tag)+++{- | 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 $ do+ 'row' section "Top Bar"+ 'row' 'grow' $ do+ 'col' section "Left Sidebar"+ 'col' section "Main Content"+ 'col' section "Right Sidebar"+ 'row' section "Bottom Bar"+ where section = 'border' 1+@+-}+layout :: Mod -> View c () -> View c ()+layout f = el (root . f)+++{- | As `layout` but as a 'Mod'++> holygrail = col root $ do+> ...+-}+root :: Mod+root =+ flexCol+ . addClass+ ( cls "layout"+ -- [ ("white-space", "pre")+ & prop @Text "width" "100vw"+ & prop @Text "height" "100vh"+ -- not sure if this property is necessary, copied from older code+ & prop @Text "min-height" "100vh"+ & prop @Text "z-index" "0"+ )+++{- | Lay out children in a column.++> col grow $ do+> el_ "Top"+> space+> el_ "Bottom"+-}+col :: Mod -> View c () -> View c ()+col f = el (flexCol . f)+++{- | Lay out children in a row++> row id $ do+> el_ "Left"+> space+> el_ "Right"+-}+row :: Mod -> View c () -> View c ()+row f = el (flexRow . f)+++{- | Grow to fill the available space in the parent 'Web.View.Layout.row' or 'Web.View.Layout.col'++> row id $ do+> el grow none+> el_ "Right"+-}+grow :: Mod+grow = addClass $ cls "grow" & prop @Int "flex-grow" 1+++{- | Space that fills the available space in the parent 'Web.View.Layout.row' or 'Web.View.Layout.col'.+++> row id $ do+> space+> el_ "Right"++This is equivalent to an empty element with 'grow'++> space = el grow none+-}+space :: View c ()+space = el grow none+++-- | Allow items to become smaller than their contents. This is not the opposite of grow!+collapse :: Mod+collapse = addClass $ cls "collapse" & prop @Int "min-width" 0+++{- | Make a fixed 'layout' by putting 'scroll' on a child-element++> document = row root $ do+> nav (width 300) "Sidebar"+> col (grow . scroll) "Main Content"+-}+scroll :: Mod+scroll = addClass $ cls "scroll" & prop @Text "overflow" "auto"+++-- | A Nav element+nav :: Mod -> View c () -> View c ()+nav f = tag "nav" (f . flexCol)
+ src/Web/View/Render.hs view
@@ -0,0 +1,196 @@+{-# LANGUAGE OverloadedLists #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}++module Web.View.Render where++import Data.ByteString.Lazy qualified as BL+import Data.Function ((&))+import Data.Map qualified as M+import Data.String.Interpolate (i)+import Data.Text (Text, intercalate, pack, toLower, unlines, unwords)+import Data.Text.Lazy qualified as L+import Data.Text.Lazy.Encoding qualified as LE+import Web.View.View (View, ViewState (..), runView, viewInsertContents)+import Prelude hiding (unlines, unwords)++-- import Debug.Trace+import Web.View.Types+++{- | 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>+-}+renderText :: View () () -> Text+renderText = renderText' ()+++renderLazyText :: View () () -> L.Text+renderLazyText = L.fromStrict . renderText+++renderLazyByteString :: View () () -> BL.ByteString+renderLazyByteString = LE.encodeUtf8 . renderLazyText+++{- | Render with the specified view context++> renderText' () $ el bold "Hello"+-}+renderText' :: c -> View c () -> Text+renderText' c u = intercalate "\n" content+ where+ -- T.intercalate "\n" (content <> style css)+ content :: [Text]+ content = map (unlines . renderContent) . (.contents) $ runView c addCss++ addCss = do+ viewInsertContents [styleElement]+ u++ css :: [Text]+ css = renderCSS $ (.css) $ runView c u++ styleElement :: Content+ styleElement =+ Node $ Element "style" [] [("type", "text/css")] [Text $ intercalate "\n" css]++ renderContent :: Content -> [Text]+ renderContent (Node t) = renderTag indent t+ renderContent (Text t) = [t]+ renderContent (Raw t) = [t]+++renderTag :: (Text -> Text) -> Element -> [Text]+renderTag ind tag =+ case tag.children of+ [] ->+ -- auto closing creates a bug in chrome. An auto-closed div+ -- absorbs the next children+ [open <> htmlAtts (flatAttributes tag) <> ">" <> close]+ -- single text node+ [Text t] ->+ -- SINGLE text node, just display it indented+ [open <> htmlAtts (flatAttributes tag) <> ">" <> t <> close]+ _ ->+ mconcat+ [ [open <> htmlAtts (flatAttributes tag) <> ">"]+ , ind <$> htmlChildren tag.children+ , [close]+ ]+ where+ open = "<" <> tag.name+ close = "</" <> tag.name <> ">"++ htmlContent :: Content -> [Text]+ htmlContent (Node t) = renderTag ind t+ htmlContent (Text t) = [t]+ htmlContent (Raw t) = [t]++ htmlChildren :: [Content] -> [Text]+ htmlChildren cts =+ mconcat+ $ fmap htmlContent cts++ htmlAtts :: FlatAttributes -> Text+ htmlAtts (FlatAttributes []) = ""+ htmlAtts (FlatAttributes as) =+ " "+ <> unwords (map htmlAtt $ M.toList as)+ where+ htmlAtt (k, v) =+ k <> "=" <> "'" <> v <> "'"+++renderCSS :: CSS -> [Text]+renderCSS = map renderClass . M.elems+ where+ renderClass :: Class -> Text+ renderClass c =+ let sel = selectorText c.selector+ props = intercalate "; " (map renderProp $ M.toList c.properties)+ in [i|#{sel} { #{props} }|] & addMedia c.selector.media++ addMedia Nothing css = css+ addMedia (Just m) css =+ let mc = mediaCriteria m+ in [i|@media #{mc} { #{css} }|]++ mediaCriteria :: Media -> Text+ mediaCriteria (MinWidth n) = [i|(min-width: #{n}px)|]+ mediaCriteria (MaxWidth n) = [i|(max-width: #{n}px)|]++ renderProp :: (Text, StyleValue) -> Text+ renderProp (p, cv) = p <> ":" <> renderStyle cv++ renderStyle :: StyleValue -> Text+ renderStyle (StyleValue v) = pack v+++indent :: Text -> Text+indent t = " " <> t+++-- | The css selector for this style+selectorText :: Selector -> Text+selectorText s =+ parent s.parent <> "." <> addPseudo s.pseudo (classNameElementText s.media s.parent Nothing s.className)+ where+ parent Nothing = ""+ parent (Just p) = "." <> p <> " "++ addPseudo Nothing c = c+ addPseudo (Just p) c =+ pseudoText p <> "\\:" <> c <> ":" <> pseudoSuffix p++ pseudoSuffix :: Pseudo -> Text+ pseudoSuffix Even = "nth-child(even)"+ pseudoSuffix Odd = "nth-child(odd)"+ pseudoSuffix p = pseudoText p+++-- | The class name as it appears in the element+classNameElementText :: Maybe Media -> Maybe Text -> Maybe Pseudo -> ClassName -> Text+classNameElementText mm mp mps c =+ addMedia mm . addPseudo mps . addParent mp $ c.text+ where+ addParent Nothing cn = cn+ addParent (Just p) cn = p <> "-" <> cn++ addPseudo :: Maybe Pseudo -> Text -> Text+ addPseudo Nothing cn = cn+ addPseudo (Just p) cn =+ pseudoText p <> ":" <> cn++ addMedia :: Maybe Media -> Text -> Text+ addMedia Nothing cn = cn+ addMedia (Just (MinWidth n)) cn =+ [i|mmnw#{n}-#{cn}|]+ addMedia (Just (MaxWidth n)) cn =+ [i|mmxw#{n}-#{cn}|]+++pseudoText :: Pseudo -> Text+pseudoText p = toLower $ pack $ show p+++-- | The 'Web.View.Types.Attributes' for an element, inclusive of class.+flatAttributes :: Element -> FlatAttributes+flatAttributes t =+ FlatAttributes+ $ addClass (mconcat t.classes) t.attributes+ where+ addClass [] atts = atts+ addClass cx atts = M.insert "class" (classAttValue cx) atts++ classAttValue :: [Class] -> Text+ classAttValue cx =+ unwords $ fmap (\c -> classNameElementText c.selector.media c.selector.parent c.selector.pseudo c.selector.className) cx++-- showView :: c -> View c () -> Text+-- showView c v =+-- let st = runView c v+-- in unlines $ mconcat $ map renderContent st.contents
+ src/Web/View/Reset.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE TemplateHaskell #-}++module Web.View.Reset where++import Data.ByteString+import Data.FileEmbed+import Data.Text+++{- | Default CSS to clear unintuitive default styles. This or 'cssResetLink' is required.++> import Data.String.Interpolate (i)+>+> toDocument :: Text -> Text+> toDocument cnt =+> [i|<html>+> <head>+> <style type="text/css">#{cssResetEmbed}</style>+> </head>+> <body>#{cnt}</body>+> </html>|]+-}+cssResetEmbed :: ByteString+cssResetEmbed = $(embedFile "embed/preflight.css")+++{- | Alternatively, the reset is available as on a CDN++> import Data.String.Interpolate (i)+>+> toDocument :: Text -> Text+> toDocument cnt =+> [i|<html>+> <head>+> <link rel="stylesheet" href="#{cssResetEmbed}">+> </head>+> <body>#{cnt}</body>+> </html>|]+-}+cssResetLink :: Text+cssResetLink = "<link rel=\"stylesheet\" href=\"https://unpkg.com/tailwindcss@3.3.3/src/css/preflight.css\"/>"
+ src/Web/View/Style.hs view
@@ -0,0 +1,378 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedLists #-}++module Web.View.Style where++import Data.Function ((&))+import Data.Map qualified as M+import Data.Text (Text)+import Web.View.Types+++-- * Styles+++-- | Set to a specific width+width :: PxRem -> Mod+width n =+ addClass+ $ cls ("w" -. n)+ & prop "width" n+ & prop @Int "flex-shrink" 0+++-- | Set to a specific height+height :: PxRem -> Mod+height n =+ addClass+ $ cls ("h" -. n)+ & prop "height" n+ & prop @Int "flex-shrink" 0+++-- | Allow width to grow to contents but not shrink any smaller than value+minWidth :: PxRem -> Mod+minWidth n =+ addClass+ $ cls ("mw" -. n)+ & prop "min-width" n+++-- | Allow height to grow to contents but not shrink any smaller than value+minHeight :: PxRem -> Mod+minHeight n =+ addClass+ $ cls ("mh" -. n)+ & prop "min-height" n+++{- | 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"+-}+pad :: Sides PxRem -> Mod+pad (All n) =+ addClass+ $ cls ("pad" -. n)+ & prop "padding" n+pad (Y n) =+ addClass+ $ cls ("pady" -. n)+ & prop "padding-top" n+ & prop "padding-bottom" n+pad (X n) =+ addClass+ $ cls ("padx" -. n)+ & prop "padding-left" n+ & prop "padding-right" n+pad (XY x y) =+ addClass+ $ cls ("pad" -. x -. y)+ & prop "padding-left" x+ & prop "padding-right" x+ & prop "padding-top" y+ & prop "padding-bottom" y+pad (TRBL t r b l) =+ addClass+ $ cls ("pad" -. t -. r -. b -. l)+ & prop "padding-top" t+ & prop "padding-right" r+ & prop "padding-bottom" b+ & prop "padding-left" l+++-- | The space between child elements. See 'pad'+gap :: PxRem -> Mod+gap n = addClass $ cls ("gap" -. n) & prop "gap" n+++fontSize :: PxRem -> Mod+fontSize n = addClass $ cls ("fs" -. n) & prop "font-size" n+++-- fontFamily :: Text -> Mod+-- fontFamily t = cls1 $ Class ("font" -. n) [("font-family", pxRem n)]++-- | Set container to be a row. Favor 'Web.View.Layout.row' when possible+flexRow :: Mod+flexRow =+ addClass+ $ cls "row"+ & prop @Text "display" "flex"+ & prop @Text "flex-direction" "row"+++-- | Set container to be a column. Favor 'Web.View.Layout.col' when possible+flexCol :: Mod+flexCol =+ addClass+ $ cls "col"+ & prop @Text "display" "flex"+ & prop @Text "flex-direction" "column"+++-- | Adds a basic drop shadow to an element+shadow :: Mod+shadow =+ addClass+ $ cls "shadow"+ & prop @Text "box-shadow" "0 1px 3px 0 rgb(0 0 0 / 0.1), 0 1px 2px -1px rgb(0 0 0 / 0.1)"+++-- | Round the corners of the element+rounded :: PxRem -> Mod+rounded n = addClass $ cls ("rnd" -. n) & prop "border-radius" n+++-- | Set the background color. See 'Web.View.Types.ToColor'+bg :: (ToColor c) => c -> Mod+bg c =+ addClass+ $ cls ("bg" -. colorName c)+ & prop "background-color" (colorValue c)+++-- | Set the text color. See 'Web.View.Types.ToColor'+color :: (ToColor c) => c -> Mod+color c = addClass $ cls ("clr" -. colorName c) & prop "color" (colorValue c)+++bold :: Mod+bold = addClass $ cls "bold" & prop @Text "font-weight" "bold"+++-- | Hide an element. See 'parent' and 'media'+hide :: Mod+hide =+ addClass+ $ cls "hide"+ & prop @Text "display" "none"+++{- | Set a border around the element++> el (border 1) "all sides"+> el (border (X 1)) "only left and right"+-}+border :: Sides PxRem -> Mod+border (All p) =+ addClass+ $ cls ("brd" -. p)+ & prop "border" p+ & prop @Text "border-style" "solid"+border (Y p) =+ addClass+ $ cls ("brdy" -. p)+ & prop "border-top-width" p+ & prop "border-bottom-width" p+border (X p) =+ addClass+ $ cls ("brdx" -. p)+ & prop "border-left-width" p+ & prop "border-right-width" p+border (XY x y) =+ addClass+ $ cls ("brd" -. x -. y)+ & prop "border-right-width" x+ & prop "border-left-width" x+ & prop "border-top-width" y+ & prop "border-bottom-width" y+border (TRBL t r b l) =+ addClass+ $ cls ("brd" -. t -. r -. b -. l)+ & prop "border-top-width" t+ & prop "border-right-width" r+ & prop "border-bottom-width" b+ & prop "border-left-width" l+++-- | Set a border color. See 'Web.View.Types.ToColor'+borderColor :: (ToColor c) => c -> Mod+borderColor c =+ addClass+ $ cls ("brdc" -. colorName c)+ & prop "border-color" (colorValue c)+++{- | 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"+-}+pointer :: Mod+pointer = addClass $ cls "pointer" & prop @Text "cursor" "pointer"+++-- | Cut off the contents of the element+truncate :: Mod+truncate =+ addClass+ $ cls "truncate"+ & prop @Text "white-space" "nowrap"+ & prop @Text "overflow" "hidden"+ & prop @Text "text-overflow" "ellipsis"+++{- | Animate changes to the given property++> el (transition 100 (Height 400)) "Tall"+> el (transition 100 (Height 100)) "Small"+-}+transition :: Ms -> TransitionProperty -> Mod+transition ms = \case+ (Height n) -> trans "height" n+ (Width n) -> trans "width" n+ where+ trans p px =+ addClass+ $ cls ("t" -. px -. p -. ms)+ & prop "transition-duration" ms+ & prop "transition-property" p+ & prop p px+++-- You MUST set the height/width manually when you attempt to transition it+data TransitionProperty+ = Width PxRem+ | Height PxRem+ deriving (Show)+++textAlign :: Align -> Mod+textAlign a =+ addClass+ $ cls ("ta" -. a)+ & prop "text-align" a+++data Align+ = Center+ deriving (Show, ToClassName, ToStyleValue)+++-- * Selector Modifiers+++{- | Apply when hovering over an element++> el (bg Primary . hover (bg PrimaryLight)) "Hover"+-}+hover :: Mod -> Mod+hover = applyPseudo Hover+++-- | Apply when the mouse is pressed down on an element+active :: Mod -> Mod+active = applyPseudo Active+++-- | Apply to even-numbered children+even :: Mod -> Mod+even = applyPseudo Even+++-- | Apply to odd-numbered children+odd :: Mod -> Mod+odd = applyPseudo Odd+++{- | 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 :: Media -> Mod -> Mod+media m = mapModClass $ \c ->+ c+ { selector = addMedia c.selector+ }+ where+ addMedia :: Selector -> Selector+ addMedia (Selector pr ps _ cn) = Selector pr ps (Just m) cn+++{- | 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"+-}+parent :: Text -> Mod -> Mod+parent p = mapModClass $ \c ->+ c+ { selector = addParent c.selector+ }+ where+ addParent :: Selector -> Selector+ addParent (Selector _ ps m c) = Selector (Just p) ps m c+++-- Add a pseudo-class like Hover to your style+applyPseudo :: Pseudo -> Mod -> Mod+applyPseudo ps = mapModClass $ \c ->+ c+ { selector = addToSelector c.selector+ }+ where+ addToSelector :: Selector -> Selector+ addToSelector (Selector pr _ m cn) = Selector pr (Just ps) m cn+++mapModClass :: (Class -> Class) -> Mod -> Mod+mapModClass fc fm el =+ -- apply the function to all classes added by the mod+ -- ignore+ let el' = fm $ Element "none" [] [] []+ in el+ { classes = el.classes <> (map fc <$> el'.classes)+ , attributes = el.attributes <> el'.attributes+ , children = el.children <> el'.children+ }+++-- * Creating New Styles+++{- | Add a single class++> width :: PxRem -> Mod+> width n =+> addClass+> $ cls ("w" -. n)+> & prop "width" n+> & prop @Int "flex-shrink" 0+-}+addClass :: Class -> Mod+addClass c t = t{classes = [c] : t.classes}+++-- | Construct a class from a ClassName+cls :: ClassName -> Class+cls n = Class (selector n) []+++-- | Add a property to a class+prop :: (ToStyleValue val) => Name -> val -> Class -> Class+prop n v c =+ c{properties = M.insert n (toStyleValue v) c.properties}+++-- | Hyphneate classnames+(-.) :: (ToClassName a) => ClassName -> a -> ClassName+(ClassName n) -. a = ClassName $ n <> "-" <> toClassName a+++infixl 6 -.
+ src/Web/View/Types.hs view
@@ -0,0 +1,243 @@+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE DerivingStrategies #-}++module Web.View.Types where++import Data.Map (Map)+import Data.String (IsString (..))+import Data.Text (Text, pack, unpack)+import Data.Text qualified as T+import GHC.Generics (Generic)+import Text.Casing (kebab)+++data Content+ = Node Element+ | Text Text+ | -- | Raw embedded HTML or SVG. See 'Web.View.Element.raw'+ Raw Text+++-- | A single HTML tag. Note that the class attribute is stored separately from the rest of the attributes to make adding styles easier+data Element = Element+ { name :: Name+ , classes :: [[Class]]+ , attributes :: Attributes+ , children :: [Content]+ }+++type Attributes = Map Name AttValue+type Attribute = (Name, AttValue)+type Name = Text+type AttValue = Text+++-- * Element Modifiers+++{- | 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+-}+type Mod = Element -> Element+++-- * Atomic CSS+++-- TODO: document atomic CSS here?++-- | All the atomic classes used in a 'Web.View.View'+type CSS = Map Selector Class+++-- | Atomic classes include a selector and the corresponding styles+data Class = Class+ { selector :: Selector+ , properties :: Styles+ }+++-- | The styles to apply for a given atomic 'Class'+type Styles = Map Name StyleValue+++-- | The selector to use for the given atomic 'Class'+data Selector = Selector+ { parent :: Maybe Text+ , pseudo :: Maybe Pseudo+ , media :: Maybe Media+ , className :: ClassName+ }+ deriving (Eq, Ord)+++instance IsString Selector where+ fromString s = Selector Nothing Nothing Nothing (fromString s)+++-- | Create a 'Selector' given only a 'ClassName'+selector :: ClassName -> Selector+selector = Selector Nothing Nothing Nothing+++-- | A class name+newtype ClassName = ClassName+ { text :: Text+ }+ deriving newtype (Eq, Ord, IsString)+++-- | Convert a type into a className segment to generate unique compound style names based on the value+class ToClassName a where+ toClassName :: a -> Text+ default toClassName :: (Show a) => a -> Text+ toClassName = T.toLower . T.pack . show+++instance ToClassName Int+instance ToClassName Float+instance ToClassName Text where+ toClassName = id+++{- | Psuedos allow for specifying styles that only apply in certain conditions. See `Web.View.Style.hover` etc++> el (color Primary . hover (color White)) "hello"+-}+data Pseudo+ = Hover+ | Active+ | Even+ | Odd+ deriving (Show, Eq, Ord)+++-- | The value of a css style property+newtype StyleValue = StyleValue String+ deriving newtype (IsString, Show)+++-- | Use a type as a css style property value+class ToStyleValue a where+ toStyleValue :: a -> StyleValue+ default toStyleValue :: (Show a) => a -> StyleValue+ toStyleValue = StyleValue . kebab . show+++instance ToStyleValue String where+ toStyleValue = StyleValue+++instance ToStyleValue Text where+ toStyleValue = StyleValue . unpack+++instance ToStyleValue Int+++-- | 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+newtype PxRem = PxRem Int+ deriving newtype (Show, ToClassName, Num)+++instance ToStyleValue PxRem where+ toStyleValue (PxRem 0) = "0px"+ toStyleValue (PxRem 1) = "1px"+ toStyleValue (PxRem n) = StyleValue $ show ((fromIntegral n :: Float) / 16.0) <> "rem"+++-- | Milliseconds, used for transitions+newtype Ms = Ms Int+ deriving (Show)+ deriving newtype (Num, ToClassName)+++instance ToStyleValue Ms where+ toStyleValue (Ms n) = StyleValue $ show n <> "ms"+++-- | Media allows for responsive designs that change based on characteristics of the window. See [Layout Example](https://github.com/seanhess/web-view/blob/master/example/Example/Layout.hs)+data Media+ = MinWidth Int+ | MaxWidth Int+ deriving (Eq, Ord)+++{- | 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)+-}+data Sides a+ = All a+ | TRBL a a a a+ | X a+ | Y a+ | XY a a+++-- Num instance is just to support literals+instance (Num a) => Num (Sides a) where+ a + _ = a+ a * _ = a+ abs a = a+ negate a = a+ signum a = a+ fromInteger n = All (fromInteger n)+++-- | Element's attributes do not include class, which is separated. FlatAttributes generate the class attribute and include it+newtype FlatAttributes = FlatAttributes {attributes :: Attributes}+ deriving (Generic)+++newtype Url = Url Text+ deriving newtype (IsString)+++-- ** Colors+++{- | 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"+-}+class ToColor a where+ colorValue :: a -> HexColor+ colorName :: a -> Text+ default colorName :: (Show a) => a -> Text+ colorName = T.toLower . pack . show+++instance ToColor HexColor where+ colorValue c = c+ colorName (HexColor a) = T.dropWhile (== '#') a+++-- | Hexidecimal Color. Can be specified with or without the leading '#'. Recommended to use an AppColor type instead of manually using hex colors. See 'Web.View.Types.ToColor'+newtype HexColor = HexColor Text+++instance ToStyleValue HexColor where+ toStyleValue (HexColor s) = StyleValue $ "#" <> unpack (T.dropWhile (== '#') s)+++instance IsString HexColor where+ fromString = HexColor . T.dropWhile (== '#') . T.pack
+ src/Web/View/View.hs view
@@ -0,0 +1,123 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE OverloadedLists #-}++module Web.View.View where++import Data.Map qualified as M+import Data.String (IsString (..))+import Data.Text (Text, pack)+import Effectful+import Effectful.Reader.Static+import Effectful.State.Static.Local as ES+import Web.View.Types+++-- * 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 'Web.View.Element.table' for an example+-}+newtype View context a = View {viewState :: Eff [Reader context, State ViewState] a}+ deriving newtype (Functor, Applicative, Monad)+++instance IsString (View context ()) where+ fromString s = viewModContents (const [Text (pack s)])+++data ViewState = ViewState+ { contents :: [Content]+ , css :: CSS+ }+++instance Semigroup ViewState where+ va <> vb = ViewState (va.contents <> vb.contents) (va.css <> vb.css)+++-- | Extract the 'ViewState' from a 'View'+runView :: context -> View context () -> ViewState+runView ctx (View ef) =+ runPureEff . execState (ViewState [] []) . runReader ctx $ ef+++-- | Get the current context+context :: View context context+context = View ask+++-- | Run a view with a specific `context` in a parent 'View' with a different context. This can be used to create type safe view functions, like 'Web.View.Element.table'+addContext :: context -> View context () -> View c ()+addContext ctx vw = do+ -- runs the sub-view in a different context, saving its state+ -- we need to MERGE it+ let st = runView ctx vw+ View $ ES.modify $ \s -> s <> st+++viewModContents :: ([Content] -> [Content]) -> View context ()+viewModContents f = View $ do+ ES.modify $ \s -> s{contents = f s.contents}+++viewModCss :: (CSS -> CSS) -> View context ()+viewModCss f = View $ do+ ES.modify $ \s -> s{css = f s.css}+++viewAddClasses :: [Class] -> View c ()+viewAddClasses clss = do+ viewModCss $ \cm -> foldr addClsDef cm clss+ where+ addClsDef :: Class -> CSS -> CSS+ addClsDef c = M.insert c.selector c+++viewAddContent :: Content -> View c ()+viewAddContent ct =+ viewModContents (<> [ct])+++-- | Inserts contents into the first child element+viewInsertContents :: [Content] -> View c ()+viewInsertContents cs = viewModContents insert+ where+ insert [Node e] = [Node $ insertEl e]+ insert cnt = cnt <> cs+ insertEl e = e{children = e.children <> cs}+++-- * Creating new Elements+++{- | Create a new element constructor++> aside :: Mod -> View c () -> View c ()+> aside = tag "aside"+-}+tag :: Text -> Mod -> View c () -> View c ()+tag nm f ct = do+ -- Applies the modifier and merges children into parent+ ctx <- context+ let st = runView ctx ct+ let elm = f $ Element nm [] [] st.contents+ viewAddContent $ Node elm+ viewAddClasses $ M.elems st.css+ viewAddClasses $ mconcat elm.classes+++{- | Set an attribute, replacing existing value++> hlink :: Text -> View c () -> View c ()+> hlink url content = tag "a" (att "href" url) content+-}+att :: Name -> AttValue -> Mod+att n v (Element en ec ea ecs) = Element en ec (M.insert n v ea) ecs
+ test/Tests.hs view
@@ -0,0 +1,4 @@+module Main (main) where++main :: IO ()+main = putStrLn "Test suite not yet implemented."
+ web-view.cabal view
@@ -0,0 +1,114 @@+cabal-version: 2.2++-- This file has been generated from package.yaml by hpack version 0.35.3.+--+-- see: https://github.com/sol/hpack++name: web-view+version: 0.2.0+synopsis: Type-safe HTML and CSS with intuitive layouts and composable styles.+description: Type-safe HTML and CSS with intuitive layouts and composable styles. Inspired by Tailwindcss and Elm-UI . See documentation for the @Web.View@ module below+category: Web+homepage: https://github.com/seanhess/web-view+bug-reports: https://github.com/seanhess/web-view/issues+author: Sean Hess+maintainer: seanhess@gmail.com+license: BSD-3-Clause+license-file: LICENSE+build-type: Simple+extra-doc-files:+ README.md+ CHANGELOG.md++source-repository head+ type: git+ location: https://github.com/seanhess/web-view++library+ exposed-modules:+ Web.View+ Web.View.Element+ Web.View.Layout+ Web.View.Render+ Web.View.Reset+ Web.View.Style+ Web.View.Types+ Web.View.View+ other-modules:+ Paths_web_view+ autogen-modules:+ Paths_web_view+ hs-source-dirs:+ src+ default-extensions:+ OverloadedStrings+ OverloadedRecordDot+ DuplicateRecordFields+ NoFieldSelectors+ ghc-options: -Wall -fdefer-typed-holes+ build-depends:+ base >=4.16 && <5+ , bytestring >=0.11 && <0.13+ , casing >0.1.3.0 && <0.2+ , containers >=0.6 && <1+ , effectful ==2.3.*+ , file-embed >=0.0.10 && <0.1+ , string-interpolate >=0.3.2 && <0.4+ , text >=1.2 && <3+ default-language: GHC2021++executable example+ main-is: Main.hs+ other-modules:+ Paths_web_view+ autogen-modules:+ Paths_web_view+ hs-source-dirs:+ example+ default-extensions:+ OverloadedStrings+ OverloadedRecordDot+ DuplicateRecordFields+ NoFieldSelectors+ ghc-options: -Wall -fdefer-typed-holes+ build-depends:+ base >=4.16 && <5+ , bytestring >=0.11 && <0.13+ , casing >0.1.3.0 && <0.2+ , containers >=0.6 && <1+ , effectful ==2.3.*+ , file-embed >=0.0.10 && <0.1+ , http-api-data ==0.6.*+ , http-types >=0.12.3 && <0.13+ , string-interpolate >=0.3.2 && <0.4+ , text >=1.2 && <3+ , wai >=3.2.3 && <3.3+ , warp >=3.3.30 && <3.4+ , web-view+ default-language: GHC2021++test-suite tests+ type: exitcode-stdio-1.0+ main-is: Tests.hs+ other-modules:+ Paths_web_view+ autogen-modules:+ Paths_web_view+ hs-source-dirs:+ test+ default-extensions:+ OverloadedStrings+ OverloadedRecordDot+ DuplicateRecordFields+ NoFieldSelectors+ ghc-options: -Wall -fdefer-typed-holes+ build-depends:+ base >=4.16 && <5+ , bytestring >=0.11 && <0.13+ , casing >0.1.3.0 && <0.2+ , containers >=0.6 && <1+ , effectful ==2.3.*+ , file-embed >=0.0.10 && <0.1+ , string-interpolate >=0.3.2 && <0.4+ , text >=1.2 && <3+ default-language: GHC2021