miso 0.7.5.0 → 0.7.6.0
raw patch · 6 files changed
+104/−28 lines, 6 filesdep +QuickCheckdep +quickcheck-instances
Dependencies added: QuickCheck, quickcheck-instances
Files
- README.md +13/−8
- ghcjs-src/Miso.hs +2/−1
- ghcjs-src/Miso/FFI.hs +16/−8
- jsbits/diff.js +2/−2
- miso.cabal +19/−4
- tests/Main.hs +52/−5
README.md view
@@ -46,6 +46,7 @@ - [TodoMVC](#todomvc) - [Flatris](#flatris) - [2048](#2048)+ - [Snake](#snake) - [Mario](#mario) - [Websocket](#websocket) - [SSE](#sse)@@ -298,6 +299,9 @@ ### 2048 - [Link](http://2048.haskell-miso.org/) / [Source](https://github.com/ptigwe/hs2048/) +### Snake+ - [Link](http://snake.haskell-miso.org/) / [Source](https://github.com/lbonn/miso-snake)+ ### Mario - [Link](https://mario.haskell-miso.org/) / [Source](https://github.com/dmjio/miso/blob/master/examples/mario/Main.hs) @@ -338,15 +342,16 @@ ## Sample application ```haskell--- | Haskell language pragmas+-- | Haskell language pragma {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE RecordWildCards #-} -- | Haskell module declaration module Main where -- | Miso framework import import Miso+import Miso.String -- | Type synonym for an application model type Model = Int@@ -364,11 +369,11 @@ main = startApp App {..} where initialAction = SayHelloWorld -- initial action to be executed on application load- model = 0 -- initial model- update = updateModel -- update function- view = viewModel -- view function- events = defaultEvents -- default delegated events- subs = [] -- empty subscription list+ model = 0 -- initial model+ update = updateModel -- update function+ view = viewModel -- view function+ events = defaultEvents -- default delegated events+ subs = [] -- empty subscription list -- | Updates model, optionally introduces side effects updateModel :: Action -> Model -> Effect Action Model@@ -382,7 +387,7 @@ viewModel :: Model -> View Action viewModel x = div_ [] [ button_ [ onClick AddOne ] [ text "+" ]- , text $ toMisoString (show x)+ , text (ms (show x)) , button_ [ onClick SubtractOne ] [ text "-" ] ] ```
ghcjs-src/Miso.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE BangPatterns #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE RecordWildCards #-}@@ -121,7 +122,7 @@ :: (action -> IO ()) -> (action -> model -> Effect action model) -> (model, IO ()) -> action -> (model, IO ())-foldEffects sink update = \(model, as) action ->+foldEffects sink update = \(!model, !as) action -> case update action model of Effect newModel effs -> (newModel, newAs) where
ghcjs-src/Miso/FFI.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE LambdaCase #-}@@ -28,18 +29,21 @@ import Control.Monad import Control.Monad.Trans.Maybe-import qualified Data.Aeson as AE-import Data.Aeson hiding (Object)-import qualified Data.HashMap.Strict as H+import qualified Data.Aeson as AE+import Data.Aeson hiding (Object)+import qualified Data.HashMap.Strict as H import Data.JSString-import qualified Data.JSString.Text as JSS+import qualified Data.JSString.Text as JSS+import Data.Maybe import Data.Scientific-import qualified Data.Vector as V+import qualified Data.Vector as V import GHCJS.Foreign.Callback import GHCJS.Foreign.Internal import GHCJS.Marshal import GHCJS.Types+import JavaScript.Array.Internal import qualified JavaScript.Object.Internal as OI+import Unsafe.Coerce -- | Convert JSVal to Maybe `Value` jsvalToValue :: JSVal -> IO (Maybe Value)@@ -52,12 +56,16 @@ <$> fromJSVal r JSONBool -> liftM AE.Bool <$> fromJSVal r JSONString -> liftM AE.String <$> fromJSVal r- JSONArray -> liftM (Array . V.fromList) <$> fromJSVal r+ JSONArray -> do+ xs :: [Value] <-+ catMaybes <$>+ forM (toList (unsafeCoerce r)) jsvalToValue+ pure . pure $ Array . V.fromList $ xs JSONObject -> do- Just props<- fromJSVal =<< getKeys (OI.Object r)+ Just (props :: [JSString]) <- fromJSVal =<< getKeys (OI.Object r) runMaybeT $ do propVals <- forM props $ \p -> do- v <- MaybeT (fromJSVal =<< OI.getProp p (OI.Object r))+ v <- MaybeT (jsvalToValue =<< OI.getProp p (OI.Object r)) return (JSS.textFromJSString p, v) return (AE.Object (H.fromList propVals))
jsbits/diff.js view
@@ -80,7 +80,7 @@ node.setAttributeNS("http://www.w3.org/1999/xlink", "class", newProp); else node.setAttribute(c, newProp);- } else if (c in node) {+ } else if (c in node && !(c === "list" || c === "form")) { node[c] = newProp; } else { node.setAttribute(c, newProp);@@ -99,7 +99,7 @@ node.setAttributeNS("http://www.w3.org/1999/xlink", "class", newProp); else node.setAttribute(n, newProp);- } else if (n in node) {+ } else if (n in node && !(n === "list" || n === "form")) { node[n] = nProps[n]; } else { node.setAttribute(n, newProp);
miso.cabal view
@@ -1,5 +1,5 @@ name: miso-version: 0.7.5.0+version: 0.7.6.0 category: Web, Miso, Data Structures license: BSD3 license-file: LICENSE@@ -220,14 +220,29 @@ buildable: False else hs-source-dirs:- tests+ tests, ghcjs-src, src+ other-modules:+ Miso.FFI build-depends: aeson, base < 5,- miso,+ bytestring, hspec, hspec-core,- ghcjs-base+ ghcjs-base,+ QuickCheck,+ quickcheck-instances,+ miso,+ http-types,+ network-uri,+ http-api-data,+ containers,+ scientific,+ servant,+ text,+ unordered-containers,+ transformers,+ vector default-language: Haskell2010
tests/Main.hs view
@@ -1,16 +1,55 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE NamedFieldPuns #-}+module Main where +import Control.Monad+import Data.Aeson+import qualified Data.HashMap.Strict as H+import Data.Scientific+import qualified Data.Vector as V+import Debug.Trace+import GHCJS.Marshal+import Test.Hspec (it, hspec, describe, shouldSatisfy, shouldBe, Spec)+import Test.Hspec.Core.Runner (hspecResult, Summary(..))+import Test.QuickCheck+import Test.QuickCheck.Instances -module Main where+import Miso+import Miso.FFI+import System.IO.Unsafe -import Test.Hspec (it, hspec, describe, shouldSatisfy, shouldBe, Spec)-import Test.Hspec.Core.Runner (hspecResult, Summary(..))-import Data.Aeson+instance Arbitrary Value where+ arbitrary = sized sizedArbitraryValue -import Miso+sizedArbitraryValue :: Int -> Gen Value+sizedArbitraryValue n+ | n <= 0 = oneof [pure Null, bool, number, string]+ | otherwise = resize n' $ oneof [pure Null, bool, string, number, array, object']+ where+ n' = n `div` 2+ bool = Bool <$> arbitrary+ number = Number <$> arbitrary+ string = String <$> arbitrary+ array = Array <$> arbitrary+ object' = Object <$> arbitrary +compareValue :: Value -> Value -> Bool+compareValue (Object x) (Object y) = and $ zipWith compareValue (H.elems x) (H.elems y)+compareValue (Array x) (Array y) = and $ zipWith compareValue (V.toList x) (V.toList y)+compareValue (String x) (String y) = x == y+compareValue (Bool x) (Bool y) = x == y+compareValue Null Null = True+compareValue (Number x) (Number y) = closeEnough x y+compareValue _ _ = False++closeEnough x y+ = let d = max (abs x) (abs y)+ relDiff = if (d == 0.0) then d else abs (x - y) / d+ in relDiff <= 0.00001+ main :: IO () main = do Summary { summaryFailures } <- hspecResult tests@@ -19,6 +58,7 @@ tests :: Spec tests = do storageTests+ roundTripJSVal storageTests :: Spec storageTests = describe "Storage tests" $ do@@ -32,6 +72,13 @@ setSessionStorage "foo" obj Right r <- getLocalStorage "foo" r `shouldBe` obj++roundTripJSVal =+ describe "Serialization tests" $ do+ it "Should round trip JSVal" $ do+ property $ (\(x :: Value) -> do+ Just y <- jsvalToValue =<< toJSVal x+ compareValue x y `shouldBe` True) phantomExit :: Int -> IO () phantomExit x