diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,17 @@ +# 1.0.1 + +* Add formatting support for properties to `React.Flux.Addons.Intl`. These are needed for example to translate + the placeholder text for an input element. This improvement caused a few changes to the types the Internal module. + +* Add a new example [purecss-side-menu](https://bitbucket.org/wuzzeb/react-flux/src/tip/example/purecss-side-menu) + showing a responsive side menu built with PureCSS. + +* Add `classNames` function to `React.Flux.PropertiesAndEvents` to allow easily setting class names + based on calculations. + +* Add a new module `React.Flux.Combinators` which is re-exported by `React.Flux`. The `Combinators` module + contains useful utilities that while not required, make your life a little simpler. + # 1.0.0 * Bindings to react-intl (http://formatjs.io/react/) for i18n support. This is useful even if your app is diff --git a/example/README.md b/example/README.md --- a/example/README.md +++ b/example/README.md @@ -57,9 +57,39 @@ contains an [hspec-webdriver](https://hackage.haskell.org/package/hspec-webdriver) spec for the TODO example application. +# PureCSS + +The second example application shows building a [responsive side +menu](http://purecss.io/layouts/side-menu/) using [PureCSS](http://purecss.io/). A similar +technique with slightly different CSS classes can be used to create any of the menu +[layouts](http://purecss.io/layouts/). The code is ogranzied as: + +* `NavStore.hs` contains a store which stores the current page being viewed and a boolean if the + responsive side menu is open or closed. +* `Dispatcher.hs` contains a function `changePageTo` which allows changing the page. In a larger + application, `Dispatcher.hs` should also contain functions to dispatch to the other stores + containing the actual page data. +* `PageViews.hs` contains the actual page content. In a real application, each page should probably + be split into its own module and be a controller view for the content store. +* `App.hs` contains the layout for the entire application, with the navigation bar and header. +* `Main.hs` renders the application into the DOM. + +It is also built with `-fexample`. It uses the browser [history +API](https://developer.mozilla.org/en-US/docs/Web/API/History_API) which does not work if you open `index.html` directly from the filesystem. Instead, the index.html file must be served. + +~~~ +cabal configure -fexample +cabal build +cd example/purecss-side-menu +ln -s ../../dist/build/purecss-side-menu/purecss-side-menu.jsexe/all.js purecss-side-menu.js +python3 -m http.server 8000 +~~~ + +Then open your browser to `localhost:8000`. + # Routing Example -The second example application shows routing with the [web-routes](https://hackage.haskell.org/package/web-routes) package. +The third example application shows routing with the [web-routes](https://hackage.haskell.org/package/web-routes) package. It is also built by passing `-fexample` to cabal. ~~~ diff --git a/example/purecss-side-menu/App.hs b/example/purecss-side-menu/App.hs new file mode 100644 --- /dev/null +++ b/example/purecss-side-menu/App.hs @@ -0,0 +1,55 @@ +{-# LANGUAGE OverloadedStrings #-} +module App (myApp) where + +import React.Flux +import NavStore +import Dispatcher +import PageViews + +-- | Each page rendered by the application becomes an instance of this structure. +-- I define and fill this here inside App.hs instead of in each individual page view so +-- that the navigation definition can control how the pages are displayed and organized (dropdowns, +-- categories, etc.) in the menu. +data Page = Page + { pageId :: NavPageId + , pageTitle :: ReactElementM ViewEventHandler () + -- ^ the title showed in the sidebar menu + , pageContent :: ReactView () + -- ^ the content of the page + } + +-- | Convert a page id to a page +pageFor :: NavPageId -> Page +pageFor Page1 = Page Page1 "Page 1" page1 +pageFor Page2 = Page Page2 "Page 2" page2 +pageFor Page3 = Page Page3 "Page 3" page3 + +-- | A single menu item entry in the sidebar. +menuItem_ :: NavPageId -> NavPageId -> ReactElementM ViewEventHandler () +menuItem_ curPageId linkPageId = + let linkPage = pageFor linkPageId + in + li_ [classNames [("pure-menu-item", True), ("pure-menu-selected", curPageId == pageId linkPage)]] $ + a_ ["className" $= "pure-menu-link", onClick $ \_ _ -> changePageTo $ pageId linkPage] $ + pageTitle linkPage + +-- | The navigation menu +navMenu_ :: NavPageId -> ReactElementM ViewEventHandler () +navMenu_ curPageId = + cldiv_ "pure-menu" $ do + span_ ["className" $= "pure-menu-heading"] "My Brand" + ul_ ["className" $= "pure-menu-list"] $ + mapM_ (menuItem_ curPageId) allPageIds + +-- | The entire layout of the app, consisting of the menu and the main content section. +myApp :: ReactView () +myApp = defineControllerView "my application" currentNavPageStore $ \navState () -> do + div_ ["id" $= "layout", classNames [("active", sideMenuOpen navState)]] $ do + a_ ["id" $= "menuLink" + , classNames [("menu-link", True), ("active", sideMenuOpen navState)] + , onClick $ \_ _ -> [SomeStoreAction currentNavPageStore ToggleSideMenu] + ] $ span_ mempty + div_ ["id" $= "menu", classNames [("active", sideMenuOpen navState)]] $ + navMenu_ $ currentPageId navState + div_ ["id" $= "main"] $ + view (pageContent $ pageFor $ currentPageId navState) () mempty diff --git a/example/purecss-side-menu/Dispatcher.hs b/example/purecss-side-menu/Dispatcher.hs new file mode 100644 --- /dev/null +++ b/example/purecss-side-menu/Dispatcher.hs @@ -0,0 +1,11 @@ +module Dispatcher ( + -- re-export NavPageId so views don't have to import NavStore directly + NavPageId(..) + , changePageTo +) where + +import React.Flux +import NavStore + +changePageTo :: NavPageId -> [SomeStoreAction] +changePageTo p = [SomeStoreAction currentNavPageStore $ ChangePageTo p] diff --git a/example/purecss-side-menu/Main.hs b/example/purecss-side-menu/Main.hs new file mode 100644 --- /dev/null +++ b/example/purecss-side-menu/Main.hs @@ -0,0 +1,10 @@ +module Main (main) where + +import React.Flux +import App +import NavStore (initHistory) + +main :: IO () +main = do + initHistory + reactRender "side-menu-app" myApp () diff --git a/example/purecss-side-menu/NavStore.hs b/example/purecss-side-menu/NavStore.hs new file mode 100644 --- /dev/null +++ b/example/purecss-side-menu/NavStore.hs @@ -0,0 +1,92 @@ +{-# LANGUAGE TypeFamilies, DeriveGeneric, DeriveAnyClass, OverloadedStrings #-} +-- | A store to hold the current page being viewed. +module NavStore where + +import Control.DeepSeq (NFData) +import Data.Maybe (fromMaybe) +import Data.Typeable (Typeable) +import GHC.Generics (Generic) +import React.Flux + +import GHCJS.Types (JSRef, JSString) +import GHCJS.Foreign.Callback (Callback, syncCallback1, OnBlocked(..)) +import GHCJS.Marshal (fromJSRef) +import qualified Data.JSString as JSString + +data NavPageId = Page1 + | Page2 + | Page3 + deriving (Show, Eq, Enum, Bounded, Typeable, Generic, NFData) + +-- | The page title (used for `document.title`) and the url (used for the history API and displayed +-- in the browser location bar). +pageTitleAndUrl :: NavPageId -> (String, String) +pageTitleAndUrl Page1 = ("Page 1 Title", "/page1") +pageTitleAndUrl Page2 = ("Page 2222", "/pages/page2") +pageTitleAndUrl Page3 = ("Page Three Title", "/page3.html") + +allPageIds :: [NavPageId] +allPageIds = [(minBound :: NavPageId) .. ] + +data NavAction = ChangePageTo NavPageId -- ^ use to change the page + | BackToPage NavPageId -- ^ used from the history handler to go back + | ToggleSideMenu + deriving (Show, Eq, Typeable, Generic, NFData) + +data NavState = NavState + { sideMenuOpen :: Bool + , currentPageId :: NavPageId + } deriving (Show, Eq, Generic, Typeable) + +instance StoreData NavState where + type StoreAction NavState = NavAction + transform (ChangePageTo p) _ = do + historyPushState p + setDocTitle p + return NavState { currentPageId = p, sideMenuOpen = False } + transform (BackToPage p) _ = do + setDocTitle p + return NavState { currentPageId = p, sideMenuOpen = False } + transform ToggleSideMenu s = + return $ s { sideMenuOpen = not (sideMenuOpen s) } -- use a lens! + +currentNavPageStore :: ReactStore NavState +currentNavPageStore = mkStore (NavState False Page1) + +-------------------------------------------------------------------------- +--- History API +-------------------------------------------------------------------------- + +foreign import javascript unsafe + "window['history']['pushState']({page: $1}, $2)" + js_historyPushState :: Int -> JSString -> IO () + +historyPushState :: NavPageId -> IO () +historyPushState pid = do + let (_, url) = pageTitleAndUrl pid + js_historyPushState (fromEnum pid) $ JSString.pack url + +foreign import javascript unsafe + "document['title'] = $1;" + js_setDocTitle :: JSString -> IO () + +setDocTitle :: NavPageId -> IO () +setDocTitle pid = do + let (title, _) = pageTitleAndUrl pid + js_setDocTitle $ JSString.pack title + +foreign import javascript unsafe + "window['onpopstate'] = function(e) { $1(e['state'] ? e['state'].page : 0); };" + js_setOnPopState :: Callback (JSRef -> IO ()) -> IO () + +initHistory :: IO () +initHistory = do + -- set the document title to match page1 + let (title, _) = pageTitleAndUrl Page1 + js_setDocTitle $ JSString.pack title + + -- register a callback for onpopstate event + c <- syncCallback1 ContinueAsync $ \pageRef -> do + pageInt <- fromMaybe (error "Unable to parse page") <$> fromJSRef pageRef + alterStore currentNavPageStore $ BackToPage $ toEnum pageInt + js_setOnPopState c diff --git a/example/purecss-side-menu/PageViews.hs b/example/purecss-side-menu/PageViews.hs new file mode 100644 --- /dev/null +++ b/example/purecss-side-menu/PageViews.hs @@ -0,0 +1,38 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | The pages. Normally each page should go into its own module, but for simplicity in this +-- example they are all defined here. +module PageViews where + +import React.Flux +import Dispatcher + +page1 :: ReactView () +page1 = defineView "page 1" $ \() -> div_ $ do + cldiv_ "header" $ + h1_ "Page 1!!" + cldiv_ "content" $ do + p_ $ do + "Page 1 content. " + clbutton_ "pure-button" (changePageTo Page2) "Change to page 2" + "Also, try reducing the browser width to see the responsive menu." + p_ $ do + "You must load this file from a server. If you did not, no page changes will work. Use for example " + code_ "python3 -m http.server 8000" + " or " + code_ "python2 -m SimpleHTTPServer 8000" + " from the example/purecss-side-menu directory." + +page2 :: ReactView () +page2 = defineView "page 2" $ \() -> div_ $ do + cldiv_ "header" $ + h1_ "Just page 2" + cldiv_ "content" $ + p_ "Page 2 content. Try the back button." + +page3 :: ReactView () +page3 = defineView "page 3" $ \() -> div_ $ do + cldiv_ "header" $ + h1_ "Page Three" + cldiv_ "content" $ + p_ "Page 3 content. Try the back button." diff --git a/example/purecss-side-menu/index.html b/example/purecss-side-menu/index.html new file mode 100644 --- /dev/null +++ b/example/purecss-side-menu/index.html @@ -0,0 +1,16 @@ + + + + + + Responsive Side Menu + + + + +
+ + + + + diff --git a/example/todo/TodoViews.hs b/example/todo/TodoViews.hs --- a/example/todo/TodoViews.hs +++ b/example/todo/TodoViews.hs @@ -40,13 +40,12 @@ -- inside the rendering function. mainSection_ :: TodoState -> ReactElementM ViewEventHandler () mainSection_ st = section_ ["id" $= "main"] $ do - input_ [ "id" $= "toggle-all" - , "type" $= "checkbox" - , "checked" $= if all (todoComplete . snd) $ todoList st then "checked" else "" - , onChange $ \_ -> dispatchTodo ToggleAllComplete - ] + labeledInput_ "toggle-all" "Mark all as complete" + [ "type" $= "checkbox" + , "checked" $= if all (todoComplete . snd) $ todoList st then "checked" else "" + , onChange $ \_ -> dispatchTodo ToggleAllComplete + ] - label_ [ "htmlFor" $= "toggle-all"] "Mark all as complete" ul_ [ "id" $= "todo-list" ] $ mapM_ todoItem_ $ todoList st -- | A view for each todo item. We specifically use a ReactView here to take advantage of the @@ -56,11 +55,11 @@ -- section of the React.Flux documentation. todoItem :: ReactView (Int, Todo) todoItem = defineView "todo item" $ \(todoIdx, todo) -> - li_ [ "className" @= (unwords $ [ "completed" | todoComplete todo] ++ [ "editing" | todoIsEditing todo ]) + li_ [ classNames [("completed", todoComplete todo), ("editing", todoIsEditing todo)] , "key" @= todoIdx ] $ do - div_ [ "className" $= "view"] $ do + cldiv_ "view" $ do input_ [ "className" $= "toggle" , "type" $= "checkbox" , "checked" @= todoComplete todo @@ -70,9 +69,7 @@ label_ [ onDoubleClick $ \_ _ -> dispatchTodo $ TodoEdit todoIdx] $ elemText $ todoText todo - button_ [ "className" $= "destroy" - , onClick $ \_ _ -> dispatchTodo $ TodoDelete todoIdx - ] mempty + clbutton_ "destroy" (dispatchTodo $ TodoDelete todoIdx) mempty when (todoIsEditing todo) $ todoTextInput_ TextInputArgs diff --git a/example/todo/todo.html b/example/todo/todo.html --- a/example/todo/todo.html +++ b/example/todo/todo.html @@ -8,7 +8,7 @@
- + diff --git a/jsbits/views.js b/jsbits/views.js --- a/jsbits/views.js +++ b/jsbits/views.js @@ -41,6 +41,12 @@ return this['props'].hs.root != newProps.hs.root; }; } + + if (typeof ReactIntl != "undefined") { + cl['contextTypes'] = { + 'intl': ReactIntl['intlShape'] + }; + } return cl; } diff --git a/react-flux.cabal b/react-flux.cabal --- a/react-flux.cabal +++ b/react-flux.cabal @@ -1,5 +1,5 @@ name: react-flux -version: 1.0.0 +version: 1.0.1 synopsis: A binding to React based on the Flux application architecture for GHCJS category: Web homepage: https://bitbucket.org/wuzzeb/react-flux @@ -22,6 +22,8 @@ example/todo/run-in-node.js, example/routing/*.hs, example/routing/*.html, + example/purecss-side-menu/*.hs, + example/purecss-side-menu/*.html, test/client/*.html, test/client/msgs/*.json, test/client/msgs/*.xml, @@ -53,6 +55,7 @@ exposed-modules: React.Flux React.Flux.DOM React.Flux.PropertiesAndEvents + React.Flux.Combinators React.Flux.Lifecycle React.Flux.Internal React.Flux.Addons.React @@ -115,6 +118,21 @@ , deepseq , text +executable purecss-side-menu + if !flag(example) + Buildable: False + ghc-options: -Wall + cpp-options: -DGHCJS_BROWSER + + default-language: Haskell2010 + hs-source-dirs: example/purecss-side-menu + main-is: Main.hs + build-depends: base + , react-flux + , deepseq + if impl(ghcjs) + build-depends: ghcjs-base + executable test-client-13 if !flag(test-client) Buildable: False @@ -146,6 +164,7 @@ , react-flux , time , deepseq + , aeson if impl(ghcjs) build-depends: ghcjs-base diff --git a/src/React/Flux.hs b/src/React/Flux.hs --- a/src/React/Flux.hs +++ b/src/React/Flux.hs @@ -85,6 +85,7 @@ , foreignClass , module React.Flux.DOM , module React.Flux.PropertiesAndEvents + , module React.Flux.Combinators -- * Main , reactRender @@ -101,10 +102,11 @@ import React.Flux.DOM import React.Flux.Internal import React.Flux.PropertiesAndEvents +import React.Flux.Combinators import React.Flux.Store #ifdef __GHCJS__ -import GHCJS.Types (JSString, JSRef) +import GHCJS.Types (JSString, JSRef, nullRef) import GHCJS.Marshal (fromJSRef) #endif @@ -123,7 +125,7 @@ #ifdef __GHCJS__ reactRender htmlId rc props = do - (e, _) <- mkReactElement id (return []) $ view rc props mempty + (e, _) <- mkReactElement id (return nullRef) (return []) $ view rc props mempty js_ReactRender e (toJSString htmlId) foreign import javascript unsafe @@ -149,7 +151,7 @@ #ifdef __GHCJS__ reactRenderToString includeStatic rc props = do - (e, _) <- mkReactElement id (return []) $ view rc props mempty + (e, _) <- mkReactElement id (return nullRef) (return []) $ view rc props mempty sRef <- (if includeStatic then js_ReactRenderStaticMarkup else js_ReactRenderToString) e --return sRef --return $ JSS.unpack sRef diff --git a/src/React/Flux/Addons/Intl.hs b/src/React/Flux/Addons/Intl.hs --- a/src/React/Flux/Addons/Intl.hs +++ b/src/React/Flux/Addons/Intl.hs @@ -96,6 +96,7 @@ , int_ , double_ , formattedNumber_ + , formattedNumberProp -- ** Dates and Times , DayFormat(..) @@ -105,18 +106,23 @@ , shortDateTime , utcTime_ , formattedDate_ + , formattedDateProp -- ** Relative Times , relativeTo_ , formattedRelative_ + , formattedRelativeProp -- ** Plural , plural_ + , pluralProp -- ** Messages , MessageId , message , message' + , messageProp + , messageProp' , htmlMsg , htmlMsg' @@ -129,7 +135,8 @@ ) where import Control.Monad (when, forM_) -import Data.Aeson (Object, Value(Object)) +import Data.Aeson (Object, Value(Object), object, (.=)) +import Data.Aeson.Types (Pair) import Data.Char (ord, isPrint) import Data.List (sortBy) import Data.Maybe (catMaybes, fromMaybe) @@ -139,6 +146,7 @@ import Language.Haskell.TH (runIO, Q, Loc, location, ExpQ) import Language.Haskell.TH.Syntax (liftString, qGetQ, qPutQ, reportWarning, Dec) import React.Flux +import React.Flux.Internal (PropertyOrHandler(PropertyFromContext)) import System.IO (withFile, IOMode(..)) import qualified Data.Aeson as Aeson import qualified Data.ByteString as B @@ -149,7 +157,9 @@ #ifdef __GHCJS__ -import GHCJS.Types (JSRef) +import GHCJS.Types (JSRef, JSString) +import GHCJS.Marshal (ToJSRef(..)) +import qualified Data.JSString as JSS foreign import javascript unsafe "$r = ReactIntl['IntlProvider']" @@ -202,6 +212,23 @@ (sec, fracSec) = properFraction pSec micro = round $ fracSec * 1000000 + +foreign import javascript unsafe + "$1['intl'][$2]($3, $4)" + js_callContextAPI :: JSRef -> JSString -> JSRef -> JSRef -> IO JSRef + + +data ContextApiCall a = ContextApiCall String a [Pair] JSRef + +instance ToJSRef a => ToJSRef (ContextApiCall a) where + toJSRef (ContextApiCall name a b ctx) = do + aRef <- toJSRef a + bRef <- toJSRef $ object b + js_callContextAPI ctx (JSS.pack name) aRef bRef + +formatCtx :: ToJSRef a => String -> String -> a -> [Pair] -> PropertyOrHandler handler +formatCtx name func val options = PropertyFromContext name $ ContextApiCall func val options + #else type JSRef = () @@ -233,6 +260,11 @@ timeToRef :: UTCTime -> JSRef timeToRef _ = () +class ToJSRef a + +formatCtx :: String -> String -> a -> [Pair] -> PropertyOrHandler handler +formatCtx name _ _ _ = PropertyFromContext name $ \() -> () + #endif -- | Use the IntlProvider to set the @locale@, @formats@, and @messages@ property. @@ -275,6 +307,18 @@ formattedNumber_ :: [PropertyOrHandler eventHandler] -> ReactElementM eventHandler () formattedNumber_ props = foreignClass js_formatNumber props mempty +-- | Format a number as a string, and then use it as the value for a property. 'int_', 'double_', +-- or 'formattedNumber_' should be prefered because as components they can avoid re-rendering when +-- the number has not changed. 'formattedNumberProp' is needed if the formatted number has to be +-- a property on another element, such as the placeholder for an input element. +formattedNumberProp :: ToJSRef num + => String -- ^ the property to set + -> num -- ^ the number to format + -> [Pair] -- ^ any options accepted by + -- + -> PropertyOrHandler handler +formattedNumberProp name x options = formatCtx name "formatNumber" x options + -------------------------------------------------------------------------------- -- Date/Time -------------------------------------------------------------------------------- @@ -371,6 +415,19 @@ where valProp = property "value" $ either dayToRef timeToRef t +-- | Format a day or time as a string, and then use it as the value for a property. 'day_', +-- 'utcTime_', or 'formattedDate_' should be prefered because as components they can avoid re-rendering when +-- the date has not changed. 'formattedDateProp' is needed if the formatted date has to be +-- a property on another element, such as the placeholder for an input element. +formattedDateProp :: String -- ^ the property to set + -> Either Day UTCTime -- ^ the day or time to format + -> [Pair] -- ^ Any options supported by + -- . + -> PropertyOrHandler eventHandler +formattedDateProp name (Left day) options = + formatCtx name "formatDate" (dayToRef day) options +formattedDateProp name (Right time) options = + formatCtx name "formatTime" (timeToRef time) options -- | Display the 'UTCTime' as a relative time. In addition, wrap the display in a HTML5 -- element. @@ -386,6 +443,17 @@ formattedRelative_ :: UTCTime -> [PropertyOrHandler eventHandler] -> ReactElementM eventHandler () formattedRelative_ t props = foreignClass js_formatRelative (property "value" (timeToRef t) : props) mempty +-- | Format a time as a relative time string, and then use it as the value for a property. +-- 'relativeTo_' or 'formattedRelative_' should be prefered because as components they can avoid re-rendering when +-- the date has not changed. 'formattedRelativeProp' is needed if the formatted date has to be +-- a property on another element, such as the placeholder for an input element. +formattedRelativeProp :: String -- ^ te property to set + -> UTCTime -- ^ the time to format + -> [Pair] -- ^ an object with properties \"units\" and \"style\". \"units\" accepts values second, minute, hour + -- day, month, or year and \"style\" accepts only the value \"numeric\". + -> PropertyOrHandler eventHandler +formattedRelativeProp name time options = formatCtx name "formatRelative" (timeToRef time) options + -------------------------------------------------------------------------------- -- Plural -------------------------------------------------------------------------------- @@ -397,6 +465,12 @@ plural_ :: [PropertyOrHandler eventHandler] -> ReactElementM eventHandler () plural_ props = foreignClass js_formatPlural props mempty +-- | Format a number properly based on pluralization, and then use it as the value for a property. +-- 'plural_' should be preferred, but 'pluralProp' can be used in places where a component is not +-- possible such as the placeholder of an input element. +pluralProp :: ToJSRef val => String -> val -> [Pair] -> PropertyOrHandler eventHandler +pluralProp name val options = formatCtx name "formatPlural" val options + -------------------------------------------------------------------------------- -- Messages -------------------------------------------------------------------------------- @@ -447,6 +521,41 @@ -> ExpQ --Q (TExp ([PropertyOrHandler eventHandler] -> ReactElementM eventHandler ())) message ident m = formattedMessage [|js_formatMsg|] ident $ Message "" m +-- | Similar to 'message', but produce an expression of type @['Pair'] -> PropertyOrHandler handler@, +-- which should be passed the values for the message. This allows you to format messages in places +-- where using a component like 'message' is not possible, such as the placeholder of input +-- elements. 'message' should be prefered since it can avoid re-rendering the formatting if the +-- value has not changed. +-- +-- >import Data.Aeson ((.=)) +-- > +-- >input_ [ "type" $= "numeric" +-- > , $(messageProp "placeholder" "ageplaceholder" "Hello {name}, enter your age") +-- > [ "name" .= nameFrom storeData ] +-- > ] +messageProp :: String -- ^ the property name to set + -> MessageId -- ^ the message identifier + -> T.Text -- ^ the default message written in ICU message syntax. + -> ExpQ +messageProp name ident m = + formatMessageProp "formatMessage" name ident $ Message "" m + +-- | A variant of 'message' which allows you to specify some context for translators. +message' :: MessageId + -> T.Text -- ^ A description indented to provide context for translators + -> T.Text -- ^ The default message written in ICU message syntax + -> ExpQ --Q (TExp ([PropertyOrHandler eventHandler] -> ReactElementM eventHandler ())) +message' ident descr m = formattedMessage [|js_formatMsg|] ident $ Message descr m + +-- | A varient of 'messageProp' which allows you to specify some context for translators. +messageProp' :: String -- ^ property to set + -> MessageId + -> T.Text -- ^ A description intended to provide context for translators + -> T.Text -- ^ The default message written in ICU message syntax + -> ExpQ +messageProp' name ident descr m = + formatMessageProp "formatMessage" name ident $ Message descr m + -- | Similar to 'message' but use a @FormattedHTMLMessage@ which allows HTML inside the message. It -- is recomended that you instead use 'message' together with 'elementProperty' to include rich text -- inside the message. This splice produces a value of type @[PropertyOrHandler @@ -456,13 +565,6 @@ -> ExpQ htmlMsg ident m = formattedMessage [|js_formatHtmlMsg|] ident $ Message "" m --- | A variant of 'message' which allows you to specify some context for translators. -message' :: MessageId - -> T.Text -- ^ A description indented to provide context for translators - -> T.Text -- ^ The default message written in ICU message syntax - -> ExpQ --Q (TExp ([PropertyOrHandler eventHandler] -> ReactElementM eventHandler ())) -message' ident descr m = formattedMessage [|js_formatMsg|] ident $ Message descr m - -- | A variant of 'htmlMsg' that allows you to specify some context for translators. htmlMsg' :: MessageId -> T.Text -- ^ A description intended to provide context for translators @@ -470,9 +572,8 @@ -> ExpQ htmlMsg' ident descr m = formattedMessage [|js_formatHtmlMsg|] ident $ Message descr m --- | Utility function for messages -formattedMessage :: ExpQ -> MessageId -> Message -> ExpQ --Q (TExp ([PropertyOrHandler eventHandler] -> ReactElementM eventHandler ())) -formattedMessage cls ident m = do +recordMessage :: MessageId -> Message -> Q () +recordMessage ident m = do curLoc <- location mmap :: MessageMap <- fromMaybe H.empty <$> qGetQ case H.lookup ident mmap of @@ -485,9 +586,19 @@ _ -> return () qPutQ $ H.insert ident (m, curLoc) mmap +-- | Utility function for messages +formattedMessage :: ExpQ -> MessageId -> Message -> ExpQ --Q (TExp ([PropertyOrHandler eventHandler] -> ReactElementM eventHandler ())) +formattedMessage cls ident m = do + recordMessage ident m let liftText x = [| T.pack $(liftString $ T.unpack x)|] liftedMsg = [| Message $(liftText $ msgDescription m) $(liftText $ msgDefaultMsg m) |] [|\vals -> foreignClass $cls (messageToProps $(liftText ident) $liftedMsg vals) mempty |] + +formatMessageProp :: String -> String -> MessageId -> Message -> ExpQ -- Q (TExp ([Pair] -> PropertyOrHandler eventHandler)) +formatMessageProp func name ident m = do + recordMessage ident m + let liftedMsg = [| object ["id" .= T.pack $(liftString $ T.unpack ident), "defaultMessage" .= T.pack $(liftString $ T.unpack $ msgDefaultMsg m) ] |] + [|\options -> formatCtx $(liftString name) $(liftString func) $liftedMsg options |] -- | Perform an arbitrary IO action on the accumulated messages at compile time, which usually -- should be to write the messages to a file. Despite producing a value of type @Q [Dec]@, diff --git a/src/React/Flux/Combinators.hs b/src/React/Flux/Combinators.hs new file mode 100644 --- /dev/null +++ b/src/React/Flux/Combinators.hs @@ -0,0 +1,117 @@ +-- | This module contains some useful combinators I have come across as I built a large +-- react-flux application. None of these are required to use React.Flux, they just reduce somewhat +-- the typing needed to create rendering functions. +module React.Flux.Combinators ( + clbutton_ + , cldiv_ + , faIcon_ + , foreign_ + , labeledInput_ +) where + +import Data.Monoid ((<>)) +import React.Flux.DOM +import React.Flux.Internal +import React.Flux.PropertiesAndEvents +import React.Flux.Views + +#ifdef __GHCJS__ +import GHCJS.Types (JSString, JSRef) + +foreign import javascript unsafe + "$r = window[$1]" + js_lookupWindow :: JSString -> JSRef +#else +js_lookupWindow :: a -> () +js_lookupWindow _ = () +#endif + +-- | A wrapper around 'foreignClass' that looks up the class on the `window`. I use it for several +-- third-party react components. For example, with , assuming `window.Modal` contains the definition of the classes, +-- +-- >foreign_ "Modal" [ "isOpen" @= isModelOpen myProps +-- > , callback "onRequestClose" $ dispatch closeModel +-- > , "style" @= Aeson.object [ "overlay" @= Aeson.object ["left" $= "50%", "right" $= "50%"]] +-- > ] $ do +-- > h1_ "Hello, World!" +-- > p_ "...." +-- +-- Here is another example using : +-- +-- >reactSelect_ :: [PropertyOrHandler eventHandler] -> ReactElementM eventHandler () +-- >reactSelect_ props = foreign_ "Select" props mempty +-- > +-- >someView :: ReactView () +-- >someView = defineView "some view" $ \() -> +-- > reactSelect_ +-- > [ "name" $= "form-field-name" +-- > , "value" $= "one" +-- > , "options" @= [ object [ "value" .= "one", "label" .= "One" ] +-- > , object [ "value" .= "two", "label" .= "Two" ] +-- > ] +-- > , callback "onChange" $ \(i :: String) -> dispatch $ ItemChangedTo i +-- > ] +foreign_ :: String -- ^ this should be the name of a property on `window` which contains a react class. + -> [PropertyOrHandler handler] -- ^ properties + -> ReactElementM handler a -- ^ children + -> ReactElementM handler a +foreign_ x = foreignClass (js_lookupWindow $ toJSString x) + +-- | A 'div_' with the given class name (multiple classes can be separated by spaces). This is +-- useful for defining rows and columns in your CSS framework of choice. I use +-- so I use it something like: +-- +-- >cldiv_ "pure-g" $ do +-- > cldiv_ "pure-u-1-3" $ p_ "First Third" +-- > cldiv_ "pure-u-1-3" $ p_ "Middle Third" +-- > cldiv_ "pure-u-1-3" $ p_ "Last Third" +-- +-- You should consider writing something like the following for the various components in your frontend +-- of choice. In PureCSS, I use: +-- +-- >prow_ :: ReactElementM handler a -> ReactElementM handler a +-- >prow_ = cldiv_ "pure-g" +-- > +-- >pcol_ :: String -> ReactElementM handler a -> ReactElementM handler a +-- >pcol_ cl = cldiv_ (unwords $ map ("pure-u-"++) $ words cl) +cldiv_ :: String -> ReactElementM handler a -> ReactElementM handler a +cldiv_ cl = div_ ["className" @= cl] + +-- | A 'button_' with the given class names and `onClick` handler. +-- +-- >clbutton_ ["pure-button button-success"] (dispatch LaunchMissiles) $ do +-- > faIcon_ "rocket" +-- > "Launch the missiles!" +clbutton_ :: String -- ^ class names separated by spaces + -> handler -- ^ the onClick handler for the button + -> ReactElementM handler a -- ^ the children + -> ReactElementM handler a +clbutton_ cl h = button_ ["className" @= cl, onClick (\_ _ -> h)] + +-- | A 'label_' and an 'input_' together. Useful for laying out forms. For example, a +-- stacked could be +-- +-- >form_ ["className" $= "pure-form pure-form-stacked"] $ +-- > fieldset_ $ do +-- > legend_ "A stacked form" +-- > labeledInput_ "email" "Email" ["type" $= "email"] +-- > labeledInput_ "password" +-- > ($(message "password-label" "Your password") []) +-- > ["type" $= "password"] +-- +-- The second 'labeledInput_' shows an example using "React.Flux.Addons.Intl". +labeledInput_ :: String -- ^ the ID for the input element + -> ReactElementM handler () -- ^ the label content. This is wrapped in a 'label_' with a `htmlFor` property + -- equal to the given ID. + -> [PropertyOrHandler handler] -- ^ the properties to pass to 'input_'. A property with key `id` is added to this list of properties. + -> ReactElementM handler () +labeledInput_ ident lbl props = label_ ["htmlFor" @= ident] lbl <> input_ (("id" @= ident):props) + +-- | A icon. The given string is prefixed +-- by `fa fa-` and then used as the class for an `i` element. This allows you to icons such as +-- +-- >faIcon_ "fighter-jet" -- produces +-- >faIcon_ "refresh fa-spin" -- produces +faIcon_ :: String -> ReactElementM handler () +faIcon_ cl = i_ ["className" @= ("fa fa-" ++ cl)] mempty diff --git a/src/React/Flux/Internal.hs b/src/React/Flux/Internal.hs --- a/src/React/Flux/Internal.hs +++ b/src/React/Flux/Internal.hs @@ -75,6 +75,10 @@ { propertyName :: String , propertyVal :: ref } + | forall ref. ToJSRef ref => PropertyFromContext + { propFromThisName :: String + , propFromThisVal :: JSRef -> ref -- ^ will be passed this.context + } | NestedProperty { nestedPropertyName :: String , nestedPropertyVals :: [PropertyOrHandler handler] @@ -94,6 +98,7 @@ instance Functor PropertyOrHandler where fmap _ (Property name val) = Property name val + fmap _ (PropertyFromContext name f) = PropertyFromContext name f fmap f (NestedProperty name vals) = NestedProperty name (map (fmap f) vals) fmap f (ElementProperty name (ReactElementM mkElem)) = ElementProperty name $ ReactElementM $ mapWriter (\((),e) -> ((), fmap f e)) mkElem @@ -233,13 +238,14 @@ -- once the class is re-rendered. mkReactElement :: forall eventHandler. (eventHandler -> IO ()) + -> IO JSRef -- ^ this.context -> IO [ReactElementRef] -- ^ this.props.children -> ReactElementM eventHandler () -> IO (ReactElementRef, [Callback (JSRef -> IO ())]) #ifdef __GHCJS__ -mkReactElement runHandler getPropsChildren = runWriterT . mToElem +mkReactElement runHandler getContext getPropsChildren = runWriterT . mToElem where -- Run the ReactElementM monad to create a ReactElementRef. mToElem :: ReactElementM eventHandler () -> MkReactElementM ReactElementRef @@ -262,6 +268,10 @@ addPropOrHandlerToObj obj (Property n val) = lift $ do vRef <- toJSRef val JSO.setProp (toJSString n) vRef obj + addPropOrHandlerToObj obj (PropertyFromContext n f) = lift $ do + ctx <- getContext + vRef <- toJSRef $ f ctx + JSO.setProp (toJSString n) vRef obj addPropOrHandlerToObj obj (NestedProperty n vals) = do nested <- lift $ JSO.create mapM_ (addPropOrHandlerToObj nested) vals @@ -351,7 +361,7 @@ toJSString = JSS.pack #else -mkReactElement _ _ _ = return (ReactElementRef (), []) +mkReactElement _ _ _ _ = return (ReactElementRef (), []) toJSString :: String -> String toJSString = id diff --git a/src/React/Flux/PropertiesAndEvents.hs b/src/React/Flux/PropertiesAndEvents.hs --- a/src/React/Flux/PropertiesAndEvents.hs +++ b/src/React/Flux/PropertiesAndEvents.hs @@ -4,15 +4,20 @@ {-# LANGUAGE UndecidableInstances #-} module React.Flux.PropertiesAndEvents ( PropertyOrHandler - , (@=) - , ($=) + + -- * Creating Properties , property , elementProperty , nestedProperty , CallbackFunction , callback - -- * Events + -- ** Combinators + , (@=) + , ($=) + , classNames + + -- * Creating Events , Event(..) , EventTarget(..) , eventTargetProp @@ -22,23 +27,23 @@ , capturePhase , on - -- * Keyboard + -- ** Keyboard , KeyboardEvent(..) , onKeyDown , onKeyPress , onKeyUp - -- * Focus + -- ** Focus , FocusEvent(..) , onBlur , onFocus - -- * Form + -- ** Form , onChange , onInput , onSubmit - -- * Mouse + -- ** Mouse , MouseEvent(..) , onClick , onContextMenu @@ -59,7 +64,7 @@ , onMouseOver , onMouseUp - -- * Touch + -- ** Touch , initializeTouchEvents , Touch(..) , TouchEvent(..) @@ -68,14 +73,14 @@ , onTouchMove , onTouchStart - -- * UI + -- ** UI , onScroll - -- * Wheel + -- ** Wheel , WheelEvent(..) , onWheel - -- * Image + -- ** Image , onLoad , onError ) where @@ -86,6 +91,7 @@ import System.IO.Unsafe (unsafePerformIO) import qualified Data.Text as T import qualified Data.Aeson as A +import qualified Data.HashMap.Strict as M import React.Flux.Internal import React.Flux.Store @@ -109,17 +115,6 @@ nullRef = () #endif --- TOOD: change these to take a String next time we bump the major version - --- | Create a property. -(@=) :: A.ToJSON a => T.Text -> a -> PropertyOrHandler handler -n @= a = Property (T.unpack n) (A.toJSON a) - --- | Create a text-valued property. This is here to avoid problems when OverloadedStrings extension --- is enabled -($=) :: T.Text -> T.Text -> PropertyOrHandler handler -n $= a = Property (T.unpack n) a - -- | Some third-party React classes allow passing React elements as properties. This function -- will first run the given 'ReactElementM' to obtain an element or elements, and then use that -- element as the value for a property with the given key. @@ -183,6 +178,27 @@ -- For another example, see the haddock comments in "React.Flux.Addons.Bootstrap". callback :: CallbackFunction handler func => String -> func -> PropertyOrHandler handler callback name func = CallbackPropertyWithArgumentArray name $ \arr -> applyFromArguments arr 0 func + +---------------------------------------------------------------------------------------------------- +--- Combinators +---------------------------------------------------------------------------------------------------- + +-- | Create a property. +(@=) :: A.ToJSON a => T.Text -> a -> PropertyOrHandler handler +n @= a = Property (T.unpack n) (A.toJSON a) + +-- | Create a text-valued property. This is here to avoid problems when OverloadedStrings extension +-- is enabled +($=) :: T.Text -> T.Text -> PropertyOrHandler handler +n $= a = Property (T.unpack n) a + +-- | Set the property to consist +-- of all the names which are matched with True, allowing you to easily toggle class names based on +-- a computation. +classNames :: [(T.Text, Bool)] -> PropertyOrHandler handler +classNames xs = "className" @= T.intercalate " " names + where + names = M.keys $ M.filter id $ M.fromList xs ---------------------------------------------------------------------------------------------------- --- Generic Event diff --git a/src/React/Flux/Views.hs b/src/React/Flux/Views.hs --- a/src/React/Flux/Views.hs +++ b/src/React/Flux/Views.hs @@ -119,7 +119,7 @@ -- > -- >todoItem :: ReactView (Int, Todo) -- >todoItem = defineView "todo item" $ \(todoIdx, todo) -> --- > li_ [ "className" @= (unwords $ [ "completed" | todoComplete todo] ++ [ "editing" | todoIsEditing todo ]) +-- > li_ [ classNames [("completed", todoComplete todo), ("editing", todoIsEditing todo)] -- > , "key" @= todoIdx -- > ] $ do -- > @@ -285,6 +285,10 @@ js_ReactGetProps :: ReactThis state props -> IO (Export props) foreign import javascript unsafe + "$1['context']" + js_ReactGetContext :: ReactThis state props -> IO JSRef + +foreign import javascript unsafe "hsreact$children_to_array($1['props']['children'])" js_ReactGetChildren :: ReactThis state props -> IO JSArray @@ -352,8 +356,9 @@ let getPropsChildren = do childRef <- js_ReactGetChildren this return $ map ReactElementRef $ toList childRef + getContext = js_ReactGetContext this - (element, evtCallbacks) <- mkReactElement (runHandler this) getPropsChildren node + (element, evtCallbacks) <- mkReactElement (runHandler this) getContext getPropsChildren node evtCallbacksRef <- toJSRef $ map jsref evtCallbacks js_RenderCbSetResults arg evtCallbacksRef element @@ -396,36 +401,8 @@ let (a, childEl) = runWriter child in elementToM a $ ViewElement (reactView rc) (Just key) props childEl --- | Create a 'ReactElement' for a class defined in javascript. For example, if you would like to --- use , you could do so as follows: --- --- >foreign import javascript unsafe --- > "window['Select']" --- > js_ReactSelectClass :: JSRef --- > --- >reactSelect_ :: [PropertyOrHandler eventHandler] -> ReactElementM eventHandler () --- >reactSelect_ props = foreignClass js_ReactSelectClass props mempty --- > --- >onSelectChange :: FromJSON a --- > => (a -> handler) -- ^ receives the new value and performs an action. --- > -> PropertyOrHandler handler --- >onSelectChange f = callback "onChange" (f . parse) --- > where --- > parse v = --- > case fromJSON v of --- > Error err -> error $ "Unable to parse new value for select onChange: " ++ err --- > Success e -> e --- --- This could then be used as part of a rendering function like so: --- --- >reactSelect_ --- > [ "name" $= "form-field-name" --- > , "value" $= "one" --- > , "options" @= [ object [ "value" .= "one", "label" .= "One" ] --- > , object [ "value" .= "two", "label" .= "Two" ] --- > ] --- > , onSelectChange dispatchSomething --- > ] +-- | Create a 'ReactElement' for a class defined in javascript. See +-- 'React.Flux.Combinators.foreign_' for a convenient wrapper and some examples. foreignClass :: JSRef -- ^ The javascript reference to the class -> [PropertyOrHandler eventHandler] -- ^ properties and handlers to pass when creating an instance of this class. -> ReactElementM eventHandler a -- ^ The child element or elements diff --git a/test/client/TestClient.hs b/test/client/TestClient.hs --- a/test/client/TestClient.hs +++ b/test/client/TestClient.hs @@ -197,7 +197,8 @@ displayChildren :: ReactView String displayChildren = defineView "display children" $ \ident -> - span_ ["className" $= "display-children", "id" @= ident] childrenPassedToView + span_ [classNames [("display-children", True), ("missing-name", False)], "id" @= ident] + childrenPassedToView displayChildren_ :: String -> ReactElementM handler () -> ReactElementM handler () displayChildren_ = view displayChildren diff --git a/test/client/TestClient14.hs b/test/client/TestClient14.hs --- a/test/client/TestClient14.hs +++ b/test/client/TestClient14.hs @@ -5,6 +5,7 @@ import React.Flux import React.Flux.Addons.Intl import GHCJS.Types (JSRef) +import Data.Aeson ((.=)) import TestClient @@ -17,12 +18,19 @@ js_translations :: JSRef intlSpec :: ReactView () -intlSpec = defineView "intl" $ \() -> div_ ["id" $= "intl-spec"] $ intlProvider_ "en-US" (Just js_translations) Nothing $ +intlSpec = defineView "intl" $ \() -> + intlProvider_ "en-US" (Just js_translations) Nothing $ + view intlSpecBody () mempty + +intlSpecBody :: ReactView () +intlSpecBody = defineView "intl body" $ \() -> div_ ["id" $= "intl-spec"] $ ul_ $ do li_ ["id" $= "f-number"] $ formattedNumber_ [ "value" @= (0.9 :: Double), "style" $= "percent" ] li_ ["id" $= "f-int"] $ int_ 100000 li_ ["id" $= "f-double"] $ double_ 40000.2 + li_ ["id" $= "f-number-prop"] $ + input_ [formattedNumberProp "placeholder" (123456 :: Int) []] let moon = fromGregorian 1969 7 20 fullDayF = DayFormat { weekdayF = Just "long", eraF = Just "short", yearF = Just "2-digit", monthF = Just "long", dayF = Just "2-digit" } @@ -31,6 +39,8 @@ li_ ["id" $= "f-fullday"] $ day_ fullDayF moon li_ ["id" $= "f-date"] $ formattedDate_ (Left moon) [ "weekday" $= "short", "month" $= "short", "day" $= "numeric", "year" $= "2-digit" ] + li_ ["id" $= "f-date-prop"] $ + input_ [formattedDateProp "placeholder" (Left moon) []] let step = UTCTime moon (2*60*60 + 56*60) -- 1969-7-20 02:56 UTC fullT = (fullDayF, TimeFormat { hourF = Just "numeric", minuteF = Just "2-digit", secondF = Just "numeric", timeZoneNameF = Just "long" }) @@ -43,6 +53,15 @@ , "timeZoneName" $= "short" , "timeZone" $= "Pacific/Tahiti" ] + li_ ["id" $= "f-time-prop"] $ + input_ [formattedDateProp "placeholder" (Right step) + [ "year" .= ("2-digit" :: String) + , "month" .= ("short" :: String) + , "day" .= ("2-digit" :: String) + , "hour" .= ("numeric" :: String) + , "timeZone" .= ("Pacific/Tahiti" :: String) + ] + ] {- li_ ["id" $= "f-relative"] $ relativeTo_ step @@ -50,6 +69,8 @@ -} li_ ["id" $= "f-plural"] $ plural_ [ "value" @= (100 :: Int), "one" $= "plural one", "other" $= "plural other"] + li_ ["id" $= "f-plural-prop"] $ + input_ [pluralProp "placeholder" (100 :: Int) ["one" .= ("plural one" :: String), "other" .= ("plural other" :: String)]] li_ ["id" $= "f-msg"] $ $(message "photos" "{name} took {numPhotos, plural, =0 {no photos} =1 {one photo} other {# photos}} {takenAgo}.") @@ -58,6 +79,13 @@ , elementProperty "takenAgo" $ span_ ["id" $= "takenAgoSpan"] "years ago" ] + li_ ["id" $= "f-msg-prop"] $ + input_ [ $(messageProp "placeholder" "photosprop" "{name} took {numPhotos, plural, =0 {no photos} =1 {one photo} other {# photos}}") + [ "name" .= ("Neil Armstrong" :: String) + , "numPhotos" .= (100 :: Int) + ] + ] + li_ ["id" $= "f-msg-with-trans"] $ $(message "with_trans" "this is not used {abc}") ["abc" $= "xxx"] @@ -66,6 +94,13 @@ [ "name" $= "Neil Armstrong" , "numPhotos" @= (0 :: Int) ] + + li_ ["id" $= "f-msg-prop-with-descr"] $ + input_ [$(messageProp' "placeholder" "photosprop2" "How many photos?" "{name} took {numPhotos, number} photos") + [ "name" .= ("Neil Armstrong" :: String) + , "numPhotos" .= (0 :: Int) + ] + ] li_ ["id" $= "f-html-msg"] $ $(htmlMsg "html1" "{num} is the answer to life, the universe, and everything") diff --git a/test/client/msgs/android.xml b/test/client/msgs/android.xml --- a/test/client/msgs/android.xml +++ b/test/client/msgs/android.xml @@ -6,5 +6,8 @@ {name} took {numPhotos, plural, =0 {no photos} =1 {one photo} other {# photos}} {takenAgo}. {name} took {numPhotos, plural, =0 {no photos} =1 {one photo} other {# photos}}. +{name} took {numPhotos, plural, =0 {no photos} =1 {one photo} other {# photos}} + +{name} took {numPhotos, number} photos this is not used {abc} diff --git a/test/client/msgs/jsonmsgs.json b/test/client/msgs/jsonmsgs.json --- a/test/client/msgs/jsonmsgs.json +++ b/test/client/msgs/jsonmsgs.json @@ -1,1 +1,1 @@ -{"photos":{"message":"{name} took {numPhotos, plural, =0 {no photos} =1 {one photo} other {# photos}} {takenAgo}."},"html2":{"message":"{num} is the answer to life, the universe, and everything","description":"Hitchhiker's Guide"},"photos2":{"message":"{name} took {numPhotos, plural, =0 {no photos} =1 {one photo} other {# photos}}.","description":"How many photos?"},"html1":{"message":"{num} is the answer to life, the universe, and everything"},"with_trans":{"message":"this is not used {abc}"}} +{"photos":{"message":"{name} took {numPhotos, plural, =0 {no photos} =1 {one photo} other {# photos}} {takenAgo}."},"html2":{"message":"{num} is the answer to life, the universe, and everything","description":"Hitchhiker's Guide"},"photos2":{"message":"{name} took {numPhotos, plural, =0 {no photos} =1 {one photo} other {# photos}}.","description":"How many photos?"},"photosprop2":{"message":"{name} took {numPhotos, number} photos","description":"How many photos?"},"html1":{"message":"{num} is the answer to life, the universe, and everything"},"with_trans":{"message":"this is not used {abc}"},"photosprop":{"message":"{name} took {numPhotos, plural, =0 {no photos} =1 {one photo} other {# photos}}"}} diff --git a/test/client/msgs/jsonnodescr.json b/test/client/msgs/jsonnodescr.json --- a/test/client/msgs/jsonnodescr.json +++ b/test/client/msgs/jsonnodescr.json @@ -1,1 +1,1 @@ -{"photos":"{name} took {numPhotos, plural, =0 {no photos} =1 {one photo} other {# photos}} {takenAgo}.","html2":"{num} is the answer to life, the universe, and everything","photos2":"{name} took {numPhotos, plural, =0 {no photos} =1 {one photo} other {# photos}}.","html1":"{num} is the answer to life, the universe, and everything","with_trans":"this is not used {abc}"} +{"photos":"{name} took {numPhotos, plural, =0 {no photos} =1 {one photo} other {# photos}} {takenAgo}.","html2":"{num} is the answer to life, the universe, and everything","photos2":"{name} took {numPhotos, plural, =0 {no photos} =1 {one photo} other {# photos}}.","photosprop2":"{name} took {numPhotos, number} photos","html1":"{num} is the answer to life, the universe, and everything","with_trans":"this is not used {abc}","photosprop":"{name} took {numPhotos, plural, =0 {no photos} =1 {one photo} other {# photos}}"} diff --git a/test/spec/TestClientSpec.hs b/test/spec/TestClientSpec.hs --- a/test/spec/TestClientSpec.hs +++ b/test/spec/TestClientSpec.hs @@ -48,6 +48,12 @@ e <- findElem (ById $ T.pack ident) getText e `shouldReturn` T.pack txt +intlPlaceholderShouldBe :: String -> String -> WD () +intlPlaceholderShouldBe ident txt = do + e <- findElem (ById $ T.pack ident) + input <- findElemFrom e $ ByTag "input" + (input `attr` "placeholder") `shouldReturn` Just (T.pack txt) + -- | Only up to 999,999 since this is just used for the number of days since 1969 showWithComma :: Integer -> String showWithComma i = show x ++ "," ++ show y @@ -187,16 +193,19 @@ it "does not display null children" $ runWD $ do s <- findElem $ ById "empty-children" + s `attr` "class" `shouldReturn` Just "display-children" findElemsFrom s (ByCSS "*") `shouldReturn` [] getText s `shouldReturn` "" it "displays a single child" $ runWD $ do s <- findElem $ ById "single-child-wrapper" + s `attr` "class" `shouldReturn` Just "display-children" s' <- findElemFrom s $ ByCSS "span#single-child" getText s' `shouldReturn` "Single Child!!" it "displays a child list" $ runWD $ do s <- findElem $ ById "multi-child" + s `attr` "class" `shouldReturn` Just "display-children" c1 <- findElemFrom s $ ByCSS "span#child1" getText c1 `shouldReturn` "Child 1" c2 <- findElemFrom s $ ByCSS "span#child2" @@ -316,3 +325,11 @@ getText htmlMsg' `shouldReturn` "42 is the answer to life, the universe, and everything" (findElemFrom htmlMsg' (ByTag "b") >>= getText) `shouldReturn` "answer" + + it "displays formatted properties" $ runWD $ do + "f-number-prop" `intlPlaceholderShouldBe` "123,456" + "f-date-prop" `intlPlaceholderShouldBe` "7/20/1969" + "f-time-prop" `intlPlaceholderShouldBe` "Jul 19, 69, 4 PM" + "f-plural-prop" `intlPlaceholderShouldBe` "other" + "f-msg-prop" `intlPlaceholderShouldBe` "Neil Armstrong took 100 photos" + "f-msg-prop-with-descr" `intlPlaceholderShouldBe` "Neil Armstrong took 0 photos"