bulmex (empty) → 1.0.0
raw patch · 13 files changed
+820/−0 lines, 13 filesdep +aesondep +basedep +bytestringsetup-changed
Dependencies added: aeson, base, bytestring, containers, jsaddle, jsaddle-dom, lens, network-uri, reflex, reflex-dom-core, reflex-dom-helpers, text, time, witherable
Files
- ChangeLog.md +5/−0
- LICENSE +30/−0
- README.md +1/−0
- Setup.hs +2/−0
- bulmex.cabal +59/−0
- src/Reflex/Bulmex/Attr.hs +56/−0
- src/Reflex/Bulmex/Event.hs +85/−0
- src/Reflex/Bulmex/Html.hs +110/−0
- src/Reflex/Bulmex/Input/Polymorphic.hs +101/−0
- src/Reflex/Bulmex/Load.hs +43/−0
- src/Reflex/Bulmex/PreventDefault.hs +48/−0
- src/Reflex/Bulmex/Space.hs +14/−0
- src/Reflex/Bulmex/Tag.hs +266/−0
+ ChangeLog.md view
@@ -0,0 +1,5 @@+# Revision history for common++## 0.1.0.0 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2018, Jappie Klooster++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Jappie Klooster nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,1 @@+# awesome-project-name
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ bulmex.cabal view
@@ -0,0 +1,59 @@+-- This file has been generated from package.yaml by hpack version 0.28.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: 2b99255d36d075b833dc8c72472ac37a01a82e94c211ebc8955bb3075e4f5d12++name: bulmex+version: 1.0.0+synopsis: Reflex infused with bulma (css)+description: Please see the README on GitHub at <https://github.com/githubuser/awesome-project-name#readme>+category: Web+homepage: https://github.com/jappeace/bulmex#readme+bug-reports: https://github.com/jappeace/bulmex/issues+author: Jappie Klooster+maintainer: jappieklooster@hotmail.com+copyright: 2018 Jappie Klooster+license: MIT+license-file: LICENSE+build-type: Simple+cabal-version: >= 1.10+extra-source-files:+ ChangeLog.md+ README.md++source-repository head+ type: git+ location: https://github.com/jappeace/bulmex++library+ exposed-modules:+ Reflex.Bulmex.Attr+ Reflex.Bulmex.Event+ Reflex.Bulmex.Html+ Reflex.Bulmex.Input.Polymorphic+ Reflex.Bulmex.Load+ Reflex.Bulmex.PreventDefault+ Reflex.Bulmex.Space+ Reflex.Bulmex.Tag+ other-modules:+ Paths_bulmex+ hs-source-dirs:+ src+ ghc-options: -Wall -Wcompat -Wincomplete-uni-patterns -Widentities+ build-depends:+ aeson+ , base >=4.7 && <5+ , bytestring+ , containers+ , jsaddle+ , jsaddle-dom+ , lens+ , network-uri+ , reflex >=0.6.1 && <0.7+ , reflex-dom-core >=0.5 && <0.6+ , reflex-dom-helpers >=0.2.0.1 && <0.3.0.0+ , text+ , time+ , witherable+ default-language: Haskell2010
+ src/Reflex/Bulmex/Attr.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Deal with attribute maps, which revolves mostly around assigning+-- a class so we get appropriate styling++module Reflex.Bulmex.Attr+ ( AttrMap+ , attrUnion+ , isSelectedAttr+ , whenAttr+ , inputAttr+ , classAttr+ , disabled+ , isHidden+ , switchAttr+ , colspan+ ) where++import Data.Bool+import qualified Data.Map.Strict as Map+import qualified Data.Text as Text+import Reflex+import Reflex.Bulmex.Space++-- | This type occures to often to not alias+type AttrMap = Map.Map Text.Text Text.Text++isHidden :: AttrMap+isHidden = classAttr "is-hidden"++-- | Unifies all keys by concatinating the values with a whitespace+attrUnion :: AttrMap -> AttrMap -> AttrMap+attrUnion = Map.unionWith spaceJoin++-- | If bool true adds isSelected+isSelectedAttr :: Bool -> AttrMap+isSelectedAttr = whenAttr "is-selected"++whenAttr :: Text.Text -> Bool -> AttrMap+whenAttr = switchAttr mempty++switchAttr :: Text.Text -> Text.Text -> Bool -> AttrMap+switchAttr lies truth = bool (classAttr lies) (classAttr truth)++inputAttr :: Reflex t => Dynamic t AttrMap+inputAttr = constDyn $ classAttr "input"++-- | class attr is what is needed most of the time+classAttr :: Text.Text -> AttrMap+classAttr = Map.singleton "class"++disabled :: AttrMap+disabled = Map.singleton "disabled" "disabled"++colspan :: Int -> AttrMap+colspan = Map.singleton "colspan" . Text.pack . show
+ src/Reflex/Bulmex/Event.hs view
@@ -0,0 +1,85 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RankNTypes #-}++-- | Helper functions for dealing with events+module Reflex.Bulmex.Event where++import Control.Applicative (empty)+import Control.Monad (void)+import Control.Monad.IO.Class (MonadIO)+import Data.Time.Clock (NominalDiffTime)+import Data.Witherable+import Reflex+import qualified Reflex.Dom.Builder.Class as Dom+import qualified Reflex.Dom.Widget.Basic as Dom++eventJoin :: (Reflex t, MonadHold t m) => Event t (Event t a) -> m (Event t a)+eventJoin = switchHold never++-- | Block those nothing events and only let trough 'Just' values+noNothing :: (Filterable f, Filterable f) => f (Maybe a) -> f a+noNothing = fmapMaybe id++-- | Do something monadic with an event val+-- Because of haskell lazyness the things inside a holdevent+-- don't get evaluated untill the event fires, which makes the first+-- time slow. However it is good for initialization as we don't+-- need to load things unused.+holdEvent ::+ (Dom.DomBuilder t m, MonadHold t m)+ => b+ -> Event t a+ -> (a -> m b)+ -> m (Dynamic t b)+holdEvent val evt fun = Dom.widgetHold (pure val) $ fun <$> evt++-- | Convenience holdEvent for the case where we don't care about the+-- value.+holdEvent_ ::+ (Dom.DomBuilder t m, MonadHold t m) => Event t a -> (a -> m b) -> m ()+holdEvent_ = fmap void . holdEvent undefined -- we throw away the value+++-- | Get rid of a dynimc around a tupple of events,+-- common sense says we should be able to do this for any traversable,+-- but keeping the values of events hetrogenous is hard (I don't know how to)+switchTup ::+ (Reflex t) => Dynamic t (Event t b, Event t c) -> (Event t b, Event t c)+switchTup tup = (switchDyn $ fst <$> tup, switchDyn $ snd <$> tup)++-- | Do something monadic with an event val, and get the event which is+-- delayed for a moment.+-- Using this may indicate you're doing something weird.+-- Although I've found it handy in getting just something to work+holdAfter ::+ ( PostBuild t m+ , Dom.DomBuilder t m+ , MonadHold t m+ , PerformEvent t m+ , TriggerEvent t m+ , MonadIO (Performable m)+ )+ => b+ -> Event t a+ -> (a -> Event t a -> m b)+ -> m (Dynamic t b)+holdAfter val evt fun = delay 0 evt >>= holdEvent val evt . flip fun++-- | show something for 5 seconds after an event+flash ::+ (Monoid c, Dom.DomBuilder t m, PerformEvent t m, MonadHold t m, TriggerEvent t m, (MonadIO (Performable m)))+ => Event t b+ -> (b -> m c)+ -> m (Dynamic t c)+flash = flash' 5 mempty++flash' :: (Dom.DomBuilder t m, PerformEvent t m, MonadHold t m, TriggerEvent t m, (MonadIO (Performable m)))+ => NominalDiffTime+ -> c+ -> Event t b+ -> (b -> m c)+ -> m (Dynamic t c)+flash' time defVal event monadFunc = do+ delayed <- delay time event+ holdEvent defVal (leftmost [pure <$> event, empty <$ delayed]) $+ maybe (pure defVal) monadFunc
+ src/Reflex/Bulmex/Html.hs view
@@ -0,0 +1,110 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}++-- | A root for an app,+-- usefull for server side html rendering.+-- has a neat api for the head tag, use this if that api your needs.+module Reflex.Bulmex.Html+ ( htmlWidget+ -- * Head tag stuff+ , HeadSettings(..)+ , head_js+ , head_css+ , head_title+ , HeadScript(..)+ , script_uri+ , script_is_async+ -- * Defaults+ , defScript+ , defSettings+ ) where++import Control.Lens+import Control.Monad (void)+import Data.Foldable (traverse_)+import qualified Data.Map.Strict as Map+import qualified Data.Text as Text+import GHC.Generics (Generic)+import Network.URI+import qualified Reflex.Dom.Builder.Class as Dom+import qualified Reflex.Dom.Widget as Dom++-- | Adds the core html tags.+-- we already know most of the head.+htmlWidget :: (Dom.DomBuilder t m) => HeadSettings -> m a -> m a+htmlWidget settings content =+ Dom.el "html" $ do+ void $ Dom.el "head" $ do+ headWidget settings+ Dom.el "body" $ content++defSettings :: HeadSettings+defSettings = HeadSettings{+ _head_js = mempty+ , _head_css = mempty+ , _head_title = mempty+ }++data HeadSettings = HeadSettings+ { _head_js :: [HeadScript]+ , _head_css :: [URI]+ , _head_title :: Text.Text+ } deriving (Generic, Show)++head_js :: Lens' HeadSettings [HeadScript]+head_js = lens _head_js $ \x b -> x{_head_js=b}++head_css :: Lens' HeadSettings [URI]+head_css = lens _head_css $ \x b -> x{_head_css=b}++head_title :: Lens' HeadSettings Text.Text+head_title = lens _head_title $ \x b -> x{_head_title=b}++data HeadScript = HeadScript+ { _script_is_async :: Bool+ , _script_uri :: URI+ } deriving (Generic, Show)++defScript :: HeadScript+defScript = HeadScript {+ _script_is_async = True+ , _script_uri = nullURI+ }++script_uri :: Lens' HeadScript URI+script_uri = lens _script_uri $ \x b -> x{_script_uri=b}++script_is_async :: Lens' HeadScript Bool+script_is_async = lens _script_is_async $ \x b -> x{_script_is_async=b}++isasync :: (Text.Text, Text.Text)+isasync = ("async","true")++scriptToMap :: HeadScript -> Map.Map Text.Text Text.Text+scriptToMap script = Map.fromList $+ if (script ^. script_is_async) then [isasync, src] else [src]+ where+ src = ("src", script ^. script_uri . to (Text.pack . show))++-- | Try to keep the head as small as possible.+-- Only things that are required initially should be placed in the head.+-- so the pattern is that we require a bunch of different components+-- initially but we put them in different files.+-- for example we needed the bulma css file for most styling+-- and balloon css for just tooltips.+headWidget :: Dom.DomBuilder t m => HeadSettings -> m ()+headWidget settings = do+ traverse_ (\attrlist -> Dom.elAttr "script" attrlist Dom.blank) $ settings ^.. head_js . traversed . to scriptToMap+ -- google complaints about viewport, but it breaks the table+ -- metaAttr (Map.fromList [("name", "viewport"), ("content", "device-width, initial-scale=1")]) Dom.blank+ void $ Dom.el "title" $ Dom.text $ settings ^. head_title+ traverse_+ (\href ->+ Dom.elAttr "link"+ (Map.fromList -- bulmo+ [("rel", "stylesheet"), ("href", href)])+ Dom.blank) $ settings ^.. head_css . traversed . to (Text.pack . show)
+ src/Reflex/Bulmex/Input/Polymorphic.hs view
@@ -0,0 +1,101 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecursiveDo #-}+{-# LANGUAGE TypeFamilies #-}+++-- | This is just a copy of the upstream code except polymorphic:+-- Get rid of m ~ Ghcjsdomspace to allow these widgets to be prerendered+module Reflex.Bulmex.Input.Polymorphic+ (textInput, TextInput(..), textArea, TextArea(..), textArea_value, textArea_keypress+ , textInput_value+ , textInput_keyup+ , textInput_keypress+ , textInput_keydown+ , textInput_input+ , textInput_hasFocus+ ) where++import Control.Lens+import qualified Data.Map.Strict as Map+import qualified Data.Text as Text+import Reflex+import Reflex.Dom.Builder.Class+import Reflex.Dom.Widget.Basic+import qualified Reflex.Dom.Widget.Input as Inp++textInput :: (DomBuilder t m, PostBuild t m) => Inp.TextInputConfig t -> m (TextInput t)+textInput (Inp.TextInputConfig inputType initial eSetValue dAttrs) = do+ modifyAttrs <- dynamicAttributesToModifyAttributes $ fmap (Map.insert "type" inputType) dAttrs+ i <- inputElement $ Inp.def+ & inputElementConfig_initialValue .~ initial+ & inputElementConfig_setValue .~ eSetValue+ & inputElementConfig_elementConfig . elementConfig_modifyAttributes .~ fmap mapKeysToAttributeName modifyAttrs+ return $ TextInput+ { _textInput_value = _inputElement_value i+ , _textInput_input = _inputElement_input i+ , _textInput_keypress = domEvent Keypress i+ , _textInput_keydown = domEvent Keydown i+ , _textInput_keyup = domEvent Keyup i+ , _textInput_hasFocus = _inputElement_hasFocus i+ }++data TextInput t+ = TextInput { _textInput_value :: Dynamic t Text.Text+ , _textInput_input :: Event t Text.Text+ , _textInput_keypress :: Event t Word+ , _textInput_keydown :: Event t Word+ , _textInput_keyup :: Event t Word+ , _textInput_hasFocus :: Dynamic t Bool+ }++instance Inp.HasValue (TextInput t) where+ type Value (TextInput t) = Dynamic t Text.Text+ value = _textInput_value++textArea :: (DomBuilder t m, PostBuild t m) => Inp.TextAreaConfig t -> m (TextArea t)+textArea (Inp.TextAreaConfig initial eSet attrs) = do+ modifyAttrs <- dynamicAttributesToModifyAttributes attrs+ i <- textAreaElement $ Inp.def+ & textAreaElementConfig_initialValue .~ initial+ & textAreaElementConfig_setValue .~ eSet+ & textAreaElementConfig_elementConfig . elementConfig_modifyAttributes .~ fmap mapKeysToAttributeName modifyAttrs+ return $ TextArea+ { _textArea_value = _textAreaElement_value i+ , _textArea_input = _textAreaElement_input i+ , _textArea_keypress = domEvent Keypress i+ , _textArea_hasFocus = _textAreaElement_hasFocus i+ }++data TextArea t = TextArea { _textArea_value :: Dynamic t Text.Text+ , _textArea_input :: Event t Text.Text+ , _textArea_hasFocus :: Dynamic t Bool+ , _textArea_keypress :: Event t Word+ }++instance Inp.HasValue (TextArea t) where+ type Value (TextArea t) = Dynamic t Text.Text+ value = _textArea_value++textArea_keypress :: Lens' (TextArea t) (Event t Word)+textArea_keypress f (TextArea x1 x2 x3 x4) = (\y -> TextArea x1 x2 x3 y) <$> f x4++textArea_value :: Lens' (TextArea t) (Dynamic t Text.Text)+textArea_value f (TextArea x1 x2 x3 x4) = (\y -> TextArea y x2 x3 x4) <$> f x1++textInput_hasFocus :: Lens' (TextInput t) (Dynamic t Bool)+textInput_hasFocus f (TextInput x1 x2 x3 x4 x5 x6 ) = (\y -> TextInput x1 x2 x3 x4 x5 y ) <$> f x6++textInput_input :: Lens' (TextInput t) (Event t Text.Text)+textInput_input f (TextInput x1 x2 x3 x4 x5 x6 ) = (\y -> TextInput x1 y x3 x4 x5 x6 ) <$> f x2++textInput_keydown :: Lens' (TextInput t) (Event t Word)+textInput_keydown f (TextInput x1 x2 x3 x4 x5 x6 ) = (\y -> TextInput x1 x2 x3 y x5 x6 ) <$> f x4++textInput_keypress :: Lens' (TextInput t) (Event t Word)+textInput_keypress f (TextInput x1 x2 x3 x4 x5 x6 ) = (\y -> TextInput x1 x2 y x4 x5 x6 ) <$> f x3++textInput_keyup :: Lens' (TextInput t) (Event t Word)+textInput_keyup f (TextInput x1 x2 x3 x4 x5 x6 ) = (\y -> TextInput x1 x2 x3 x4 y x6 ) <$> f x5++textInput_value :: Lens' (TextInput t) (Dynamic t Text.Text)+textInput_value f (TextInput x1 x2 x3 x4 x5 x6 ) = (\y -> TextInput y x2 x3 x4 x5 x6) <$> f x1
+ src/Reflex/Bulmex/Load.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Load functions+module Reflex.Bulmex.Load where++import Control.Monad (join)+import Data.Aeson+import Data.Aeson.Text+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Map as Map+import Data.Maybe+import qualified Data.Text as Text+import Data.Text.Encoding+import qualified Data.Text.Lazy as LText+import JSDOM+import JSDOM.Generated.Element+import JSDOM.Generated.NonElementParentNode+import Reflex+import qualified Reflex.Dom.Builder.Class as Dom+import qualified Reflex.Dom.Prerender as Dom+import qualified Reflex.Dom.Widget.Basic as Dom++-- | Insert an encodable in the document body,+-- in case of the server side rendering we encode it as script tag with jsonval,+-- in case of ghcjsdom we read the value from that script tag+-- first arg is the idname to connect the two up (has to be uniq for a doc)+writeReadDom :: (FromJSON a, ToJSON a, Dom.DomBuilder t m, Dom.Prerender js t m) =>+ Text.Text -> a -> m (Dynamic t a)+writeReadDom comelid serverState =+ Dom.prerender (do+ Dom.elAttr "script" (Map.fromList [+ ("type", "application/json"),+ ("id", comelid)+ ]) $+ Dom.text $ LText.toStrict $ encodeToLazyText serverState+ pure serverState+ ) $ do+ mayDoc <- currentDocument+ mayEl' <- sequence $ (getElementById <$> mayDoc) <*> pure comelid+ mayInner <- sequence $ getInnerHTML <$> join mayEl'+ let result = (join $ decode . LBS.fromStrict . encodeUtf8 <$> mayInner)+ pure $ fromMaybe serverState -- TODO don't fail silently+ result
+ src/Reflex/Bulmex/PreventDefault.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | ripped from https://gist.github.com/3noch/134b1ee7fa48c347be9d164c3fac4ef7+module Reflex.Bulmex.PreventDefault where++import Control.Lens ((%~), (.~))+import Data.Map (Map)+import Data.Proxy (Proxy (..))+import Data.Text (Text)+import Reflex.Dom.Core++-- | Like 'elDynAttr'' but configures "prevent default" on the given event.+elDynAttrPrevDef ::+ forall a en m t. (DomBuilder t m, PostBuild t m)+ => EventName en -- ^ Event on the element to configure with 'preventDefault'+ -> Text -- ^ Element tag+ -> Dynamic t (Map Text Text) -- ^ Element attributes+ -> m a -- ^ Child of element+ -> m (Element EventResult (DomBuilderSpace m) t, a) -- An element and the result of the child+elDynAttrPrevDef ev =+ elDynAttrModConf+ (\elCfg ->+ elCfg &+ elementConfig_eventSpec %~+ addEventSpecFlags+ (Proxy :: Proxy (DomBuilderSpace m))+ ev+ (const preventDefault))++-- | Like 'elDynAttr'' but allows you to modify the element configuration.+--+-- Special thanks to @luigy: https://gist.github.com/luigy/b49ce04de8462e594c9c2b5b455ae5a5#file-foo-hs+elDynAttrModConf ::+ (DomBuilder t m, PostBuild t m)+ => (ElementConfig EventResult t (DomBuilderSpace m) -> ElementConfig EventResult t (DomBuilderSpace m))+ -> Text+ -> Dynamic t (Map Text Text)+ -> m a+ -> m (Element EventResult (DomBuilderSpace m) t, a)+elDynAttrModConf f elementTag attrs child = do+ modifyAttrs <- dynamicAttributesToModifyAttributes attrs+ let cfg =+ def & modifyAttributes .~ fmapCheap mapKeysToAttributeName modifyAttrs+ result <- element elementTag (f cfg) child+ postBuild <- getPostBuild+ notReadyUntil postBuild+ pure result
+ src/Reflex/Bulmex/Space.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Sometimes you just need some space in your life+module Reflex.Bulmex.Space+ ( space, spaceJoin+ ) where++import qualified Data.Text as Text++space :: Text.Text+space = " "++spaceJoin :: Text.Text -> Text.Text -> Text.Text+spaceJoin a b = a <> space <> b
+ src/Reflex/Bulmex/Tag.hs view
@@ -0,0 +1,266 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}++-- | bulma divs+module Reflex.Bulmex.Tag where++import Control.Applicative+import Data.Bool+import qualified Data.Map.Strict as Map+import qualified Data.Text as Text+import Reflex+import Reflex.Bulmex.Attr+import Reflex.Bulmex.Space+import qualified Reflex.Dom.Builder.Class as Dom+import qualified Reflex.Dom.Widget as Dom+import qualified Reflex.Tags as T++container :: Dom.DomBuilder t m => m a -> m a+container = containerClass mempty++containerClass :: Dom.DomBuilder t m => Text.Text -> m a -> m a+containerClass = partialDiv "container"++partialDiv :: Dom.DomBuilder t m => Text.Text -> Text.Text -> m a -> m a+partialDiv = txtEl T.divClass++txtEl :: (Text.Text -> m a -> m a) -> Text.Text -> Text.Text -> m a -> m a+txtEl = defaultEl spaceJoin++-- | allows us to set a default value for tags by defining a join function+-- not a monoid because often it does it wrong, text needs a space+-- for example in case of classes, and the default map monoid is broken+defaultEl :: (arg -> arg -> arg) -> (arg -> m a -> m a) -> arg -> arg -> m a -> m a+defaultEl monoidF elF a b = elF $ monoidF a b++buttons :: Dom.DomBuilder t m => m a -> m a+buttons = T.divClass "buttons"++-- | kindoff hard to set an image tag in reflex+image :: Dom.DomBuilder t m => Text.Text -> m()+image url = T.imgAttr (Map.singleton "src" url) Dom.blank++-- | first class second src+imageClass :: Dom.DomBuilder t m => Text.Text -> Text.Text -> m()+imageClass clazz url = T.imgAttr (Map.fromList [("src",url), ("class", clazz)]) Dom.blank++-- | bulma hero sturcture+-- | <section class="hero">+-- | <div class="hero-body">+-- | <div class="container">+hero :: Dom.DomBuilder t m => Text.Text -> m a -> m a+hero styles =+ txtEl T.sectionClass "hero" styles . T.divClass "hero-body" . container++content :: Dom.DomBuilder t m => m a -> m a+content = T.divClass "content"++sect :: (Dom.DomBuilder t m) => m a -> m a+sect = T.divClass "section"++section :: (PostBuild t m, Dom.DomBuilder t m) => m a -> m a+section = sectionDyn $ constDyn mempty++sectionDyn ::+ (PostBuild t m, Dom.DomBuilder t m) => Dynamic t AttrMap -> m a -> m a+sectionDyn =+ dynAttrEl (\a b -> T.divDynAttr a $ container b) $ classAttr "section"++columns :: Dom.DomBuilder t m => m a -> m a+columns = columnsClass mempty++column :: Dom.DomBuilder t m => m a -> m a+column = columnClass mempty++columnsClass :: Dom.DomBuilder t m => Text.Text -> m a -> m a+columnsClass = partialDiv "columns"++columnClass :: Dom.DomBuilder t m => Text.Text -> m a -> m a+columnClass = partialDiv "column"++control :: Dom.DomBuilder t m => m a -> m a+control = controlClass mempty++controlClass :: Dom.DomBuilder t m => Text.Text -> m a -> m a+controlClass = partialDiv "control"++controlDyn ::+ (PostBuild t m, Dom.DomBuilder t m) => Dynamic t AttrMap -> m a -> m a+controlDyn = dynAttrEl T.divDynAttr $ classAttr "control"++tile :: Dom.DomBuilder t m => Text.Text -> m a -> m a+tile = partialDiv "tile"++tileChild :: Dom.DomBuilder t m => m a -> m a+tileChild = tileChildClass mempty++tileChildClass :: Dom.DomBuilder t m => Text.Text -> m a -> m a+tileChildClass = txtEl tile "is-child"++tileParentClass :: Dom.DomBuilder t m => Text.Text -> m a -> m a+tileParentClass = txtEl tile "is-parent"++tileParent :: Dom.DomBuilder t m => m a -> m a+tileParent = tileParentClass mempty++tileAncestor :: Dom.DomBuilder t m => m a -> m a+tileAncestor = tile "is-ancestor"++dynAttrEl ::+ Reflex t+ => (Dynamic t AttrMap -> m a -> m a)+ -> AttrMap+ -> Dynamic t AttrMap+ -> m a+ -> m a+dynAttrEl f = defaultEl ((<*>) . (<$>) attrUnion) f . constDyn++field :: Dom.DomBuilder t m => m a -> m a+field = fieldClass mempty++fieldClass :: Dom.DomBuilder t m => Text.Text -> m a -> m a+fieldClass = partialDiv "field"++fieldGrouped :: Dom.DomBuilder t m => m a -> m a+fieldGrouped = fieldClass "is-grouped"++title :: Dom.DomBuilder t m => m a -> m a+title = titleClazz "is-1"++titleClazz :: Dom.DomBuilder t m => Text.Text -> m a -> m a+titleClazz = txtEl T.h1Class "title"++subtitle :: Dom.DomBuilder t m => m a -> m a+subtitle = subtitleClass "is-3"++subtitleClass :: Dom.DomBuilder t m => Text.Text -> m a -> m a+subtitleClass = txtEl T.h2Class "subtitle"++box :: Dom.DomBuilder t m => m a -> m a+box = T.divClass "box"++evtText :: (Dom.DomBuilder t m, PostBuild t m, MonadHold t m) => Event t Text.Text -> m ()+evtText evt = Dom.dynText =<< holdDyn "" evt+++labeled' :: Dom.DomBuilder t m => m () -> m a -> m a+labeled' labelM inputM = do+ labelEl labelM+ control inputM++-- | named labelEl cause didn't want to fix name clashes+labelEl :: Dom.DomBuilder t m => m a -> m a+labelEl = labelClass mempty++labelClass :: Dom.DomBuilder t m => Text.Text -> m a -> m a+labelClass = txtEl T.labelClass "label"++data ToolDirection+ = Top -- top is graphic bugged+ | Lft+ | Rght+ | Down++-- | balloon css, for example: https://cdnjs.cloudflare.com/ajax/libs/balloon-css/0.5.0/balloon.min.css+tooltipText ::+ (PostBuild t m, Dom.DomBuilder t m) => Dynamic t Text.Text -> m a -> m a+tooltipText = tooltipText' Rght++tooltipText' ::+ (PostBuild t m, Dom.DomBuilder t m)+ => ToolDirection+ -> Dynamic t Text.Text+ -> m a+ -> m a+tooltipText' dir tipDyn monad = T.spanDynAttr (tipToAttr dir <$> tipDyn) $ monad++tipToAttr :: ToolDirection -> Text.Text -> AttrMap+tipToAttr dir "" = tipToAttr dir "-"+tipToAttr dir tip =+ Map.fromList [("data-balloon", tip), ("data-balloon-pos", direction dir)]++direction :: ToolDirection -> Text.Text+direction Top = "top"+direction Lft = "left"+direction Rght = "right"+direction Down = "down"++icon :: (PostBuild t m, Dom.DomBuilder t m) => Text.Text -> m ()+icon = iconClass ""++-- | second is name+iconClass ::+ (PostBuild t m, Dom.DomBuilder t m) => Text.Text -> Text.Text -> m ()+iconClass wrapClass =+ iconDyn (constDyn (classAttr wrapClass)) . constDyn . classAttr++iconDyn ::+ (PostBuild t m, Dom.DomBuilder t m)+ => Dynamic t AttrMap+ -> Dynamic t AttrMap+ -> m ()+iconDyn wrapClass mdiClass = do+ textSpace+ T.spanDynAttr (attrUnion (classAttr "icon") <$> wrapClass) $+ T.iDynAttr (Map.unionWith (<>) (classAttr "mdi mdi-") <$> mdiClass) $+ Dom.blank+ textSpace++-- | sometimes you just need 2 pieces of text to seperate with a space+textSpace :: Dom.DomBuilder t m => m ()+textSpace = Dom.text space++flask :: (PostBuild t m, Dom.DomBuilder t m) => m ()+flask = icon "flask"++-- | a html tag that accepts any text into it's href value+ahref :: (Dom.DomBuilder t m, PostBuild t m) => Text.Text -> m a -> m a+ahref = ahref' mempty++ahref' :: (Dom.DomBuilder t m, PostBuild t m) => AttrMap -> Text.Text -> m a -> m a+ahref' uno = ahrefDyn (constDyn uno) . constDyn++ahrefDyn :: (Dom.DomBuilder t m, PostBuild t m) => Dynamic t AttrMap -> Dynamic t Text.Text -> m a -> m a+ahrefDyn uno txt = T.aDynAttr $ (attrUnion <$> uno) <*> (Map.singleton "href" <$> txt)++switchDiv ::+ (PostBuild t m, Dom.DomBuilder t m)+ => Dynamic t Bool+ -> m ()+ -> m a+ -> m a+switchDiv attrDyn true false = do+ hideDiv_ (not <$> attrDyn) true+ hideDiv_ attrDyn false++-- | when dynamic is true ishidden will be added, else the attrmap is used+hideDiv ::+ (PostBuild t m, Dom.DomBuilder t m)+ => Dynamic t AttrMap+ -> Dynamic t Bool+ -> m a+ -> m a+hideDiv attrDyn hide =+ T.divDynAttr $ bool <$> attrDyn <*> constDyn isHidden <*> hide++hideDiv_ :: (PostBuild t m, Dom.DomBuilder t m) => Dynamic t Bool -> m a -> m a+hideDiv_ = hideDiv $ constDyn Map.empty++loadSpinner :: (Dom.DomBuilder t m) => m ()+loadSpinner = imageClass "loadSpinner" "spinner.svg"++hideEmptyDiv ::+ (Eq (f b), Alternative f, PostBuild t m, Dom.DomBuilder t m)+ => Dynamic t (f b)+ -> m a+ -> m a+hideEmptyDiv = hideEmptyDyn $ constDyn Map.empty++hideEmptyDyn ::+ (Eq (f b), Alternative f, PostBuild t m, Dom.DomBuilder t m)+ => Dynamic t AttrMap+ -> Dynamic t (f b)+ -> m a+ -> m a+hideEmptyDyn dyn = hideDiv dyn . fmap ((==) empty)