From bcb83ebd98116a6a67dc9f18cfbff8bde267ddaf Mon Sep 17 00:00:00 2001
From: Sean Hess <seanhess@gmail.com>
Date: Tue, 24 Dec 2024 12:52:21 -0700
Subject: [PATCH] 0.6.2 position, stack, ListItem, Layer

---
 bin/dev                 |   1 +
 example/app/Main.hs     |  39 +++++++++--
 package.yaml            |   2 +-
 src/Web/View.hs         |  39 +++++++----
 src/Web/View/Element.hs |  22 +++---
 src/Web/View/Layout.hs  |  77 ++++++++++++++++++---
 src/Web/View/Render.hs  |   2 +-
 src/Web/View/Style.hs   | 149 +++++++++++++++++++++-------------------
 src/Web/View/Types.hs   |  16 ++++-
 src/Web/View/View.hs    |   2 +-
 test/Test/StyleSpec.hs  |   2 +-
 web-view.cabal          |   2 +-
 12 files changed, 238 insertions(+), 115 deletions(-)

diff --git a/bin/dev b/bin/dev
index 95e0675..353acd2 100755
--- a/bin/dev
+++ b/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
diff --git a/example/app/Main.hs b/example/app/Main.hs
index eb705f8..ab2d7b5 100644
--- a/example/app/Main.hs
+++ b/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"
diff --git a/package.yaml b/package.yaml
index ab94741..f8dea07 100644
--- a/package.yaml
+++ b/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
diff --git a/src/Web/View.hs b/src/Web/View.hs
index 3c5f967..25c6d1c 100644
--- a/src/Web/View.hs
+++ b/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,9 +104,19 @@ module Web.View
   , border
   , borderColor
   , pointer
-  , transition
+  , position
+  , Position (..)
+  , offset
+  , zIndex
   , textAlign
+  , Align (..)
   , list
+  , ListType (..)
+  , display
+  , Display (..)
+  , transition
+  , TransitionProperty (..)
+  , Ms
 
     -- ** Selector States
   , hover
@@ -111,6 +124,7 @@ module Web.View
   , 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
diff --git a/src/Web/View/Element.hs b/src/Web/View/Element.hs
index 92236ef..2971478 100644
--- a/src/Web/View/Element.hs
+++ b/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
diff --git a/src/Web/View/Layout.hs b/src/Web/View/Layout.hs
index be3ba48..ed30742 100644
--- a/src/Web/View/Layout.hs
+++ b/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"
diff --git a/src/Web/View/Render.hs b/src/Web/View/Render.hs
index 1e37020..f712224 100644
--- a/src/Web/View/Render.hs
+++ b/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)
diff --git a/src/Web/View/Style.hs b/src/Web/View/Style.hs
index f1bfec7..97675b7 100644
--- a/src/Web/View/Style.hs
+++ b/src/Web/View/Style.hs
@@ -9,7 +9,7 @@
 module Web.View.Style where
 
 import Data.Function ((&))
-import Data.Map qualified as M
+import Data.Map.Strict qualified as M
 import Data.Text (Text)
 import Web.View.Types
 
@@ -77,13 +77,7 @@ pad (X n) =
     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 (XY x y) = pad (TRBL y x y x)
 pad (TRBL t r b l) =
   addClass $
     cls ("pad" -. t -. r -. b -. l)
@@ -91,6 +85,10 @@ pad (TRBL t r b l) =
       & prop "padding-right" r
       & prop "padding-bottom" b
       & prop "padding-left" l
+pad (T x) = addClass $ cls ("padt" -. x) & prop "padding-top" x
+pad (R x) = addClass $ cls ("padr" -. x) & prop "padding-right" x
+pad (B x) = addClass $ cls ("padb" -. x) & prop "padding-bottom" x
+pad (L x) = addClass $ cls ("padl" -. x) & prop "padding-left" x
 
 
 -- | The space between child elements. See 'pad'
@@ -105,51 +103,13 @@ fontSize n = addClass $ cls ("fs" -. n) & prop "font-size" n
 -- fontFamily :: Text -> Mod c
 -- 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 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"
-
-
--- | Set container display to Block or 'None'
-display :: (Style Display a, ToClassName a) => a -> Mod c
-display display =
-  addClass $
-    cls ("disp" -. display)
-      & prop "display" (styleValue @Display display)
-
-
-data Display
-  = Block
-  deriving (Show, ToClassName, ToStyleValue)
-instance Style Display Display
-instance Style Display None
-
-
--- | Hide an element. See 'display'
-hide :: Mod c
-hide = display None
+{- | Add a drop shadow to an element
 
-
--- | Adds a basic drop shadow to an element
-shadow :: Mod c
-shadow = shadow' ()
-
-
-shadow' :: (Style Shadow a, ToClassName a) => a -> Mod c
-shadow' a =
+> input (shadow Inner) "Inset Shadow"
+> button (shadow ()) "Click Me"
+-}
+shadow :: (Style Shadow a, ToClassName a) => a -> Mod c
+shadow a =
   addClass $
     cls ("shadow" -. a)
       & prop "box-shadow" (styleValue @Shadow a)
@@ -200,6 +160,13 @@ underline :: Mod c
 underline = addClass $ cls "underline" & prop @Text "text-decoration" "underline"
 
 
+{- | Set the list style of an item
+
+> ol id $ do
+>   li (list Decimal) "First"
+>   li (list Decimal) "Second"
+>   li (list Decimal) "Third"
+-}
 list :: (ToClassName a, Style ListType a) => a -> Mod c
 list a =
   addClass $
@@ -243,13 +210,7 @@ border (X p) =
     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 (XY x y) = border (TRBL y x y x)
 border (TRBL t r b l) =
   addClass $
     cls ("brd" -. t -. r -. b -. l)
@@ -257,6 +218,10 @@ border (TRBL t r b l) =
       & prop "border-right-width" r
       & prop "border-bottom-width" b
       & prop "border-left-width" l
+border (T x) = addClass $ cls ("bordert" -. x) & prop "border-top-width" x
+border (R x) = addClass $ cls ("borderr" -. x) & prop "border-right-width" x
+border (B x) = addClass $ cls ("borderb" -. x) & prop "border-bottom-width" x
+border (L x) = addClass $ cls ("borderl" -. x) & prop "border-left-width" x
 
 
 -- | Set a border color. See 'Web.View.Types.ToColor'
@@ -281,16 +246,6 @@ pointer :: Mod c
 pointer = addClass $ cls "pointer" & prop @Text "cursor" "pointer"
 
 
--- | 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"
-
-
 {- | Animate changes to the given property
 
 > el (transition 100 (Height 400)) "Tall"
@@ -327,6 +282,60 @@ textAlign a =
       & prop "text-align" a
 
 
+-- | Set Top, Right, Bottom and Left. Requires 'position' Absolute or Fixed. Also see 'Web.View.Layout.popup'
+offset :: Sides Length -> Mod c
+offset (All n) = offset (TRBL n n n n)
+offset (Y n) = offset (XY 0 n)
+offset (X n) = offset (XY n 0)
+offset (XY x y) = offset (TRBL y x y x)
+offset (TRBL t r b l) =
+  addClass $
+    cls ("offset" -. t -. r -. b -. l)
+      & prop "top" t
+      & prop "right" r
+      & prop "bottom" b
+      & prop "left" l
+offset (T x) = addClass $ cls ("top" -. x) & prop "top" x
+offset (R x) = addClass $ cls ("right" -. x) & prop "right" x
+offset (B x) = addClass $ cls ("bottom" -. x) & prop "bottom" x
+offset (L x) = addClass $ cls ("left" -. x) & prop "left" x
+
+
+-- | position:absolute. See 'stack' and 'popout'
+position :: Position -> Mod c
+position p = addClass $ cls (toClassName p) & prop "position" p
+
+
+data Position
+  = Absolute
+  | Fixed
+  | Sticky
+  | Relative
+  deriving (Show, ToClassName, ToStyleValue)
+
+
+zIndex :: Int -> Mod c
+zIndex n = addClass $ cls ("z" -. n) & prop "z-index" n
+
+
+{- | Set container display
+
+el (display None) "HIDDEN"
+-}
+display :: (Style Display a, ToClassName a) => a -> Mod c
+display disp =
+  addClass $
+    cls ("disp" -. disp)
+      & prop "display" (styleValue @Display disp)
+
+
+data Display
+  = Block
+  deriving (Show, ToClassName, ToStyleValue)
+instance Style Display Display
+instance Style Display None
+
+
 -- * Selector Modifiers
 
 
@@ -467,7 +476,7 @@ prop n v c =
 infixl 6 -.
 
 
--- uniquely set the style value based on this
+-- uniquely set the stAyle value based on this
 class Style style value where
   styleValue :: value -> StyleValue
   default styleValue :: (ToStyleValue value) => value -> StyleValue
diff --git a/src/Web/View/Types.hs b/src/Web/View/Types.hs
index 4cac832..c620cd8 100644
--- a/src/Web/View/Types.hs
+++ b/src/Web/View/Types.hs
@@ -4,8 +4,9 @@
 
 module Web.View.Types where
 
+import Data.Char (toLower)
 import Data.Kind (Type)
-import Data.Map (Map)
+import Data.Map.Strict (Map)
 import Data.String (IsString (..))
 import Data.Text (Text, pack, unpack)
 import Data.Text qualified as T
@@ -287,6 +288,10 @@ data Sides a
   | X a
   | Y a
   | XY a a
+  | T a
+  | R a
+  | B a
+  | L a
 
 
 -- Num instance is just to support literals
@@ -352,8 +357,13 @@ instance ToClassName HexColor where
 
 
 data Align
-  = Center
-  deriving (Show, ToClassName, ToStyleValue)
+  = AlignCenter
+  | AlignLeft
+  | AlignRight
+  | AlignJustify
+  deriving (Show, ToClassName)
+instance ToStyleValue Align where
+  toStyleValue a = StyleValue $ map toLower $ drop 5 $ show a
 
 
 data None = None
diff --git a/src/Web/View/View.hs b/src/Web/View/View.hs
index d6094cb..332bd27 100644
--- a/src/Web/View/View.hs
+++ b/src/Web/View/View.hs
@@ -4,7 +4,7 @@
 
 module Web.View.View where
 
-import Data.Map qualified as M
+import Data.Map.Strict qualified as M
 import Data.String (IsString (..))
 import Data.Text (Text, pack)
 import Effectful
diff --git a/test/Test/StyleSpec.hs b/test/Test/StyleSpec.hs
index 6aa32c8..4a7ffed 100644
--- a/test/Test/StyleSpec.hs
+++ b/test/Test/StyleSpec.hs
@@ -1,6 +1,6 @@
 module Test.StyleSpec (spec) where
 
-import Data.Map qualified as M
+import Data.Map.Strict qualified as M
 import Skeletest
 import Web.View
 import Web.View.Style ((-.))
diff --git a/web-view.cabal b/web-view.cabal
index 31825c5..da0b772 100644
--- a/web-view.cabal
+++ b/web-view.cabal
@@ -5,7 +5,7 @@ cabal-version: 2.2
 -- see: https://github.com/sol/hpack
 
 name:           web-view
-version:        0.6.1
+version:        0.6.2
 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