packages feed

web-view 0.6.1 → 0.6.2

raw patch · 10 files changed

+212/−112 lines, 10 files

Files

README.md view
@@ -137,7 +137,7 @@ View on Github * https://github.com/seanhess/web-view -View [Examples](https://github.com/seanhess/web-view/blob/main/example/app/Main.hs)+View [Examples](https://github.com/seanhess/web-view/blob/latest/example/app/Main.hs)   [hackage]: https://hackage.haskell.org/package/web-view@@ -146,6 +146,7 @@ Contributors ------------ -* [Sean Hess](seanhess)+* [Sean Hess](https://github.com/seanhess) * [Kamil Figiela](https://github.com/kfigiela)+* [Pfalzgraf Martin](https://github.com/Skyfold)
src/Web/View.hs view
@@ -36,12 +36,18 @@   , 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 @@   , height   , minWidth   , minHeight-  , flexRow-  , flexCol-  , display   , pad   , gap-  , hide   , opacity-  , truncate   , shadow+  , Shadow+  , Inner (..)   , rounded   , fontSize   , color@@ -101,9 +104,19 @@   , border   , borderColor   , pointer-  , transition+  , position+  , Position (..)+  , offset+  , zIndex   , textAlign+  , Align (..)   , list+  , ListType (..)+  , display+  , Display (..)+  , transition+  , TransitionProperty (..)+  , Ms      -- ** Selector States   , hover@@ -111,6 +124,7 @@   , even   , odd   , media+  , Media (..)   , parent      -- * View Context@@ -123,15 +137,10 @@      -- * Types   , Sides (..)-  , Media (..)   , PxRem   , Length (..)-  , TransitionProperty (..)-  , Ms   , ToColor (..)   , HexColor (..)-  , Align (..)-  , ListType (..)   , None (..)      -- * Url
src/Web/View/Element.hs view
@@ -1,4 +1,6 @@ {-# LANGUAGE DataKinds #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}  module Web.View.Element where @@ -74,7 +76,7 @@   form :: Mod c -> View c () -> View c ()-form f = tag "form" (f . flexCol)+form = tag "form"   input :: Mod c -> View c ()@@ -172,16 +174,28 @@ -- * Lists  -data ListItem = ListItem+newtype ListItem c a = ListItem (View c a)+  deriving newtype (Functor, Applicative, Monad)  -ul :: Mod c -> View ListItem () -> View c ()-ul f cnt = tag "ul" f $ addContext ListItem cnt+{- | List elements do not include any inherent styling but are useful for accessibility. See 'Web.View.Style.list'. +> ol id $ do+>  let nums = list Decimal+>  li nums "one"+>  li nums "two"+>  li nums "three"+-}+ol :: Mod c -> ListItem c () -> View c ()+ol f (ListItem cnt) = do+  tag "ol" f cnt -ol :: Mod c -> View ListItem () -> View c ()-ol f cnt = tag "ol" f $ addContext ListItem cnt +ul :: Mod c -> ListItem c () -> View c ()+ul f (ListItem cnt) = do+  tag "ul" f cnt -li :: Mod ListItem -> View ListItem () -> View ListItem ()-li = tag "li"++li :: Mod c -> View c () -> ListItem c ()+li f cnt = ListItem $ do+  tag "li" f cnt
src/Web/View/Layout.hs view
@@ -1,3 +1,6 @@+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+ module Web.View.Layout where  import Data.Function@@ -94,11 +97,6 @@ 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 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 view
@@ -9,7 +9,7 @@ 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)
src/Web/View/Style.hs view
@@ -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 @@     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 @@       & 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 @@ -- 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----- | Adds a basic drop shadow to an element-shadow :: Mod c-shadow = shadow' ()-+{- | Add a drop shadow to an element -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 = 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 @@     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 @@       & 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 = 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 @@       & 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 @@ 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
src/Web/View/Types.hs view
@@ -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 @@   | 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 @@   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
src/Web/View/View.hs view
@@ -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
test/Test/StyleSpec.hs view
@@ -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 ((-.))
web-view.cabal view
@@ -5,7 +5,7 @@ -- 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