bulmex 2.0.0 → 2.1.0

raw patch · 19 files changed

+631/−133 lines, 19 filesdep +generic-lensdep +hspecdep +hspec-corePVP ok

version bump matches the API change (PVP)

Dependencies added: generic-lens, hspec, hspec-core, keycode

API changes (from Hackage documentation)

Files

• bulmex.cabal +61/−5
• src/Reflex/Bulmex/Attr.hs +0/−1
• src/Reflex/Bulmex/Event.hs +26/−4
• src/Reflex/Bulmex/Form.hs +127/−0
• src/Reflex/Bulmex/Form/FormTypes.hs +44/−0
• src/Reflex/Bulmex/Html.hs +48/−39
• src/Reflex/Bulmex/Input/Basic.hs +70/−0
• src/Reflex/Bulmex/Input/Polymorphic.hs +75/−51
• src/Reflex/Bulmex/Load.hs +65/−0
• src/Reflex/Bulmex/Modal.hs +70/−0
• src/Reflex/Bulmex/Space.hs +2/−1
• src/Reflex/Bulmex/Tag/Abstract.hs +4/−3
• src/Reflex/Bulmex/Tag/Bulma.hs +1/−4
• src/Reflex/Bulmex/Tag/Hide.hs +1/−5
• src/Reflex/Bulmex/Tag/Icon.hs +3/−4
• src/Reflex/Bulmex/Tag/Odd.hs +15/−11
• src/Reflex/Bulmex/Tag/Tooltip.hs +5/−5
• test/Spec.hs +1/−0
• test/Test/TestSpec.hs +13/−0

@@ -1,11 +1,13 @@--- This file has been generated from package.yaml by hpack version 0.28.2.+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.31.2. -- -- see: https://github.com/sol/hpack ----- hash: ff65f5447cccce6ee9bed9f2913c5cfb43a800f93be78f0fc411b1c89f46ab8b+-- hash: d67294831c6d62f3268fe8a5d7abc24d2271686c6842d096537e2fdda8d7a170  name:           bulmex-version:        2.0.0+version:        2.1.0 synopsis:       Reflex infused with bulma (css) description:    Reflex infused with bulma, With a bunch of helper functions for making server side rendering easier. See related [blogpost](https://jappieklooster.nl/reflex-server-side-html-rendering.html). category:       Web@@ -17,10 +19,9 @@ license:        MIT license-file:   LICENSE build-type:     Simple-cabal-version:  >= 1.10 extra-source-files:-    ChangeLog.md     README.md+    ChangeLog.md  source-repository head   type: git@@ -30,8 +31,13 @@   exposed-modules:       Reflex.Bulmex.Attr       Reflex.Bulmex.Event+      Reflex.Bulmex.Form+      Reflex.Bulmex.Form.FormTypes       Reflex.Bulmex.Html+      Reflex.Bulmex.Input.Basic       Reflex.Bulmex.Input.Polymorphic+      Reflex.Bulmex.Load+      Reflex.Bulmex.Modal       Reflex.Bulmex.Space       Reflex.Bulmex.Tag       Reflex.Bulmex.Tag.Abstract@@ -50,8 +56,58 @@     , base >=4.7 && <5     , bytestring     , containers+    , generic-lens     , jsaddle     , jsaddle-dom+    , keycode+    , 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++test-suite unit+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Test.TestSpec+      Reflex.Bulmex.Attr+      Reflex.Bulmex.Event+      Reflex.Bulmex.Form+      Reflex.Bulmex.Form.FormTypes+      Reflex.Bulmex.Html+      Reflex.Bulmex.Input.Basic+      Reflex.Bulmex.Input.Polymorphic+      Reflex.Bulmex.Load+      Reflex.Bulmex.Modal+      Reflex.Bulmex.Space+      Reflex.Bulmex.Tag+      Reflex.Bulmex.Tag.Abstract+      Reflex.Bulmex.Tag.Bulma+      Reflex.Bulmex.Tag.Hide+      Reflex.Bulmex.Tag.Icon+      Reflex.Bulmex.Tag.Odd+      Reflex.Bulmex.Tag.Tooltip+      Paths_bulmex+  hs-source-dirs:+      test+      src+  ghc-options: -Wall -Wcompat -Wincomplete-uni-patterns -Widentities+  build-depends:+      aeson+    , base >=4.7 && <5+    , bytestring+    , containers+    , generic-lens+    , hspec+    , hspec-core+    , jsaddle+    , jsaddle-dom+    , keycode     , lens     , network-uri     , reflex >=0.6.1 && <0.7

@@ -2,7 +2,6 @@  -- | Deal with attribute maps, which revolves mostly around assigning --   a class so we get appropriate styling- module Reflex.Bulmex.Attr   ( AttrMap   , attrUnion

@@ -6,8 +6,10 @@ module Reflex.Bulmex.Event where  import           Control.Applicative      (empty)+import           Control.Lens import           Control.Monad            (void) import           Control.Monad.IO.Class   (MonadIO)+import           Data.Bool import qualified Data.Text                as Text import           Data.Time.Clock          (NominalDiffTime) import           Data.Witherable@@ -41,7 +43,6 @@      (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)@@ -69,13 +70,25 @@  -- | 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)))+     ( 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)))+flash' ::+     ( Dom.DomBuilder t m+     , PerformEvent t m+     , MonadHold t m+     , TriggerEvent t m+     , (MonadIO (Performable m))+     )   => NominalDiffTime   -> c   -> Event t b@@ -86,5 +99,14 @@   holdEvent defVal (leftmost [pure <$> event, empty <$ delayed]) $     maybe (pure defVal) monadFunc -evtText :: (Dom.DomBuilder t m, PostBuild t m, MonadHold t m) => Event t Text.Text -> m ()+evtText ::+     (Dom.DomBuilder t m, PostBuild t m, MonadHold t m)+  => Event t Text.Text+  -> m () evtText evt = Dom.dynText =<< holdDyn "" evt++gatePrism :: Reflex t => Prism' a b -> Event t a -> Event t b+gatePrism pr = fmapMaybe (preview pr)++blockFalse :: Reflex t => Event t Bool -> Event t ()+blockFalse = fmapMaybe $ bool Nothing (Just ())

@@ -0,0 +1,127 @@+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecursiveDo       #-}+{-# LANGUAGE TypeFamilies      #-}++-- | Form capture enter presses and provide an html like control flow.+--   They also indicate to the child monad how an action is performing+--   with spinstates.+module Reflex.Bulmex.Form+  ( actionForm+  , form+  -- * Spin+  , withSpinDyn+  , spinWidget+  , aSpinButtonClass+  , loadAttr+  -- * Types+  , module X+  ) where++import           Control.Lens+import           Control.Monad.Fix+import           Control.Monad.IO.Class       (MonadIO)+import qualified Data.Map.Strict              as Map+import qualified Data.Text                    as Text+import           Reflex+import           Reflex.Bulmex.Attr+import           Reflex.Bulmex.Event+import           Reflex.Bulmex.Form.FormTypes as X+import           Reflex.Bulmex.Input.Basic+import qualified Reflex.Dom.Builder.Class     as Dom+import qualified Reflex.Dom.Widget            as Dom+import qualified Reflex.Tags                  as T+import qualified Web.KeyCode                  as Dom++-- | This will make send on enter work for a form.+--   Gives a spinstate to a form and hooks up onenter press to it+--   use actReqButton for sane defaults+actionForm ::+     (Dom.DomBuilder t m, MonadHold t m, MonadFix m)+  => (a -> Event t () -> m (Event t b))+  -> (Event t b -> Dynamic t SpinState -> m (a, Event t FormAction, c))+  -> m c+actionForm actF monM =+  form $ \onEnter -> do+    rec let action = formDat ^. _2+            sendEvt =+              onEnter <> (() <$ noNothing (preview _PostDefault <$> action))+            startSpin =+              sendEvt <> (() <$ noNothing (preview _Loading <$> action))+            stopSpin =+              (() <$ reqRes) <> (() <$ noNothing (preview _FormRest <$> action))+        state <- spinState startSpin stopSpin+        formDat <- monM reqRes state+        reqRes <- actF (formDat ^. _1) sendEvt+    pure $ formDat ^. _3++spinState ::+     (Reflex t, MonadHold t m, MonadFix m)+  => Event t ()+  -> Event t ()+  -> m (Dynamic t SpinState)+spinState start stop =+  accumDyn (const id) SpinRest $ leftmost [Spinning <$ start, SpinRest <$ stop]++-- | This looks a lot like `withDebounceEvtReq`, maybe a better abstraction is possible?+spinWidget ::+     ( Dom.DomBuilder t m+     , PerformEvent t m+     , TriggerEvent t m+     , (MonadIO (Performable m))+     , MonadHold t m+     , MonadFix m+     )+  => (Dynamic t SpinState -> m (Event t ()))+  -> (Event t () -> m (Event t b))+  -> m (Event t b)+spinWidget widgetF eventHandlr = do+  rec onClick <- widgetF dynamicClass+      onRequest <- eventHandlr onClick+      let setClassOnReq = () <$ onRequest+      setClassafterReq <- delay 0 setClassOnReq -- on redraws it needs a delay+      dynamicClass <- spinState onClick $ setClassOnReq <> setClassafterReq+  pure onRequest++loadAttr :: SpinState -> AttrMap+loadAttr SpinRest = mempty+loadAttr Spinning = Map.fromList [("class", "is-loading"), ("disabled", "1")]++withSpinDyn -- XXX only used once? maybe remove+ ::+     ( Dom.DomBuilder t m+     , PerformEvent t m+     , TriggerEvent t m+     , (MonadIO (Performable m))+     , MonadHold t m+     , MonadFix m+     )+  => AttrMap+  -> (Dynamic t AttrMap -> m (Event t ()))+  -> (Event t () -> m (Event t b))+  -> m (Event t b)+withSpinDyn atrributes f =+  spinWidget (f . fmap (attrUnion atrributes . loadAttr))++aSpinButtonClass ::+     (Dom.DomBuilder t m, PostBuild t m)+  => Text.Text+  -> Dynamic t SpinState+  -> m ()+  -> m (Event t ())+aSpinButtonClass clazz spinstate =+  fmap fst .+  abuttonDynAttr (attrUnion (classAttr clazz) . loadAttr <$> spinstate)++-- attrmap+-- | A form captures enter presses of child componetns and+--   sends it to them+form :: (Dom.DomBuilder t m, MonadFix m) => (Event t () -> m a) -> m a+form monF = do+  rec val <-+        T.formAttr'+          -- sometimes it reloads on enter, not always, this stops that+          (Map.singleton "onsubmit" "return false;") $+        monF enter+      let enter = Dom.keypress Dom.Enter (val ^. _1)+  pure $ val ^. _2

@@ -0,0 +1,44 @@+{-# LANGUAGE DataKinds        #-}+{-# LANGUAGE DeriveGeneric    #-}+{-# LANGUAGE TypeApplications #-}++-- | Types for Form.+module Reflex.Bulmex.Form.FormTypes+  ( FormAction(..)+  , SpinState(..)+  -- * Prisms+  , _PostDefault+  , _Loading+  , _FormRest+  ) where++import           Control.Lens+import           Data.Generics.Sum+import           GHC.Generics      (Generic)++data FormAction+  = PostDefault -- ^ do the post+  | Loading -- ^ trigger spin state without doing default the post+  | FormRest -- ^ stop the spin state+  deriving (Generic)++_PostDefault :: Prism' FormAction ()+_PostDefault = _Ctor @"PostDefault"++_Loading :: Prism' FormAction ()+_Loading = _Ctor @"Loading"++_FormRest :: Prism' FormAction ()+_FormRest = _Ctor @"FormRest"++data SpinState -- TODO rename to load state?+  = SpinRest+  | Spinning+  deriving (Show)++instance Semigroup SpinState where+  (<>) SpinRest SpinRest = SpinRest+  (<>) _ _               = Spinning++instance Monoid SpinState where+  mempty = SpinRest

@@ -62,16 +62,12 @@ htmlWidget :: (Dom.DomBuilder t m) => HeadSettings -> m a -> m a htmlWidget settings content =   Dom.el "html" $ do-    void $ Dom.el "head" $ do-      headWidget settings+    void $ Dom.el "head" $ do headWidget settings     Dom.el "body" $ content  defSettings :: HeadSettings-defSettings = HeadSettings{-    _head_js    = mempty-  , _head_css   = mempty-  , _head_title = mempty-  }+defSettings =+  HeadSettings {_head_js = mempty, _head_css = mempty, _head_title = mempty}  data HeadSettings = HeadSettings   { _head_js    :: [HeadScript]@@ -80,13 +76,13 @@   } deriving (Generic, Show)  head_js :: Lens' HeadSettings [HeadScript]-head_js = lens _head_js $ \x b -> x{_head_js=b}+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_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}+head_title = lens _head_title $ \x b -> x {_head_title = b}  data HeadScript = HeadScript   { _script_is_async :: Bool@@ -94,23 +90,23 @@   } deriving (Generic, Show)  defScript :: HeadScript-defScript = HeadScript {-    _script_is_async = True-  , _script_uri = nullURI-  }+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_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}+script_is_async = lens _script_is_async $ \x b -> x {_script_is_async = b}  isasync :: (Text.Text, Text.Text)-isasync = ("async","true")+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]+scriptToMap script =+  Map.fromList $+  if (script ^. script_is_async)+    then [isasync, src]+    else [src]   where     src = ("src", script ^. script_uri . to (Text.pack . show)) @@ -120,37 +116,50 @@ --   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 :: Dom.DomBuilder t m => HeadSettings -> m () headWidget settings = do-  traverse_ (\attrlist -> Dom.elAttr "script" attrlist Dom.blank) $ settings ^.. head_js .  traversed . to scriptToMap+  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"+       Dom.elAttr+         "link"          (Map.fromList -- bulmo             [("rel", "stylesheet"), ("href", href)])-         Dom.blank) $ settings ^.. head_css . traversed . to (Text.pack . show)+         Dom.blank) $+    settings ^..+    head_css .+    traversed .+    to (Text.pack . show)  -- | 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 ::+     (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+  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

@@ -0,0 +1,70 @@+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecursiveDo       #-}+{-# LANGUAGE TypeFamilies      #-}++-- | Basic inputs with bulma styling+module Reflex.Bulmex.Input.Basic+  ( abuttonClass+  , abuttonLarge+  , txtInput+  , abutton+  , buttonClassAttr+  , abuttonDynAttr+  , txtArea+  ) where++import           Control.Lens+import qualified Data.Text                       as Text+import           Reflex+import           Reflex.Bulmex.Attr+import           Reflex.Bulmex.Input.Polymorphic+import qualified Reflex.Dom.Builder.Class        as Dom+import qualified Reflex.Dom.Widget               as Dom+import qualified Reflex.Tags                     as T++txtArea ::+     (Dom.DomBuilder t m, PostBuild t m)+  => Dom.TextAreaConfig t+  -> m (TextArea t)+txtArea conf =+  textArea $+  conf &+  Dom.textAreaConfig_attributes %~+  ((<*>) $ constDyn $ attrUnion $ classAttr "textarea")++-- | Unlabeled text input with input class applied+txtInput ::+     (PostBuild t m, Dom.DomBuilder t m)+  => Dom.TextInputConfig t+  -> m (TextInput t)+txtInput config =+  textInput+    (config &+     Dom.textInputConfig_attributes %~ \x -> attrUnion <$> inputAttr <*> x)++buttonClassAttr :: AttrMap+buttonClassAttr = classAttr "button"++abuttonLarge :: (PostBuild t m, Dom.DomBuilder t m) => m a -> m (Event t ())+abuttonLarge = fmap fst . abuttonClass "is-large"++abuttonClass ::+     (PostBuild t m, Dom.DomBuilder t m)+  => Text.Text+  -> m a+  -> m (Event t (), a)+abuttonClass = abutton . classAttr++abutton ::+     (PostBuild t m, Dom.DomBuilder t m) => AttrMap -> m a -> m (Event t (), a)+abutton = abuttonDynAttr . constDyn++abuttonDynAttr ::+     (PostBuild t m, Dom.DomBuilder t m)+  => Dynamic t AttrMap+  -> m a+  -> m (Event t (), a)+abuttonDynAttr attrs monadF = do+  over (mapped . _1) (Dom.domEvent Dom.Click) $+    T.aDynAttr' (attrUnion buttonClassAttr <$> attrs) monadF

@@ -2,11 +2,15 @@ {-# 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+  , TextInput(..)+  , textArea+  , TextArea(..)+  , textArea_value+  , textArea_keypress   , textInput_value   , textInput_keyup   , textInput_keypress@@ -23,79 +27,99 @@ 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 ::+     (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-    }+  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-               }+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+  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 ::+     (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-    }+  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-              }+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+  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_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_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_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_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_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_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+textInput_value f (TextInput x1 x2 x3 x4 x5 x6) =+  (\y -> TextInput y x2 x3 x4 x5 x6) <$> f x1

@@ -0,0 +1,65 @@+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecursiveDo       #-}++-- | Bulma loading screen w/ help of extension:+--   https://wikiki.github.io/elements/pageloader/+module Reflex.Bulmex.Load+  ( pageLoader+  , prerenderLoad+  -- * Load tricks+  , withReadyEvt+  , postpone+  , getReady+  ) where++import           Control.Monad              (void)+import           Control.Monad.IO.Class     (MonadIO)+import qualified Data.Text                  as Text+import           Reflex+import           Reflex.Bulmex.Event+import           Reflex.Bulmex.Tag.Abstract+import           Reflex.Dom.Builder.Class+import           Reflex.Dom.Prerender+import qualified Reflex.Dom.Widget.Basic    as Dom+import qualified Reflex.Tags                as T++pageLoader :: DomBuilder t m => Text.Text -> m a -> m a+pageLoader = partialDiv "pageloader"++-- | show a spinning image while loading JS+prerenderLoad :: (Prerender js t m, DomBuilder t m) => m () -> m ()+prerenderLoad spinner =+  void $ prerender (T.divClass "prerender-load" $ spinner) Dom.blank++-- | Don't display something untill event occurs,+--   combine with getready to delay loading of non-critical components+postpone :: (DomBuilder t m, MonadHold t m) => Event t () -> m () -> m ()+postpone evt m = holdEvent_ evt (const m)++-- | This doesn't work always,+--   When finished use: https://github.com/reflex-frp/reflex-dom/pull/273+--   postbuild is imediate for sampling, adding a delay makes it after+--   widget completes see: https://github.com/reflex-frp/reflex-dom-semui/issues/18+getReady ::+     ( PostBuild t m+     , PerformEvent t m+     , TriggerEvent t m+     , MonadIO (Performable m)+     )+  => m (Event t ())+getReady = getPostBuild >>= delay 0++-- | attach the ready event to the widget, which fires once it's usuable+withReadyEvt ::+     ( PostBuild t m+     , PerformEvent t m+     , TriggerEvent t m+     , MonadIO (Performable m)+     )+  => m b+  -> m (b, Event t ())+withReadyEvt mb = do+  res <- mb+  evt <- getReady+  pure (res, evt)

@@ -0,0 +1,70 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecursiveDo       #-}++-- | A modal dialogue, eg pop up, for example to confirm an action.+--   Puts code behinds bulma's modal styling: https://bulma.io/documentation/components/modal/+module Reflex.Bulmex.Modal+  ( modal+  , OnClose+  , modal'+  , modalClose+  ) where++import           Control.Lens+import           Control.Monad.Fix+import           Reflex+import           Reflex.Bulmex.Attr+import qualified Reflex.Dom.Builder.Class as Dom+import qualified Reflex.Dom.Widget.Basic  as Dom+import qualified Reflex.Tags              as T++data OnClose =+  OnClose++-- | A modal that opens on event and has a cross to close it.+modal ::+     (PostBuild t m, MonadHold t m, MonadFix m, Dom.DomBuilder t m)+  => Event t ()+  -> m a+  -> m (a, Event t OnClose)+modal = modal' never++-- | A modal that can be opened and closed with events.+--   Also has a cross to close it.+modal' ::+     (PostBuild t m, MonadHold t m, MonadFix m, Dom.DomBuilder t m)+  => Event t ()+  -> Event t ()+  -> m a+  -> m (a, Event t OnClose)+modal' closeEvt openEvt monad =+  modalClose openEvt $ do+    res <- monad+    pure (res, closeEvt)++modalClose ::+     (PostBuild t m, MonadHold t m, MonadFix m, Dom.DomBuilder t m)+  => Event t ()+  -> m (a, Event t ())+  -> m (a, Event t OnClose)+modalClose openEvt monad = do+  rec stateDyn <-+        holdDyn closed (leftmost [opened <$ openEvt, closed <$ result ^. _2])+      result <-+        T.divDynAttr stateDyn $ do+          (backgroundEl, _) <-+            T.divAttr' (classAttr "modal-background") $ Dom.blank+          monadResult <- T.divClass "modal-content" $ monad+          (buttonEl, _) <-+            T.aAttr' (classAttr "modal-close is-large") $ Dom.blank+          let closeClick =+                leftmost+                  [ Dom.domEvent Dom.Click backgroundEl+                  , Dom.domEvent Dom.Click buttonEl+                  , monadResult ^. _2+                  ]+          pure $ (monadResult ^. _1, difference closeClick openEvt)+  pure $ over _2 ((<$) OnClose) result+  where+    closed = classAttr "modal"+    opened = classAttr "modal is-active"

@@ -2,7 +2,8 @@  -- | Sometimes you just need some space in your life module Reflex.Bulmex.Space-  ( space, spaceJoin+  ( space+  , spaceJoin   ) where  import qualified Data.Text as Text

@@ -4,8 +4,8 @@  -- | Abstract tags, most tags have very similiar overload mechanisms --   this provides an abstraction over that-module Reflex.Bulmex.Tag.Abstract(-   defaultEl+module Reflex.Bulmex.Tag.Abstract+  ( defaultEl   , txtEl   , dynAttrEl   , partialDiv@@ -27,7 +27,8 @@ -- | 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 ::+     (arg -> arg -> arg) -> (arg -> m a -> m a) -> arg -> arg -> m a -> m a defaultEl monoidF elF a b = elF $ monoidF a b  dynAttrEl ::

@@ -4,9 +4,7 @@  -- | Bulma styled tags: https://bulma.io/ module Reflex.Bulmex.Tag.Bulma-  (-  -- * Layout-    container+  ( container   , containerClass   , hero   , content@@ -66,7 +64,6 @@ -- > <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

@@ -14,11 +14,7 @@ import qualified Reflex.Tags              as T  switchDiv ::-     (PostBuild t m, Dom.DomBuilder t m)-  => Dynamic t Bool-  -> m ()-  -> m a-  -> m a+     (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

@@ -4,12 +4,11 @@  -- | Icons with material design module Reflex.Bulmex.Tag.Icon-  (-- * Icon-    icon+  ( icon   , iconClass   , iconDyn-  ,-- * Flask-    flask+   -- * Flask+  , flask   ) where  import qualified Data.Map.Strict          as Map

@@ -3,13 +3,10 @@ {-# LANGUAGE RankNTypes          #-} {-# LANGUAGE ScopedTypeVariables #-} - -- | Odd tag helpers, these have uncommen html attributes --   They don't fit in the 'normal' pattern of Abstract module Reflex.Bulmex.Tag.Odd-  (-  -- * Image-    image+  ( image   , imageClass   -- * Link   , ahref@@ -36,14 +33,14 @@ import qualified Reflex.Dom.Widget        as Dom import qualified Reflex.Tags              as T - -- | kindoff hard to set an image tag in reflex-image :: Dom.DomBuilder t m => Text.Text -> m()+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+imageClass :: Dom.DomBuilder t m => Text.Text -> Text.Text -> m ()+imageClass clazz url =+  T.imgAttr (Map.fromList [("src", url), ("class", clazz)]) Dom.blank  -- | sometimes you just need 2 pieces of text to seperate with a space textSpace :: Dom.DomBuilder t m => m ()@@ -53,11 +50,18 @@ 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' ::+     (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)+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)  -- | From https://gist.github.com/3noch/134b1ee7fa48c347be9d164c3fac4ef7 --   Like 'elDynAttr'' but configures "prevent default" on the given event.

@@ -3,11 +3,11 @@ {-# LANGUAGE RankNTypes        #-}  -- | Tooltips with balloon css-module Reflex.Bulmex.Tag.Tooltip(-  tooltipText,-  tooltipText',-  ToolDirection(..),-  tipToAttr+module Reflex.Bulmex.Tag.Tooltip+  ( tooltipText+  , tooltipText'+  , ToolDirection(..)+  , tipToAttr   ) where  import qualified Data.Map.Strict          as Map

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}

@@ -0,0 +1,13 @@+module Test.TestSpec+  ( spec+  ) where++import           Test.Hspec++one :: Int+one = 1++spec :: Spec+spec = do+  describe "The sanity of our test setup" $ do+    it "should satisfy equality" $ one `shouldBe` 1