aboutsummaryrefslogtreecommitdiff
path: root/client/src
diff options
context:
space:
mode:
Diffstat (limited to 'client/src')
-rw-r--r--client/src/Icon.hs58
-rw-r--r--client/src/Main.hs15
-rw-r--r--client/src/View/Payment.hs7
-rw-r--r--client/src/View/Payment/Pages.hs42
4 files changed, 96 insertions, 26 deletions
diff --git a/client/src/Icon.hs b/client/src/Icon.hs
index 7223def..6b2749a 100644
--- a/client/src/Icon.hs
+++ b/client/src/Icon.hs
@@ -2,11 +2,15 @@
{-# LANGUAGE OverloadedStrings #-}
module Icon
- ( loading
- , signOut
- , clone
- , edit
+ ( clone
, delete
+ , edit
+ , loading
+ , doubleLeft
+ , doubleLeftBar
+ , doubleRight
+ , doubleRightBar
+ , signOut
) where
import Data.Map (Map)
@@ -15,30 +19,50 @@ import Data.Text (Text)
import Reflex.Dom (MonadWidget)
import qualified Reflex.Dom as R
-loading :: forall t m. MonadWidget t m => m ()
-loading =
- svgAttr "svg" (M.fromList [ ("width", "24"), ("height", "24"), ("viewBox", "0 0 24 24"), ("class", "loader") ]) $
- svgAttr "path" (M.fromList [("d", "M13.75 22c0 .966-.783 1.75-1.75 1.75s-1.75-.784-1.75-1.75.783-1.75 1.75-1.75 1.75.784 1.75 1.75zm-1.75-22c-1.104 0-2 .896-2 2s.896 2 2 2 2-.896 2-2-.896-2-2-2zm10 10.75c.689 0 1.249.561 1.249 1.25 0 .69-.56 1.25-1.249 1.25-.69 0-1.249-.559-1.249-1.25 0-.689.559-1.25 1.249-1.25zm-22 1.25c0 1.105.896 2 2 2s2-.895 2-2c0-1.104-.896-2-2-2s-2 .896-2 2zm19-8c.551 0 1 .449 1 1 0 .553-.449 1.002-1 1-.551 0-1-.447-1-.998 0-.553.449-1.002 1-1.002zm0 13.5c.828 0 1.5.672 1.5 1.5s-.672 1.501-1.502 1.5c-.826 0-1.498-.671-1.498-1.499 0-.829.672-1.501 1.5-1.501zm-14-14.5c1.104 0 2 .896 2 2s-.896 2-2.001 2c-1.103 0-1.999-.895-1.999-2s.896-2 2-2zm0 14c1.104 0 2 .896 2 2s-.896 2-2.001 2c-1.103 0-1.999-.895-1.999-2s.896-2 2-2z")]) $ R.blank
-
-signOut :: forall t m. MonadWidget t m => m ()
-signOut =
- svgAttr "svg" (M.fromList [ ("width", "24"), ("height", "24"), ("viewBox", "0 0 24 24") ]) $
- svgAttr "path" (M.fromList [("d", "M16 9v-4l8 7-8 7v-4h-8v-6h8zm-2 10v-.083c-1.178.685-2.542 1.083-4 1.083-4.411 0-8-3.589-8-8s3.589-8 8-8c1.458 0 2.822.398 4 1.083v-2.245c-1.226-.536-2.577-.838-4-.838-5.522 0-10 4.477-10 10s4.478 10 10 10c1.423 0 2.774-.302 4-.838v-2.162z")]) $ R.blank
-
clone :: forall t m. MonadWidget t m => m ()
clone =
svgAttr "svg" (M.fromList [ ("width", "24"), ("height", "24"), ("viewBox", "0 0 24 24") ]) $
svgAttr "path" (M.fromList [("d", "M15.143 13.244l.837-2.244 2.698 5.641-5.678 2.502.805-2.23s-8.055-3.538-7.708-10.913c2.715 5.938 9.046 7.244 9.046 7.244zm8.857-7.244v18h-18v-6h-6v-18h18v6h6zm-2 2h-12.112c-.562-.578-1.08-1.243-1.521-2h7.633v-4h-14v14h4v-3.124c.6.961 1.287 1.823 2 2.576v6.548h14v-14z")]) $ R.blank
+delete :: forall t m. MonadWidget t m => m ()
+delete =
+ svgAttr "svg" (M.fromList [ ("width", "24"), ("height", "24"), ("viewBox", "0 0 24 24") ]) $
+ svgAttr "path" (M.fromList [("d", "M3 6v18h18v-18h-18zm5 14c0 .552-.448 1-1 1s-1-.448-1-1v-10c0-.552.448-1 1-1s1 .448 1 1v10zm5 0c0 .552-.448 1-1 1s-1-.448-1-1v-10c0-.552.448-1 1-1s1 .448 1 1v10zm5 0c0 .552-.448 1-1 1s-1-.448-1-1v-10c0-.552.448-1 1-1s1 .448 1 1v10zm4-18v2h-20v-2h5.711c.9 0 1.631-1.099 1.631-2h5.315c0 .901.73 2 1.631 2h5.712z")]) $ R.blank
+
+doubleLeft :: forall t m. MonadWidget t m => m ()
+doubleLeft =
+ svgAttr "svg" (M.fromList [ ("width", "13"), ("height", "13"), ("viewBox", "0 0 1792 1792") ]) $
+ svgAttr "path" (M.fromList [("d", "M1683 141q19-19 32-13t13 32v1472q0 26-13 32t-32-13l-710-710q-8-9-13-19v710q0 26-13 32t-32-13l-710-710q-19-19-19-45t19-45l710-710q19-19 32-13t13 32v710q5-11 13-19z")]) $ R.blank
+
+doubleLeftBar :: forall t m. MonadWidget t m => m ()
+doubleLeftBar =
+ svgAttr "svg" (M.fromList [ ("width", "13"), ("height", "13"), ("viewBox", "0 0 1792 1792") ]) $
+ svgAttr "path" (M.fromList [("d", "M1747 141q19-19 32-13t13 32v1472q0 26-13 32t-32-13l-710-710q-9-9-13-19v710q0 26-13 32t-32-13l-710-710q-9-9-13-19v678q0 26-19 45t-45 19h-128q-26 0-45-19t-19-45v-1408q0-26 19-45t45-19h128q26 0 45 19t19 45v678q4-11 13-19l710-710q19-19 32-13t13 32v710q4-11 13-19z")]) $ R.blank
+
+doubleRight :: forall t m. MonadWidget t m => m ()
+doubleRight =
+ svgAttr "svg" (M.fromList [ ("width", "13"), ("height", "13"), ("viewBox", "0 0 1792 1792") ]) $
+ svgAttr "path" (M.fromList [("d", "M109 1651q-19 19-32 13t-13-32v-1472q0-26 13-32t32 13l710 710q8 8 13 19v-710q0-26 13-32t32 13l710 710q19 19 19 45t-19 45l-710 710q-19 19-32 13t-13-32v-710q-5 10-13 19z")]) $ R.blank
+
+doubleRightBar :: forall t m. MonadWidget t m => m ()
+doubleRightBar =
+ svgAttr "svg" (M.fromList [ ("width", "13"), ("height", "13"), ("viewBox", "0 0 1792 1792") ]) $
+ svgAttr "path" (M.fromList [("d", "M45 1651q-19 19-32 13t-13-32v-1472q0-26 13-32t32 13l710 710q8 8 13 19v-710q0-26 13-32t32 13l710 710q8 8 13 19v-678q0-26 19-45t45-19h128q26 0 45 19t19 45v1408q0 26-19 45t-45 19h-128q-26 0-45-19t-19-45v-678q-5 10-13 19l-710 710q-19 19-32 13t-13-32v-710q-5 10-13 19z")]) $ R.blank
+
edit :: forall t m. MonadWidget t m => m ()
edit =
svgAttr "svg" (M.fromList [ ("width", "24"), ("height", "24"), ("viewBox", "0 0 24 24") ]) $
svgAttr "path" (M.fromList [("d", "M18.363 8.464l1.433 1.431-12.67 12.669-7.125 1.436 1.439-7.127 12.665-12.668 1.431 1.431-12.255 12.224-.726 3.584 3.584-.723 12.224-12.257zm-.056-8.464l-2.815 2.817 5.691 5.692 2.817-2.821-5.693-5.688zm-12.318 18.718l11.313-11.316-.705-.707-11.313 11.314.705.709z")]) $ R.blank
-delete :: forall t m. MonadWidget t m => m ()
-delete =
+loading :: forall t m. MonadWidget t m => m ()
+loading =
+ svgAttr "svg" (M.fromList [ ("width", "24"), ("height", "24"), ("viewBox", "0 0 24 24"), ("class", "loader") ]) $
+ svgAttr "path" (M.fromList [("d", "M13.75 22c0 .966-.783 1.75-1.75 1.75s-1.75-.784-1.75-1.75.783-1.75 1.75-1.75 1.75.784 1.75 1.75zm-1.75-22c-1.104 0-2 .896-2 2s.896 2 2 2 2-.896 2-2-.896-2-2-2zm10 10.75c.689 0 1.249.561 1.249 1.25 0 .69-.56 1.25-1.249 1.25-.69 0-1.249-.559-1.249-1.25 0-.689.559-1.25 1.249-1.25zm-22 1.25c0 1.105.896 2 2 2s2-.895 2-2c0-1.104-.896-2-2-2s-2 .896-2 2zm19-8c.551 0 1 .449 1 1 0 .553-.449 1.002-1 1-.551 0-1-.447-1-.998 0-.553.449-1.002 1-1.002zm0 13.5c.828 0 1.5.672 1.5 1.5s-.672 1.501-1.502 1.5c-.826 0-1.498-.671-1.498-1.499 0-.829.672-1.501 1.5-1.501zm-14-14.5c1.104 0 2 .896 2 2s-.896 2-2.001 2c-1.103 0-1.999-.895-1.999-2s.896-2 2-2zm0 14c1.104 0 2 .896 2 2s-.896 2-2.001 2c-1.103 0-1.999-.895-1.999-2s.896-2 2-2z")]) $ R.blank
+
+signOut :: forall t m. MonadWidget t m => m ()
+signOut =
svgAttr "svg" (M.fromList [ ("width", "24"), ("height", "24"), ("viewBox", "0 0 24 24") ]) $
- svgAttr "path" (M.fromList [("d", "M3 6v18h18v-18h-18zm5 14c0 .552-.448 1-1 1s-1-.448-1-1v-10c0-.552.448-1 1-1s1 .448 1 1v10zm5 0c0 .552-.448 1-1 1s-1-.448-1-1v-10c0-.552.448-1 1-1s1 .448 1 1v10zm5 0c0 .552-.448 1-1 1s-1-.448-1-1v-10c0-.552.448-1 1-1s1 .448 1 1v10zm4-18v2h-20v-2h5.711c.9 0 1.631-1.099 1.631-2h5.315c0 .901.73 2 1.631 2h5.712z")]) $ R.blank
+ svgAttr "path" (M.fromList [("d", "M16 9v-4l8 7-8 7v-4h-8v-6h8zm-2 10v-.083c-1.178.685-2.542 1.083-4 1.083-4.411 0-8-3.589-8-8s3.589-8 8-8c1.458 0 2.822.398 4 1.083v-2.245c-1.226-.536-2.577-.838-4-.838-5.522 0-10 4.477-10 10s4.478 10 10 10c1.423 0 2.774-.302 4-.838v-2.162z")]) $ R.blank
svgAttr :: forall t m a. MonadWidget t m => Text -> Map Text Text -> m a -> m a
svgAttr elementTag attrs child = R.elWith elementTag (R.ElConfig (Just "http://www.w3.org/2000/svg") attrs) child
diff --git a/client/src/Main.hs b/client/src/Main.hs
index 1f167d4..14f0fee 100644
--- a/client/src/Main.hs
+++ b/client/src/Main.hs
@@ -4,11 +4,13 @@ module Main
import qualified Data.Aeson as Aeson
import qualified Data.ByteString.Lazy as LB
-import Data.JSString.Text (textFromJSString)
+import qualified Data.JSString.Text as Dom
import qualified Data.Text.Encoding as T
-import qualified GHCJS.DOM as Dom
-import qualified GHCJS.DOM.NonElementParentNode as Dom
-import GHCJS.DOM.Types (JSM, Element, JSString)
+import qualified JSDOM as Dom
+import qualified JSDOM.Generated.HTMLElement as Dom
+import qualified JSDOM.Generated.NonElementParentNode as Dom
+import JSDOM.Types (JSM, HTMLElement(..))
+import qualified JSDOM.Types as Dom
import Prelude hiding (init, error)
import Common.Model (InitResult(InitEmpty))
@@ -28,13 +30,10 @@ readInit = do
initNode <- Dom.getElementById document "init"
case initNode of
Just node -> do
- text <- textFromJSString <$> js_getInnerText node
+ text <- Dom.textFromJSString <$> Dom.getInnerText (Dom.uncheckedCastTo HTMLElement node)
return $ case Aeson.decode (LB.fromStrict . T.encodeUtf8 $ text) of
Just init -> init
Nothing -> initParseError
_ ->
return initParseError
where initParseError = InitEmpty (Left $ Message.get Key.SignIn_ParseError)
-
-foreign import javascript unsafe "$1[\"innerText\"]"
- js_getInnerText :: Element -> IO JSString
diff --git a/client/src/View/Payment.hs b/client/src/View/Payment.hs
index e80790b..d1430c9 100644
--- a/client/src/View/Payment.hs
+++ b/client/src/View/Payment.hs
@@ -11,8 +11,10 @@ module View.Payment
import Reflex.Dom (MonadWidget)
import qualified Reflex.Dom as R
-import Common.Model (Init)
+import Common.Model (Init(..))
+import View.Payment.Pages (PagesIn(..))
+import qualified View.Payment.Pages as Pages
import View.Payment.Table (TableIn(..))
import qualified View.Payment.Table as Table
@@ -30,4 +32,7 @@ widget paymentIn = do
_ <- Table.widget $ TableIn
{ _tableIn_init = _paymentIn_init paymentIn
}
+ _ <- Pages.widget $ PagesIn
+ { _pagesIn_payments = _init_payments . _paymentIn_init $ paymentIn
+ }
return $ PaymentOut {}
diff --git a/client/src/View/Payment/Pages.hs b/client/src/View/Payment/Pages.hs
new file mode 100644
index 0000000..f9a2b4e
--- /dev/null
+++ b/client/src/View/Payment/Pages.hs
@@ -0,0 +1,42 @@
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecursiveDo #-}
+
+module View.Payment.Pages
+ ( widget
+ , PagesIn(..)
+ , PagesOut(..)
+ ) where
+
+import qualified Data.Text as T
+import Reflex.Dom (MonadWidget)
+import qualified Reflex.Dom as R
+
+import Common.Model (Payment(..))
+
+import qualified Icon
+
+data PagesIn = PagesIn
+ { _pagesIn_payments :: [Payment]
+ }
+
+data PagesOut = PagesOut
+ {
+ }
+
+widget :: forall t m. MonadWidget t m => PagesIn -> m PagesOut
+widget _ = do
+ R.divClass "pages" $ do
+ page Icon.doubleLeftBar
+ page Icon.doubleLeft
+ page (R.text . T.pack . show $ (1 :: Integer))
+ page (R.text . T.pack . show $ (2 :: Integer))
+ page (R.text . T.pack . show $ (3 :: Integer))
+ page (R.text . T.pack . show $ (4 :: Integer))
+ page (R.text . T.pack . show $ (5 :: Integer))
+ page Icon.doubleRight
+ page Icon.doubleRightBar
+ return $ PagesOut {}
+
+page :: forall t m. MonadWidget t m => m () -> m ()
+page content = R.elClass "button" "page" $ content
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-22 22:54:32 +0000