diff --git a/spago.dhall b/spago.dhall index 74eb1a7..ddf3b2e 100644 --- a/spago.dhall +++ b/spago.dhall @@ -14,6 +14,7 @@ , "effect" , "either" , "exceptions" + , "foldable-traversable" , "foreign" , "generic-parser" , "halogen" diff --git a/src/App/Container.js b/src/App/Container.js new file mode 100644 index 0000000..d84714d --- /dev/null +++ b/src/App/Container.js @@ -0,0 +1,15 @@ +// Sets some raw HTML into a page given an element. +// In the Halogen code, the parameter is of type `Web.HTML.HTMLElement`. +// +// Function signature: Web.HTML.HTMLElement -> RawHTML -> Effect Unit +// +// `RawHTML` is just a wrapper around a `String`. Nothing fancy. +// +// newtype RawHTML = RawHTML String +export function unsafeSetInnerHTML(element) { + return function (html) { + return function () { + element.innerHTML = html; + }; + }; +} diff --git a/src/App/Container.purs b/src/App/Container.purs index 7c2a93e..9350c22 100644 --- a/src/App/Container.purs +++ b/src/App/Container.purs @@ -50,15 +50,18 @@ import Prelude (Unit, bind, discard, unit, ($), (=<<), (<>), show, pure, (+), (& import Bulma as Bulma import Data.Array as A -import Data.Maybe (Maybe(..), maybe) +import Data.ArrayBuffer.Types (ArrayBuffer) import Data.Either (Either(..)) +import Data.Foldable (for_) +import Data.Maybe (Maybe(..), maybe) import Data.Tuple (Tuple(..)) +import Effect.Aff.Class (class MonadAff) +import Effect (Effect) import Halogen as H import Halogen.HTML as HH import Halogen.HTML.Properties as HP import Type.Proxy (Proxy(..)) -import Effect.Aff.Class (class MonadAff) -import Data.ArrayBuffer.Types (ArrayBuffer) +import Web.HTML (HTMLElement) import App.Message.DNSManagerDaemon as DNSManager import App.Message.AuthenticationDaemon as AuthD @@ -96,6 +99,12 @@ type Login = String type Password = String type LogInfo = Tuple Login Password +newtype RawHTML = RawHTML String + +-- | Since Halogen doesn't have a function to put raw HTML into a page, we have to improvise. +-- | This foreign function adds raw HTML into a page, given a parent node reference. +foreign import unsafeSetInnerHTML :: HTMLElement -> RawHTML -> Effect Unit + -- | A keepalive message is sent every 30 seconds to keep the connection open. -- | `max_keepalive` represents the maximum number of keepalive messages -- | before closing the connections due to inactivity. @@ -282,10 +291,19 @@ render state -- The footer includes logs and both the WS child components. , Bulma.hr , Bulma.columns_ [ Bulma.column_ [ Bulma.h3 "Logs (watch this if something fails 😅)", render_logs ] - , Bulma.column_ [ Bulma.level [render_auth_WS, render_dnsmanager_WS, legal_notice_btn] [] ] + , Bulma.column_ [ Bulma.level + [ render_auth_WS + , render_dnsmanager_WS + , legal_notice_btn + , paypal_btn + ] [] ] ] ] where + + paypal_btn :: forall w i. HH.HTML w i + paypal_btn = HH.div [ HP.ref ref_paypal_div ] [] + legal_notice_btn = Bulma.btn_ [] "Legal notice" (Routing LegalNotice) reconnection_bar :: forall w. HH.HTML w Action reconnection_bar = @@ -348,6 +366,9 @@ render state render_logs :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad render_logs = Bulma.container [ HH.slot_ _log unit AppLog.component unit ] +ref_paypal_div :: H.RefLabel +ref_paypal_div = H.RefLabel "paypal-div" + handleAction :: forall o monad. MonadAff monad => Action -> H.HalogenM State Action ChildSlots o monad Unit handleAction = case _ of Initialize -> do @@ -364,6 +385,21 @@ handleAction = case _ of Just name -> do H.modify_ _ { login = Just name } H.tell _nav unit $ NavigationInterface.TellLogin (Just name) + -- Render the paypal button. + -- How it works: it takes all nodes in the DOM with the reference `ref_paypal_div` ("paypal-div") + -- then it replaces the inner HTML by the provided code. + parentElem <- H.getHTMLElementRef ref_paypal_div + for_ parentElem \el -> do + H.liftEffect $ unsafeSetInnerHTML el (RawHTML """ +
+ """) + Routing page -> do -- Each time the user change load a new page, the counter gets reset -- since it proves they are still active.