0.6.2 position, stack, ListItem, Layer

Author: seanhess

bin/dev

@@ -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

example/app/Main.hs

@@ -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
@@ -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"

package.yaml

@@ -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

src/Web/View.hs

@@ -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
@@ -82,15 +88,12 @@ module Web.View
   , height
   , minWidth
   , minHeight
-  , flexRow
-  , flexCol
-  , display
   , pad
   , gap
-  , hide
   , opacity
-  , truncate
   , shadow
+  , Shadow
+  , Inner (..)
   , rounded
   , fontSize
   , color
@@ -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
@@ -123,15 +137,10 @@ module Web.View
 
     -- * Types
   , Sides (..)
-  , Media (..)
   , PxRem
   , Length (..)
-  , TransitionProperty (..)
-  , Ms
   , ToColor (..)
   , HexColor (..)
-  , Align (..)
-  , ListType (..)
   , None (..)
 
     -- * Url

src/Web/View/Element.hs

@@ -1,4 +1,6 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 
 module Web.View.Element where
 
@@ -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 ()
@@ -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'.
@@ -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

src/Web/View/Layout.hs

@@ -1,3 +1,6 @@
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
 module Web.View.Layout where
 
 import Data.Function
@@ -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
@@ -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"

src/Web/View/Render.hs

@@ -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)