packages feed

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 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