web-view 0.6.2 → 0.7.0
raw patch · 7 files changed
+107/−60 lines, 7 files
Files
- CHANGELOG.md +7/−0
- src/Web/View.hs +3/−2
- src/Web/View/Layout.hs +14/−12
- src/Web/View/Style.hs +51/−31
- src/Web/View/Types.hs +26/−10
- src/Web/View/Types/Url.hs +5/−4
- web-view.cabal +1/−1
CHANGELOG.md view
@@ -1,5 +1,12 @@ # Revision history for web-view +## 0.7.0++* stack, popup, offset, layer - more intuitive interface+* added Web.View.Url.renderPath+* Style class+* added code, lists+ ## 0.6.0 * stack - layout children on top of each other
src/Web/View.hs view
@@ -41,7 +41,7 @@ , stack , Layer , layer- , popout+ , popup , scroll , grow , flexRow@@ -106,8 +106,8 @@ , pointer , position , Position (..)- , offset , zIndex+ , offset , textAlign , Align (..) , list@@ -142,6 +142,7 @@ , ToColor (..) , HexColor (..) , None (..)+ , Attributes -- * Url , module Web.View.Types.Url
src/Web/View/Layout.hs view
@@ -1,5 +1,7 @@+{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase #-} module Web.View.Layout where @@ -112,11 +114,11 @@ nav f = tag "nav" (f . flexCol) -{- | Stack children on top of each other. Each child has the full width. See 'popout'+{- | Stack children on top of each other. Each child has the full width. See 'popup' > stack id $ do-> row id "Background"-> row (bg Black . opacity 0.5) "Overlay"+> layer id "Background"+> layer (bg Black . opacity 0.5) "Overlay" -} stack :: Mod c -> Layer c () -> View c () stack f (Layer children) = do@@ -136,29 +138,29 @@ 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+-- | A normal layer contributes to the size of the parent. See 'stack'+layer :: Mod c -> View c () -> Layer c ()+layer f cnt = Layer $ do+ el (flexCol . f) cnt -{- | This child of a 'stack' can pop out of the parent, covering content outside of it. Only usable inside 'stack'+{- | This 'layer' is not included in the 'stack' size, and covers content outside of it. If used outside of stack, the popup is offset from the entire page. > stack id $ do > layer id $ input (value "Autocomplete Box")-> layer (popout (TRBL 50 0 0 0)) $ do+> layer (popup (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+popup :: Sides Length -> Mod c+popup sides =+ position Absolute . offset sides -- | Hide an element. See 'display'
src/Web/View/Style.hs view
@@ -89,6 +89,10 @@ 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+pad (TR t r) = pad (TRBL t r 0 0)+pad (TL t l) = pad (TRBL t 0 0 l)+pad (BR b r) = pad (TRBL 0 r b 0)+pad (BL b l) = pad (TRBL 0 0 b l) -- | The space between child elements. See 'pad'@@ -218,10 +222,14 @@ & 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+border (T x) = addClass $ cls ("brdt" -. x) & prop "border-top-width" x+border (R x) = addClass $ cls ("brdr" -. x) & prop "border-right-width" x+border (B x) = addClass $ cls ("brdb" -. x) & prop "border-bottom-width" x+border (L x) = addClass $ cls ("brdl" -. x) & prop "border-left-width" x+border (TR t r) = border (TRBL t r 0 0)+border (TL t l) = border (TRBL t 0 0 l)+border (BR b r) = border (TRBL 0 r b 0)+border (BL b l) = border (TRBL 0 0 b l) -- | Set a border color. See 'Web.View.Types.ToColor'@@ -282,26 +290,7 @@ & 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:absolute, relative, etc. See 'Web.View.Layout.stack' and 'Web.View.Layout.popup' position :: Position -> Mod c position p = addClass $ cls (toClassName p) & prop "position" p @@ -318,6 +307,44 @@ zIndex n = addClass $ cls ("z" -. n) & prop "z-index" n +-- | Set top, bottom, right, and left. See 'Web.View.Layout.stack' and 'Web.View.Layout.popup'+offset :: Sides Length -> Mod c+offset sides = addClass (off sides)+ where+ off :: Sides Length -> Class+ off = \case+ All n -> off (TRBL n n n n)+ Y n -> off (XY 0 n)+ X n -> off (XY n 0)+ XY x y -> off (TRBL y x y x)+ TRBL t r b l ->+ cls ("pop" -. t -. r -. b -. l)+ & prop "top" t+ & prop "right" r+ & prop "bottom" b+ & prop "left" l+ T x -> cls ("popt" -. x) & prop "top" x+ R x -> cls ("popr" -. x) & prop "right" x+ B x -> cls ("popb" -. x) & prop "bottom" x+ L x -> cls ("popl" -. x) & prop "left" x+ TR t r ->+ cls ("poptr" -. t -. r)+ & prop "top" t+ & prop "right" r+ TL t l ->+ cls ("poptl" -. t -. l)+ & prop "top" t+ & prop "left" l+ BR b r ->+ cls ("popbr" -. b -. r)+ & prop "right" r+ & prop "bottom" b+ BL b l ->+ cls ("popbl" -. b -. l)+ & prop "bottom" b+ & prop "left" l++ {- | Set container display el (display None) "HIDDEN"@@ -474,10 +501,3 @@ infixl 6 -.----- uniquely set the stAyle value based on this-class Style style value where- styleValue :: value -> StyleValue- default styleValue :: (ToStyleValue value) => value -> StyleValue- styleValue = toStyleValue
src/Web/View/Types.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DerivingStrategies #-} @@ -37,11 +38,13 @@ element :: Name -> Attributes c -> [Content] -> Element element n atts = Element False n (stripContext atts)- where- stripContext :: Attributes c -> Attributes ()- stripContext (Attributes cls other) = Attributes cls other +-- | Internal. Convert an Attributes to any context+stripContext :: Attributes a -> Attributes b+stripContext (Attributes cls other) = Attributes cls other++ -- | The Attributes for an 'Element'. Classes are merged and managed separately from the other attributes. data Attributes c = Attributes { classes :: CSS@@ -219,6 +222,13 @@ toStyleValue = id +-- | Convert a type to a prop name+class ToProp a where+ toProp :: a -> Name+ default toProp :: (Show a) => a -> Name+ toProp = pack . kebab . show++ data Length = PxRem PxRem | Pct Float@@ -292,6 +302,10 @@ | R a | B a | L a+ | TR a a+ | TL a a+ | BR a a+ | BL a a -- Num instance is just to support literals@@ -369,10 +383,12 @@ data None = None deriving (Show, ToClassName, ToStyleValue) --- data Size--- = Sm--- | Md--- | Lg--- | Xl--- | Xl2--- deriving (Show, ToClassName)++-- uniquely set the style value based on the style+class Style cls value where+ styleValue :: value -> StyleValue+ default styleValue :: (ToStyleValue value) => value -> StyleValue+ styleValue = toStyleValue++class ToClass cls value where+ toClass :: value -> Class
src/Web/View/Types/Url.hs view
@@ -103,7 +103,8 @@ renderUrl :: Url -> Text-renderUrl u = u.scheme <> u.domain <> paths u.path <> decodeUtf8 (renderQuery True u.query)- where- paths :: [Segment] -> Text- paths ss = "/" <> T.intercalate "/" (map cleanSegment ss)+renderUrl u = u.scheme <> u.domain <> renderPath u.path <> decodeUtf8 (renderQuery True u.query)+++renderPath :: [Segment] -> Text+renderPath ss = "/" <> T.intercalate "/" (map cleanSegment ss)
web-view.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: web-view-version: 0.6.2+version: 0.7.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