Shpadoinkle-backend-snabbdom (empty) → 0.1.0.0

raw patch · 6 files changed

+258/−0 lines, 6 filesdep +Shpadoinkledep +basedep +file-embed

Dependencies added: Shpadoinkle, base, file-embed, jsaddle, mtl, text

Files

CHANGELOG.md +0/−0
LICENSE +26/−0
README.md +18/−0
Shpadoinkle-backend-snabbdom.cabal +43/−0
Shpadoinkle/Backend/Snabbdom.hs +135/−0
Shpadoinkle/Backend/Snabbdom/Setup.js +36/−0

+ CHANGELOG.md view

+ LICENSE view

@@ -0,0 +1,26 @@+Shpadoinkle Snabbdom, I think I know exactly what it means+Copyright © 2019 Isaac Shpaira+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:+1. Redistributions of source code must retain the above copyright+notice, this list of conditions and the following disclaimer.+2. Redistributions in binary form must reproduce the above copyright+notice, this list of conditions and the following disclaimer in the+documentation and/or other materials provided with the distribution.+3. Neither the name of the <`3:organization`> nor the+names of its contributors may be used to endorse or promote products+derived from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY <|2|> ''AS IS'' AND ANY+EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL <|2|> BE LIABLE FOR ANY+DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND+ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+

+ README.md view

@@ -0,0 +1,18 @@+# Shpadoinkle Backend Snabbdom++[![Goldwater](https://gitlab.com/fresheyeball/Shpadoinkle/badges/master/pipeline.svg)](https://gitlab.com/fresheyeball/Shpadoinkle)+[![BSD-3](https://img.shields.io/badge/License-BSD%203--Clause-blue.svg)](https://opensource.org/licenses/BSD-3-Clause)+[![built with nix](https://img.shields.io/badge/built%20with-nix-41439a)](https://builtwithnix.org)+[![Hackage](https://img.shields.io/hackage/v/Shpadoinkle-backend-snabbdom.svg)](https://hackage.haskell.org/package/Shpadoinkle-backend-snabbdom)+[![Hackage Deps](https://img.shields.io/hackage-deps/v/Shpadoinkle-backend-snabbdom.svg)](http://packdeps.haskellers.com/reverse/Shpadoinkle-backend-snabbdom)+[![Hackage CI](https://matrix.hackage.haskell.org/api/v2/packages/Shpadoinkle-backend-snabbdom/badge)](https://matrix.hackage.haskell.org/#/package/Shpadoinkle-backend-snabbdom)++This package contains a script to setup the [Snabbdom](https://github.com/snabbdom/snabbdom) virtual dom library as a backend to render Shpadoinkle applications.++> Snabbdom consists of an extremely simple, performant, and extensible core that is only ≈ 200 SLOC. It offers a modular architecture with rich functionality for extensions through custom modules. To keep the core simple, all non-essential functionality is delegated to modules.++These design decisions made Snabbdom a good fit for Shpadoinkle's first high-performance pure JavaScript backend. Right now Snabbdom is being provided via [CloudFlare](https://cdnjs.com/) content delivery network (CDN) and is not included in this repo. This is great for getting started fast and having a transparent developer experience where you can simply switch to the backend of your choosing. However, this is not a stable long term approach as the CDN artifact could be removed at any time. If you wish to use Snabbdom in production, I recommend either:++- Proactively monitoring the CDN endpoints+- Wrap `SnabbdomT` in your own `newtype` and overriding the `setup` method in the `Backend` instance with a mechanism where you provide Snabbdom's JavaScript artifacts yourself.+

+ Shpadoinkle-backend-snabbdom.cabal view

@@ -0,0 +1,43 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.32.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: 65d971f46c65e7bf9238533aaa2d123da99931470b4b1a444c39110f953e032b++name:           Shpadoinkle-backend-snabbdom+version:        0.1.0.0+synopsis:       Use the high-performance Snabbdom virtual dom library written in JavaScript.+description:    Snabbdom is a battle-tested virtual dom library for JavaScript. It's extremely fast, lean, and modular. Snabbdom's design made it a natural choice for a Shpadoinkle rendering backend, as it has a similar core philosophy of "just don't do much" and is friendly to purely functional binding.+category:       Web+author:         Isaac Shapira+maintainer:     fresheyeball@protonmail.com+license:        BSD3+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    CHANGELOG.md+    Shpadoinkle/Backend/Snabbdom/Setup.js++source-repository head+  type: git+  location: https://gitlab.com/fresheyeball/Shpadoinkle.git++library+  exposed-modules:+      Shpadoinkle.Backend.Snabbdom+  other-modules:+      Paths_Shpadoinkle_backend_snabbdom+  hs-source-dirs:+      ./.+  ghc-options: -Wall -Wcompat -fwarn-redundant-constraints -fwarn-incomplete-uni-patterns -fwarn-tabs -fwarn-incomplete-record-updates -fwarn-identities+  build-depends:+      Shpadoinkle+    , base >=4.12.0 && <4.15+    , file-embed >=0.0.11 && <0.1+    , jsaddle >=0.9.7 && <0.20+    , mtl >=2.2.2 && <2.3+    , text >=1.2.3 && <1.3+  default-language: Haskell2010

+ Shpadoinkle/Backend/Snabbdom.hs view

@@ -0,0 +1,135 @@+{-# LANGUAGE CPP                        #-}+{-# LANGUAGE ExtendedDefaultRules       #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE InstanceSigs               #-}+{-# LANGUAGE LambdaCase                 #-}+{-# LANGUAGE MultiParamTypeClasses      #-}+{-# LANGUAGE OverloadedStrings          #-}+{-# LANGUAGE RankNTypes                 #-}+{-# LANGUAGE StandaloneDeriving         #-}+{-# LANGUAGE TemplateHaskell            #-}+{-# LANGUAGE TypeApplications           #-}+{-# LANGUAGE TypeFamilies               #-}+{-# LANGUAGE TypeOperators              #-}+{-# OPTIONS_GHC -fno-warn-type-defaults #-}+++module Shpadoinkle.Backend.Snabbdom+  ( SnabbdomT (..)+  , runSnabbdom+  , stage+  ) where++import           Control.Category+import           Control.Monad.Reader+import           Data.FileEmbed+import           Data.Text+import           Data.Traversable+import           GHC.Conc+import           Language.Javascript.JSaddle hiding (( # ))+import           Prelude                     hiding ((.))++import           Shpadoinkle                 hiding (children, name, props)+++default (Text)+++newtype SnabVNode = SnabVNode { unVNode :: JSVal }+instance ToJSVal   SnabVNode where toJSVal   = return . unVNode+instance FromJSVal SnabVNode where fromJSVal = return . Just . SnabVNode+++newtype SnabbdomT model m a = Snabbdom { unSnabbdom :: ReaderT (TVar model) m a }+  deriving (Functor, Applicative, Monad, MonadIO, MonadReader (TVar model), MonadTrans)+++#ifndef ghcjs_HOST_OS+deriving instance MonadJSM m => MonadJSM (SnabbdomT model m)+#endif+++runSnabbdom :: TVar model -> SnabbdomT model m a -> m a+runSnabbdom t (Snabbdom r) = runReaderT r t+++props :: (m ~> JSM) -> TVar a -> [(Text, Prop (SnabbdomT a m) a)] -> JSM Object+props toJSM i xs = do+  o <- create+  a <- create+  e <- create+  c <- create+  void $ xs `for` \(k, p) -> case p of+    PText t -> do+      t' <- toJSVal t+      true <- toJSVal True+      case k of+        "className" | t /= "" -> unsafeSetProp (toJSString t) true c+        _                     -> unsafeSetProp (toJSString k) t' a+    PListener f -> do+      f' <- toJSVal . fun $ \_ _ -> \case+        [] -> return ()+        ev:_ -> do+          rn <- unsafeGetProp "target" =<< valToObject ev+          liftIO . atomically . writeTVar i =<< (toJSM . runSnabbdom i) (f (RawNode rn) (RawEvent ev))+      unsafeSetProp (toJSString k) f' e+    PFlag b -> do+      f <- toJSVal b+      unsafeSetProp (toJSString k) f a++  p <- toJSVal a+  l <- toJSVal e+  k <- toJSVal c+  unsafeSetProp "props" p o+  unsafeSetProp "class" k o+  unsafeSetProp "on"    l o+  return o+++instance (MonadJSM m, Eq a) => Backend (SnabbdomT a) m a where+  type VNode (SnabbdomT a) m = SnabVNode++  interpret :: (m ~> JSM) -> Html (SnabbdomT a m) a -> SnabbdomT a m SnabVNode+  interpret toJSM = \case++    TextNode t -> liftJSM $ fromJSValUnchecked =<< toJSVal t++    Node name ps [TextNode t] -> do+      i <- ask; liftJSM $ do+        o <- props toJSM i ps+        fromJSValUnchecked =<< jsg3 "vnode" name o t++    Node name ps children -> do+      i <- ask; liftJSM $ do+        o <- props toJSM i ps+        traverse ((toJSM . runSnabbdom i) . interpret toJSM >=> toJSVal) children+          >>= jsg3 "vnode" name o >>= fromJSValUnchecked++    Potato mrn -> liftJSM $ do+      o <- create+      hook <- create+      rn <- mrn+      ins <- toJSVal =<< function (\_ _ -> \case+        [n] -> void $ jsg2 "potato" n rn+        _ -> return ())+      unsafeSetProp "insert" ins hook+      hoo <- toJSVal hook+      unsafeSetProp "hook" hoo o+      fromJSValUnchecked =<< jsg2 "vnode" "div" o+++  patch :: RawNode -> Maybe SnabVNode -> SnabVNode -> SnabbdomT a m SnabVNode+  patch (RawNode r) f t = t <$ (liftJSM . void $ jsg2 "patchh" f' t)+    where f' = maybe r unVNode f+++  setup :: JSM () -> SnabbdomT a m ()+  setup cb = liftJSM $ do+    void $ eval @Text $(embedStringFile "Shpadoinkle/Backend/Snabbdom/Setup.js")+    void . jsg1 "startApp" . fun $ \_ _ _ -> cb+++stage :: MonadJSM m => SnabbdomT a m RawNode+stage = liftJSM $ fromJSValUnchecked =<< jsg "container"+

+ Shpadoinkle/Backend/Snabbdom/Setup.js view

@@ -0,0 +1,36 @@+(() => {++const head = document.getElementsByTagName('head')[0];+const addScript = x => {+  const s = document.createElement('script');+  s.type = 'text/javascript';+  s.src = x;+  head.appendChild(s);+}++const cdnjs = x => "https://cdnjs.cloudflare.com/ajax/libs/snabbdom/0.7.4/" + x;++addScript(cdnjs("snabbdom.min.js"));+addScript(cdnjs("snabbdom-class.min.js"));+addScript(cdnjs("snabbdom-props.min.js"));+addScript(cdnjs("snabbdom-style.min.js"));+addScript(cdnjs("snabbdom-attributes.min.js"));+addScript(cdnjs("snabbdom-eventlisteners.min.js"));+addScript(cdnjs("h.min.js"));++window.startApp = cb => setTimeout(() => {+  const patch = snabbdom.init([+    snabbdom_props.default,+    snabbdom_class.default,+    snabbdom_attributes.default,+    snabbdom_eventlisteners.default+  ]);+  window.patchh = (a,b) => patch(a,b);+  window.vnode = h.default;+  window.potato = (n, e) => n.elm.appendChild(e)+  window.container = document.createElement('div');+  document.body.appendChild(container);+  cb();+}, 1000);++})();