aboutsummaryrefslogtreecommitdiff
path: root/client/src/Component/Modal.hs
diff options
context:
space:
mode:
authorJoris2021-01-03 13:40:40 +0100
committerJoris2021-01-03 13:54:20 +0100
commit11052951b74b9ad4b6a9412ae490086235f9154b (patch)
tree64526ac926c1bf470ea113f6cac8a33158684e8d /client/src/Component/Modal.hs
parent371449b0e312a03162b78797b83dee9d81706669 (diff)
downloadbudget-11052951b74b9ad4b6a9412ae490086235f9154b.tar.gz
budget-11052951b74b9ad4b6a9412ae490086235f9154b.tar.bz2
budget-11052951b74b9ad4b6a9412ae490086235f9154b.zip
Rewrite in Rust
Diffstat (limited to 'client/src/Component/Modal.hs')
-rw-r--r--client/src/Component/Modal.hs117
1 files changed, 0 insertions, 117 deletions
diff --git a/client/src/Component/Modal.hs b/client/src/Component/Modal.hs
deleted file mode 100644
index 46d3f64..0000000
--- a/client/src/Component/Modal.hs
+++ /dev/null
@@ -1,117 +0,0 @@
-module Component.Modal
- ( In(..)
- , Content
- , view
- ) where
-
-import Control.Monad (void)
-import qualified Data.Map as M
-import qualified Data.Map.Lazy as LM
-import Data.Text (Text)
-import qualified Data.Text as T
-import Data.Time.Clock (NominalDiffTime)
-import qualified GHCJS.DOM.Element as Element
-import qualified GHCJS.DOM.Node as Node
-import JSDOM.Types (JSString)
-import Reflex.Dom (Dynamic, Event, MonadWidget)
-import qualified Reflex.Dom as R
-import qualified Reflex.Dom.Class as R
-
-import qualified Util.Reflex as ReflexUtil
-
--- Content = CurtainClickEvent -> (CancelEvent, ConfirmEvent)
-type Content t m = Event t () -> m (Event t (), Event t ())
-
-data In t m = In
- { _in_show :: Event t ()
- , _in_content :: Content t m
- }
-
-view :: forall t m a. MonadWidget t m => In t m -> m (Event t ())
-view input = do
- rec
- let show = Show <$ (_in_show input)
-
- startHiding =
- R.attachWithMaybe
- (\a _ -> if a then Just StartHiding else Nothing)
- (R.current canBeHidden)
- (R.leftmost [ hide, curtainClick ])
-
- canBeHidden <-
- R.holdDyn True $ R.leftmost
- [ False <$ startHiding
- , True <$ endHiding
- ]
-
- endHiding <-
- R.delay (0.2 :: NominalDiffTime) (EndHiding <$ startHiding)
-
- let action =
- R.leftmost [ show, startHiding, endHiding ]
-
- modalClass <-
- R.holdDyn "" (fmap getModalClass action)
-
- (elem, dyn) <-
- R.buildElement "div" (getAttributes <$> modalClass) $
- ReflexUtil.visibleIfEvent
- (isVisible <$> action)
- (R.blank >> return (R.never, R.never, R.never))
- (do
- (curtain, _) <- R.elAttr' "div" (M.singleton "class" "g-Modal__Curtain") $ R.blank
- let curtainClick = R.domEvent R.Click curtain
- (hide, content) <- R.divClass "g-Modal__Content" (_in_content input curtainClick)
- return (curtainClick, hide, content))
-
-
- performShowEffects action elem
-
- let curtainClick = R.switchDyn $ (\(a, _, _) -> a) <$> dyn
- let hide = R.switchDyn $ (\(_, b, _) -> b) <$> dyn
- let content = R.switchDyn $ (\(_, _, c) -> c) <$> dyn
-
- -- Delay the event in order to let time for the modal to disappear
- R.delay (0.5 :: NominalDiffTime) content
-
-getAttributes :: Text -> LM.Map Text Text
-getAttributes modalClass =
- M.singleton "class" $
- T.intercalate " " [ "g-Modal", modalClass]
-
-performShowEffects
- :: forall t m a. MonadWidget t m
- => Event t Action
- -> Element.Element
- -> m ()
-performShowEffects showEvent elem = do
- body <- ReflexUtil.getBody
-
- let showEffects =
- flip fmap showEvent (\case
- Show -> do
- Node.appendChild body elem
- Element.setClassName body ("g-Body--Modal" :: JSString)
- StartHiding ->
- return ()
- EndHiding -> do
- Node.removeChild body elem
- Element.setClassName body ("" :: JSString)
- )
-
- R.performEvent_ $ void `fmap` showEffects
-
-data Action
- = Show
- | StartHiding
- | EndHiding
-
-getModalClass :: Action -> Text
-getModalClass Show = "g-Modal--Show"
-getModalClass StartHiding = "g-Modal--Hiding"
-getModalClass _ = ""
-
-isVisible :: Action -> Bool
-isVisible Show = True
-isVisible StartHiding = True
-isVisible EndHiding = False