diff --git a/ghc-src/Miso/String.hs b/ghc-src/Miso/String.hs deleted file mode 100644 --- a/ghc-src/Miso/String.hs +++ /dev/null @@ -1,100 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE TypeSynonymInstances #-} -{-# LANGUAGE OverloadedStrings #-} ------------------------------------------------------------------------------ --- | --- Module : Miso.String --- Copyright : (C) 2016-2018 David M. Johnson --- License : BSD3-style (see the file LICENSE) --- Maintainer : David M. Johnson --- Stability : experimental --- Portability : non-portable ----------------------------------------------------------------------------- -module Miso.String - ( ToMisoString (..) - , FromMisoString (..) - , fromMisoString - , MisoString - , module Data.Monoid - , module Data.Text - , ms - ) where - -import qualified Data.ByteString as B -import qualified Data.ByteString.Lazy as BL -import Data.Monoid -import Data.JSString -import Data.JSString.Text -import Data.Text -import qualified Data.Text as T -import qualified Data.Text.Encoding as T -import qualified Data.Text.Lazy as LT -import qualified Data.Text.Lazy.Encoding as LT -import Text.Read(readEither) - - --- | String type swappable based on compiler -type MisoString = Text - --- | Convenience class for creating `MisoString` from other string-like types -class ToMisoString str where - toMisoString :: str -> MisoString - --- | Class from safely parsing 'MisoString' -class FromMisoString t where - -- -- | Parses a `MisoString` - fromMisoStringEither :: MisoString -> Either String t - --- | Parses a `MisoString`, throws an error when decoding --- fails. Use `fromMisoStringEither` for as a safe alternative. -fromMisoString :: FromMisoString a => MisoString -> a -fromMisoString s = case fromMisoStringEither s of - Left err -> error err - Right x -> x - --- | 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 JSString where - toMisoString = textFromJSString -instance ToMisoString B.ByteString where - toMisoString = toMisoString . T.decodeUtf8 -instance ToMisoString BL.ByteString where - toMisoString = toMisoString . LT.decodeUtf8 -instance ToMisoString Float where - toMisoString = T.pack . show -instance ToMisoString Double where - toMisoString = T.pack . show -instance ToMisoString Int where - toMisoString = T.pack . show -instance ToMisoString Word where - toMisoString = T.pack . show - -instance FromMisoString MisoString where - fromMisoStringEither = Right -instance FromMisoString String where - fromMisoStringEither = Right . T.unpack -instance FromMisoString LT.Text where - fromMisoStringEither = Right . LT.fromStrict -instance FromMisoString JSString where - fromMisoStringEither = Right . textToJSString -instance FromMisoString B.ByteString where - fromMisoStringEither = fmap T.encodeUtf8 . fromMisoStringEither -instance FromMisoString BL.ByteString where - fromMisoStringEither = fmap LT.encodeUtf8 . fromMisoStringEither -instance FromMisoString Float where - fromMisoStringEither = readEither . T.unpack -instance FromMisoString Double where - fromMisoStringEither = readEither . T.unpack -instance FromMisoString Int where - fromMisoStringEither = readEither . T.unpack -instance FromMisoString Word where - fromMisoStringEither = readEither . T.unpack diff --git a/ghcjs-src/Miso/String.hs b/ghcjs-src/Miso/String.hs deleted file mode 100644 --- a/ghcjs-src/Miso/String.hs +++ /dev/null @@ -1,147 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE ExistentialQuantification #-} -{-# LANGUAGE TypeSynonymInstances #-} -{-# LANGUAGE OverloadedStrings #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} ------------------------------------------------------------------------------ --- | --- Module : Miso.String --- Copyright : (C) 2016-2018 David M. Johnson --- License : BSD3-style (see the file LICENSE) --- Maintainer : David M. Johnson --- Stability : experimental --- Portability : non-portable ----------------------------------------------------------------------------- -module Miso.String ( - ToMisoString (..) - , FromMisoString (..) - , fromMisoString - , MisoString - , module Data.JSString - , module Data.Monoid - , ms - ) where - -import Data.Aeson -import qualified Data.ByteString as B -import qualified Data.ByteString.Lazy as BL -import Data.Char -import Data.JSString -import qualified Data.JSString as JS -import Data.JSString.Text -import Data.Monoid -import qualified Data.Text as T -import qualified Data.Text.Encoding as T -import qualified Data.Text.Lazy as LT -import qualified Data.Text.Lazy.Encoding as LT -import Prelude hiding (foldr) -import Text.StringLike (StringLike(..)) - --- | String type swappable based on compiler -type MisoString = JS.JSString - --- | `ToJSON` for `MisoString` -instance ToJSON MisoString where - toJSON = String . textFromJSString - --- | `FromJSON` for `MisoString` -instance FromJSON MisoString where - parseJSON = - withText "Not a valid string" $ \x -> - pure (toMisoString x) - --- | Convenience class for creating `MisoString` from other string-like types -class ToMisoString str where - toMisoString :: str -> MisoString - --- | Class used to parse a 'MisoString'. Like a safe 'Read' for 'MisoString' -class FromMisoString t where - -- -- | Reads a `MisoString` - fromMisoStringEither :: MisoString -> Either String t - --- | Reads a 'MisoString', throws an error when decoding --- fails. Use `fromMisoStringEither` for as a safe alternative. -fromMisoString :: FromMisoString a => MisoString -> a -fromMisoString s = - case fromMisoStringEither s of - Left err -> error err - Right x -> x - --- | Convenience function, shorthand for `toMisoString` -ms :: ToMisoString str => str -> MisoString -ms = toMisoString - -instance ToMisoString MisoString where - toMisoString = id -instance ToMisoString String where - toMisoString = JS.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 Float where - toMisoString = JS.pack . show -instance ToMisoString Double where - toMisoString = JS.pack . show -instance ToMisoString Int where - toMisoString = JS.pack . show -instance ToMisoString Word where - toMisoString = JS.pack . show - -instance FromMisoString MisoString where - fromMisoStringEither = Right -instance FromMisoString String where - fromMisoStringEither = Right . JS.unpack -instance FromMisoString T.Text where - fromMisoStringEither = Right . textFromJSString -instance FromMisoString LT.Text where - fromMisoStringEither = Right . lazyTextFromJSString -instance FromMisoString B.ByteString where - fromMisoStringEither = fmap T.encodeUtf8 . fromMisoStringEither -instance FromMisoString BL.ByteString where - fromMisoStringEither = fmap LT.encodeUtf8 . fromMisoStringEither -instance FromMisoString Float where - fromMisoStringEither = fmap realToFrac . jsStringToDoubleEither -instance FromMisoString Double where - fromMisoStringEither = jsStringToDoubleEither -instance FromMisoString Int where - fromMisoStringEither = parseInt -instance FromMisoString Word where - fromMisoStringEither = parseWord - -jsStringToDoubleEither :: JS.JSString -> Either String Double -jsStringToDoubleEither s = let d = read $ JS.unpack s - in if isNaN d then Left "jsStringToDoubleEither: parse failed" - else Right d - - -parseWord :: MisoString -> Either String Word -parseWord s = case JS.uncons s of - Nothing -> Left "parseWord: parse error" - Just (c,s') -> JS.foldl' k (pDigit c) s' - where - pDigit c | isDigit c = Right . fromIntegral . digitToInt $ c - | otherwise = Left "parseWord: parse error" - k ea c = (\a x -> 10*a + x) <$> ea <*> pDigit c - -parseInt :: MisoString -> Either String Int -parseInt s = case JS.uncons s of - Just ('-',s') -> ((-1)*) . fromIntegral <$> parseWord s' - _ -> fromIntegral <$> parseWord s - -instance StringLike MisoString where - uncons = JS.uncons - toString = JS.unpack - fromChar = JS.singleton - strConcat = JS.concat - empty = JS.empty - strNull = JS.null - cons = JS.cons - append = JS.append - strMap = JS.map diff --git a/jsbits/delegate.js b/jsbits/delegate.js --- a/jsbits/delegate.js +++ b/jsbits/delegate.js @@ -30,7 +30,7 @@ for (var event in events) { mountPointElement.addEventListener(events[event][0], function(e) { getVTree(function (obj) { - window['delegateEvent'](e, obj, window['buildTargetToElement'](mountPointElement, e.target), []); + window['delegateEvent'](e, obj, window['buildTargetToElement'](mountPointElement, e.target), []); }); }, events[event][1]); } @@ -57,15 +57,15 @@ else { var eventObj = obj['events'][event.type]; if (eventObj) { - var options = eventObj.options; + var options = eventObj.options; if (options['preventDefault']) - event.preventDefault(); + event.preventDefault(); eventObj['runEvent'](event); if (!options['stopPropagation']) - window['propogateWhileAble'] (parentStack, event); + window['propogateWhileAble'] (parentStack, event); } else { - /* still propagate to parent handlers even if event not defined */ - window['propogateWhileAble'] (parentStack, event); + /* still propagate to parent handlers even if event not defined */ + window['propogateWhileAble'] (parentStack, event); } } }; @@ -83,7 +83,7 @@ for (var i = 0; i < parentStack.length; i++) { if (parentStack[i]['events'][event.type]) { var eventObj = parentStack[i]['events'][event.type], - options = eventObj['options']; + options = eventObj['options']; if (options['preventDefault']) event.preventDefault(); eventObj['runEvent'](event); if (options['stopPropagation']) break; @@ -131,10 +131,10 @@ function getAllPropertyNames(obj) { var props = {}, i = 0; do { - var names = Object.getOwnPropertyNames(obj); - for (i = 0; i < names.length; i++) { - props [names[i]] = null; - } + var names = Object.getOwnPropertyNames(obj); + for (i = 0; i < names.length; i++) { + props [names[i]] = null; + } } while (obj = Object.getPrototypeOf(obj)); return props; }; diff --git a/jsbits/isomorphic.js b/jsbits/isomorphic.js --- a/jsbits/isomorphic.js +++ b/jsbits/isomorphic.js @@ -4,8 +4,8 @@ var ax = 0, adjusted = vs.length > 0 ? [vs[0]] : []; for (var ix = 1; ix < vs.length; ix++) { if (adjusted[ax]['type'] === 'vtext' && vs[ix]['type'] === 'vtext') { - adjusted[ax]['text'] += vs[ix]['text']; - continue; + adjusted[ax]['text'] += vs[ix]['text']; + continue; } adjusted[++ax] = vs[ix]; } @@ -17,21 +17,21 @@ var mountChildIdx = 0, node; // If script tags are rendered first in body, skip them. if (!mountPoint) { - if (doc.body.childNodes.length > 0) { - node = doc.body.firstChild; - } else { - node = doc.body.appendChild (doc.createElement('div')); - } + if (doc.body.childNodes.length > 0) { + node = doc.body.firstChild; + } else { + node = doc.body.appendChild (doc.createElement('div')); + } } else if (mountPoint.childNodes.length === 0) { - node = mountPoint.appendChild (doc.createElement('div')); + node = mountPoint.appendChild (doc.createElement('div')); } else { - while (mountPoint.childNodes[mountChildIdx] && (mountPoint.childNodes[mountChildIdx].nodeType === Node.TEXT_NODE || mountPoint.childNodes[mountChildIdx].localName === 'script')){ - mountChildIdx++; - } - if (!mountPoint.childNodes[mountChildIdx]) { - node = doc.body.appendChild (doc.createElement('div')); - } else { - node = mountPoint.childNodes[mountChildIdx]; + while (mountPoint.childNodes[mountChildIdx] && (mountPoint.childNodes[mountChildIdx].nodeType === Node.TEXT_NODE || mountPoint.childNodes[mountChildIdx].localName === 'script')){ + mountChildIdx++; + } + if (!mountPoint.childNodes[mountChildIdx]) { + node = doc.body.appendChild (doc.createElement('div')); + } else { + node = mountPoint.childNodes[mountChildIdx]; } } @@ -72,21 +72,21 @@ vdomChild = vtree['children'][i]; domChild = node.childNodes[i]; if (!domChild) { - window['diagnoseError'](logLevel,vdomChild, domChild); - return false; + window['diagnoseError'](logLevel,vdomChild, domChild); + return false; } if (vdomChild.type === 'vtext') { if (domChild.nodeType !== Node.TEXT_NODE) { - window['diagnoseError'](logLevel, vdomChild, domChild); - return false; - } + window['diagnoseError'](logLevel, vdomChild, domChild); + return false; + } if (vdomChild['text'] === domChild.textContent) { vdomChild['domRef'] = domChild; } else { window['diagnoseError'](logLevel, vdomChild, domChild); return false; - } + } } else { if (domChild.nodeType !== Node.ELEMENT_NODE) return false; vdomChild['domRef'] = domChild; diff --git a/jsstring-src/Miso/String.hs b/jsstring-src/Miso/String.hs new file mode 100644 --- /dev/null +++ b/jsstring-src/Miso/String.hs @@ -0,0 +1,149 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +----------------------------------------------------------------------------- +-- | +-- Module : Miso.String +-- Copyright : (C) 2016-2018 David M. Johnson +-- License : BSD3-style (see the file LICENSE) +-- Maintainer : David M. Johnson +-- Stability : experimental +-- Portability : non-portable +---------------------------------------------------------------------------- +module Miso.String ( + ToMisoString (..) + , FromMisoString (..) + , fromMisoString + , MisoString + , module Data.JSString + , module Data.Monoid + , ms + ) where + +import Data.Aeson +import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as BL +import Data.Char +import Data.JSString +import qualified Data.JSString as JS +import Data.JSString.Text +import Data.Monoid +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import qualified Data.Text.Lazy as LT +import qualified Data.Text.Lazy.Encoding as LT +import Prelude hiding (foldr) +import Text.StringLike (StringLike(..)) + +-- | String type swappable based on compiler +type MisoString = JS.JSString + +#ifdef __GHCJS__ +-- | `ToJSON` for `MisoString` +instance ToJSON MisoString where + toJSON = String . textFromJSString + +-- | `FromJSON` for `MisoString` +instance FromJSON MisoString where + parseJSON = + withText "Not a valid string" $ \x -> + pure (toMisoString x) +#endif + +-- | Convenience class for creating `MisoString` from other string-like types +class ToMisoString str where + toMisoString :: str -> MisoString + +-- | Class used to parse a 'MisoString'. Like a safe 'Read' for 'MisoString' +class FromMisoString t where + -- -- | Reads a `MisoString` + fromMisoStringEither :: MisoString -> Either String t + +-- | Reads a 'MisoString', throws an error when decoding +-- fails. Use `fromMisoStringEither` for as a safe alternative. +fromMisoString :: FromMisoString a => MisoString -> a +fromMisoString s = + case fromMisoStringEither s of + Left err -> error err + Right x -> x + +-- | Convenience function, shorthand for `toMisoString` +ms :: ToMisoString str => str -> MisoString +ms = toMisoString + +instance ToMisoString MisoString where + toMisoString = id +instance ToMisoString String where + toMisoString = JS.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 Float where + toMisoString = JS.pack . show +instance ToMisoString Double where + toMisoString = JS.pack . show +instance ToMisoString Int where + toMisoString = JS.pack . show +instance ToMisoString Word where + toMisoString = JS.pack . show + +instance FromMisoString MisoString where + fromMisoStringEither = Right +instance FromMisoString String where + fromMisoStringEither = Right . JS.unpack +instance FromMisoString T.Text where + fromMisoStringEither = Right . textFromJSString +instance FromMisoString LT.Text where + fromMisoStringEither = Right . lazyTextFromJSString +instance FromMisoString B.ByteString where + fromMisoStringEither = fmap T.encodeUtf8 . fromMisoStringEither +instance FromMisoString BL.ByteString where + fromMisoStringEither = fmap LT.encodeUtf8 . fromMisoStringEither +instance FromMisoString Float where + fromMisoStringEither = fmap realToFrac . jsStringToDoubleEither +instance FromMisoString Double where + fromMisoStringEither = jsStringToDoubleEither +instance FromMisoString Int where + fromMisoStringEither = parseInt +instance FromMisoString Word where + fromMisoStringEither = parseWord + +jsStringToDoubleEither :: JS.JSString -> Either String Double +jsStringToDoubleEither s = let d = read $ JS.unpack s + in if isNaN d then Left "jsStringToDoubleEither: parse failed" + else Right d + + +parseWord :: MisoString -> Either String Word +parseWord s = case JS.uncons s of + Nothing -> Left "parseWord: parse error" + Just (c,s') -> JS.foldl' k (pDigit c) s' + where + pDigit c | isDigit c = Right . fromIntegral . digitToInt $ c + | otherwise = Left "parseWord: parse error" + k ea c = (\a x -> 10*a + x) <$> ea <*> pDigit c + +parseInt :: MisoString -> Either String Int +parseInt s = case JS.uncons s of + Just ('-',s') -> ((-1)*) . fromIntegral <$> parseWord s' + _ -> fromIntegral <$> parseWord s + +instance StringLike MisoString where + uncons = JS.uncons + toString = JS.unpack + fromChar = JS.singleton + strConcat = JS.concat + empty = JS.empty + strNull = JS.null + cons = JS.cons + append = JS.append + strMap = JS.map diff --git a/miso.cabal b/miso.cabal --- a/miso.cabal +++ b/miso.cabal @@ -1,5 +1,5 @@ name: miso -version: 1.8.1.0 +version: 1.8.2.0 category: Web, Miso, Data Structures license: BSD3 license-file: LICENSE @@ -10,7 +10,7 @@ bug-reports: https://github.com/dmjio/miso/issues build-type: Simple extra-source-files: README.md -cabal-version: >=1.22 +cabal-version: 1.22 synopsis: A tasty Haskell front-end framework description: Miso is a small, production-ready, "isomorphic" Haskell front-end framework featuring a virtual-dom, recursive diffing / patching algorithm, event delegation, event batching, SVG, Server-sent events, Websockets, type-safe servant-style routing and an extensible Subscription-based subsystem. Inspired by Elm, Redux and Bobril. Miso is pure by default, but side effects (like XHR) can be introduced into the system via the Effect data type. Miso makes heavy use of the GHCJS FFI and therefore has minimal dependencies. @@ -38,6 +38,13 @@ description: Cross compile to iOS +flag jsstring-only + manual: True + default: + False + description: + Always set MisoString = JSString + executable tests main-is: Main.hs @@ -123,12 +130,12 @@ -Wall hs-source-dirs: src - if impl(ghcjs) + if impl(ghcjs) || flag (jsstring-only) hs-source-dirs: - ghcjs-src + jsstring-src else hs-source-dirs: - ghc-src + text-src build-depends: aeson, base < 5, diff --git a/src/Miso/Html/Types.hs b/src/Miso/Html/Types.hs --- a/src/Miso/Html/Types.hs +++ b/src/Miso/Html/Types.hs @@ -252,6 +252,8 @@ go [] xs = xs go (TagLeaf (TagText s) : next) views = go next (Text s : views) + go (TagLeaf (TagOpen name attrs) : next) views = + go (TagBranch name attrs [] : next) views go (TagBranch name attrs kids : next) views = let attrs' = [ P key $ A.String (fromMisoString val) diff --git a/text-src/Miso/String.hs b/text-src/Miso/String.hs new file mode 100644 --- /dev/null +++ b/text-src/Miso/String.hs @@ -0,0 +1,100 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE OverloadedStrings #-} +----------------------------------------------------------------------------- +-- | +-- Module : Miso.String +-- Copyright : (C) 2016-2018 David M. Johnson +-- License : BSD3-style (see the file LICENSE) +-- Maintainer : David M. Johnson +-- Stability : experimental +-- Portability : non-portable +---------------------------------------------------------------------------- +module Miso.String + ( ToMisoString (..) + , FromMisoString (..) + , fromMisoString + , MisoString + , module Data.Monoid + , module Data.Text + , ms + ) where + +import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as BL +import Data.Monoid +import Data.JSString +import Data.JSString.Text +import Data.Text +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import qualified Data.Text.Lazy as LT +import qualified Data.Text.Lazy.Encoding as LT +import Text.Read(readEither) + + +-- | String type swappable based on compiler +type MisoString = Text + +-- | Convenience class for creating `MisoString` from other string-like types +class ToMisoString str where + toMisoString :: str -> MisoString + +-- | Class from safely parsing 'MisoString' +class FromMisoString t where + -- -- | Parses a `MisoString` + fromMisoStringEither :: MisoString -> Either String t + +-- | Parses a `MisoString`, throws an error when decoding +-- fails. Use `fromMisoStringEither` for as a safe alternative. +fromMisoString :: FromMisoString a => MisoString -> a +fromMisoString s = case fromMisoStringEither s of + Left err -> error err + Right x -> x + +-- | 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 JSString where + toMisoString = textFromJSString +instance ToMisoString B.ByteString where + toMisoString = toMisoString . T.decodeUtf8 +instance ToMisoString BL.ByteString where + toMisoString = toMisoString . LT.decodeUtf8 +instance ToMisoString Float where + toMisoString = T.pack . show +instance ToMisoString Double where + toMisoString = T.pack . show +instance ToMisoString Int where + toMisoString = T.pack . show +instance ToMisoString Word where + toMisoString = T.pack . show + +instance FromMisoString MisoString where + fromMisoStringEither = Right +instance FromMisoString String where + fromMisoStringEither = Right . T.unpack +instance FromMisoString LT.Text where + fromMisoStringEither = Right . LT.fromStrict +instance FromMisoString JSString where + fromMisoStringEither = Right . textToJSString +instance FromMisoString B.ByteString where + fromMisoStringEither = fmap T.encodeUtf8 . fromMisoStringEither +instance FromMisoString BL.ByteString where + fromMisoStringEither = fmap LT.encodeUtf8 . fromMisoStringEither +instance FromMisoString Float where + fromMisoStringEither = readEither . T.unpack +instance FromMisoString Double where + fromMisoStringEither = readEither . T.unpack +instance FromMisoString Int where + fromMisoStringEither = readEither . T.unpack +instance FromMisoString Word where + fromMisoStringEither = readEither . T.unpack