diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,5 @@ +# Revision history for ClashSS + +## 0.1.0.0 -- YYYY-mm-dd + +* First version. Released on an unsuspecting world. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,20 @@ +Copyright (c) 2024 Galen Sprout + +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + +The above copyright notice and this permission notice shall be included +in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY +CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, +TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE +SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/reflex-classhss.cabal b/reflex-classhss.cabal new file mode 100644 --- /dev/null +++ b/reflex-classhss.cabal @@ -0,0 +1,60 @@ +cabal-version: 2.4 +name: reflex-classhss +version: 0.1.0.0 +synopsis: + ClasshSS defined element builders for Reflex +description: + Using ClasshSS this module provides a number of interfaces to rapidly build UIs, + in particular there is a focus on text and layouts + +homepage: https://github.com/augyg/ClasshSS +license: MIT +license-file: LICENSE +author: Galen Sprout +maintainer: galen.sprout@gmail.com +-- copyright: +category: Web +build-type: Simple +extra-doc-files: CHANGELOG.md +-- extra-source-files: + +source-repository head + type: git + location: https://github.com/augyg/reflex-classhss + +common warnings + ghc-options: -Wall + +library + import: warnings + exposed-modules: Classh.Reflex + Classh.Reflex.El + Classh.Reflex.Layout + Classh.Reflex.Text + Classh.Reflex.Place + build-depends: ClasshSS >= 0.2.0 && < 0.3 + , base >= 4.20.2 && < 4.21 + , containers >= 0.7 && < 0.8 + , data-default >= 0.8.0 && < 0.9 + , lens >= 5.3.6 && < 5.4 + , reflex-dom-core >= 0.8.1 && < 0.9 + , template-haskell >= 2.22.0 && < 2.23 + , text >= 2.1.3 && < 2.2 + + + build-depends: base + --^>=4.15.1.0 + , containers + , data-default + -->= 0.7.1 && < 0.8 + , lens + -->= 5.2.3 && < 5.3 + , template-haskell + , reflex-dom-core + , ClasshSS + -->= 2.17.0 && < 2.18 + , text + -->= 1.2.5 && < 1.3 + hs-source-dirs: src + ghc-options: -Wall -threaded -fno-show-valid-hole-fits + default-language: Haskell2010 diff --git a/src/Classh/Reflex.hs b/src/Classh/Reflex.hs new file mode 100644 --- /dev/null +++ b/src/Classh/Reflex.hs @@ -0,0 +1,121 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE RankNTypes #-} + +-------------------------------------------------------------------------------- +-- | +-- Module : Classh.Reflex.Layout +-- Copyright : (c) 2024, Galen Sprout +-- License : BSD-style (see end of this file) +-- +-- Maintainer : Galen Sprout +-- Stability : provisional +-- Portability : portable +-- +-- A collection of patterns that have emerged from usage of ClasshSS in order to reduce the amount of +-- code necessary to build beautiful UIs that will be easier to maintain. +-- +-- For example, lets use grids to show 3 components (just text here) that on mobile and +-- tablet(sm) will take up the full row, and at larger sizes take up 3\/12 width, 4\/12 width, and 5\/12 width +-- respectively. +-- +-- Let's also pretend this is a landing page and we want all rows evenly spaced, we can make this obvious +-- with 'row' +-- +-- @ +-- {-# LANGUAGE OverloadedStrings #-} +-- {-# LANGUAGE FlexibleContexts #-} +-- module Main where +-- +-- import Reflex.Dom.Core +-- import Classh +-- +-- mySimpleResponsivePage :: DomBuilder t m => m () +-- mySimpleResponsivePage = do +-- row [y .~~ TWSize 10] $ do +-- gridCol Col12 $ do +-- col [12,12,3] $ normalText "hey" +-- col [12,12,4] $ normalText "hello" +-- col [12,12,5] $ normalText "howdy" +-- where +-- normalText = textS $(classh' [text_size .|~ [LG, XL, XL2, XL3] ] ) +-- @ +-- +-- +------------------------------------------------------------------------------- + + +module Classh.Reflex ( module X) where + +import Classh.Reflex.El as X +import Classh.Reflex.Text as X +import Classh.Reflex.Place as X +import Classh.Reflex.Layout as X + + + + +-- | Not real: just ideating +-- | How can we model a discrete set of consistent brand options? +-- +-- data Mytextsize = Heading | Subtext | Normal +-- domain = Map.fromList [ (Heading , XL7) , (Normal , XL3) , (Subtext , XS) ] +-- +-- brandF :: k -> WhenTW k +-- brandF (domainType :: Ord k => k) = +-- let baseSize = fromJust $ Map.lookup domainType (domain :: Map (k :: Ord k => k) (v :: ShowTW x => x)) +-- in +-- autoScale baseSize +-- +-- then this above code suggests that we should think of our domain as mobile first +-- it is important to remember this is not meant to represent 100% of CSS but rather ~80% +-- and should be a way to communicate branding concisely such that a stoopid cud impl. it to be +-- consistent +-- +-- Now, it wont always be super complex: for example, color +-- +-- def = TW.def & text_color .~~ aceBlue +-- +-- But then again, a brand may have multiple colors +-- +-- brandColors = Map.fromList [ (AceBlue, hex _), (AceNavyBlue, hex _), (AceBabyBlue, hex _) ] +-- and also: + -- What about dark mode? \ + -- +-- and note: lets say 90% of titles should have Bold as their weight, we can set this and + + + + + + + + +-- | TODO: styledParagraphs :: [( BottomPadding, [(tw,T.Text)])] -> m () +-- then apply to bannerFor in Landing.* + + +-- buttonC :: Map.Map T.Text T.Text -> m a -> m (Event t a) +-- buttonC attrs inner = do +-- (e,x) <- elAttr' "button" attrs inner +-- pure $ x <$ domEvent Click e + + + +-- textTW' :: (DomBuilder t m, ShowTW tw) => tw -> T.Text -> m () +-- textTW' = styledText' + +-- styledText' :: (DomBuilder t m, ShowTW tw) => tw -> T.Text -> m () +-- styledText' cfg txt = elClass "span" (showTW cfg) $ text txt + +-- dynTextTW' :: (DomBuilder t m, PostBuild t m, ShowTW tw) => tw -> Dynamic t T.Text -> m () +-- dynTextTW' cfg txt = elClass "span" (showTW cfg) $ dynText txt + +-- textDynTW' :: (DomBuilder t m, PostBuild t m, ShowTW tw) => Dynamic t tw -> T.Text -> m () +-- textDynTW' dynCfg txt = elDynClass "span" ( (\cfg -> defaultClasses <> " " <> showTW cfg) <$> dynCfg ) $ text txt + +-- styledTexts' :: (ShowTW tw, DomBuilder t m) => [(tw, T.Text)] -> m () +-- styledTexts' styTexs = el "div" $ forM_ styTexs $ \(cfg, txt) -> styledText' cfg txt + + diff --git a/src/Classh/Reflex/El.hs b/src/Classh/Reflex/El.hs new file mode 100644 --- /dev/null +++ b/src/Classh/Reflex/El.hs @@ -0,0 +1,161 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +-------------------------------------------------------------------------------- +-- | +-- Module : Classh.Reflex.Text +-- Copyright : (c) 2024, Galen Sprout +-- License : BSD-style (see end of this file) +-- +-- Maintainer : Galen Sprout +-- Stability : provisional +-- Portability : portable +-- +-- A collection of Classh-typed versions of elClass and similar funcs using classhUnsafe +-- +------------------------------------------------------------------------------- + + +module Classh.Reflex.El where + +import Reflex.Dom.Core +import Classh +import Control.Monad (void) +import qualified Data.Map as Map +import qualified Data.Text as T + + + + +type Shell m a = m a -> m a + +-- | is elClass except that it takes a BoxConfig instead of a string for classes +elTW :: DomBuilder t m => T.Text -> BoxConfig -> m a -> m a +elTW etag cfg ma = elClass etag (defaultClasses <> " " <> showTW cfg) ma + +-- | is elClass' except that it takes a BoxConfig instead of a string for classes. +elTW' :: DomBuilder t m => T.Text -> BoxConfig -> m a -> m (Element EventResult (DomBuilderSpace m) t, a) +elTW' etag cfg ma = elClass' etag (defaultClasses <> " " <> showTW cfg) ma + +-- | is elDynClass except that it takes a BoxConfig instead of a string for classes +elDynTW :: (PostBuild t m, DomBuilder t m) => T.Text -> Dynamic t BoxConfig -> m a -> m a +elDynTW etag cfgDyn ma = elDynClass etag ( (\cfg -> defaultClasses <> " " <> showTW cfg) <$> cfgDyn ) ma + +-- | is elDynClass' except that it takes a BoxConfig instead of a string for classes +elDynTW' :: (PostBuild t m, DomBuilder t m) => T.Text -> Dynamic t BoxConfig -> m a -> m (Element EventResult (DomBuilderSpace m) t, a) +elDynTW' etag cfgDyn ma = elDynClass' etag ( (\cfg -> defaultClasses <> " " <> showTW cfg) <$> cfgDyn ) ma + +div_ :: DomBuilder t m => m a -> m a +div_ = el "div" + +-- | When we want to do absolutely nothing but create an area devoid of influence by outside +-- | Most common case is for differing displays like inline-block vs grid +-- | +-- | In practice this can also be used to solve a common problem where +-- | helper functions unnecessarily restrict size of children. +-- | +-- | TODO: we need to probably use this everywhere +in_ :: DomBuilder t m => m a -> m a +in_ = divClass $(classh' [h .~~ pct 100, w .~~ pct 100]) + +-- | Example Use Case: +-- | divClass $(classh' [pos .~~ centered]) $ do +-- | inH_ leaf +inH_ :: DomBuilder t m => m a -> m a +inH_ = divClass $(classh' [h .~~ pct 100]) + + +type PlaceHolder = T.Text +inputEl :: DomBuilder t m => T.Text -> T.Text -> PlaceHolder -> m () +inputEl elClasses textClasses placeholder = void $ inputElement $ def & inputElementConfig_elementConfig . initialAttributes .~ + ("class" =: (elClasses <&> textClasses) + <> "placeholder" =: placeholder + ) + +type TextAreaRows = Int +textAreaEl :: DomBuilder t m => TextAreaRows -> T.Text -> T.Text -> PlaceHolder -> m () +textAreaEl rows elClasses textClasses placeholder = + void $ textAreaElement $ def & textAreaElementConfig_elementConfig . initialAttributes .~ + ("class" =: (elClasses <&> textClasses) + <> "rows" =: tshow rows + <> "placeholder" =: placeholder + ) + +-- Dog running through the field +type ScreenWidth = DimensionConstraint +imgResponsive + :: DomBuilder t m + => [ (StaticImagePath + , (CSSSize, ScreenWidth) + ) + ] + -> CompiledS + -> m () +imgResponsive imageInfo classes = elAttr "img" (imgSrcSet imageInfo classes) blank + +-- example = imgResponsive (imgSrcSet [] "") + +--imgSrcSet +type StaticImagePath = T.Text +type Pixels = Int + +imgSrcSet :: [(StaticImagePath, (CSSSize, DimensionConstraint))] -> CompiledS -> Map.Map T.Text T.Text +imgSrcSet [] _ = error "No images given to Classh.Reflex.imgSrcSet" -- we know this must be the start, there is no recursion +imgSrcSet xs classes = + let + mkPair = \(src',(w_,_)) -> src' <&> (renderCSS w_) <> "w" + pairs = mkPair <$> xs + + showMW :: DimensionConstraint -> T.Text + showMW m_ = "(max-width: " <> showTW m_ <> ")" + + mkFuckingAlgebraicSizes :: [(StaticImagePath, (CSSSize, DimensionConstraint))] -> T.Text + mkFuckingAlgebraicSizes [] = error "mkFuckingAlgebraicSizes received no input" + mkFuckingAlgebraicSizes ((_,(w_, maxW__)):xs_) = + if null xs_ + then renderCSS w_ + else showMW maxW__ <> renderCSS w_ <> "," <> mkFuckingAlgebraicSizes xs_ + in + "srcset" =: (T.intercalate "," pairs) + <> "sizes" =: (mkFuckingAlgebraicSizes xs) + <> "class" =: classes + +divClassh :: BoxConfig -> [BoxConfig -> BoxConfig] -> Compiled Expression +divClassh base muts = case compileS $ foldl (\acc f -> f acc) base muts of + Left e -> fail $ T.unpack e + Right styleString -> [| divClass styleString |] + +divClassh' :: [BoxConfig -> BoxConfig] -> Compiled Expression +divClassh' muts = case compileS $ foldl (\acc f -> f acc) def muts of + Left e -> fail $ T.unpack e + Right styleString -> [| divClass styleString |] + +textClassh :: TextConfigTW -> [TextConfigTW -> TextConfigTW] -> Compiled Expression +textClassh base muts = case compileS $ foldl (\acc f -> f acc) base muts of + Left e -> fail $ T.unpack e + Right styleString -> [| textS styleString |] + +textClassh' :: [TextConfigTW -> TextConfigTW] -> Compiled Expression +textClassh' muts = case compileS $ foldl (\acc f -> f acc) def muts of + Left e -> fail $ T.unpack e + Right styleString -> [| textS styleString |] + +textPos' :: [TextPosition -> TextPosition] -> Compiled Expression +textPos' muts = case compileS $ foldl (\acc f -> f acc) def muts of + Left e -> fail $ T.unpack e + Right styleString -> [| textPosition styleString |] + +textPos :: TextPosition -> [TextPosition -> TextPosition] -> Compiled Expression +textPos base muts = case compileS $ foldl (\acc f -> f acc) base muts of + Left e -> fail $ T.unpack e + Right styleString -> [| textPosition styleString |] diff --git a/src/Classh/Reflex/Layout.hs b/src/Classh/Reflex/Layout.hs new file mode 100644 --- /dev/null +++ b/src/Classh/Reflex/Layout.hs @@ -0,0 +1,262 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE OverloadedStrings #-} + + +-------------------------------------------------------------------------------- +-- | +-- Module : Classh.Reflex.Layout +-- Copyright : (c) 2024, Galen Sprout +-- License : BSD-style (see end of this file) +-- +-- Maintainer : Galen Sprout +-- Stability : provisional +-- Portability : portable +-- +-- A collection of functions to quickly divide up a Dom into rows and columns. +-- +-- Note that these functions are really just meant to be reduced Boxes that visually instruct +-- other developers what the UI is doing. +-- +-- For example, lets use grids to show 3 components (just text here) that on mobile and +-- tablet(sm) will take up the full row, and at larger sizes take up 3/12 cols, 4/12 cols, and 5/12 cols +-- respectively. +-- +-- Let's also pretend this is a landing page and we want all rows evenly spaced, we can make this obvious +-- with 'row' +-- +-- @ +-- row [y .~~ TWSize 10] $ do +-- gridCol Col12 $ do +-- col [12,12,3] $ text "hey" +-- col [12,12,4] $ text "hello" +-- col [12,12,5] $ text "howdy" +-- @ +-- +-- +------------------------------------------------------------------------------- + + + + +module Classh.Reflex.Layout where + + +import Classh.Reflex.Place +import Classh +import Reflex.Dom.Core +import Control.Monad +import qualified Data.Text as T + + +type Mutation a = a -> a + +type MinWidth = DimensionConstraint +type MaxWidth = DimensionConstraint +type TargetWidth = TWSizeOrFraction + +-- | Centering relative to full sized containers, as constants +centeredFullH :: [Mutation BoxConfig] +centeredFullH = [h .~~ pct 100, pos .~~ centered] +centeredFullW :: [Mutation BoxConfig] +centeredFullW = [w .~~ pct 100, pos .~~ centered] +centeredFull :: [Mutation BoxConfig] +centeredFull = [h .~~ pct 100, w .~~ pct 100, pos .~~ centered] + +inline :: DomBuilder t m => m a -> m a +inline ma = divClass (classhUnsafe [box_custom .~ "inline-block"]) ma + +inlines :: DomBuilder t m => [m a] -> m () +inlines [] = pure () +inlines (ma:mas) = inline ma >> inlines mas + + +-- | Call as infix: topDOM `overtopOf` bottomDOM +overtopOf :: DomBuilder t m => [TWSizeOrFraction] -> m () -> m () -> m () +overtopOf heights topDOM bottomDOM = do + -- TODO: throw compile error if its a non-static height + when (null heights) $ do + error "`overtopOf` received null list" + el "div" $ do + divClass shell_relative $ do + divClass shell_top $ do + topDOM + divClass shell_bottom $ do + bottomDOM + where + shell_relative = (classhUnsafe [ custom .~ "relative", h .|~ heights]) + shell_top = (classhUnsafe [ custom .~ "absolute z-30", w .~~ TWSize_Full, h .|~ heights]) + shell_bottom = (classhUnsafe [ custom .~ "absolute z-20", w .~~ TWSize_Full, h .|~ heights]) + + + +-- | A generic interface to creating a centered row of some width+width constraints +rowW :: DomBuilder t m => [(MinWidth,TargetWidth,MaxWidth)] -> (Justify, Align) -> m a -> m a +rowW widthCfg pos_ = centerSimple . divClass (classhUnsafe [minW .|~ minWidths, maxW .|~ maxWidths, w .|~ targetWidths, pos .~~ pos_ ]) + where + (minWidths, targetWidths, maxWidths) = unzip3 widthCfg + +-- | A handy way to visually (to the dev and to the user) divide up a section vertically +-- > row [ y .~~ TWSize 10, l .~~ pix 5 ] $ text "hey" +row :: DomBuilder t m => [Mutation BoxPadding] -> m a -> m a +row paddingF = elClass "div" ( "" <&> showTW (applyFs def paddingF) ) + +-- | Divide a row into a number of columns +-- | Purposefully designed to take no other data besides ColInt in order to be very self-contained +-- > gridCol Col12 $ do { col [6] $ text "hey"; col [6] $ text "hi" } +gridCol :: DomBuilder t m => ColInt -> m a -> m a +gridCol cInt ma = elClass "div" ("grid grid-cols-" <> showTW cInt) ma + +-- | Divide a row into a number of columns, with other arbitrary classes +-- > gridColW Col12 "bg-black" $ do { col [6] $ text "hey"; col [6] $ text "hi" } +gridCol' :: DomBuilder t m => ColInt -> T.Text -> m a -> m a +gridCol' cInt customCs ma = elClass "div" ("grid grid-cols-" <> showTW cInt <&> customCs) ma + +-- | Divide a row into a number of columns, and take up a fraction of parent row +-- > gridColW Col12 "bg-black" $ do { col [6] $ text "hey"; col [6] $ text "hi" } +gridColW :: DomBuilder t m => ColInt -> TWSizeOrFraction -> m a -> m a +gridColW cInt width_ ma = elClass "div" ("grid grid-cols-" <> showTW cInt <&> ("w-" <> showTW width_)) ma + +-- TODO: this should have the ability to add rows somehow +-- and how we can think of this is that if we start at a large->Col12 and scale down to +-- lets say a 'sm' then Col12 / n where n is from config. So lets say n=2 then sm->Col6 which will show up as +-- 2 rows of 6; similarly n=6 => 6 rows of 2 ; n=12 -> 12 rows of 1; n=3 => 3 rows of 4 ; n=4 => 4 rows of 3 +-- +-- | Divide a row into a number of columns where columns is based on screen size +-- | Purposefully designed to take no other data besides ColInt in order to be very self-contained +-- > gridColWhen [Col6, Col12] $ do { col [6] $ text "hey"; col [6] $ text "hi" } +gridColWhen :: DomBuilder t m => WhenTW ColInt -> m a -> m a +gridColWhen cInts' ma = elClass "div" (showCInts cInts') ma + where + showCInts [] = "" + showCInts (("def",cInt):cInts) = "grid grid-cols-" <> showTW cInt <&> showCInts cInts + showCInts ((case_,cInt):cInts) = case_ <> ":" <> "grid" <&> case_ <> ":" <> "grid-cols-" <> showTW cInt + <&> showCInts cInts + +-- Shouldn't it be assumed that its responsive? that is the whole point of Classh really +-- +-- | Takes a list of values for how many columns should be taken up at a given screen size +-- | using 'zipScreens' +col :: DomBuilder t m => [Int] -> m a -> m a +col = responsiveRowCol + +-- | Takes a list of values for how many columns should be taken up at a given screen size +-- | using 'zipScreens', as well as where this should start (if you want to skip columns) +-- > do { colFrom [(2,2)] $ text "hey" ; colFrom [(9,2)] $ text "hi" } +colFrom :: DomBuilder t m => [(Int,Int)] -> m a -> m a +colFrom colsCfg ma = + let + (colStarts, colSpans) = unzip colsCfg + spandex = renderWhenTW (zipScreens colSpans) ((<>) "col-span-" . tshow) + startdex = renderWhenTW (zipScreens colStarts) ((<>) "col-start-" . tshow) + in elClass "div" (spandex <&> startdex) ma + +-- | Like col except that the list of cols to take up, is Dynamic. An example use is +-- | an element that expands and contracts based on a click and that we also want to be responsive +-- | to screen sizes, like a side navbar +colDyn :: forall a t m. + ( PostBuild t m + , DomBuilder t m + ) + => Dynamic t [Int] + -> m a + -> m a +colDyn dynCols ma = + let + spandex = ffor dynCols $ \(colSpans) -> + renderWhenTWRank2 + (zipScreens colSpans) + (\condition c -> + if c == 0 + then twWhenText condition ("col-span-" <> tshow c) <&> twWhenText condition "hidden" + else twWhenText condition ("col-span-" <> tshow c) <&> twWhenText condition "block" -- negate hidden if shown on larger size + + ) + in elDynClass "div" spandex ma + +-- | Like col except that its height is 100% of container +-- | +-- | If we look at Width and height of CSS Boxes as Categories then there are 2 main ones on either end +-- | 1) Assume Height == HeightOfContents +-- | 2) Assume Height == HeightOfContainer +-- | and this is true for width as well, but this is handled by the argument which is logical since +-- | responsiveness has a far bigger bearing on width +col' :: DomBuilder t m => [Int] -> m a -> m a +col' colSpans ma = + let + spandex = renderWhenTW (zipScreens colSpans) ((<>) "col-span-" . tshow) + heightCol = $(classh' [h .~~ TWSize_Full]) + in elClass "div" (heightCol <&> spandex) ma + +-- | Takes a list of values for how many columns should be taken up at a given screen size +-- | using 'zipScreens' +responsiveCol :: DomBuilder t m => [Int] -> m a -> m a +responsiveCol = responsiveRowCol + +-- TODO: should we have a variant which controls for padding needs when being a full row? What should that look like? Do we even need that?? +-- +-- | Takes a list of values for how many columns should be taken up at a given screen size +-- | using 'zipScreens' +responsiveRowCol :: DomBuilder t m => [Int] -> m a -> m a +responsiveRowCol colSpans ma = + let spandex = renderWhenTW (zipScreens colSpans) ((<>) "col-span-" . tshow) + in elClass "div" spandex ma + +-- | A type to model how two elements should rotate +-- | as the screen size gets smaller and they are forced into one column +-- | ie. should the element on the right be on top or bottom? +data Rotation a b = CounterClockwise a b | Clockwise a b + +-- | An interface to control how two elements should rotate +-- | as the screen size gets smaller and they are forced into one column +-- | ie. should the element on the right be on top or bottom? +rotatingBox :: DomBuilder t m => TWSizeOrFraction -> Rotation (m ()) (m ()) -> m () +rotatingBox widthA rotation = do + case rotation of + CounterClockwise domA domB -> do + -- A | B || (A : 100% width) + -- || (B : 100% width) + nonMobile widthA domA domB + flip mobile domA domB + Clockwise domA domB -> do + -- A | B || (B : 100% width) + -- || (A : 100% width) + nonMobile widthA domA domB + mobile domA domB + where + boxMobileOnly = col [12] . divClass "block md:hidden w-[100%]" + boxNonMobileLeft width_ = col [7] . divClass (classhUnsafe [w .~~ width_, custom .~ "hidden md:block"]) + boxNonMobileRight = col [5] . divClass "hidden md:block" + + nonMobile width_ domX domY = do + _ <- boxNonMobileLeft width_ $ do + domX + boxNonMobileRight $ do + domY + mobile domX domY = do + _ <- boxMobileOnly $ do + domX + boxMobileOnly $ do + domY + + -- in case rotation of + -- CounterClockwise domA domB -> do + -- -- A | B || (A : 100% width) + -- -- || (B : 100% width) + -- nonMobile + -- flip mobile domA domB + -- -- boxMobileOnly $ do + -- -- domB + -- -- boxMobileOnly $ do + -- -- domA + -- Clockwise domA domB -> do + -- -- A | B || B + -- -- || A + -- nonMobile + -- mobile domA domB + -- -- boxMobileOnly $ do + -- -- domA + -- -- boxMobileOnly $ do + -- -- domB + diff --git a/src/Classh/Reflex/Place.hs b/src/Classh/Reflex/Place.hs new file mode 100644 --- /dev/null +++ b/src/Classh/Reflex/Place.hs @@ -0,0 +1,64 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE OverloadedStrings #-} + +-------------------------------------------------------------------------------- +-- | +-- Module : Classh.Reflex.Place +-- Copyright : (c) 2024, Galen Sprout +-- License : BSD-style (see end of this file) +-- +-- Maintainer : Galen Sprout +-- Stability : provisional +-- Portability : portable +-- +-- A collection of ways to quickly place an element within a parent +-- +------------------------------------------------------------------------------- + + + +module Classh.Reflex.Place where + +--import Classh.Reflex.Layout +import Reflex.Dom.Core +import Classh + +-- | A row of some target width to place a component/container +placeCenterWidth :: DomBuilder t m => WhenTW TWSizeOrFraction -> m a -> m a +placeCenterWidth widthResponsive = centerSimple . divClass (classhUnsafe [ w .~ widthResponsive ]) + +-- | A collection of classes to center horizontally and vertically +centerXY :: ClassCollection BoxConfig +centerXY = ClassCollection [ position .~~ centered, w .~~ pct 100, h .~~ pct 100 ] + +-- | A collection of classes to center horizontally +centerX :: ClassCollection BoxConfig +centerX = ClassCollection [ position .~~ centered, w .~~ pct 100 ] + +-- | A collection of classes to center vertically +centerY :: ClassCollection BoxConfig +centerY = ClassCollection [ position .~~ centered, h .~~ pct 100 ] + +-- | A utility to easily place the element given as an arg in the center (vertically,horizontally) of its parent +centerSimple :: DomBuilder t m => m a -> m a +centerSimple = divClass $(classh' [ position .~~ centered, w .~~ pct 100, h .~~ pct 100 ]) + +-- | A utility to easily place the element given as an arg in the center (horizontally) of its parent +centerHSimple :: DomBuilder t m => m a -> m a +centerHSimple = divClass $(classh' [ position .~~ centered, w .~~ pct 100 ]) + +-- | A utility to easily place the element given as an arg in the center (vertically) of its parent +centerVSimple :: DomBuilder t m => m a -> m a +centerVSimple = divClass $(classh' [ position .~~ centered, h .~~ pct 100 ]) + +-- | A utility to easily place the element-arg centered between some padding +responsiveXPaddedRegion :: DomBuilder t m => [TWSizeOrFraction] -> m a -> m a +responsiveXPaddedRegion opts = centerHSimple . divClass (classhUnsafe [w .|~ opts]) + +-- | A utility to easily place the element-arg centered between some padding, with pre-chosen values +-- | this is really useful for prototyping +responsiveXPaddedRegion' :: DomBuilder t m => m a -> m a +responsiveXPaddedRegion' = responsiveXPaddedRegion [pct 100, pct 80, pct 80, pct 80, pct 80, pct 70] + + + diff --git a/src/Classh/Reflex/Text.hs b/src/Classh/Reflex/Text.hs new file mode 100644 --- /dev/null +++ b/src/Classh/Reflex/Text.hs @@ -0,0 +1,120 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE FlexibleContexts #-} + +-------------------------------------------------------------------------------- +-- | +-- Module : Classh.Reflex.Text +-- Copyright : (c) 2024, Galen Sprout +-- License : BSD-style (see end of this file) +-- +-- Maintainer : Galen Sprout +-- Stability : provisional +-- Portability : portable +-- +-- A collection of interfaces to handle text from a single word to multiple paragraphs +-- +------------------------------------------------------------------------------- + + +module Classh.Reflex.Text where + +import Classh.Reflex.Layout (row) +import Reflex.Dom.Core +import Classh + +import qualified Data.Text as T + + +-- TODO TEXT CONTAINER WITH STATIC SIZING + +-- TODO: variants which do not get checked/compiled + +-- | Text wrapped in a span to ensure classes work properly regardless of context +textS :: DomBuilder t m => CompiledS -> T.Text -> m () +textS s txt = elClass "span" s $ text txt + +-- | Text wrapped in a \'u\' tag to ensure classes work properly regardless of context +textU :: DomBuilder t m => CompiledS -> T.Text -> m () +textU s txt = elClass "u" s $ text txt + +-- | Like textS except that the classes are Dynamic so they may change in response to user events +textDynS + :: ( PostBuild t m + , DomBuilder t m + ) + => Dynamic t CompiledS + -> T.Text + -> m () +textDynS s txt = elDynClass "span" s $ text txt + +-- | Like textS except that the Text is Dynamic so they may change in response to user events +-- | This is just the classhified version of dynText +dynTextS + :: ( PostBuild t m + , DomBuilder t m + ) + => CompiledS + -> Dynamic t T.Text + -> m () +dynTextS s txt = elClass "span" s $ dynText txt + +-- | Like textS except that the Text and class attribute is Dynamic so they may change in response to user events +dynTextDynS + :: ( PostBuild t m + , DomBuilder t m + ) + => Dynamic t CompiledS + -> Dynamic t T.Text + -> m () +dynTextDynS s txt = elDynClass "span" s $ dynText txt + +-- | For creating generic Templates which dont deeply depend on the text or text config given, or allow +-- | for multiple 'TextConfigTW's across a single text. +-- | A simple example is a sentence with highlighted or different color words for emphasis +-- | The one caveat is you do need to manually set the TextSize. +-- > intercalate (only XL2) " " [ textS $(classh' [text_size .~~ XL2, text_color .~~ Black]) "Hey" +-- > , dynTextS $(classh' [text_size .~~ XL2, text_color .~~ White]) (user :: Dynamic t String) +-- > ] +intercalate + :: DomBuilder t m + => WhenTW TextSize + -> T.Text + -> [m ()] + -> m () +intercalate _ _ [] = pure () +intercalate textSize inter (txt':txts') = do + txt' >> prependAll textSize inter txts' + where + prependAll _ _ [] = pure () + prependAll s i (txt:txts) = elClass "span" (renderWhenTW s showTW ) (text i) >> txt >> prependAll s i txts + +-- | Works by setting top padding by one consistent value. Does not add padding for first element + +-- | Display a number of paragraphs (where a paragraph is 1 or more sentences, with whatever crazy styling, like intercalate) +-- | with even spacing between them, defined by the first arg of TWSize +paragraphs + :: DomBuilder t m + => WhenTW TWSize + -> [m ()] + -> m () +paragraphs _ [] = pure () +paragraphs spacing (para:paras) = do + row [] $ para + withTopPadding spacing paras + where + withTopPadding _ [] = pure () + withTopPadding p_ (r_:rs_) = row [t .~ p_] r_ >> withTopPadding p_ rs_ + +-- | Display a number of paragraphs (where a paragraph is 1 or more sentences, with whatever crazy styling, like intercalate) +-- | with variable spacing between them, defined by the first element of the tuple, of type TWSize +paragraphs' + :: DomBuilder t m + => [(WhenTW TWSize, m ())] + -> m () +paragraphs' [] = pure () +paragraphs' ((topPadding,para):rows) = row [t .~ topPadding] para >> paragraphs' rows + + + +textPosition :: DomBuilder t m => CompiledS -> m a -> m a +textPosition = divClass