diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -57,6 +57,7 @@ - [ThreeJS](#threejs) - [Simple](#simple) - [File Reader](#file-reader) + - [WebVR](#webvr) - [Haddocks](#haddocks) - [GHC](#ghc) - [GHCJS](#ghcjs) @@ -86,21 +87,21 @@ Add a `stack.yaml` file that uses a recent version of `miso`. ```bash ➜ cat app/stack.yaml -resolver: lts-6.20 -compiler: ghcjs-0.2.0.9006020_ghc-7.10.3 +resolver: lts-6.30 +compiler: ghcjs-0.2.0.9006030_ghc-7.10.3 compiler-check: match-exact packages: - '.' extra-deps: - - miso-0.7.2.0 + - miso-0.10.0.0 setup-info: ghcjs: source: - ghcjs-0.2.0.9006020_ghc-7.10.3: - url: http://ghcjs.tolysz.org/lts-6.20-9006020.tar.gz - sha1: a6cea90cd8121eee3afb201183c6e9bd6bacd94a + ghcjs-0.2.0.9006030_ghc-7.10.3: + url: http://ghcjs.tolysz.org/lts-6.30-9006030.tar.gz + sha1: 2371e2ffe9e8781808b7a04313e6a0065b64ee51 ``` Add a `cabal` file @@ -214,7 +215,7 @@ isExecutable = true; executableHaskellDepends = [ base miso ]; description = "First miso app"; - license = stdenv.lib.licenses.unfree; + license = stdenv.lib.licenses.bsd3; } ``` @@ -225,8 +226,8 @@ result = import (pkgs.fetchFromGitHub { owner = "dmjio"; repo = "miso"; - sha256 = "13wfxxplnqajqnykyxdy7477kdfxshpv800b2shr1iib8m01lygn"; - rev = "91b7194c6e0baab3d367073449a8ada7ba8dc346"; + sha256 = "18jhr1ihf0vwwvp134j24isvzq699x5iy7l9ihrah760zmcxi7d2"; + rev = "e3d3d874337a4a44adc4b6bdb8b18d907c6c1e34"; }) {}; in pkgs.haskell.packages.ghcjs.callPackage ./app.nix { miso = result.miso-ghcjs; @@ -331,6 +332,9 @@ ### File Reader - [Link](https://file-reader.haskell-miso.org/) / [Source](https://github.com/dmjio/miso/blob/master/examples/file-reader/Main.hs) + +### WebVR + - [Link](https://fizruk.github.io/fpconf-2017-talk/miso-aframe-demo/dist/demo.jsexe/index.html) / [Source](https://github.com/fizruk/miso-aframe) ## Haddocks diff --git a/examples/svg/Main.hs b/examples/svg/Main.hs --- a/examples/svg/Main.hs +++ b/examples/svg/Main.hs @@ -4,12 +4,16 @@ {-# LANGUAGE TypeOperators #-} module Main where -import qualified Data.Map as M +import qualified Data.Map as M +import Control.Arrow import Miso -import Miso.String (MisoString, pack, ms) -import Miso.Svg hiding (height_, id_, style_, width_) +import Miso.String (MisoString, pack, ms) +import Miso.Svg hiding (height_, id_, style_, width_) +import Touch +trunc = truncate *** truncate + main :: IO () main = startApp App {..} where @@ -17,7 +21,9 @@ model = emptyModel update = updateModel view = viewModel - events = defaultEvents + events = M.insert (pack "mousemove") False $ + M.insert (pack "touchstart") False $ + M.insert (pack "touchmove") False defaultEvents subs = [ mouseSub HandleMouse ] mountPoint = Nothing @@ -25,12 +31,18 @@ emptyModel = Model (0,0) updateModel :: Action -> Model -> Effect Action Model +updateModel (HandleTouch (TouchEvent touch)) model = + model <# do + putStrLn "Touch did move" + print touch + return $ HandleMouse $ trunc . page $ touch updateModel (HandleMouse newCoords) model = noEff model { mouseCoords = newCoords } updateModel Id model = noEff model data Action = HandleMouse (Int, Int) + | HandleTouch TouchEvent | Id newtype Model @@ -45,6 +57,7 @@ , ("height", "700px") ] , width_ "auto" + , onTouchMove HandleTouch ] [ g_ [] [ ellipse_ [ cx_ $ pack $ show x diff --git a/examples/svg/Touch.hs b/examples/svg/Touch.hs new file mode 100644 --- /dev/null +++ b/examples/svg/Touch.hs @@ -0,0 +1,44 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +module Touch where + +import Control.Monad +import Data.Aeson.Types +import Debug.Trace +import Miso + +data Touch = Touch + { identifier :: Int + , screen :: (Int, Int) + , client :: (Double, Double) + , page :: (Double, Double) + } deriving (Eq, Show) + +instance FromJSON Touch where + parseJSON = + withObject "touch" $ \o -> do + identifier <- o .: "identifier" + screen <- (,) <$> o .: "screenX" <*> o .: "screenY" + client <- (,) <$> o .: "clientX" <*> o .: "clientY" + page <- (,) <$> o .: "pageX" <*> o .: "pageY" + return Touch {..} + +data TouchEvent = + TouchEvent Touch + deriving (Eq, Show) + +instance FromJSON TouchEvent where + parseJSON obj = do + ((x:_):_) <- parseJSON obj + return $ TouchEvent x + +touchDecoder :: Decoder TouchEvent +touchDecoder = Decoder {..} + where + decodeAt = DecodeTargets [["changedTouches"], ["targetTouches"], ["touches"]] + decoder = parseJSON + +onTouchMove :: (TouchEvent -> action) -> Attribute action +onTouchMove = on "touchmove" touchDecoder + +onTouchStart = on "touchstart" touchDecoder diff --git a/examples/todo-mvc/Main.hs b/examples/todo-mvc/Main.hs --- a/examples/todo-mvc/Main.hs +++ b/examples/todo-mvc/Main.hs @@ -231,7 +231,7 @@ viewControls :: Model -> MisoString -> [ Entry ] -> View Msg viewControls model visibility entries = footer_ [ class_ "footer" - , hidden_ (bool "" "hidden" $ null entries) + , hidden_ (null entries) ] [ viewControlsCount entriesLeft , viewControlsFilters visibility diff --git a/examples/xhr/Main.hs b/examples/xhr/Main.hs --- a/examples/xhr/Main.hs +++ b/examples/xhr/Main.hs @@ -88,10 +88,7 @@ where attrs = [ onClick FetchGitHub , class_ $ pack "button is-large is-outlined" - ] ++ - [ disabled_ $ pack "disabled" - | isJust info - ] + ] ++ [ disabled_ True | isJust info ] data APIInfo = APIInfo diff --git a/ghc-src/Miso/Html/Internal.hs b/ghc-src/Miso/Html/Internal.hs --- a/ghc-src/Miso/Html/Internal.hs +++ b/ghc-src/Miso/Html/Internal.hs @@ -83,10 +83,24 @@ in L.with ele as where Props xs = vProps - as = [ L.makeAttribute k v' + as = [ L.makeAttribute k (if k `elem` exceptions && v == Bool True then k else v') | (k,v) <- M.toList xs , let v' = toHtmlFromJSON v + , not (k `elem` exceptions && v == Bool False) ] + exceptions = [ "checked" + , "disabled" + , "selected" + , "hidden" + , "readOnly" + , "autoplay" + , "required" + , "default" + , "autofocus" + , "multiple" + , "noValidate" + , "autocomplete" + ] toTag = T.toLower kids = foldMap L.toHtml vChildren diff --git a/ghc-src/Miso/String.hs b/ghc-src/Miso/String.hs --- a/ghc-src/Miso/String.hs +++ b/ghc-src/Miso/String.hs @@ -33,13 +33,24 @@ -- | Convenience class for creating `MisoString` from other string-like types class ToMisoString str where toMisoString :: str -> MisoString + fromMisoString :: MisoString -> str -- | Convenience function, shorthand for `toMisoString` ms :: ToMisoString str => str -> MisoString ms = toMisoString -instance ToMisoString MisoString where toMisoString = id -instance ToMisoString String where toMisoString = T.pack -instance ToMisoString LT.Text where toMisoString = LT.toStrict -instance ToMisoString B.ByteString where toMisoString = toMisoString . T.decodeUtf8 -instance ToMisoString BL.ByteString where toMisoString = toMisoString . LT.decodeUtf8 +instance ToMisoString MisoString where + toMisoString = id + fromMisoString = id +instance ToMisoString String where + toMisoString = T.pack + fromMisoString = T.unpack +instance ToMisoString LT.Text where + toMisoString = LT.toStrict + fromMisoString = LT.fromStrict +instance ToMisoString B.ByteString where + toMisoString = toMisoString . T.decodeUtf8 + fromMisoString = T.encodeUtf8 . fromMisoString +instance ToMisoString BL.ByteString where + toMisoString = toMisoString . LT.decodeUtf8 + fromMisoString = LT.encodeUtf8 . fromMisoString diff --git a/ghcjs-src/Miso/Html/Internal.hs b/ghcjs-src/Miso/Html/Internal.hs --- a/ghcjs-src/Miso/Html/Internal.hs +++ b/ghcjs-src/Miso/Html/Internal.hs @@ -103,6 +103,11 @@ set :: ToJSVal v => JSString -> v -> Object -> IO () set k v obj = toJSVal v >>= \x -> setProp k x obj +-- | `ToJSVal` instance for `Decoder` +instance ToJSVal DecodeTarget where + toJSVal (DecodeTarget xs) = toJSVal xs + toJSVal (DecodeTargets xs) = toJSVal xs + -- | Create a new @VNode@. -- -- @node ns tag key attrs children@ creates a new node with tag @tag@ diff --git a/ghcjs-src/Miso/String.hs b/ghcjs-src/Miso/String.hs --- a/ghcjs-src/Miso/String.hs +++ b/ghcjs-src/Miso/String.hs @@ -48,14 +48,27 @@ -- | Convenience class for creating `MisoString` from other string-like types class ToMisoString str where toMisoString :: str -> MisoString + fromMisoString :: MisoString -> str -- | Convenience function, shorthand for `toMisoString` ms :: ToMisoString str => str -> MisoString ms = toMisoString -instance ToMisoString MisoString where toMisoString = id -instance ToMisoString String where toMisoString = pack -instance ToMisoString T.Text where toMisoString = textToJSString -instance ToMisoString LT.Text where toMisoString = lazyTextToJSString -instance ToMisoString B.ByteString where toMisoString = toMisoString . T.decodeUtf8 -instance ToMisoString BL.ByteString where toMisoString = toMisoString . LT.decodeUtf8 +instance ToMisoString MisoString where + toMisoString = id + fromMisoString = id +instance ToMisoString String where + toMisoString = pack + fromMisoString = unpack +instance ToMisoString T.Text where + toMisoString = textToJSString + fromMisoString = textFromJSString +instance ToMisoString LT.Text where + toMisoString = lazyTextToJSString + fromMisoString = lazyTextFromJSString +instance ToMisoString B.ByteString where + toMisoString = toMisoString . T.decodeUtf8 + fromMisoString = T.encodeUtf8 . fromMisoString +instance ToMisoString BL.ByteString where + toMisoString = toMisoString . LT.decodeUtf8 + fromMisoString = LT.encodeUtf8 . fromMisoString diff --git a/jsbits/delegate.js b/jsbits/delegate.js --- a/jsbits/delegate.js +++ b/jsbits/delegate.js @@ -72,10 +72,28 @@ /* Convert event to JSON at a specific location in the DOM tree*/ function objectToJSON (at, obj) { - for (var i in at) obj = obj[at[i]]; - var newObj = {}; - for (var i in obj) - if (typeof obj[i] == "string" || typeof obj[i] == "number" || typeof obj[i] == "boolean") - newObj[i] = obj[i]; + /* If at is of type [[MisoString]] */ + if (typeof at[0] == "object") { + var ret = []; + for (var i = 0; i < at.length; i++) + ret.push(objectToJSON(at[i], obj)); + return (ret); + } + + for (var i in at) obj = obj[at[i]]; + + /* If obj is a list-like object */ + if ("length" in obj) { + var newObj = []; + for (var i = 0; i < obj.length; i++) + newObj.push(objectToJSON([], obj[i])); return (newObj); + } + + /* If obj is a non-list-like object */ + var newObj = {}; + for (var i in obj) + if (typeof obj[i] == "string" || typeof obj[i] == "number" || typeof obj[i] == "boolean") + newObj[i] = obj[i]; + return (newObj); } diff --git a/miso.cabal b/miso.cabal --- a/miso.cabal +++ b/miso.cabal @@ -1,5 +1,5 @@ name: miso -version: 0.10.0.0 +version: 0.11.0.0 category: Web, Miso, Data Structures license: BSD3 license-file: LICENSE @@ -172,9 +172,12 @@ else hs-source-dirs: examples/svg + other-modules: + Touch build-depends: base < 5, containers, + aeson, miso default-language: Haskell2010 diff --git a/src/Miso/Event/Decoder.hs b/src/Miso/Event/Decoder.hs --- a/src/Miso/Event/Decoder.hs +++ b/src/Miso/Event/Decoder.hs @@ -12,6 +12,7 @@ module Miso.Event.Decoder ( -- * Decoder Decoder (..) + , DecodeTarget (..) , at -- * Decoders , emptyDecoder @@ -27,15 +28,20 @@ import Miso.Event.Types import Miso.String +-- | Data type for storing the target when parsing events +data DecodeTarget + = DecodeTarget [MisoString] -- ^ Decode a single object + | DecodeTargets [[MisoString]] -- ^ Decode multiple objecjects + -- | Decoder data type for parsing events data Decoder a = Decoder { decoder :: Value -> Parser a -- ^ FromJSON-based Event decoder -, decodeAt :: [MisoString] -- ^ Location in DOM of where to decode +, decodeAt :: DecodeTarget -- ^ Location in DOM of where to decode } -- | Smart constructor for building at :: [MisoString] -> (Value -> Parser a) -> Decoder a -at decodeAt decoder = Decoder {..} +at decodeAt decoder = Decoder {decodeAt = DecodeTarget decodeAt, ..} -- | Empty decoder for use with events like "click" that do not -- return any meaningful values @@ -48,7 +54,7 @@ keycodeDecoder :: Decoder KeyCode keycodeDecoder = Decoder {..} where - decodeAt = mempty + decodeAt = DecodeTarget mempty decoder = withObject "event" $ \o -> KeyCode <$> (o .: "keyCode" <|> o .: "which" <|> o .: "charCode") @@ -56,13 +62,13 @@ valueDecoder :: Decoder MisoString valueDecoder = Decoder {..} where - decodeAt = ["target"] + decodeAt = DecodeTarget ["target"] decoder = withObject "target" $ \o -> o .: "value" -- | Retrieves "checked" field in Decoder checkedDecoder :: Decoder Checked checkedDecoder = Decoder {..} where - decodeAt = ["target"] + decodeAt = DecodeTarget ["target"] decoder = withObject "target" $ \o -> Checked <$> (o .: "checked") diff --git a/src/Miso/Html/Property.hs b/src/Miso/Html/Property.hs --- a/src/Miso/Html/Property.hs +++ b/src/Miso/Html/Property.hs @@ -151,8 +151,8 @@ selected_ :: Bool -> Attribute action selected_ = boolProp "selected" -- |