reflex-dom-ionic (empty) → 0.1.0.0
raw patch · 4 files changed
+186/−0 lines, 4 filesdep +basedep +containersdep +ghcjs-dom
Dependencies added: base, containers, ghcjs-dom, lens, ref-tf, reflex, reflex-dom-core, text
Files
- CHANGELOG.md +5/−0
- README.md +1/−0
- reflex-dom-ionic.cabal +45/−0
- src/Reflex/Dom/Widget/Ionic.hs +135/−0
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for reflex-dom-ionic++## 0.1.0.0 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.
+ README.md view
@@ -0,0 +1,1 @@+# reflex-dom-ionic
+ reflex-dom-ionic.cabal view
@@ -0,0 +1,45 @@+cabal-version: 2.4+name: reflex-dom-ionic+version: 0.1.0.0+++synopsis: Compatible highlevel Wigdets for some Ionic Input Components++-- A longer description of the package.+description:+ Reflex-DOM is a very powerful web framework for functional reactive programming (FRP).+ It contains some highlevel Widgets for Input.++ This library provides widgets for ion-input and ion-select.++-- A URL where users can report bugs.+bug-reports: https://github.com/chrbauer/reflex-dom-ionic/issues+homepage: https://github.com/chrbauer/reflex-dom-ionic+ +license: BSD-3-Clause+author: Christoph Bauer+maintainer: mail@christoph-bauer.net++-- A copyright notice.+-- copyright:+-- category:+extra-source-files:+ README.md+ CHANGELOG.md++library+ exposed-modules: Reflex.Dom.Widget.Ionic++ -- other-modules:++ build-depends: base >= 4 && < 5+ , containers+ , lens+ , ghcjs-dom+ , ref-tf+ , reflex+ , reflex-dom-core+ , text+ hs-source-dirs: src+ default-language: Haskell2010+ ghc-options: -Wall
+ src/Reflex/Dom/Widget/Ionic.hs view
@@ -0,0 +1,135 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleContexts #-}+module Reflex.Dom.Widget.Ionic+ (ionInputElement,+ ionSelectElement)+where++import Control.Lens (Identity(..), imapM_, iforM_, (^.), makeLenses)+import Control.Monad.Ref+import Data.Maybe+import Data.IORef+import Control.Monad+import Data.Functor.Misc+import Control.Monad.Fix+import GHCJS.DOM.Document (Document, createDocumentFragment, createElement, createElementNS, createTextNode, createComment)+import GHCJS.DOM.Types (liftJSM, askJSM, runJSM, JSM, MonadJSM, FocusEvent, IsElement, IsEvent, IsNode, KeyboardEvent, Node, TouchEvent, WheelEvent, uncheckedCastTo, ClipboardEvent)+import Reflex.Class as Reflex+import Reflex.Host.Class++import qualified GHCJS.DOM as DOM++import qualified GHCJS.DOM.EventM as DOM+import qualified GHCJS.DOM.FileList as FileList+import qualified GHCJS.DOM.GlobalEventHandlers as Events+import qualified GHCJS.DOM.HTMLInputElement as Input+import qualified GHCJS.DOM.HTMLSelectElement as Select++import qualified GHCJS.DOM.EventTargetClosures as DOM (EventName, unsafeEventName, unsafeEventNameAsync)+--import qualified GHCJS.DOM.Types as DOM+--import qualified GHCJS.DOM.EventM as DOM+import qualified GHCJS.DOM.Text as DOM+import qualified GHCJS.DOM.Types as DOM++import Reflex.Dom.Widget.Basic+import Reflex.Dom.Widget.Input++import Reflex.Dom.Builder.Class+import Reflex.Dom.Builder.Immediate+import Reflex.Dom.Builder.Class.Events+import Reflex.Dom.Class+import Reflex.Dom.Old+import Reflex.Dynamic+import Data.Text(Text)+import qualified Data.Map as Map+import Data.Map (Map)+import Reflex.TriggerEvent.Class (TriggerEvent)++default (Text)++ionInputElement+ :: (MonadWidget t m, DomRenderHook t m)+ => Text -> InputElementConfig EventResult t (DomBuilderSpace m) -> m (InputElement EventResult (DomBuilderSpace m) t)+ionInputElement tag cfg = do+ (e, ()) <- element tag (cfg ^. inputElementConfig_elementConfig) $ return ()+ let domInputElement = uncheckedCastTo DOM.HTMLInputElement $ _element_raw e+ eventSelector = _element_events e+ Input.setValue domInputElement $ cfg ^. inputElementConfig_initialValue+ v0 <- Input.getValue domInputElement+ let getMyValue = Input.getValue domInputElement+ valueChangedByUI <- requestDomAction $ liftJSM getMyValue <$ Reflex.select eventSelector (WrapArg Input)+ valueChangedBySetValue <- case _inputElementConfig_setValue cfg of+ Nothing -> return never+ Just eSetValue -> requestDomAction $ ffor eSetValue $ \v' -> do+ Input.setValue domInputElement v'+ getMyValue + v <- holdDyn v0 $ leftmost+ [ valueChangedBySetValue+ , valueChangedByUI+ ]+ Input.setChecked domInputElement $ _inputElementConfig_initialChecked cfg+ checkedChangedByUI <- wrapDomEvent domInputElement (`DOM.on` Events.click) $ do+ Input.getChecked domInputElement+ checkedChangedBySetChecked <- case _inputElementConfig_setChecked cfg of+ Nothing -> return never+ Just eNewchecked -> requestDomAction $ ffor eNewchecked $ \newChecked -> do+ oldChecked <- Input.getChecked domInputElement+ Input.setChecked domInputElement newChecked+ return $ if newChecked /= oldChecked+ then Just newChecked+ else Nothing+ c <- holdDyn (_inputElementConfig_initialChecked cfg) $ leftmost+ [ fmapMaybe id checkedChangedBySetChecked+ , checkedChangedByUI+ ]+ hasFocus <- mkHasFocus e+ files <- holdDyn mempty <=< wrapDomEvent domInputElement (`DOM.on` Events.change) $ do+ mfiles <- Input.getFiles domInputElement+ let getMyFiles xs = fmap catMaybes . mapM (FileList.item xs) . flip take [0..] . fromIntegral =<< FileList.getLength xs+ maybe (return []) getMyFiles mfiles+ checked <- holdUniqDyn c+ return $ InputElement+ { _inputElement_value = v+ , _inputElement_checked = checked+ , _inputElement_checkedChange = checkedChangedByUI+ , _inputElement_input = valueChangedByUI+ , _inputElement_hasFocus = hasFocus+ , _inputElement_element = e+ , _inputElement_raw = domInputElement+ , _inputElement_files = files+ }+++ionSelectElement :: (MonadWidget t m, DomRenderHook t m, TriggerEvent t m )+ => Text -> SelectElementConfig EventResult t (DomBuilderSpace m) ->+ m r ->+ m (SelectElement EventResult (DomBuilderSpace m) t, r)+ionSelectElement tag cfg child = do+ (e@(Element eventSelector domElement), result) <- element tag (cfg ^. selectElementConfig_elementConfig) $ child+ let domSelectElement = uncheckedCastTo DOM.HTMLSelectElement domElement+ Select.setValue domSelectElement $ cfg ^. selectElementConfig_initialValue+ v0 <- Select.getValue domSelectElement+ let getMyValue = Select.getValue domSelectElement+ ionChange :: (DOM.IsGlobalEventHandlers self, DOM.IsEventTarget self) => DOM.EventName self DOM.Event+ ionChange = DOM.unsafeEventName (DOM.toJSString ("ionChange" :: Text))+ valueChangedByUI <- wrapDomEvent (DOM.uncheckedCastTo DOM.HTMLElement $ domElement) (`DOM.on` ionChange) $ do+ liftJSM getMyValue+ valueChangedBySetValue <- case _selectElementConfig_setValue cfg of+ Nothing -> return never+ Just eSetValue -> requestDomAction $ ffor eSetValue $ \v' -> do+ Select.setValue domSelectElement v'+ getMyValue -- We get the value after setting it in case the browser has mucked with it somehow+ v <- holdDyn v0 $ leftmost+ [ valueChangedBySetValue+ , valueChangedByUI+ ]+ hasFocus <- mkHasFocus e+ let wrapped = SelectElement+ { _selectElement_value = v+ , _selectElement_change = valueChangedByUI+ , _selectElement_hasFocus = hasFocus+ , _selectElement_element = e+ , _selectElement_raw = domSelectElement+ }+ return (wrapped, result)