templates (empty) → 0.1.0.0
raw patch · 15 files changed
+926/−0 lines, 15 filesdep +ClasshSSdep +basedep +containers
Dependencies added: ClasshSS, base, containers, data-default, filepath, lens, reflex-classhss, reflex-dom, text
Files
- LICENSE +20/−0
- src/Templates/DomExtras.hs +15/−0
- src/Templates/Partials/Buttons.hs +203/−0
- src/Templates/Partials/Checkbox.hs +46/−0
- src/Templates/Partials/Containers.hs +125/−0
- src/Templates/Partials/Containers/Dropdown.hs +73/−0
- src/Templates/Partials/Errors.hs +39/−0
- src/Templates/Partials/Image.hs +23/−0
- src/Templates/Partials/Inputs.hs +56/−0
- src/Templates/Partials/Invitebar.hs +86/−0
- src/Templates/Partials/Lists.hs +91/−0
- src/Templates/Partials/Modal.hs +33/−0
- src/Templates/Partials/Searchbar.hs +45/−0
- src/Templates/Types.hs +18/−0
- templates.cabal +53/−0
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2024 lazyLambda++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.
+ src/Templates/DomExtras.hs view
@@ -0,0 +1,15 @@+{-# Language OverloadedStrings #-}+module Templates.DomExtras where++import Reflex.Dom.Core+import Data.Text as T++elStyle :: DomBuilder t m =>+ T.Text+ -> T.Text+ -> m a+ -> m a+elStyle etag styleString inner = elAttr etag ("style" =: styleString) inner++elDynStyle :: (PostBuild t m, DomBuilder t m) => T.Text -> Dynamic t T.Text -> m a -> m a+elDynStyle etag styleString inner = elDynAttr etag ((=:) "style" <$> styleString) inner
+ src/Templates/Partials/Buttons.hs view
@@ -0,0 +1,203 @@+{-# LANGUAGE OverloadedStrings #-}++module Templates.Partials.Buttons where++import Templates.Types+import Classh as C+import Classh.Reflex as C+import Data.Text as T+import Reflex.Dom.Core+import Control.Lens ((%~))+import Data.Proxy+import Data.Char (isAlphaNum, isSpace)++iconButton :: DomBuilder t m => Text -> m (Event t ())+iconButton icon = do+ (e, _) <- elClass' "button" classes $ text icon+ pure $ domEvent Click e+ where+ classes = "focus:outline-none bg-primary rounded p-2.5 w-[50%] font-icon text-icon text-white leading-none shadow-button h-[95%]"++iconButton' :: (DomBuilder t m, PostBuild t m) => Dynamic t Bool -> Text -> m (Event t ())+iconButton' enabled icon = do+ let attrs = ffor enabled $ \b -> if b then "class" =: classes else "class" =: classes <> "disabled" =: "1"+ (e, _) <- elDynAttr' "button" attrs $ text icon+ pure $ domEvent Click e+ where+ classes = "focus:outline-none flex-shrink-0 bg-primary rounded p-2.5 font-icon text-icon text-white leading-none shadow-button"++++primaryButton' :: (DomBuilder t m, PostBuild t m) => Dynamic t Bool -> Text -> m (Event t ())+primaryButton' enabled buttonText = do+ let attrs = ffor enabled $ \b -> if b then "class" =: classes else "class" =: classes <> "disabled" =: "1"+ (e, _) <- elDynAttr' "button" attrs $ text buttonText+ pure $ domEvent Click e+ where+ classes =+ "focus:outline-none w-full p-4 mt-12 shadow-button bg-primary \+ \ font-facit font-bold text-white text-body text-center rounded \+ \ hover:bg-primary-rich active:bg-primary-desaturated \+ \ focus:ring-4 ring-primary ring-opacity-50"++secondaryIconButton :: DomBuilder t m => Text -> Text -> m (Event t ())+secondaryIconButton cs icon = do+ (e, _) <- elClass' "button" classes $+ elClass "div" "font-icon leading-none text-icon text-primary-dark" $ text icon+ pure $ domEvent Click e+ where+ classes =+ "focus:outline-none rounded border border-metaline \+ \ focus:ring-4 ring-primary ring-opacity-50 \+ \ p-2.5 flex-shrink-0 bg-primary-light " <> cs+++secondaryButton :: DomBuilder t m => Text -> Text -> m (Event t ())+secondaryButton cs label = do+ (e, _) <- elClass' "button" classes $+ text label+ pure $ domEvent Click e+ where+ classes =+ "w-full p-2.5 leading-none text-center rounded border border-metaline \+ \ bg-primary-light text-primary-darker font-bold font-facit focus:outline-none \+ \ focus:ring-4 ring-primary ring-opacity-50 " <> cs++sendButton :: DomBuilder t m => m (Event t ())+sendButton = iconButton "send"+++navyBlueButton :: DomBuilder t m => Text -> m (Event t ())+navyBlueButton buttonText = do+ (e, _) <- elClass' "button" other $ C.textS textCfg' buttonText+ pure $ domEvent Click e+ where+ textCfg' = $(C.classh' [ C.text_color C..~~ C.White+ , C.text_font C..~~ C.Font_Custom "Sarabun"+ , C.text_weight C..~~ C.Bold+ ])+ other =+ "focus:outline-none w-full p-4 shadow-button bg-[#2E3A59] \+ \ rounded-3xl hover:bg-primary-rich active:bg-primary-desaturated \+ \ focus:ring-4 ring-primary ring-opacity-50 \+ \ transition-all duration-300 ease-in-out \+ \ transform hover:scale-105 active:scale-95 \+ \ hover:shadow-md active:shadow-lg"+++++-- FROM ACE++primaryButtonImageDyn+ :: ( PostBuild t m+ , DomBuilder t m+ )+ => Dynamic t Text+ -> Height+ -> Width+ -> m (Event t ())+primaryButtonImageDyn dynImageHref height width = do+ (e, _) <- elClass' "button" classes $+ elDynAttr "img" imgAttrs blank+ pure $ domEvent Click e+ where+ otherImgAttrs = "height" =: height <> "width" =: width <> "class" =: "block mx-auto"+ imgAttrs = (\src -> otherImgAttrs <> "src" =: src) <$> dynImageHref+ classes =+ "focus:outline-none w-full p-4 mt-16 shadow-button bg-[#00B9DA] \+ \ font-[Sarabun] font-bold text-white text-body text-center rounded-xl \+ \ hover:bg-primary-rich active:bg-primary-desaturated \+ \ focus:ring-4 ring-primary ring-opacity-50 \+ \ transition-all duration-300 ease-in-out \+ \ transform hover:scale-105 active:scale-95 \+ \ hover:shadow-md active:shadow-lg"++++type Height = Text+type Width = Text+primaryButtonImage :: DomBuilder t m => Text -> Height -> Width -> m (Event t ())+primaryButtonImage imageHref height width = do+ (e, _) <- elClass' "button" classes $+ elAttr "img" ("src" =: imageHref <> "height" =: height <> "width" =: width <> "class" =: "block mx-auto") blank+ pure $ domEvent Click e+ where+ classes =+ "focus:outline-none w-full p-4 mt-16 shadow-button bg-[#00B9DA] \+ \ font-[Sarabun] font-bold text-white text-body text-center rounded-xl \+ \ hover:bg-primary-rich active:bg-primary-desaturated \+ \ focus:ring-4 ring-primary ring-opacity-50 \+ \ transition-all duration-300 ease-in-out \+ \ transform hover:scale-105 active:scale-95 \+ \ hover:shadow-md active:shadow-lg"++primaryButtonImageText :: DomBuilder t m => Text -> Height -> Width -> Text -> m (Event t ())+primaryButtonImageText imageHref height width bottomText = do+ (e, _) <- elClass' "button" classes $ do+ elAttr "img" ("src" =: imageHref <> "height" =: height <> "width" =: width <> "class" =: "block mx-auto") blank+ text bottomText -- TODO: replace with styledText+ pure $ domEvent Click e+ where+ classes =+ "focus:outline-none w-full p-4 mt-16 shadow-button bg-[#00B9DA] \+ \ font-[Sarabun] font-bold text-white text-body text-center rounded-xl \+ \ hover:bg-primary-rich active:bg-primary-desaturated \+ \ focus:ring-4 ring-primary ring-opacity-50 \+ \ transition-all duration-300 ease-in-out \+ \ transform hover:scale-105 active:scale-95 \+ \ hover:shadow-md active:shadow-lg"+++primaryButtonSized :: DomBuilder t m => TWSize -> TWSize -> Text -> m (Event t ())+primaryButtonSized height width buttonText = do+ (e, _) <- elAttr' "button" ("class" =: classTW <> "name" =: name) $ text buttonText+ pure $ domEvent Click e+ where+ classTW = primaryClass <&> ("py-" <> showTW height) <&> ("px-" <> showTW width)+ -- for testing / selenium mainly+ name = T.filter (\c -> isAlphaNum c || isSpace c ) buttonText+++primaryButton :: DomBuilder t m => Text -> m (Event t ())+primaryButton buttonText = do+ (e, _) <- elAttr' "button" ("class" =: (primaryClass <&> "py-4 px-8") <> "name" =: name) $ text buttonText+ pure $ domEvent Click e+ where+ -- for testing / selenium mainly+ name = T.filter (\c -> isAlphaNum c || isSpace c ) buttonText++primaryClass =+ "focus:outline-none shadow-button bg-[#00B9DA] \+ \ font-[Sarabun] font-bold text-white text-body text-center rounded-xl \+ \ hover:bg-primary-rich active:bg-primary-desaturated \+ \ focus:ring-4 ring-primary ring-opacity-50 \+ \ transition-all duration-300 ease-in-out \+ \ transform hover:scale-105 active:scale-95 \+ \ whitespace-nowrap inline-block \+ \ hover:shadow-md active:shadow-lg min-[0px]:text-xs md:text-lg"++example :: Template t m => m (Event t ())+example = buttonToggleBody "" True $ \case+ True -> text "hey"+ False -> text "Hello"++-- | Toggles between 2 inner bodies based on its clicks+buttonToggleBody :: Template t m => Dynamic t T.Text -> Bool -> (Bool -> m a) -> m (Event t ())+buttonToggleBody buttonClasses start dynDom = mdo+ (e, _) <- elDynClass' "button" buttonClasses $ dyn $ ffor booly $ dynDom+ let clk = domEvent Click e+ booly <- toggle start clk+ pure clk+++-- | Stop event propogation on click+greedyButton :: forall t m a. DomBuilder t m => m a -> m (Event t (), a)+greedyButton c = do+ let cfg = (def :: ElementConfig EventResult t (DomBuilderSpace m))+ & elementConfig_eventSpec %~ addEventSpecFlags (Proxy :: Proxy (DomBuilderSpace m)) Click (const stopPropagation)+ (e, a) <- element "button" cfg c+ return (domEvent Click e, a)++greedyButton_ :: forall t m a. DomBuilder t m => m a -> m (Event t ())+greedyButton_ c = fmap fst $ greedyButton c
+ src/Templates/Partials/Checkbox.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE OverloadedStrings #-}++module Templates.Partials.Checkbox where++import Reflex.Dom.Core hiding (checkbox, Checkbox(..), CheckboxConfig(..))+import Data.Default+import qualified Data.Map as Map+import qualified Data.Text as T++++data CheckboxConfig t = CheckboxConfig+ { _checkboxConfig_setValue :: Event t Bool+ , _checkboxConfig_attributes :: Dynamic t (Map.Map T.Text T.Text)+ }++instance Reflex t => Default (CheckboxConfig t) where+ {-# INLINABLE def #-}+ def = CheckboxConfig { _checkboxConfig_setValue = never+ , _checkboxConfig_attributes = constDyn mempty+ }++data Checkbox t+ = Checkbox { _checkbox_value :: Dynamic t Bool+ , _checkbox_change :: Event t Bool+ }++instance HasValue (Checkbox t) where+ type Value (Checkbox t) = Dynamic t Bool+ value = _checkbox_value++checkbox :: (DomBuilder t m, PostBuild t m) => Bool -> CheckboxConfig t -> m (Checkbox t)+checkbox checked config = do+ let permanentAttrs = "type" =: "checkbox"+ dAttrs = Map.delete "checked" . Map.union permanentAttrs <$> _checkboxConfig_attributes config+ modifyAttrs <- dynamicAttributesToModifyAttributes dAttrs+ i <- inputElement $ def+ & inputElementConfig_initialChecked .~ checked+ & inputElementConfig_setChecked .~ _checkboxConfig_setValue config+ & inputElementConfig_elementConfig . elementConfig_initialAttributes .~ Map.mapKeys (AttributeName Nothing) permanentAttrs+ & inputElementConfig_elementConfig . elementConfig_modifyAttributes .~ fmap mapKeysToAttributeName modifyAttrs+ return $ Checkbox+ { _checkbox_value = _inputElement_checked i+ , _checkbox_change = _inputElement_checkedChange i+ }
+ src/Templates/Partials/Containers.hs view
@@ -0,0 +1,125 @@+{-# LANGUAGE OverloadedStrings #-}+module Templates.Partials.Containers where++import Classh+import Classh.Reflex+import Templates.Partials.Image+import Templates.Partials.Buttons+import Templates.Types++import Data.Text as T (Text)+import Data.Bool+import Control.Monad.Fix+import Control.Monad+import Reflex.Dom.Core++screenContainer :: (DomBuilder t m) => m a -> m a+screenContainer = elClass "div" $(classh' [w .~~ TWSize_Screen, h .~~ TWSize_Screen, custom .~ "flex flex-col overflow-hidden"])++toggleButton :: (MonadFix m, DomBuilder t m, PostBuild t m, MonadHold t m) => Text -> m (Dynamic t Bool)+toggleButton label = do+ let+ classes :: Bool -> Text+ classes shown =+ "text-icon font-icon transform select-none " -- Icon display classes+ <> "transition-transform duration-300 ease-in-out " -- Animation settings classes+ <> bool "rotate-180" mempty shown -- Do a little twirl!++ -- The icon for a rendered container is a triangle pointing up, and+ -- the icon for an unrendered container is that same triangle, rotated+ -- 180deg. Using a single icon + a rotation means the transition can+ -- be animated; Having the "neutral" position be "no transform" means+ -- the icon won't do a twirl on page load.+ rec+ (labelEl, _) <- elClass' "div" $(classh' [ mt .~~ TWSize 8+ , custom .~ "cursor-pointer flex flex-row justify-between"+ ]) $ do+ textS $(classh' [ text_color .~~ White ]) label+ elDynClass' "span" (classes <$> toggled) $ text "expand_less"+ let toggleEv = domEvent Click labelEl+ toggled <- holdUniqDyn =<< toggle True toggleEv++ pure toggled+++++-- | Wrap the body contents in a container that can be collapsed by+-- clicking on its header. As an optimisation, when the container is+-- collapsed, the inner tree is not rendered.+collapsibleContainer_ :: (MonadFix m, DomBuilder t m, PostBuild t m, MonadHold t m) => Text -> m a -> m ()+collapsibleContainer_ label body = do+ toggled <- toggleButton label++ dyn_ (bool blank (void body) <$> toggled)++-- | Wrap the body contents in a container that can be collapsed by+-- clicking on its header.+collapsibleContainer :: (MonadFix m, DomBuilder t m, PostBuild t m, MonadHold t m) => Text -> m a -> m a+collapsibleContainer label body = do+ let+ bodyClasses :: Bool -> Text+ bodyClasses shown = bool "hidden" mempty shown++ toggled <- toggleButton label++ elDynClass "div" (bodyClasses <$> toggled) body+++-- | Wrap the body contents in a container that can be collapsed by+-- clicking on its header.+collapsibleContainerWithImage+ :: (MonadFix m, DomBuilder t m, PostBuild t m, MonadHold t m)+ => Text+ -> Text+ -> m a+ -> m a+collapsibleContainerWithImage imgSrc label body = do+ let+ bodyClasses :: Bool -> Text+ bodyClasses shown = bool "hidden" mempty shown++ toggled <- toggleButton' imgSrc label+ elDynClass "div" (bodyClasses <$> toggled) body+++toggleButton' :: (MonadFix m, DomBuilder t m, PostBuild t m, MonadHold t m) => Text -> Text -> m (Dynamic t Bool)+toggleButton' imgSrc label = do+ let+ classes :: Bool -> Text+ classes shown =+ "text-icon font-icon transform select-none " -- Icon display classes+ <> "transition-transform duration-300 ease-in-out " -- Animation settings classes+ <> bool "rotate-180" mempty shown -- Do a little twirl!++ -- The icon for a rendered container is a triangle pointing up, and+ -- the icon for an unrendered container is that same triangle, rotated+ -- 180deg. Using a single icon + a rotation means the transition can+ -- be animated; Having the "neutral" position be "no transform" means+ -- the icon won't do a twirl on page load.+ rec+ (labelEl, _) <- elClass' "div" "grid grid-cols-12 p-4" $ do+ elClass "div" $(classh' [colSpan .~~ 2]) $ imgClass imgSrc ""+ elClass "div" $(classh' [colSpan .~~ 9]) $ textS $(classh' [text_size .|~ [Base,LG,XL,XL2, XL3]]) label+ elDynClass' "span" (classes <$> toggled) $+ dynText "expand_less"++ let toggleEv = domEvent Click labelEl+ toggled <- holdUniqDyn =<< toggle True toggleEv++ pure toggled++++openCloseButton :: Template t m => ImgSrc -> Color -> T.Text -> m (Event t ())+openCloseButton imgSrc tColor name = do+ buttonToggleBody (constDyn "pl-10") True $ \case+ True -> do+ --gridCol Col12 $ do+ col [6] $ imgClass imgSrc $(classh' [custom .~ "rotate-180 inline-block", position .~~ centered ])+ divClass $(classh' [colSpan .|~ [6], position .~~ centered, custom .~ "inline-block"]) $ do+ textS (classhUnsafe [text_color .~~ tColor]) $ "close" <&> name+ False -> do+ col [6] $ imgClass imgSrc $(classh' [custom .~ "rotate-180 inline-block", position .~~ centered ])+ divClass $(classh' [colSpan .|~ [6], position .~~ centered, custom .~ "inline-block"]) $ do+ textS (classhUnsafe [text_color .~~ tColor]) $ "open" <&> name
+ src/Templates/Partials/Containers/Dropdown.hs view
@@ -0,0 +1,73 @@+{-# LANGUAGE OverloadedStrings #-}++module Templates.Partials.Containers.Dropdown where++import Classh+import Classh.Reflex+import Reflex.Dom.Core+import Control.Monad.Fix+import Data.Maybe+import qualified Data.Map as Map+import qualified Data.Text as T+++-- | TODO: take an element config for the options elements as well+-- | TODO: clean up and upstream to reflex-dom-contrib+dropdown'+ :: ( MonadFix m+ , DomBuilder t m+ )+ => Map.Map a T.Text+ -> SelectElementConfig er t (DomBuilderSpace m)+ -> m (Dynamic t a)+dropdown' options cfg' = mdo+ let class' = "w-full px-4 py-3 border border-gray-300 rounded-lg focus:outline-none focus:border-[#00B9DA] font-[Sarabun] text-lg mb-5 bg-white"+ let safeInitial = (snd . head $ Map.toList options)+ let cfg = cfg'+ & selectElementConfig_initialValue .~ safeInitial+ & selectElementConfig_setValue .~ optionsEvent+ & selectElementConfig_elementConfig . elementConfig_initialAttributes .~ ("class" =: class')+ (selectEl, optionsEvent) <- selectElement cfg $ do+ optionsEv <- mapM makeOpt $ fmap snd $ Map.toList options+ pure $ leftmost optionsEv+ let options' = Map.fromList $ fmap flipTup $ Map.toList options+ pure $ fmap (\v -> fromJust $ Map.lookup v options') $ _selectElement_value selectEl+ where+ flipTup (a_,b_) = (b_,a_)+ makeOpt optText = do+ (e, _) <- elAttr' "option" ("value" =: optText) $ text optText+ pure $ optText <$ domEvent Click e++dropdownWithDefault+ :: ( MonadFix m+ , DomBuilder t m+ )+ => Map.Map a T.Text+ -> T.Text+ -> SelectElementConfig er t (DomBuilderSpace m)+ -> m (Dynamic t a)+dropdownWithDefault options start cfg' = mdo+ let class' = $(classh' [ w .~~ TWSize_Full, px .~~ TWSize 4, py .~~ TWSize 3+ , bw .~~ B1+ , bc .~ [("def",Gray C300), ("focus", hex "00B9DA")]+ , br .~~ R_Lg+ , border . bStyle .~ [("focus",BNone)]+ , custom .~ "focus:outline-none focus:border-"+ , mb .~~ TWSize 5+ , bgColor .~~ White+ ])+ let safeInitial = start+ let cfg = cfg'+ & selectElementConfig_initialValue .~ safeInitial+ & selectElementConfig_setValue .~ optionsEvent+ & selectElementConfig_elementConfig . elementConfig_initialAttributes .~ ("class" =: class')+ (selectEl, optionsEvent) <- selectElement cfg $ do+ optionsEv <- mapM makeOpt $ fmap snd $ Map.toList options+ pure $ leftmost optionsEv+ let options' = Map.fromList $ fmap flipTup $ Map.toList options+ pure $ fmap (\v -> fromJust $ Map.lookup v options') $ _selectElement_value selectEl+ where+ flipTup (a_,b_) = (b_,a_)+ makeOpt optText = do+ (e, _) <- elAttr' "option" ("value" =: optText) $ textS $(classh' [text_font .~~ Font_Custom "Sarabun", text_size .~~ LG]) optText+ pure $ optText <$ domEvent Click e
+ src/Templates/Partials/Errors.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE OverloadedStrings #-}+-- | Partial templates for displaying error messages.+module Templates.Partials.Errors where++import Classh+import Classh.Reflex (textS)++import Templates.Types+import Reflex.Dom.Core+import Data.Text (Text)++eitherDisplay+ :: Template t m+ => Dynamic t (Either e a) -- ^ What to watch for+ -> (a -> m ()) -- ^ How to render contents+ -> (e -> m ())+ -> m ()+eitherDisplay dynEith template failtemplate = dyn_ $ ffor dynEith $ \case+ Left e -> failtemplate e+ Right x_ -> template x_++-- | Render the given template only when the 'Dynamic' is 'Just'.+maybeDisplay+ :: Template t m+ => (a -> m ()) -- ^ How to render contents+ -> Dynamic t (Maybe a) -- ^ What to watch for+ -> m ()+maybeDisplay template val = dyn_ $ ffor val $ \case+ Nothing -> blank+ Just x -> template x++-- | Render the given template when the 'Event' fires.+displayOn :: Template t m => (a -> m ()) -> Event t a -> m ()+displayOn template ev = maybeDisplay template =<< holdDyn Nothing (Just <$> ev)++-- | Render an error message.+errorMessage :: Template t m => Text -> m ()+errorMessage t =+ elClass "div" $(classh' [mt .~~ TWSize 1, h .~~ twSize' 4]) $ textS "text-opacity-70" t
+ src/Templates/Partials/Image.hs view
@@ -0,0 +1,23 @@+module Templates.Partials.Image where++import Templates.Types+import Reflex.Dom.Core+import System.FilePath (takeBaseName)+import qualified Data.Map as Map+import qualified Data.Text as T++mkBasicName :: T.Text -> T.Text +mkBasicName = T.replace (T.pack "-") (T.pack " ") . T.pack . takeBaseName . T.unpack + +img :: DomBuilder t m => ImgSrc -> m ()+img src = elAttr (T.pack "img") ((T.pack "src") =: src <> (T.pack "alt") =: mkBasicName src) blank++imgAttr :: DomBuilder t m => ImgSrc -> Map.Map T.Text T.Text -> m ()+imgAttr src atrs = elAttr (T.pack "img") ((T.pack "src") =: src <> atrs <> maybeAlt) blank+ where+ maybeAlt = case Map.lookup (T.pack "alt") atrs of+ Just _ -> mempty+ Nothing -> (T.pack "alt") =: mkBasicName src++imgClass :: DomBuilder t m => ImgSrc -> T.Text -> m ()+imgClass src class' = elAttr (T.pack "img") ((T.pack "src") =: src <> (T.pack "class") =: class' <> (T.pack "alt") =: mkBasicName src) blank
+ src/Templates/Partials/Inputs.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE OverloadedStrings #-}+module Templates.Partials.Inputs where++import Reflex.Dom.Core hiding (El)+import Templates.Types+import Data.Text as T+import Data.Map as Map++import Classh as C++commonClassesBox :: T.Text+commonClassesBox = $(classh' [mx .~~ TWSize 1, custom .~ "focus:outline-none bg-inset flex-grow" ]) ++commonClassesText :: T.Text+commonClassesText = $(classh' [text_size .|~ [XL2, XL4], custom .~ "font-label" ])++messageInput'+ :: Template t m+ => Event t (Map AttributeName Text)+ -> Event t ()+ -> m (InputEl t m)+messageInput' newAttributes clearEvent = inputElement $ def+ & initialAttributes .~ messageInputAttrs+ & inputElementConfig_setValue .~ ("" <$ clearEvent)+ & (inputElementConfig_elementConfig . elementConfig_modifyAttributes) .~ ((fmap.fmap) Just newAttributes)++messageInput+ :: Template t m+ => Event t (Map AttributeName Text)+ -> Event t ()+ -> m (TextAreaElement EventResult (DomBuilderSpace m) t)+messageInput newAttributes clearEvent = textAreaElement $ def+ & initialAttributes .~ messageInputAttrs+ & textAreaElementConfig_setValue .~ ("" <$ clearEvent)+ & (textAreaElementConfig_elementConfig . elementConfig_modifyAttributes) .~ ((fmap.fmap) Just newAttributes)+++messageInputAttrs :: Map.Map AttributeName T.Text+messageInputAttrs =+ "class" =: $(classh' [w .~~ TWSize_Full, p .~~ TWSize 4, custom .~ "text-2xl"] )+ <> "placeholder" =: "Type your message"+ <> "type" =: "text"+ <> "rows" =: "2"++attachmentInput+ :: Template t m+ => Event t ()+ -> m (InputEl t m)+attachmentInput clearEvent =+ divClass classhd $+ inputElement $ def+ & initialAttributes .~ ("type" =: "file" <> "class" =: "")+ & inputElementConfig_setValue .~ ("" <$ clearEvent)+ where+ classhd = "focus:outline-none mx-1 font-facit font-label text-2xl bg-inset"+ <&> boxCSS (def & position .~ centeredOnly )
+ src/Templates/Partials/Invitebar.hs view
@@ -0,0 +1,86 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE LambdaCase #-}+module Templates.Partials.Invitebar where++import Classh+import Classh.Reflex (textS)++import Data.Default+import Data.Text (Text)+import Data.Text as T+import Control.Monad.Fix (MonadFix)++import Reflex.Dom.Core+import Templates.Types +import Templates.Partials.Buttons++emailParse :: a -> Either T.Text Bool+emailParse _ = Right True++-- | Builds an input bar for emails, it returns both the input and+-- the button that sends it.+invitebar :: (PostBuild t m, DomBuilder t m, MonadHold t m, MonadFix m) => Text -> m (InputEl t m, Event t ())+invitebar placeholder = do+ rec+ let emailClass e = ffor (emailParse <$> e) $ \case+ Right True -> "border-rose-600 text-rose-600"+ _ -> "border-rose-600 text-rose-600"+ emailText e = case emailParse e of+ Right True -> "Invitation sent to " <> e+ -- TODO: remove+ Right False -> "Email must be @aceinterviewprep.io"+ Left _ -> "Invalid email format"+ invbar@(invInput, invButton) <- elClass "div" $(classh' [my .~~ TWSize 2+ , w .~~ TWSize_Full+ , custom .~ "shadow-button flex flex-row"+ , bgColor .~~ White+ , br .~~ R_Normal+ ]) $ do+ elClass "button" $(classh' [ pl .~~ TWSize 2 ]) $ textS "font-icon text-icon" "email"+ invInput' <- inputElement $ def+ & initialAttributes .~+ ("class" =:+ $(classh' [ w .~~ TWSize_Full+ , h .~~ TWSize_Full+ , bgColor .~~ Transparent+ , px .~~ TWSize 1+ , pt .~~ TWSize 3+ , pb .~~ TWSize 3+ , pr .~~ TWSize 2+ , custom .~ "focus:outline-none flex-grow placeholder-light font-label"+ ]+ ) + <> "placeholder" =: placeholder+ <> "type" =: "email"+ )+ invButton' <- iconButton' toEnable "send"++ return (invInput', invButton')++ toEnable <- holdDyn False $+ const True <$> gate + (current $ T.null <$> _inputElement_value invInput)+ (_inputElement_input invInput)++ toHide <- holdDyn "hidden " $+ const mempty <$> gate + (current $ not . T.null <$> _inputElement_value invInput)+ invButton++ feedback <- holdDyn mempty $+ emailText <$> tag + (current $ _inputElement_value invInput)+ invButton++ let+ dynClass = + fmap ( (<>) $(classh' [pl .~~ TWSize 1, pt .~~ TWSize 0, pb .~~ TWSize 1, pr .~~ TWSize 3, custom .~ "text-center"]))+ $ toHide+ <> (emailClass $ _inputElement_value invInput)++ elDynClass "div" dynClass+ $ dynText feedback++ return invbar
+ src/Templates/Partials/Lists.hs view
@@ -0,0 +1,91 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Partial for rendering list items.+module Templates.Partials.Lists where++import Classh+import Classh.Reflex (textS)++import Data.Default+import Data.List (intersperse)+import Data.Text (Text)+import qualified Data.Text as T+import Reflex.Dom.Core++-- | Configuration for a list item.+data ListItemConfig t = ListItemConfig+ { _listItemConfig_clickable :: Dynamic t Bool+ , _listItemConfig_subtext :: Dynamic t (Maybe Text)+ , _listItemConfig_icon :: Dynamic t (Maybe Text)+ , _listItemConfig_highlight :: Dynamic t (Maybe Text)+ , _listItemConfig_unread :: Dynamic t (Maybe Int)+ }++-- | The default configuration for list items is to have no subtext, no+-- icon, no highlighting information, and to not be clickable.+defListItemConfig :: Applicative (Dynamic t) => ListItemConfig t+defListItemConfig = ListItemConfig+ { _listItemConfig_clickable = pure False+ , _listItemConfig_subtext = pure Nothing+ , _listItemConfig_icon = pure Nothing+ , _listItemConfig_highlight = pure Nothing+ , _listItemConfig_unread = pure Nothing + }++instance Reflex t => Default (ListItemConfig t) where+ def = defListItemConfig++-- | Render the given 'Text' with highlighting given by the+-- 'ListItemConfig'.+renderHighlight :: (DomBuilder t m, PostBuild t m) => ListItemConfig t -> Text -> m ()+renderHighlight cfg txt = dyn_ $ ffor (_listItemConfig_highlight cfg) $ \case+ Just tok | not (T.null tok) -> + sequence_ $ intersperse + (elClass "span" "font-bold" (text tok)) -- Bold occurences of the highlighted text,+ (text <$> T.splitOn tok txt) -- inbetween the rest of the label text+ _ -> text txt -- If there is no highlighting information, just render it as text.+++-- | Render a list item with the given label.+listItem+ :: ( DomBuilder t m+ , PostBuild t m+ )+ => ListItemConfig t -- ^ Visual configuration for the list item+ -> Dynamic t Text -- ^ The label+ -> m (Event t ()) + -- ^ If the configuration has '_listItemConfig_clickable' set, then+ -- this is the 'Click' event for the list item. Otherwise, it's+ -- 'never'.+listItem cfg label = do+ let + topClass :: (Bool, Maybe Int) -> Text+ topClass (click, unread) = T.intercalate " " $+ [ "flex flex-col py-2 border-b border-metaline" ]+ <> case click of+ True -> ["cursor-pointer hover:bg-[#2E3A59]"]+ False -> []+ <> case unread of+ Just _ -> [ "bg-[#FF6D31]" ]+ Nothing -> []+ let topClassDyn = topClass <$> ((,) <$> _listItemConfig_clickable cfg <*> _listItemConfig_unread cfg)++ + (e, _) <- elDynClass' "div" topClassDyn $ do++ elClass "div" "leading-none font-facit text-body text-xl text-white flex flex-row items-center gap-2 overflow-hidden" $ do+ dyn_ $ ffor (_listItemConfig_icon cfg) $ \case+ Nothing -> blank+ Just icon -> elClass "span" "font-icon text-icon select-none" $ text icon++ el "span" $ dyn_ $ renderHighlight cfg <$> label++ dyn_ $ ffor (_listItemConfig_subtext cfg) $ \case+ Just subtext -> elClass "div" "mt-1 leading-none font-facit text-label text-light" $ text subtext+ Nothing -> blank++ + pure $ domEvent Click e +++
+ src/Templates/Partials/Modal.hs view
@@ -0,0 +1,33 @@+{-# LANGUAGE OverloadedStrings #-}++module Templates.Partials.Modal where++import Templates.Partials.Image+import Templates.Types+import Reflex.Dom.Core+import Control.Monad.Fix+import Data.Text as T+++modal :: ( DomBuilder t m+ , MonadFix m+ , MonadHold t m+ , PostBuild t m+ )+ => ImgSrc+ -> Event t ()+ -> m a+ -> m (Event t a)+modal xButtonImgSrc open modalDom = mdo+ let styleBase = "position:fixed;z-index:20;padding-top:100px;left:0;top:0;width:100%;height:100%;overflow:auto;background-color:rgb(0,0,0);background-color:rgba(0,0,0,0.4);"+ hideModal = ("style" =: ("display:none;" <> styleBase))+ showModal = ("style" =: ("display:block;" <> styleBase))+ modalAttrs <- holdDyn hideModal $ mergeWith const [showModal <$ open, hideModal <$ close]+ close <- elDynAttr "div" modalAttrs $ do+ elAttr "div" ("style" =: "background-color:#00004D;margin:auto;padding:20px;width:80%;color:white;"+ <> "class" =: "border-double rounded-md border-8 border-black text-base") $ do+ e <- fmap fst $ elClass' "span" "pl-5 ml-5 pb-4 text-rose-500 grid justify-items-end" $ do+ imgAttr xButtonImgSrc ("height" =: "30px" <> "width" =: "30px")+ x' <- modalDom+ pure $ x' <$ (domEvent Click e)+ pure close
+ src/Templates/Partials/Searchbar.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+module Templates.Partials.Searchbar where++import Classh++import Data.Default+import Data.Text (Text)++import Reflex.Dom.Core+import Templates.Types++searchbar+ :: DomBuilder t m+ => Text+ -> Event t a+ -> m (InputEl t m)+searchbar placeholder clearEvent = do+ elClass "div" $(classh' [mt .~~ TWSize 0, w .~~ TWSize_Full, bgColor .~~ White, br .~~ R_Normal, custom .~ "flex flex-row"]) $ do+ elClass "button" $(classh' [ px .~~ TWSize 3+ , br .~~ R_Normal+ , custom .~ "leading-none shadow-button focus:outline-none font-icon"]) $ text "search"+ inputElement $ def+ & initialAttributes .~+ ("class" =: ($(classh' [ w .~~ (pix 96) + , h .~~ TWSize_Full+ , bgColor .~~ Transparent+ , pl .~~ TWSize 2+ , py .~~ TWSize 1+ , pr .~~ TWSize 3+ , custom .~ "focus:outline-none flex-grow placeholder-light"+ ]+ ) <> $(classh' [ text_color .~~ Black + , text_weight .~~ Light+ , text_size .~~ XL+ , custom .~ "text-icon"+ ]+ )+ )+ <> "placeholder" =: placeholder+ <> "type" =: "text"+ )+ & inputElementConfig_setValue .~ (mempty <$ clearEvent)+
+ src/Templates/Types.hs view
@@ -0,0 +1,18 @@+{-# LANGUAGE OverloadedStrings #-}+module Templates.Types+ ( module Templates.Types+ ) where++import Reflex.Dom.Core hiding (El)+import Control.Monad.Fix (MonadFix)+import Data.Text (Text)++type Template t m = (DomBuilder t m, PostBuild t m, MonadHold t m, MonadFix m)++type InputEl t m = InputElement EventResult (DomBuilderSpace m) t++type TextAreaEl t m = TextAreaElement EventResult (DomBuilderSpace m) t ++type El t m = Element EventResult (DomBuilderSpace m) t++type ImgSrc = Text
+ templates.cabal view
@@ -0,0 +1,53 @@+name: templates+version: 0.1.0.0+cabal-version: >= 1.10+build-type: Simple+maintainer: galen.sprout@gmail.com+category: Web +license-file: LICENSE +license: MIT +synopsis: Out of the box reflex-dom elements+description:+ Out of the box reflex-dom elements built with ClasshSS and reflex-classhss+source-repository head+ type: git+ location: https://github.com/Ace-Interview-Prep/templates++library+ hs-source-dirs: src+ exposed-modules: Templates.Partials.Buttons+ Templates.Partials.Checkbox+ Templates.Partials.Image+ Templates.Partials.Containers+ Templates.Partials.Containers.Dropdown+ Templates.Partials.Inputs+ Templates.Partials.Lists+ Templates.Partials.Modal+ Templates.Partials.Searchbar+ Templates.Partials.Errors+ Templates.Partials.Invitebar+ Templates.Types+ Templates.DomExtras+ default-language: Haskell2010 + default-extensions:+ ConstraintKinds+ FlexibleContexts+ FlexibleInstances+ FunctionalDependencies+ GADTs+ LambdaCase+ MultiParamTypeClasses+ RankNTypes+ RecursiveDo+ ScopedTypeVariables+ TemplateHaskell++ build-depends: ClasshSS >= 0.2.0 && < 0.3+ , base >= 4.19.0 && < 4.21+ , containers >= 0.7 && < 0.8+ , data-default >= 0.8.0 && < 0.9+ , filepath >= 1.5.4 && < 1.6+ , lens >= 5.3.6 && < 5.4+ , reflex-classhss >= 0.1.0 && < 0.2+ , reflex-dom >= 0.6.3 && < 0.7+ , text >= 2.1.3 && < 2.2