Shpadoinkle 0.2.0.0 → 0.3.0.0

raw patch · 7 files changed

+351/−182 lines, 7 filesdep +containersdep +waidep +wai-app-staticsetup-changedPVP ok

version bump matches the API change (PVP)

Dependencies added: containers, wai, wai-app-static, warp

API changes (from Hackage documentation)

Files

• Control/PseudoInverseCategory.hs +9/−9
• README.md +1/−2
• Setup.hs +1/−1
• Shpadoinkle.cabal +9/−6
• Shpadoinkle/Continuation.hs +22/−27
• Shpadoinkle/Core.hs +120/−137
• Shpadoinkle/Run.hs +189/−0

@@ -23,8 +23,9 @@   import qualified Control.Categorical.Functor as F-import           Control.Category-import           Data.Functor.Identity+import           Control.Category            (Category (..))+import           Data.Bifunctor              (bimap, first, second)+import           Data.Functor.Identity       (Identity (..)) import           Data.Tuple                  (swap) import           Prelude                     hiding (id, (.)) @@ -178,14 +179,13 @@ instance PIArrow EndoIso where   piiso = EndoIso id   piendo f = EndoIso f id id-  pifirst (EndoIso f g h) = EndoIso (\(x,y)->(f x,y)) (\(x,y)->(g x,y)) (\(x,y)->(h x,y))-  pisecond (EndoIso f g h) = EndoIso (\(x,y)->(x,f y)) (\(x,y)->(x,g y)) (\(x,y)->(x,h y))+  pifirst (EndoIso f g h) = EndoIso (first f) (first g) (first h)+  pisecond (EndoIso f g h) = EndoIso (second f) (second g) (second h)   pisplit (EndoIso f g h) (EndoIso i j k) = EndoIso-    (\(x,y) -> (f x, i y))-    (\(x,y) -> (g x, j y))-    (\(x,y) -> (h x, k y))+    (bimap f i)+    (bimap g j)+    (bimap h k)   pifan (EndoIso f g h) (EndoIso i j _) = EndoIso-    (\x -> f (i x))+    (f . i)     (\x -> (g x, j x))     (\(x,_) -> h x) -- it shouldn't matter which side we use to go back because we have isomorphisms-

@@ -8,8 +8,7 @@ [![Hackage Deps](https://img.shields.io/hackage-deps/v/Shpadoinkle.svg)](http://packdeps.haskellers.com/reverse/Shpadoinkle) [![Hackage CI](https://matrix.hackage.haskell.org/api/v2/packages/Shpadoinkle/badge)](https://matrix.hackage.haskell.org/#/package/Shpadoinkle) -Shpadoinkle is a programming model for UI development, oriented around simplicity,-performance, and ergonomics.+Shpadoinkle is a Haskell UI programming paradigm.  ## The core concept 

@@ -1,2 +1,2 @@-import Distribution.Simple+import           Distribution.Simple main = defaultMain

@@ -1,13 +1,13 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.32.0.+-- This file has been generated from package.yaml by hpack version 0.33.0. -- -- see: https://github.com/sol/hpack ----- hash: 1d3c55562c8448cd288523fb62cb616caa2a301fba5f92e2ac5b61a931143bbd+-- hash: 551573dac4a13219ffcfb0a630517ffaeef58089ef1c69e2feb128417516a320  name:           Shpadoinkle-version:        0.2.0.0+version:        0.3.0.0 synopsis:       A programming model for declarative, high performance user interface. description:    Shpadoinkle is an abstract frontend programming model, with one-way data flow, and a single source of truth. This module provides a parsimonious implementation of Shpadoinkle with few implementation details. category:       Web@@ -30,6 +30,7 @@       Shpadoinkle       Shpadoinkle.Continuation       Shpadoinkle.Core+      Shpadoinkle.Run   other-modules:       Paths_Shpadoinkle   hs-source-dirs:@@ -38,14 +39,16 @@   build-depends:       base >=4.12.0 && <4.16     , category >=0.2 && <0.3+    , containers     , ghcjs-dom >=0.9.4 && <0.20     , jsaddle >=0.9.7 && <0.20     , text >=1.2.3 && <1.3     , transformers     , unliftio-  if impl(ghcjs)-    build-depends:-  else+  if !impl(ghcjs)     build-depends:         jsaddle-warp >=0.9.7 && <0.20+      , wai+      , wai-app-static+      , warp   default-language: Haskell2010

@@ -1,4 +1,3 @@-{-# LANGUAGE InstanceSigs          #-} {-# LANGUAGE LambdaCase            #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes            #-}@@ -24,7 +23,7 @@   -- ** Hoist   , hoist   -- * Forgetting-  , voidC', voidC, forgetC, forgetC'+  , voidC', voidC, forgetC   -- * Lifts   , liftC', liftCMay', liftC, liftCMay   -- * Utilities@@ -44,11 +43,14 @@ import           Control.Arrow                 (first) import qualified Control.Categorical.Functor   as F import           Control.Monad                 (liftM2, void)-import           Control.Monad.Trans.Class-import           Control.PseudoInverseCategory+import           Control.Monad.Trans.Class     (MonadTrans (..))+import           Control.PseudoInverseCategory (EndoIso (..))+import           Data.Maybe                    (fromMaybe) import           GHC.Conc                      (retry)-import           UnliftIO-import           UnliftIO.Concurrent+import           UnliftIO                      (MonadUnliftIO, TVar, atomically,+                                                newTVarIO, readTVar, readTVarIO,+                                                writeTVar)+import           UnliftIO.Concurrent           (forkIO)   -- | A Continuation builds up an@@ -128,7 +130,7 @@ -- | @f@ is a Functor to Hask from the category where the objects are --   Continuation types and the morphisms are functions. class Continuous f where-  mapC :: Functor m => Functor n => (Continuation m a -> Continuation n b) -> f m a -> f n b+  mapC :: (Continuation m a -> Continuation m b) -> f m a -> f m b   instance Continuous Continuation where@@ -137,8 +139,8 @@  -- | Given a natural transformation, change a Continuation's underlying functor. hoist :: Functor m => (forall b. m b -> n b) -> Continuation m a -> Continuation n a-hoist _ (Pure f) = Pure f-hoist f (Rollback r) = Rollback (hoist f r)+hoist _ (Pure f)              = Pure f+hoist f (Rollback r)          = Rollback (hoist f r) hoist f (Continuation (g, h)) = Continuation . (g,) $ \x -> f $ hoist f <$> h x  @@ -154,7 +156,7 @@ liftCMay' f g (Pure h)     = Pure $ \x -> maybe x (flip f x . h) $ g x liftCMay' f g (Rollback r) = Rollback (liftCMay' f g r) liftCMay' f g (Continuation (h, i)) =-  Continuation (\x -> maybe x (flip f x . h) $ g x, \x -> maybe (pure done) (fmap (liftCMay' f g) . i) $ g x)+  Continuation (\x -> maybe x (flip f x . h) $ g x, maybe (pure done) (fmap (liftCMay' f g) . i) . g)   -- | Given a lens, change the value type of @f@ by applying the lens in the Continuations inside @f@.@@ -180,15 +182,10 @@   -- | Forget about the Continuations.-forgetC :: Monad m => Monad n => Continuous f => f m a -> f n b+forgetC :: Continuous f => f m a -> f m b forgetC = mapC (const done)  --- | Forget about the Continuations without changing the monad. This can be easier on type inference compared to forgetC.-forgetC' :: Monad m => Continuous f => f m a -> f m b-forgetC' = forgetC-- --- | Change the type of a Continuation by applying it to the left coordinate of a tuple. leftC' :: Functor m => Continuation m a -> Continuation m (a,b) leftC' = liftC' (\x (_,y) -> (x,y)) fst@@ -211,11 +208,11 @@  -- | Transform a Continuation to work on 'Maybe's. If it encounters 'Nothing', then it cancels itself. maybeC' :: Applicative m => Continuation m a -> Continuation m (Maybe a)-maybeC' (Pure f) = (Pure (fmap f))+maybeC' (Pure f) = Pure (fmap f) maybeC' (Rollback r) = Rollback (maybeC' r) maybeC' (Continuation (f, g)) = Continuation . (fmap f,) $   \case-    Just x -> maybeC' <$> g x+    Just x  -> maybeC' <$> g x     Nothing -> pure (Rollback done)  @@ -227,9 +224,7 @@ -- | Turn a @Maybe a@ updating function into an @a@ updating function which acts as --   the identity function when the input function outputs 'Nothing'. comaybe :: (Maybe a -> Maybe a) -> (a -> a)-comaybe f x = case f (Just x) of-  Nothing -> x-  Just y  -> y+comaybe f x = fromMaybe x . f $ Just x   -- | Change the type of a Maybe-valued Continuation into the Maybe-wrapped type.@@ -288,7 +283,7 @@ --   of the coproduct selected by the input value used to create the structure. eitherC :: Monad m => Continuous f => (a -> f m a) -> (b -> f m b) -> Either a b -> f m (Either a b) eitherC l _ (Left x)  = mapC (\c -> eitherC' c (pur id)) (l x)-eitherC _ r (Right x) = mapC (\c -> eitherC' (pur id) c) (r x)+eitherC _ r (Right x) = mapC (eitherC' (pur id)) (r x)   -- | Transform the type of a Continuation using an isomorphism.@@ -314,9 +309,9 @@   (Continuation (f, g)) <> (Continuation (h, i)) =     Continuation (f.h, \x -> liftM2 (<>) (g x) (i x))   (Continuation (f, g)) <> (Rollback h) =-    Rollback (Continuation (f, (\x -> liftM2 (<>) (g x) (return h))))+    Rollback (Continuation (f, \x -> liftM2 (<>) (g x) (return h)))   (Rollback h) <> (Continuation (_, g)) =-    Rollback (Continuation (id, \x -> liftM2 (<>) (return h) (g x)))+    Rollback (Continuation (id, fmap (h <>) . g))   (Rollback f) <> (Rollback g) = Rollback (f <> g)   (Pure f) <> (Pure g) = Pure (f.g)   (Pure f) <> (Continuation (g,h)) = Continuation (f.g,h)@@ -337,7 +332,7 @@   m <- f (h i)   case m of     Continuation (g,gs) -> writeUpdate' (g.h) model gs-    Pure g -> atomically $ writeTVar model =<< g.h <$> readTVar model+    Pure g -> atomically (writeTVar model . g . h =<< readTVar model)     Rollback gs -> writeUpdate' id model (const (return gs))  @@ -347,8 +342,8 @@ writeUpdate :: MonadUnliftIO m => TVar a -> Continuation m a -> m () writeUpdate model = \case   Continuation (f,g) -> void . forkIO $ writeUpdate' f model g-  Pure f -> atomically $ writeTVar model =<< f <$> readTVar model-  Rollback f -> writeUpdate model f+  Pure f             -> atomically (writeTVar model . f =<< readTVar model)+  Rollback f         -> writeUpdate model f   -- | Execute a fold by watching a state variable and executing the next

@@ -1,16 +1,14 @@ {-# LANGUAGE AllowAmbiguousTypes    #-} {-# LANGUAGE BangPatterns           #-} {-# LANGUAGE CPP                    #-}-{-# LANGUAGE ExplicitNamespaces     #-} {-# LANGUAGE FlexibleContexts       #-} {-# LANGUAGE FlexibleInstances      #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE GADTs                  #-} {-# LANGUAGE InstanceSigs           #-}-{-# LANGUAGE KindSignatures         #-} {-# LANGUAGE LambdaCase             #-}-{-# LANGUAGE MultiParamTypeClasses  #-} {-# LANGUAGE OverloadedStrings      #-}+{-# LANGUAGE PartialTypeSignatures  #-} {-# LANGUAGE RankNTypes             #-} {-# LANGUAGE ScopedTypeVariables    #-} {-# LANGUAGE TupleSections          #-}@@ -30,7 +28,7 @@   -- * Base Types   Html(..), Prop(..)   -- ** Prop Constructors-  , textProp, listenerProp, flagProp+  , dataProp, flagProp, textProp, listenerProp, bakedProp   -- *** Listeners   , listenRaw, listen, listenM, listenM_, listenC, listener   -- ** Html Constructors@@ -50,35 +48,40 @@   , type (~>)   -- * The Shpadoinkle Primitive   , shpadoinkle-  -- ** Convenience Variants-  , runJSorWarp-  , fullPage-  , fullPageJSM-  , simple   -- * Re-Exports-  , JSM, MonadJSM, TVar, newTVarIO, readTVarIO+  , JSM, MonadJSM, askJSM, runJSM, MonadUnliftIO(..), UnliftIO(..), liftJSM+  , module UnliftIO.STM   ) where  -import           Control.Arrow                    (second)-import qualified Control.Categorical.Functor      as F-import           Control.Category                 ((.))-import           Control.PseudoInverseCategory-import           Data.Functor.Identity-import           Data.Kind-import           Data.String-import           Data.Text-import           GHCJS.DOM.Types                  (JSM, MonadJSM)-import           Language.Javascript.JSaddle      (FromJSVal (..), JSVal,-                                                   ToJSVal (..))-import           Prelude                          hiding ((.))-import           UnliftIO.STM                     (TVar, newTVarIO, readTVarIO)-#ifndef ghcjs_HOST_OS-import           Language.Javascript.JSaddle.Warp (run)-#endif+import           Control.Arrow                 (second)+import qualified Control.Categorical.Functor   as F+import           Control.Category              ((.))+import           Control.PseudoInverseCategory (EndoIso (..),+                                                HasHaskFunctors (fmapA),+                                                PIArrow (piendo, piiso, pisecond),+                                                PseudoInverseCategory (piinverse),+                                                ToHask (piapply))+import           Data.Functor.Identity         (Identity (Identity, runIdentity))+import           Data.Kind                     (Type)+import           Data.List                     (foldl')+import           Data.Map                      (alter, toList)+import           Data.String                   (IsString (..))+import           Data.Text                     (Text, pack)+import           GHCJS.DOM.Types               (JSM, MonadJSM, liftJSM)+import           Language.Javascript.JSaddle   (FromJSVal (..), JSVal,+                                                ToJSVal (..), askJSM, runJSM)+import           Prelude                       hiding ((.))+import           UnliftIO                      (MonadUnliftIO (..),+                                                UnliftIO (..))+import           UnliftIO.STM                  (STM, TVar, atomically,+                                                modifyTVar, newTVarIO, readTVar,+                                                readTVarIO, retrySTM, writeTVar)  -import           Shpadoinkle.Continuation+import           Shpadoinkle.Continuation      (Continuation, Continuous (..),+                                                causes, eitherC, hoist, impur,+                                                pur, shouldUpdate)   -- | This is the core type in Backend.@@ -105,8 +108,16 @@ -- node in JavaScript. If you wish to add attributes, you may do so -- by setting its corresponding property. data Prop :: (Type -> Type) -> Type -> Type where+  -- | A data property, these do NOT appear in static rendering+  PData :: JSVal -> Prop m a   -- | A text property   PText :: Text -> Prop m a+  -- | A boolean property+  PFlag :: Bool -> Prop m a+  -- | Bake a custom property+  -- The STM Monad will be called recursively.+  -- The semantics here is roughly an event stream of continuations.+  PPotato :: (RawNode -> JSM (STM (Continuation m a))) -> Prop m a   -- | Event listeners are provided with the 'RawNode' target, and the 'RawEvent', and may perform   -- a monadic action such as a side effect. This is the one and only place where you may   -- introduce a custom monadic action. The JSM to compute the Continuation must be@@ -116,12 +127,28 @@   -- and that may not be the case if the code to compute the Continuation of some   -- listener is blocking.   PListener :: (RawNode -> RawEvent -> JSM (Continuation m a)) -> Prop m a-  -- | A boolean property works as a flag:-  -- for example @("disabled", PFlag False)@ has no effect,-  -- while @("disabled", PFlag True)@ will add the @disabled@ attribute.-  PFlag :: Bool -> Prop m a  +-- | Ensure all prop keys are unique.+-- Collisions for Data, Text, Flags, and Potatoes are last write wins+-- Collisions for Listeners are Continuation Semigroup operations+nubProps :: Monad m => Html m a -> Html m a+nubProps = mapPropsRecursive $ toList . foldl' f mempty+  where+  f acc (t,p) = alter (Just . g t p) t acc+  g k new old = case (new, old) of+    (PText t, Just (PText t')) | k == "className" -> PText $ t <> " " <> t'+    (PListener l, Just (PListener l')) -> PListener $+      \raw evt -> mappend <$> l raw evt <*> l' raw evt+    _ -> new+++mapPropsRecursive :: ([(Text, Prop m a)] -> [(Text, Prop m a)]) -> Html m a -> Html m a+mapPropsRecursive f = \case+  Node t ps cs -> Node t (f ps) (mapPropsRecursive f <$> cs)+  x            -> x++ -- | Construct a listener from its name and a simple monadic event handler. listenM :: Monad m => Text -> m (a -> a) -> (Text, Prop m a) listenM k = listenC k . impur@@ -138,11 +165,11 @@  -- | If you can provide a Natural Transformation from one Functor to another -- then you may change the action of 'Html'.-hoistHtml :: Functor m => (m ~> n) -> Html m a -> Html n a+hoistHtml :: Functor m => Functor n => (m ~> n) -> Html m a -> Html n a hoistHtml f = \case   Node t ps cs -> Node t (fmap (hoistProp f) <$> ps) (hoistHtml f <$> cs)-  Potato p -> Potato p-  TextNode t -> TextNode t+  Potato p     -> Potato p+  TextNode t   -> TextNode t {-# INLINE hoistHtml #-}  @@ -150,9 +177,11 @@ -- then you may change the action of 'Prop'. hoistProp :: Functor m => (m ~> n) -> Prop m a -> Prop n a hoistProp f = \case-  PListener g -> PListener (\x y -> hoist f <$> g x y)+  PListener g -> PListener $ \x -> fmap (hoist f) . g x+  PData t     -> PData t   PText t     -> PText t-  PFlag b     -> PFlag b+  PFlag t     -> PFlag t+  PPotato p   -> PPotato $ fmap (fmap (hoist f)) . p {-# INLINE hoistProp #-}  @@ -193,13 +222,20 @@     where f' :: EndoIso (Continuation m a) (Continuation m b)           f' = F.map f +          mapFwd :: Prop m a -> Prop m b+          mapFwd (PData t)     = PData t           mapFwd (PText t)     = PText t-          mapFwd (PListener g) = PListener (\r e -> piapply f' <$> g r e)-          mapFwd (PFlag b)     = PFlag b+          mapFwd (PFlag t)     = PFlag t+          mapFwd (PListener g) = PListener $ \r e -> piapply f' <$> g r e+          mapFwd (PPotato p)   = PPotato $ fmap (fmap (piapply f')) . p -          mapBack (PText t) = PText t-          mapBack (PListener g) = PListener (\r e -> piapply (piinverse f') <$> g r e)-          mapBack (PFlag b) = PFlag b++          mapBack :: Prop m b -> Prop m a+          mapBack (PData t)     = PData t+          mapBack (PText t)     = PText t+          mapBack (PFlag t)     = PFlag t+          mapBack (PListener g) = PListener $ \r e -> piapply (piinverse f') <$> g r e+          mapBack (PPotato b)   = PPotato $ fmap (fmap (piapply (piinverse f'))) . b   {-# INLINE map #-}  @@ -235,39 +271,58 @@ --   lens to convert the types of the Continuations which it contains --   if it is a listener. instance Continuous Prop where+  mapC _ (PData t)     = PData t   mapC _ (PText t)     = PText t-  mapC f (PListener g) = PListener (\r e -> f <$> g r e)   mapC _ (PFlag b)     = PFlag b+  mapC f (PListener g) = PListener $ \r -> fmap f . g r+  mapC f (PPotato b)   = PPotato $ fmap (fmap f) . b   {-# INLINE mapC #-}  +-- | Create a data property.+dataProp :: JSVal -> Prop m a+dataProp = PData+{-# INLINE dataProp #-}++ -- | Create a text property. textProp :: Text -> Prop m a textProp = PText {-# INLINE textProp #-}  +flagProp :: Bool -> Prop m a+flagProp = PFlag+{-# INLINE flagProp #-}++ -- | Create an event listener property. listenerProp :: (RawNode -> RawEvent -> JSM (Continuation m a)) -> Prop m a-listenerProp f = PListener (\r e -> f r e)+listenerProp = PListener {-# INLINE listenerProp #-}  --- | Create a boolean property.-flagProp :: Bool -> Prop m a-flagProp = PFlag-{-# INLINE flagProp #-}+-- | Create a delicious proptato.+bakedProp :: (RawNode -> JSM (STM (Continuation m a))) -> Prop m a+bakedProp = PPotato+{-# INLINE bakedProp #-}   -- | Transform a p-algebra into a p-catamorphism. This is like polymorphic pattern matching.-cataProp :: (Text -> b)-         -> ((RawNode -> RawEvent -> JSM (Continuation m a)) -> b)-         -> (Bool -> b)-         -> Prop m a -> b-cataProp f g h' = \case-  PText t -> f t-  PListener l -> g l-  PFlag b -> h' b+cataProp+  :: (JSVal -> b)+  -> (Text -> b)+  -> (Bool -> b)+  -> ((RawNode -> RawEvent -> JSM (Continuation m a)) -> b)+  -> ((RawNode -> JSM (STM (Continuation m a))) -> b)+  -> Prop m a+  -> b+cataProp d t f l p = \case+  PData     x -> d x+  PText     x -> t x+  PFlag     x -> f x+  PListener x -> l x+  PPotato   x -> p x   -- | Construct an HTML element JSX-style.@@ -292,7 +347,7 @@ props :: Applicative f => ([(Text, Prop m a)] -> f [(Text, Prop m a)]) -> Html m a -> f (Html m a) props inj = \case   Node t ps cs -> (\ps' -> Node t ps' cs) <$> inj ps-  t -> pure t+  t            -> pure t {-# INLINE props #-}  @@ -300,7 +355,7 @@ children :: Applicative f => ([Html m a] -> f [Html m a]) -> Html m a -> f (Html m a) children inj = \case   Node t ps cs -> Node t ps <$> inj cs-  t -> pure t+  t            -> pure t {-# INLINE children #-}  @@ -308,7 +363,7 @@ name :: Applicative f => (Text -> f Text) -> Html m a -> f (Html m a) name inj = \case   Node t ps cs -> (\t' -> Node t' ps cs) <$> inj t-  t -> pure t+  t            -> pure t {-# INLINE name #-}  @@ -316,7 +371,7 @@ textContent :: Applicative f => (Text -> f Text) -> Html m a -> f (Html m a) textContent inj = \case   TextNode t -> TextNode <$> inj t-  n -> pure n+  n          -> pure n {-# INLINE textContent #-}  @@ -333,8 +388,8 @@       -> Html m a -> b cataH f g h' = \case   Node t ps cs -> f t ps (cataH f g h' <$> cs)-  Potato p -> g p-  TextNode t -> h' t+  Potato p     -> g p+  TextNode t   -> h' t   -- | Natural Transformation@@ -382,8 +437,8 @@   -- | Construct a listener from its 'Text' name and an output value.-listen :: Text -> a -> (Text, Prop m a)-listen k = listenC k . constUpdate+listen :: Text -> (a -> a) -> (Text, Prop m a)+listen k = listenC k . pur {-# INLINE listen #-}  @@ -468,87 +523,15 @@      go :: RawNode -> VNode b m -> a -> JSM (VNode b m)     go c n a = j $ do-      !m  <- interpret toJSM (view a)+      !m  <- interpret toJSM . nubProps $ view a       patch c (Just n) m    setup @b @m @a $ do     (c,n) <- j $ do       c <- stage-      n <- interpret toJSM (view initial)+      n <- interpret toJSM . nubProps $ view initial       _ <- patch c Nothing n       return (c,n)     _ <- shouldUpdate (go c) n model     return () ---- | Wrapper around 'shpadoinkle' for full page apps--- that do not need outside control of the territory-fullPage-  :: Backend b m a => Monad (b m) => Eq a-  => (m ~> JSM)-  -- ^ How do we get to JSM?-  -> (TVar a -> b m ~> m)-  -- ^ What backend are we running?-  -> a-  -- ^ What is the initial state?-  -> (a -> Html (b m) a)-  -- ^ How should the html look?-  -> b m RawNode-  -- ^ Where do we render?-  -> JSM ()-fullPage g f i view getStage = do-  model <- newTVarIO i-  shpadoinkle g f i model view getStage-{-# INLINE fullPage #-}----- | 'fullPageJSM' is a wrapper around 'shpadoinkle'--- for full page apps that do not need outside control--- of the territory, where actions are performed directly in JSM.------ This set of assumptions is extremely common when starting--- a new project.-fullPageJSM-  :: Backend b JSM a => Monad (b JSM) => Eq a-  => (TVar a -> b JSM ~> JSM)-  -- ^ What backend are we running?-  -> a-  -- ^ What is the initial state?-  -> (a -> Html (b JSM) a)-  -- ^ How should the html look?-  -> b JSM RawNode-  -- ^ Where do we render?-  -> JSM ()-fullPageJSM = fullPage id-{-# INLINE fullPageJSM #-}----- | Start the program!------ This function works in GHC and GHCjs. I saved you from using C preprocessor directly. You're welcome.-runJSorWarp :: Int -> JSM () -> IO ()-#ifdef ghcjs_HOST_OS-runJSorWarp _ = id-{-# INLINE runJSorWarp #-}-#else-runJSorWarp = run-{-# INLINE runJSorWarp #-}-#endif----- | Simple app------ (a good starting place)-simple-  :: Backend b JSM a => Monad (b JSM) => Eq a-  => (TVar a -> b JSM ~> JSM)-  -- ^ What backend are we running?-  -> a-  -- ^ what is the initial state?-  -> (a -> Html (b JSM) a)-  -- ^ how should the html look?-  -> b JSM RawNode-  -- ^ where do we render?-  -> JSM ()-simple = fullPageJSM-{-# INLINE simple #-}

@@ -0,0 +1,189 @@+{-# LANGUAGE CPP               #-}+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE KindSignatures    #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes        #-}+{-# LANGUAGE TypeOperators     #-}+++module Shpadoinkle.Run (+  -- * Agnostic Run+  runJSorWarp+  -- * Live Reloads+  , Env(..), Port+  , liveWithBackend+  , liveWithStatic+  , live+  -- ** Convenience Variants+  , fullPage+  , fullPageJSM+  , simple+  , entrypoint+  ) where+++import           Data.Text                              (Text)+import           GHCJS.DOM.Types                        (JSM)+import           Shpadoinkle                            (Backend, Html, RawNode,+                                                         TVar, newTVarIO,+                                                         shpadoinkle, type (~>))+++#ifndef ghcjs_HOST_OS+++import           Language.Javascript.JSaddle.Warp       (run)+import           Language.Javascript.JSaddle.WebSockets (debug, debugOr)+import           Network.Wai                            (Application)+import           Network.Wai.Application.Static         (defaultFileServerSettings,+                                                         staticApp)+++-- | Serve a web server and a jsaddle warp frontend at the same time.+-- This is useful for live reloads for development purposes.+-- For example:+-- @+--   ghcid -c "cabal repl dev" -W -T "Main.main"+-- @+liveWithBackend+  :: Port+  -- ^ Port to server the live server+  -> JSM ()+  -- ^ Frontend application+  -> IO Application+  -- ^ Server API+  -> IO ()+liveWithBackend port frontend server = debugOr port frontend =<< server+++-- | Serve jsaddle warp frontend.+-- This is useful for live reloads for development purposes.+-- For example:+-- @+--   ghcid -c "cabal repl" -W -T "Main.dev"+-- @+live+  :: Port+  -- ^ Port to server the live server+  -> JSM ()+  -- ^ Frontend application+  -> IO ()+live = debug+++-- | Serve jsaddle warp frontend with a static file server.+liveWithStatic+  :: Port+  -- ^ Port to serve the live server+  -> JSM ()+  -- ^ Frontend application+  -> FilePath+  -- ^ Path to static files+  -> IO ()+liveWithStatic port frontend =+  liveWithBackend port frontend . pure . staticApp . defaultFileServerSettings+++#else+++data Application+++live :: Port -> JSM () -> IO ()+live = error "Live reloads require GHC"+++liveWithStatic :: Port -> JSM () -> FilePath -> IO ()+liveWithStatic = error "Live reloads require GHC"+++liveWithBackend :: Port -> JSM () -> IO Application -> IO ()+liveWithBackend = error "Live reloads require GHC"+++#endif+++data Env = Dev | Prod+++type Port = Int+++-- | Wrapper around 'shpadoinkle' for full page apps+-- that do not need outside control of the territory+fullPage+  :: Backend b m a => Monad (b m) => Eq a+  => (m ~> JSM)+  -- ^ How do we get to JSM?+  -> (TVar a -> b m ~> m)+  -- ^ What backend are we running?+  -> a+  -- ^ What is the initial state?+  -> (a -> Html (b m) a)+  -- ^ How should the html look?+  -> b m RawNode+  -- ^ Where do we render?+  -> JSM ()+fullPage g f i view getStage = do+  model <- newTVarIO i+  shpadoinkle g f i model view getStage+{-# INLINE fullPage #-}+++-- | 'fullPageJSM' is a wrapper around 'shpadoinkle'+-- for full page apps that do not need outside control+-- of the territory, where actions are performed directly in JSM.+--+-- This set of assumptions is extremely common when starting+-- a new project.+fullPageJSM+  :: Backend b JSM a => Monad (b JSM) => Eq a+  => (TVar a -> b JSM ~> JSM)+  -- ^ What backend are we running?+  -> a+  -- ^ What is the initial state?+  -> (a -> Html (b JSM) a)+  -- ^ How should the html look?+  -> b JSM RawNode+  -- ^ Where do we render?+  -> JSM ()+fullPageJSM = fullPage id+{-# INLINE fullPageJSM #-}+++-- | Start the program!+--+-- This function works in GHC and GHCjs. I saved you from using C preprocessor directly. You're welcome.+runJSorWarp :: Int -> JSM () -> IO ()+#ifdef ghcjs_HOST_OS+runJSorWarp _ = id+{-# INLINE runJSorWarp #-}+#else+runJSorWarp = run+{-# INLINE runJSorWarp #-}+#endif+++-- | Simple app+--+-- (a good starting place)+simple+  :: Backend b JSM a => Monad (b JSM) => Eq a+  => (TVar a -> b JSM ~> JSM)+  -- ^ What backend are we running?+  -> a+  -- ^ what is the initial state?+  -> (a -> Html (b JSM) a)+  -- ^ how should the html look?+  -> b JSM RawNode+  -- ^ where do we render?+  -> JSM ()+simple = fullPageJSM+{-# INLINE simple #-}+++entrypoint :: Env -> Text+entrypoint Dev  = "/jsaddle.js"+entrypoint Prod = "/all.min.js"