Skip to content

Commit

Permalink
0.6.2 position, stack, ListItem, Layer
Browse files Browse the repository at this point in the history
  • Loading branch information
seanhess committed Dec 24, 2024
1 parent 110c758 commit bcb83eb
Show file tree
Hide file tree
Showing 12 changed files with 238 additions and 115 deletions.
1 change: 1 addition & 0 deletions bin/dev
Original file line number Diff line number Diff line change
Expand Up @@ -22,4 +22,5 @@ watchexec -e hs,yaml cabal test &

# Autoreload on save. Show errors and warnings
# run even if warnings
cd example
ghcid --command "cabal repl example" -T Main.main -W
39 changes: 35 additions & 4 deletions example/app/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -85,14 +85,46 @@ stacks = layout id $ do
col (pad 10 . gap 10) $ do
el_ "Stacks put contents on top of each other"
stack (border 1) $ do
row (bg Light) $ el (pad 10) "In the background"
row (pad 10) $ do
layer $ el (bg Light . pad 10) "In the background"
layer $ row (pad 10) $ do
space
el (bg SecondaryLight . grow . pad 5) "Above"
row (pad (XY 15 5)) $ do
layer $ row (pad (XY 15 5)) $ do
space
el (bg Primary . pad 10 . color White) "Max Above!"

el_ "We can collapse items in a stack so they don't affect the width"
stack (bg Light . pad 10) $ do
layer $ el_ "WOOT"
popout (offset (R 0) . offset (B 0)) $ col (pad 10 . bg SecondaryLight) $ do
el_ "One"
el_ "Two"
el_ "Three"
el_ "Four"

el_ "Example Popup Search"
stack (border 1) $ do
layer $ row (bg Light . pad 10) "This is a search bar"
popout (offset (TRBL 43 5 5 5) . border 1) $ do
col (bg SecondaryLight . pad (L 50) . pad (R 50)) $ do
el (hover (bg White) . pointer) "I am a popup"
el_ "I am a popup"
el_ "I am a popup"
el_ "I am a popup"

col (gap 10) $ do
el_ "Content asldkjfalsdk jjklasd flkajsd flkjasd lfkjalskdfj alsdkjf "
el_ "Content asldkjfalsdk jjklasd flkajsd flkjasd lfkjalskdfj alsdkjf "
el_ "Content asldkjfalsdk jjklasd flkajsd flkjasd lfkjalskdfj alsdkjf "
el_ "Content asldkjfalsdk jjklasd flkajsd flkjasd lfkjalskdfj alsdkjf "
el_ "Content asldkjfalsdk jjklasd flkajsd flkjasd lfkjalskdfj alsdkjf "
el_ "Content asldkjfalsdk jjklasd flkajsd flkjasd lfkjalskdfj alsdkjf "
el_ "Content asldkjfalsdk jjklasd flkajsd flkjasd lfkjalskdfj alsdkjf "
el_ "Content asldkjfalsdk jjklasd flkajsd flkjasd lfkjalskdfj alsdkjf "
el_ "Content asldkjfalsdk jjklasd flkajsd flkjasd lfkjalskdfj alsdkjf "

col (border 1 . position Absolute . offset (R 0) . offset (T 0)) "I AM AN ELEMENT"


tests :: View c ()
tests = col (gap 10 . pad 20) $ do
Expand All @@ -112,7 +144,6 @@ tests = col (gap 10 . pad 20) $ do
li nums "first"
li nums "second"
li nums "third"
col id "HELLO"

ul id $ do
li (list Disc) "first"
Expand Down
2 changes: 1 addition & 1 deletion package.yaml
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@
name: web-view
version: 0.6.1
version: 0.6.2
synopsis: Type-safe HTML and CSS with intuitive layouts and composable styles.
homepage: https://github.com/seanhess/web-view
github: seanhess/web-view
Expand Down
39 changes: 24 additions & 15 deletions src/Web/View.hs
Original file line number Diff line number Diff line change
Expand Up @@ -36,12 +36,18 @@ module Web.View
, root
, col
, row
, stack
, grow
, space
, collapse
, scroll
, nav
, stack
, Layer
, layer
, popout
, scroll
, grow
, flexRow
, flexCol
, hide
, truncate

-- ** Content
, text
Expand Down Expand Up @@ -82,15 +88,12 @@ module Web.View
, height
, minWidth
, minHeight
, flexRow
, flexCol
, display
, pad
, gap
, hide
, opacity
, truncate
, shadow
, Shadow
, Inner (..)
, rounded
, fontSize
, color
Expand All @@ -101,16 +104,27 @@ module Web.View
, border
, borderColor
, pointer
, transition
, position
, Position (..)
, offset
, zIndex
, textAlign
, Align (..)
, list
, ListType (..)
, display
, Display (..)
, transition
, TransitionProperty (..)
, Ms

-- ** Selector States
, hover
, active
, even
, odd
, media
, Media (..)
, parent

-- * View Context
Expand All @@ -123,15 +137,10 @@ module Web.View

-- * Types
, Sides (..)
, Media (..)
, PxRem
, Length (..)
, TransitionProperty (..)
, Ms
, ToColor (..)
, HexColor (..)
, Align (..)
, ListType (..)
, None (..)

-- * Url
Expand Down
22 changes: 14 additions & 8 deletions src/Web/View/Element.hs
Original file line number Diff line number Diff line change
@@ -1,4 +1,6 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Web.View.Element where

Expand Down Expand Up @@ -74,7 +76,7 @@ link u f = tag "a" (att "href" (renderUrl u) . f)


form :: Mod c -> View c () -> View c ()
form f = tag "form" (f . flexCol)
form = tag "form"


input :: Mod c -> View c ()
Expand Down Expand Up @@ -172,7 +174,8 @@ data TableColumn c dt = TableColumn
-- * Lists


data ListItem c = ListItem
newtype ListItem c a = ListItem (View c a)
deriving newtype (Functor, Applicative, Monad)


{- | List elements do not include any inherent styling but are useful for accessibility. See 'Web.View.Style.list'.
Expand All @@ -183,13 +186,16 @@ data ListItem c = ListItem
> li nums "two"
> li nums "three"
-}
ol :: Mod c -> View (ListItem c) () -> View c ()
ol f cnt = tag "ol" f $ addContext ListItem cnt
ol :: Mod c -> ListItem c () -> View c ()
ol f (ListItem cnt) = do
tag "ol" f cnt


ul :: Mod c -> View (ListItem c) () -> View c ()
ul f cnt = tag "ul" f $ addContext ListItem cnt
ul :: Mod c -> ListItem c () -> View c ()
ul f (ListItem cnt) = do
tag "ul" f cnt


li :: Mod (ListItem c) -> View (ListItem c) () -> View (ListItem c) ()
li = tag "li"
li :: Mod c -> View c () -> ListItem c ()
li f cnt = ListItem $ do
tag "li" f cnt
77 changes: 67 additions & 10 deletions src/Web/View/Layout.hs
Original file line number Diff line number Diff line change
@@ -1,3 +1,6 @@
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Web.View.Layout where

import Data.Function
Expand Down Expand Up @@ -94,11 +97,6 @@ space :: View c ()
space = el grow none


-- | Allow items to become smaller than their contents. This is not the opposite of `grow`!
collapse :: Mod c
collapse = addClass $ cls "collapse" & prop @Int "min-width" 0


{- | Make a fixed 'layout' by putting 'scroll' on a child-element
> document = row root $ do
Expand All @@ -114,24 +112,83 @@ nav :: Mod c -> View c () -> View c ()
nav f = tag "nav" (f . flexCol)


{- | Stack children on top of each other. Each child has the full width
{- | Stack children on top of each other. Each child has the full width. See 'popout'
> stack id $ do
> row id "Background"
> row (bg Black . opacity 0.5) "Overlay"
-}
stack :: Mod c -> View c () -> View c ()
stack f =
tag "div" (f . container . absChildren)
stack :: Mod c -> Layer c () -> View c ()
stack f (Layer children) = do
tag "div" (f . container . absChildren) children
where
container =
addClass $
cls "stack"
& prop @Text "position" "relative"
& prop @Text "display" "grid"
& prop @Text "overflow" "visible"
absChildren =
addClass $
Class absSelector mempty
& prop @Text "position" "relative"
& prop @Text "grid-area" "1 / 1"
& prop @Text "min-height" "fit-content"
absSelector = (selector "abs-childs"){child = Just AllChildren}


-- | A popout does not
newtype Layer c a = Layer (View c a)
deriving newtype (Functor, Applicative, Monad)


-- | A normal layer contributes to the size of the parent
layer :: View c () -> Layer c ()
layer = Layer


{- | This child of a 'stack' can pop out of the parent, covering content outside of it. Only usable inside 'stack'
> stack id $ do
> layer id $ input (value "Autocomplete Box")
> layer (popout (TRBL 50 0 0 0)) $ do
> el_ "Item 1"
> el_ "Item 2"
> el_ "Item 3"
> el_ "This is covered by the menu"
-}
popout :: Mod c -> View c () -> Layer c () -- Sides Length -> Mod (Stack c)
popout f cnt = Layer $ do
el (position Absolute . zIndex 1 . f) cnt


-- | Hide an element. See 'display'
hide :: Mod c
hide = display None


-- | Set container to be a row. Favor 'Web.View.Layout.row' when possible
flexRow :: Mod c
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 c
flexCol =
addClass $
cls "col"
& prop @Text "display" "flex"
& prop @Text "flex-direction" "column"


-- | Cut off the contents of the element
truncate :: Mod c
truncate =
addClass $
cls "truncate"
& prop @Text "white-space" "nowrap"
& prop @Text "overflow" "hidden"
& prop @Text "text-overflow" "ellipsis"
2 changes: 1 addition & 1 deletion src/Web/View/Render.hs
Original file line number Diff line number Diff line change
Expand Up @@ -9,7 +9,7 @@ module Web.View.Render where
import Data.ByteString.Lazy qualified as BL
import Data.Function ((&))
import Data.List (foldl')
import Data.Map qualified as M
import Data.Map.Strict qualified as M
import Data.Maybe (mapMaybe)
import Data.String (fromString)
import Data.String.Interpolate (i)
Expand Down
Loading

0 comments on commit bcb83eb

Please sign in to comment.