9f862f9 · reflex-dom · git.iko.soy

git.iko.soy/reflex-dom

Merge branch 'develop' into ts-xhr-ping-pong

commit9f862f92cf3d43e4e1c7595415d70e4ccf55bf6f authorElliot Cameron <3noch@users.noreply.github.com> dateThu 16 Jul 2020, 18:01 (6 years ago) parent1facfef 0261ab7

23 files changed+312−227

compare with develop

unifiedsplit

LICENSE+12 README.md+9−9 chrome-test-utils/LICENSE+1−1 chrome-test-utils/chrome-test-utils.cabal+1−1 chrome-test-utils/src/Test/Util/UnshareNetwork.hs+2−2 reflex-dom-core/ChangeLog.md+26−30 reflex-dom-core/LICENSE+1−1 reflex-dom-core/reflex-dom-core.cabal+24−14 reflex-dom-core/src/Reflex/Dom/Builder/Class/Events.hs+2−1 reflex-dom-core/src/Reflex/Dom/Builder/Immediate.hs+13−2 reflex-dom-core/src/Reflex/Dom/Prerender.hs+3−1 reflex-dom-core/src/Reflex/Dom/Widget/Input.hs+4−1 reflex-dom-core/src/Reflex/Dom/Widget/Resize.hs+4−4 reflex-dom-core/test/gc.hs+1−1 reflex-dom-core/test/hydration.hs+34−3 reflex-dom/ChangeLog.md+10−2 reflex-dom/LICENSE+1−1 reflex-dom/benchmark.hs+2−1 reflex-dom/reflex-dom.cabal+67−21 release.nix+13−4 test/default.nix+10 test/prebuild.hs−127 test/reflex-dom-reexports.hs+72

LICENSEnew file+12

@@ -0,0 +1,12 @@

4+Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:

6+1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.

8+2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.

10+3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission.

11+

12+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

README.md+9−9

@@ -1,21 +1,21 @@

11## [Reflex-DOM](https://reflex-frp.org)

3−[![Hackage](https://img.shields.io/hackage/v/reflex-dom.svg)](http://hackage.haskell.org/package/reflex-dom)

3+[![Haskell](https://img.shields.io/badge/language-Haskell-orange.svg)](https://haskell.org) [![Hackage](https://img.shields.io/hackage/v/reflex-dom.svg)](https://hackage.haskell.org/package/reflex-dom) [![Hackage CI](https://matrix.hackage.haskell.org/api/v2/packages/reflex-dom/badge)](https://matrix.hackage.haskell.org/#/package/reflex-dom) [![BSD3 License](https://img.shields.io/badge/license-BSD3-blue.svg)](https://github.com/reflex-frp/reflex-dom/blob/master/LICENSE)

5−### A Framework for Functional Reactive Web Apps in Haskell

5+Web applications without callbacks or side-effects. Reflex-DOM brings the power of [Functional Reactive Programming (FRP)](https://wiki.haskell.org/Functional_Reactive_Programming) to the web. Build [HTML](https://developer.mozilla.org/en-US/docs/Web/HTML) and other [Document Object Model (DOM)](https://developer.mozilla.org/en-US/docs/Web/API/Document_Object_Model) data with a pure functional interface.

7−Reflex-DOM is a framework for building web applications in Haskell, based on the [Functional Reactive Programming](https://wiki.haskell.org/Functional_Reactive_Programming) library [Reflex](https://github.com/reflex-frp/reflex).

8−

9−A summary of Reflex-DOM functions is available in the [quick reference](Quickref.md).

7+Reflex-DOM is a framework for building web applications in [Haskell](https://www.haskell.org/), based on the [Functional Reactive Programming](https://wiki.haskell.org/Functional_Reactive_Programming) library [Reflex](https://github.com/reflex-frp/reflex).

108

119**Visit https://reflex-frp.org/ for more information, tutorials, documentation and [examples](https://examples.reflex-frp.org/).**

1210

1311### Additional resources

14−[Get started with Reflex](https://github.com/reflex-frp/reflex-platform)

15−

16−[/r/reflexfrp](https://www.reddit.com/r/reflexfrp)

1712

18−[irc.freenode.net #reflex-frp](http://webchat.freenode.net?channels=%23reflex-frp&uio=d4)

13+* [Official Website](https://reflex-frp.org/)

14+* [Quick Reference](Quickref.md)

15+* [Obelisk](https://github.com/obsidiansystems/obelisk#obelisk): A framework built on Reflex and Reflex-DOM for functional reactive web and mobile applications, with batteries included.

16+* [Get started with Reflex](https://github.com/reflex-frp/reflex-platform)

17+* [/r/reflexfrp](https://www.reddit.com/r/reflexfrp)

18+* [irc.freenode.net #reflex-frp](http://webchat.freenode.net?channels=%23reflex-frp&uio=d4)

1919

2020### Hacking

2121

chrome-test-utils/LICENSE+1−1

@@ -1,4 +1,4 @@

22All rights reserved.

44Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:

chrome-test-utils/chrome-test-utils.cabal+1−1

@@ -1,5 +1,5 @@

11Name: chrome-test-utils

2−Version: 0.4

2+Version: 0.5

33Synopsis: Utilities to write headless Chromium tests

44License: BSD3

55License-file: LICENSE

chrome-test-utils/src/Test/Util/UnshareNetwork.hs+2−2

@@ -4,8 +4,8 @@ import System.Linux.Namespaces

44import System.Posix

55import System.Process

7−unshareNetork :: IO ()

8−unshareNetork = do

7+unshareNetwork :: IO ()

8+unshareNetwork = do

99 uid <- getEffectiveUserID

1010 unshare [User, Network]

1111 writeUserMappings Nothing [UserMapping 0 uid 1]

reflex-dom-core/ChangeLog.md+26−30

@@ -1,51 +1,47 @@

11# Revision history for reflex-dom-core

3−## Unreleased

3+## 0.6.0.0

5+* ([#375](https://github.com/reflex-frp/reflex-dom/pull/375)) **(Breaking change)** Expose resized dimensions from `resizeDetector`, `resizeDetectorWithStyle`, and `resizeDetectorWithAttrs` from `Reflex.Dom.Widget.Resize`.

6+* ([#374](https://github.com/reflex-frp/reflex-dom/pull/374)) **(Breaking change)** Provide text clipboard data as value of `Paste` event.

7+* ([#348](https://github.com/reflex-frp/reflex-dom/pull/348)) **(Breaking change)** Make XHR response headers case insensitive by changing `_xhrResponse_headers :: Map Text Text` to `_xhrResponse_headers :: Map (CI Text) Text`.

8+* ([#225](https://github.com/reflex-frp/reflex-dom/pull/225)) **(Breaking change)** Add a functional dependency to `HasDomEvent`.

9+* ([#342](https://github.com/reflex-frp/reflex-dom/issues/342)) **(Breaking change)** The mouse wheel event is now a `WheelEventResult` rather than `()`. This provides information about the wheel's motion beyond the fact that it merely moved.

510* ([#353](https://github.com/reflex-frp/reflex-dom/pull/353)) Support GHC 8.8.

611* ([#358](https://github.com/reflex-frp/reflex-dom/pull/358)) Fix attribute support for explicitly namespaced elements.

712* ([#363](https://github.com/reflex-frp/reflex-dom/pull/363)) Remove deprecation warnings for the following widgets in

813 `Reflex.Dom.Widget.Basic`:

9−

10− * `Link`

11− * `button`

12− * `dtdd`

13− * `linkClass`

14− * `link`

15− * `tabDisplay`

16− * `tableDynAttr`

14+ * `Link`

15+ * `button`

16+ * `dtdd`

17+ * `linkClass`

18+ * `link`

19+ * `tabDisplay`

20+ * `tableDynAttr`

1721* ([#361](https://github.com/reflex-frp/reflex-dom/pull/361)) Fix bug in hydration causing the JavaScript to crash when dealing with unexpected HTML.

22+* ([#310](https://github.com/reflex-frp/reflex-dom/issues/310)) Fix the static rendering of which dropdown value is selected.

1823* ([#364](https://github.com/reflex-frp/reflex-dom/pull/364)) Export attributes used for controlling hydration at the element level:

1924 * "data-ssr" is now available as `Reflex.Dom.Builder.Immediate.hydratableAttribute`.

2025 * "data-hydration-skip" is now available as `Reflex.Dom.Builder.Immediate.skipHydrationAttribute`.

21−* ([#348](https://github.com/reflex-frp/reflex-dom/pull/348)) **(Breaking change)** Make XHR response headers case insensitive by changing `_xhrResponse_headers :: Map Text Text` to `_xhrResponse_headers :: Map (CI Text) Text`.

22−* ([#225](https://github.com/reflex-frp/reflex-dom/pull/225)) **(Breaking change)** Add a functional dependency to `HasDomEvent`.

2326* ([#366](https://github.com/reflex-frp/reflex-dom/pull/366)) Bump bounds for `reflex` to include 0.7.

2427

25−

2628## 0.5.3

2729

2830* Deprecate a number of old inflexible widget helpers in `Reflex.Dom.Widget.Basic`:

29−

30− * `Link`

31− * `button`

32− * `dtdd`

33− * `linkClass`

34− * `link`

35− * `tabDisplay`

36− * `tableDynAttr`

31+ * `Link`

32+ * `button`

33+ * `dtdd`

34+ * `linkClass`

35+ * `link`

36+ * `tabDisplay`

37+ * `tableDynAttr`

3738

3839 And in `Reflex.Dom.Widget.Input`:

39−

40− * `TextInput`

41− * `TextAreaConfig`

42− * `CheckboxConfig`

43− * `FileInput`

44−

45− * Add `< 0.7` upper bound for reflex

46−

47−* *(Breaking change)* The mouse wheel event now is a `WheelEventResult` rather than `()`.

48− This provides information about the wheel's motion beyond the fact that it merely moved.

40+ * `TextInput`

41+ * `TextAreaConfig`

42+ * `CheckboxConfig`

43+ * `FileInput`

44+* Add `< 0.7` upper bound for `reflex`.

4945

5046## 0.5.2

5147

reflex-dom-core/LICENSE+1−1

@@ -1,4 +1,4 @@

22All rights reserved.

44Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:

reflex-dom-core/reflex-dom-core.cabal+24−14

@@ -1,7 +1,18 @@

1+cabal-version: 1.24

12Name: reflex-dom-core

2−Version: 0.5.3

3+Version: 0.6.0.0

34Synopsis: Functional Reactive Web Apps with Reflex

4−Description: Reflex-DOM is a Functional Reactive web framework based on the Reflex FRP engine

5+Description:

6+ Web applications without callbacks or side-effects.

7+ Reflex-DOM brings the power of functional reactive programming (FRP) to the web.

8+ Build HTML and other Document Object Model (DOM) data with a pure functional interface.

9+ .

10+ Reflex-DOM is a Functional Reactive web framework based on the Reflex FRP engine: <https://reflex-frp.org/>.

11+ .

12+ The @reflex-dom@ package is a small wrapper around the @reflex-dom-core@ package. It pulls in the

13+ correct set of dependencies for each target platform (GHCJS, WebKitGTK, WASM, mobile, etc.).

14+ Libraries should depend on @reflex-dom-core@ and executables will usually depend on @reflex-dom@.

15+ All of @reflex-dom-core@'s modules are re-exported by @reflex-dom@.

516License: BSD3

617License-file: LICENSE

718Author: Ryan Trinkle

@@ -9,7 +20,6 @@ Maintainer: ryan.trinkle@gmail.com

920Stability: Experimental

1021Category: FRP, Web, GUI, HTML, Javascript, Reactive, Reactivity, User Interfaces, User-interface

1122Build-type: Simple

12−Cabal-version: >=1.9.2

1323-- Deal with https://github.com/haskell/cabal/issues/2544 / https://github.com/haskell/cabal/issues/367

1424extra-source-files: src-ghc/Foreign/JavaScript/Internal/Utils.hs

1525 src-ghcjs/Foreign/JavaScript/Internal/Utils.hs

@@ -50,16 +60,16 @@ library

5060 aeson >= 0.8 && < 1.5,

5161 base >= 4.7 && < 4.14,

5262 bifunctors >= 4.2 && < 6,

53− bimap >= 0.3 && < 0.4,

54− blaze-builder,

63+ bimap >= 0.3 && < 0.5,

64+ blaze-builder >= 0.4.1 && < 0.5,

5565 bytestring == 0.10.*,

5666 case-insensitive < 1.3,

5767 containers >= 0.6 && < 0.7,

58− constraints >= 0.9 && < 0.12,

68+ constraints >= 0.9 && < 0.13,

5969 contravariant >= 1.4 && < 1.6,

6070 data-default >= 0.5 && < 0.8,

6171 dependent-map >= 0.3 && < 0.4,

62− dependent-sum >= 0.6 && < 0.7,

72+ dependent-sum >= 0.6 && < 0.8,

6373 dependent-sum-template >= 0.1 && < 0.2,

6474 directory >= 1.2 && < 1.4,

6575 exception-transformers == 0.4.*,

@@ -71,7 +81,7 @@ library

7181 monad-control >= 1.0.1 && < 1.1,

7282 mtl >= 2.1 && < 2.3,

7383 primitive >= 0.5 && < 0.8,

74− random,

84+ random >= 1.1 && < 1.2,

7585 ref-tf == 0.4.*,

7686 reflex >= 0.6.2 && < 0.8,

7787 semigroups >= 0.16 && < 0.20,

@@ -94,7 +104,7 @@ library

94104 if flag(split-these)

95105 build-depends:

96106 semialign >= 1 && < 1.2,

97− these >= 1 && < 1.1

107+ these >= 1 && < 1.2

98108 else

99109 build-depends:

100110 these >= 0.4 && < 0.9

@@ -133,6 +143,7 @@ library

133143 Reflex.Dom.Xhr.ResponseType

134144 Reflex.Dom.Xhr.Exception

135145

146+ default-language: Haskell98

136147 ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2 -ferror-spans -fspecialise-aggressively

137148 ghc-prof-options: -fprof-auto

138149

@@ -147,22 +158,19 @@ library

147158

148159 if flag(use-template-haskell)

149160 build-depends:

150− dependent-sum >= 0.6,

151161 dependent-sum-template >= 0.1 && < 0.2,

152− template-haskell

162+ template-haskell >= 2.12.0 && < 2.16

153163 other-extensions: TemplateHaskell

154164 cpp-options: -DUSE_TEMPLATE_HASKELL

155165 other-modules:

156166 Reflex.Dom.Builder.Class.TH

157− else

158− build-depends:

159− dependent-sum == 0.6.*

160167

161168test-suite hlint

162169 build-depends: base, hlint

163170 hs-source-dirs: test

164171 main-is: hlint.hs

165172 type: exitcode-stdio-1.0

173+ default-language: Haskell98

166174

167175test-suite hydration

168176 build-depends: base

@@ -209,6 +217,7 @@ test-suite hydration

209217 ghc-prof-options: -fprof-auto -optP-DPROFILING

210218 main-is: hydration.hs

211219 type: exitcode-stdio-1.0

220+ default-language: Haskell98

212221 if !os(linux) || !arch(x86_64) || flag(profile-reflex)

213222 buildable: False

214223

@@ -228,6 +237,7 @@ test-suite gc

228237 ghc-prof-options: -fprof-auto -optP-DPROFILING

229238 main-is: gc.hs

230239 type: exitcode-stdio-1.0

240+ default-language: Haskell98

231241 if !os(linux) || !arch(x86_64)

232242 buildable: False

233243

reflex-dom-core/src/Reflex/Dom/Builder/Class/Events.hs+2−1

@@ -14,6 +14,7 @@ import Data.GADT.Compare.TH

1414import Data.GADT.Compare

1515 (GOrdering(..), (:~:)(..), GEq(..), GCompare(..))

1616#endif

17+import Data.Text (Text)

1718

1819data EventTag

1920 = AbortTag

@@ -151,7 +152,7 @@ type family EventResultType (en :: EventTag) :: * where

151152 EventResultType 'BeforecopyTag = ()

152153 EventResultType 'CopyTag = ()

153154 EventResultType 'BeforepasteTag = ()

154− EventResultType 'PasteTag = ()

155+ EventResultType 'PasteTag = Maybe Text

155156 EventResultType 'ResetTag = ()

156157 EventResultType 'SearchTag = ()

157158 EventResultType 'SelectstartTag = ()

reflex-dom-core/src/Reflex/Dom/Builder/Immediate.hs+13−2

@@ -144,6 +144,7 @@ import Data.String (IsString)

144144import Data.Text (Text)

145145import Foreign.JavaScript.Internal.Utils

146146import Foreign.JavaScript.TH

147+import GHCJS.DOM.ClipboardEvent as ClipboardEvent

147148import GHCJS.DOM.Document (Document, createDocumentFragment, createElement, createElementNS, createTextNode, createComment)

148149import GHCJS.DOM.Element (getScrollTop, removeAttribute, removeAttributeNS, setAttribute, setAttributeNS, hasAttribute)

149150import GHCJS.DOM.EventM (EventM, event, on)

@@ -179,6 +180,7 @@ import qualified Data.IntMap.Strict as IntMap

179180import qualified Data.Map as Map

180181import qualified Data.Text as T

181182import qualified GHCJS.DOM as DOM

183+import qualified GHCJS.DOM.DataTransfer as DataTransfer

182184import qualified GHCJS.DOM.DocumentAndElementEventHandlers as Events

183185import qualified GHCJS.DOM.DocumentOrShadowRoot as Document

184186import qualified GHCJS.DOM.Element as Element

@@ -2255,7 +2257,7 @@ defaultDomEventHandler e evt = fmap (Just . EventResult) $ case evt of

22552257 Beforecopy -> return ()

22562258 Copy -> return ()

22572259 Beforepaste -> return ()

2258− Paste -> return ()

2260+ Paste -> getPasteData

22592261 Reset -> return ()

22602262 Search -> return ()

22612263 Selectstart -> return ()

@@ -2305,7 +2307,7 @@ defaultDomWindowEventHandler w evt = fmap (Just . EventResult) $ case evt of

23052307 Beforecopy -> return ()

23062308 Copy -> return ()

23072309 Beforepaste -> return ()

2308− Paste -> return ()

2310+ Paste -> getPasteData

23092311 Reset -> return ()

23102312 Search -> return ()

23112313 Selectstart -> return ()

@@ -2582,6 +2584,15 @@ getMouseEventCoords = do

25822584 e <- event

25832585 bisequence (getClientX e, getClientY e)

25842586

2587+{-# INLINABLE getPasteData #-}

2588+getPasteData :: EventM e ClipboardEvent (Maybe Text)

2589+getPasteData = do

2590+ e <- event

2591+ mdt <- ClipboardEvent.getClipboardData e

2592+ case mdt of

2593+ Nothing -> return Nothing

2594+ Just dt -> Just <$> DataTransfer.getData dt ("text" :: Text)

2595+

25852596{-# INLINABLE getTouchEvent #-}

25862597getTouchEvent :: EventM e TouchEvent TouchEventResult

25872598getTouchEvent = do

reflex-dom-core/src/Reflex/Dom/Prerender.hs+3−1

@@ -24,7 +24,7 @@ module Reflex.Dom.Prerender

2424

2525import Control.Monad.Primitive (PrimMonad(..))

2626import Control.Monad.Reader

27−import Control.Monad.Ref (MonadRef(..))

27+import Control.Monad.Ref (MonadRef(..), MonadAtomicRef(..))

2828import Data.IORef (IORef, newIORef)

2929import Data.Semigroup (Semigroup)

3030import Data.Text (Text)

@@ -165,6 +165,8 @@ instance Monad m => MonadRef (UnrunnableT js t m) where

165165 newRef _ = unrunnable

166166 readRef _ = unrunnable

167167 writeRef _ _ = unrunnable

168+instance Monad m => MonadAtomicRef (UnrunnableT js t m) where

169+ atomicModifyRef _ _ = unrunnable

168170instance Monad m => HasDocument (UnrunnableT js t m) where

169171 askDocument = unrunnable

170172instance Monad m => HasJSContext (UnrunnableT js t m) where

reflex-dom-core/src/Reflex/Dom/Widget/Input.hs+4−1

@@ -437,9 +437,12 @@ dropdown k0 options (DropdownConfig setK attrs) = do

437437 let xs = fmap (\(ix, (k, v)) -> ((ix, k), ((ix, k), v))) $ zip [0::Int ..] $ Map.toList os

438438 in (Map.fromList $ map snd xs, Bimap.fromList $ map fst xs)

439439 modifyAttrs <- dynamicAttributesToModifyAttributes attrs

440+ postBuild <- getPostBuild

441+ let setSelection = attachPromptlyDynWithMaybe (flip Bimap.lookupR) ixKeys $

442+ leftmost [setK, k0 <$ postBuild]

440443 let cfg = def

441444 & selectElementConfig_elementConfig . elementConfig_modifyAttributes .~ fmap mapKeysToAttributeName modifyAttrs

442− & selectElementConfig_setValue .~ fmap (T.pack . show) (attachPromptlyDynWithMaybe (flip Bimap.lookupR) ixKeys setK)

445+ & selectElementConfig_setValue .~ fmap (T.pack . show) setSelection

443446 (eRaw, _) <- selectElement cfg $ listWithKey indexedOptions $ \(ix, k) v -> do

444447 let optionAttrs = fmap (\dk -> "value" =: T.pack (show ix) <> if dk == k then "selected" =: "selected" else mempty) defaultKey

445448 elDynAttr "option" optionAttrs $ dynText v

reflex-dom-core/src/Reflex/Dom/Widget/Resize.hs+4−4

@@ -37,19 +37,19 @@ import qualified GHCJS.DOM.Types as DOM

3737-- This function can cause strange scrollbars to appear in some circumstances.

3838-- These can be hidden with pseudo selectors, for example, in webkit browsers:

3939-- .wrapper *::-webkit-scrollbar { width: 0px; background: transparent; }

40−resizeDetector :: (MonadJSM m, DomBuilder t m, PostBuild t m, TriggerEvent t m, PerformEvent t m, MonadHold t m, DomBuilderSpace m ~ GhcjsDomSpace, MonadJSM (Performable m), MonadFix m) => m a -> m (Event t (), a)

40+resizeDetector :: (MonadJSM m, DomBuilder t m, PostBuild t m, TriggerEvent t m, PerformEvent t m, MonadHold t m, DomBuilderSpace m ~ GhcjsDomSpace, MonadJSM (Performable m), MonadFix m) => m a -> m (Event t (Maybe Double, Maybe Double), a)

4141resizeDetector = resizeDetectorWithStyle ""

4242

4343resizeDetectorWithStyle :: (MonadJSM m, DomBuilder t m, PostBuild t m, TriggerEvent t m, PerformEvent t m, MonadHold t m, DomBuilderSpace m ~ GhcjsDomSpace, MonadJSM (Performable m), MonadFix m)

4444 => Text -- ^ A css style string. Warning: It should not contain the "position" style attribute.

4545 -> m a -- ^ The embedded widget

46− -> m (Event t (), a) -- ^ An 'Event' that fires on resize, and the result of the embedded widget

46+ -> m (Event t (Maybe Double, Maybe Double), a) -- ^ An 'Event' that fires on resize, and the result of the embedded widget

4747resizeDetectorWithStyle styleString = resizeDetectorWithAttrs ("style" =: styleString)

4848

4949resizeDetectorWithAttrs :: (MonadJSM m, DomBuilder t m, PostBuild t m, TriggerEvent t m, PerformEvent t m, MonadHold t m, DomBuilderSpace m ~ GhcjsDomSpace, MonadJSM (Performable m), MonadFix m)

5050 => Map Text Text -- ^ A map of attributes. Warning: It should not modify the "position" style attribute.

5151 -> m a -- ^ The embedded widget

52− -> m (Event t (), a) -- ^ An 'Event' that fires on resize, and the result of the embedded widget

52+ -> m (Event t (Maybe Double, Maybe Double), a) -- ^ An 'Event' that fires on resize, and the result of the embedded widget

5353resizeDetectorWithAttrs attrs w = do

5454 let childStyle = "position: absolute; left: 0; top: 0;"

5555 containerAttrs = "style" =: "position: absolute; left: 0; top: 0; right: 0; bottom: 0; overflow: scroll; z-index: -1; visibility: hidden;"

@@ -91,4 +91,4 @@ resizeDetectorWithAttrs attrs w = do

9191 size0 <- performEvent $ fmap (const $ liftJSM reset) pb

9292 rec resize <- performEventAsync $ fmap (\d cb -> (liftIO . cb) =<< liftJSM (resetIfChanged d)) $ tag (current dimensions) $ leftmost [expandScroll, shrinkScroll]

9393 dimensions <- holdDyn (Nothing, Nothing) $ leftmost [ size0, fmapMaybe id resize ]

94− return (fmapMaybe void resize, w')

94+ return (updated dimensions, w')

reflex-dom-core/test/gc.hs+1−1

@@ -47,7 +47,7 @@ failureLimit = 0

4747

4848main :: IO ()

4949main = do

50− handle (\(_ :: IOError) -> return ()) $ unshareNetork -- If we run into an exception with sandboxing, just don't bother

50+ handle (\(_ :: IOError) -> return ()) $ unshareNetwork -- If we run into an exception with sandboxing, just don't bother

5151 withSandboxedChromeFlags True $ \chromeFlags -> do

5252 mainThread <- myThreadId

5353 browserProcess <- spawnCommand $ mconcat

reflex-dom-core/test/hydration.hs+34−3

@@ -39,6 +39,7 @@ import Data.Functor.Misc

3939import Data.GADT.Compare.TH

4040import Data.GADT.Show.TH

4141import Data.IORef (IORef)

42+import Data.List (sort)

4243import Data.Maybe

4344import Data.Proxy

4445import Data.Text (Text)

@@ -49,6 +50,7 @@ import Network.Socket

4950import Network.Wai

5051import Network.WebSockets

5152import Reflex.Dom.Core

53+import Reflex.Dom.Widget.Input (dropdown)

5254import Reflex.Patch.DMapWithMove

5355import System.Directory

5456import System.Environment

@@ -57,7 +59,7 @@ import System.IO.Silently

5759import System.IO.Temp

5860import System.Process

5961import System.Which (staticWhich)

60−import qualified Test.HUnit as HUnit (assertEqual, assertFailure)

62+import qualified Test.HUnit as HUnit

6163import qualified Test.Hspec as H

6264import qualified Test.Hspec.Core.Spec as H

6365import Test.Hspec (xit)

@@ -97,11 +99,14 @@ instance MonadRef WD where

9799 writeRef r = WD . writeRef r

98100

99101assertEqual :: (MonadIO m, Eq a, Show a) => String -> a -> a -> m ()

100−assertEqual a b = liftIO . HUnit.assertEqual a b

102+assertEqual msg a b = liftIO $ HUnit.assertEqual msg a b

101103

102104assertFailure :: MonadIO m => String -> m ()

103105assertFailure = liftIO . HUnit.assertFailure

104106

107+assertBool :: (MonadIO m) => String -> Bool -> m ()

108+assertBool msg bool = liftIO $ HUnit.assertBool msg bool

109+

105110chromeConfig :: Text -> [Text] -> WD.WDConfig

106111chromeConfig fp flags = WD.useBrowser (WD.chrome { WD.chromeBinary = Just $ T.unpack fp, WD.chromeOptions = T.unpack <$> flags }) WD.defaultConfig

107112

@@ -132,7 +137,7 @@ deriving instance MonadFail WD

132137

133138main :: IO ()

134139main = do

135− unshareNetork

140+ unshareNetwork

136141 isHeadless <- (== Nothing) <$> lookupEnv "NO_HEADLESS"

137142 withSandboxedChromeFlags isHeadless $ \chromeFlags -> do

138143 withSeleniumServer $ \selenium -> do

@@ -1295,6 +1300,29 @@ tests withDebugging wdConfig caps _selenium = do

12951300 el "ol" $ text "inner"

12961301 text "after"

12971302

1303+ -- TODO: This test presupposes the exact set of labels that "dropdown" places in the "value" fields to distinguish options.

1304+ -- This dependence on internal implementation details is undesirable in a test case, but seems fairly tricky to avoid.

1305+ -- It seems expedient for the time being to expect this test case to be updated, should those implementation details ever change.

1306+ describe "dropdown" $ session' $ do

1307+ let doTest expectedOpts (initialValue :: Text) = do

1308+ let doCheck = do

1309+ es <- findElemsWithRetry $ WD.ByTag "option"

1310+ opts <- mapM fetchElement es

1311+ assertEqual "missing/extra/incorrect option element(s)" expectedOpts (sort opts)

1312+ testWidget doCheck doCheck $ do

1313+ void $ dropdown initialValue (constDyn (("aa" :: Text) =: "aaa" <> "bb" =: "bbb")) def

1314+ fetchElement e = do

1315+ val <- WD.attr e "value"

1316+ sel <- WD.attr e "selected"

1317+ return (fromMaybe "" val, isJust sel)

1318+ -- The "aa" test case is important, but a good test implementation probably needs to avoid selenium, because HTML parsers will insert a "selected" attribute on the first "option" tag if no selected attributes are present; thus as written, this erroneously succeeds on the old implementation (but properly implemented, should fail)

1319+ -- Thus, it would appear that we do actually need a HTML5 or maybe XML parser for this test suite.

1320+ xit "statically renders initial values (on aa)" $ runWD $ do

1321+ doTest [("0",True),("1",False)] "aa"

1322+ -- These tests are currently marked "pending" (by using "xit" instead of "it") because this test has a high chance of non-deterministically failing, which is a problem elsewhere in this test suite as well

1323+ xit "statically renders initial values (on bb)" $ runWD $ do

1324+ doTest [("0",False),("1",True)] "bb"

1325+

12981326data Selenium = Selenium

12991327 { _selenium_portNumber :: PortNumber

13001328 , _selenium_stopServer :: IO ()

@@ -1362,6 +1390,9 @@ checkTextInId i expected = do

13621390findElemWithRetry :: Selector -> WD WD.Element

13631391findElemWithRetry = withRetry . WD.findElem

13641392

1393+findElemsWithRetry :: Selector -> WD [WD.Element]

1394+findElemsWithRetry = withRetry . WD.findElems

1395+

13651396getBody :: WD WD.Element

13661397getBody = WD.findElem $ WD.ByTag "body"

13671398

reflex-dom/ChangeLog.md+10−2

@@ -1,7 +1,15 @@

11# Revision history for reflex-dom

3−## Unreleased

4−

3+## 0.6.0.0

5+* ([#379](https://github.com/reflex-frp/reflex-dom/pull/379)) Re-export all modules from `reflex-dom-core`. The newly re-exported modules are:

6+ * `Foreign.JavaScript.Utils`

7+ * `Reflex.Dom.Builder.Hydratable`

8+ * `Reflex.Dom.Modals.Class`

9+ * `Reflex.Dom.Prerender`

10+ * `Reflex.Dom.Time`

11+ * `Reflex.Dom.WebSocket.Query`

12+ * `Reflex.Dom.Xhr.FormData`

513* ([#366](https://github.com/reflex-frp/reflex-dom/pull/366)) Bump bounds for `reflex` to include 0.7.

614

715## 0.5.3

reflex-dom/LICENSE+1−1

@@ -1,4 +1,4 @@

22All rights reserved.

44Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:

reflex-dom/benchmark.hs+2−1

@@ -15,8 +15,9 @@ import qualified Data.Text as T

1515import Reflex.Dom

1616import System.Random

1717import qualified Data.Map as Map

18−import Data.Dependent.Map (DMap (..), DSum (..))

18+import Data.Dependent.Map (DMap (..))

1919import qualified Data.Dependent.Map as DMap

20+import Data.Dependent.Sum (DSum (..))

2021import Data.Functor.Misc

2122import Data.Functor.Identity

2223import Data.Functor.Compose

reflex-dom/reflex-dom.cabal+67−21

@@ -1,10 +1,20 @@

1+cabal-version: 1.24

12Name: reflex-dom

2−Version: 0.5.3

3+Version: 0.6.0.0

34Synopsis: Functional Reactive Web Apps with Reflex

45Description:

5− Reflex-DOM is a Functional Reactive web framework based on the Reflex FRP engine.

6+ Web applications without callbacks or side-effects.

7+ Reflex-DOM brings the power of functional reactive programming (FRP) to the web.

8+ Build HTML and other Document Object Model (DOM) data with a pure functional interface.

69 .

7− For hackage documentation, please see: <https://hackage.haskell.org/package/reflex-dom-core>.

10+ Reflex-DOM is a Functional Reactive web framework based on the Reflex FRP engine: <https://reflex-frp.org/>.

11+ .

12+ The @reflex-dom@ package is a small wrapper around the @reflex-dom-core@ package. It pulls in the

13+ correct set of dependencies for each target platform (GHCJS, WebKitGTK, WASM, mobile, etc.).

14+ Libraries should depend on @reflex-dom-core@ and executables will usually depend on @reflex-dom@.

15+ All of @reflex-dom-core@'s modules are re-exported by @reflex-dom@.

16+ .

17+ For Hackage documentation, please see: <https://hackage.haskell.org/package/reflex-dom-core>.

818License: BSD3

919License-file: LICENSE

1020Author: Ryan Trinkle

@@ -12,7 +22,6 @@ Maintainer: ryan.trinkle@gmail.com

1222Stability: Experimental

1323Category: FRP, Web, GUI, HTML, Javascript, Reactive, Reactivity, User Interfaces, User-interface

1424Build-type: Simple

15−cabal-version: >=1.24

1625extra-source-files:

1726 java/org/reflexfrp/reflexdom/MainWidget.java

1827 ChangeLog.md

@@ -41,60 +50,67 @@ flag build-examples

4150 default: False

4251 manual: True

4352

53+flag wasm32

54+ description: Build for wasm32 architecture

55+ default: False

56+ manual: True

57+

4458library

4559 hs-source-dirs: src

4660 if os(android)

4761 hs-source-dirs: src-android

4862 other-modules: Reflex.Dom.Android.MainWidget

4963 build-depends:

50− aeson,

64+ aeson >= 1.4 && < 1.5,

5165 android-activity == 0.1.*,

5266 data-default == 0.7.*,

53− jsaddle

67+ jsaddle >= 0.9.6 && < 0.10

5468 c-sources: cbits/MainWidget.c

5569 include-dirs: cbits/include

5670 install-includes: MainWidget.h

5771 cpp-options: -DANDROID

5872 build-tools: hsc2hs

5973 build-depends:

60− base >= 4.7 && < 4.13,

74+ base >= 4.7 && < 4.14,

6175 bytestring == 0.10.*,

6276 reflex >= 0.6.2 && < 0.8,

63− reflex-dom-core >=0.5.2 && < 0.6,

77+ reflex-dom-core == 0.6.0.0,

6478 text == 1.2.*

6579 if !impl(ghcjs)

6680 if flag(use-warp) && (os(linux) || os(osx))

6781 build-depends:

68− jsaddle,

69− jsaddle-warp

82+ jsaddle >= 0.9.6 && < 0.10,

83+ jsaddle-warp >= 0.9.6 && < 0.10

7084 else

7185 if os(osx) || os(ios)

7286 build-depends:

7387 data-default == 0.7.*,

74− jsaddle,

75− jsaddle-wkwebview

88+ jsaddle >= 0.9.6 && < 0.10,

89+ jsaddle-wkwebview >= 0.9.6 && < 0.10

7690 else

77− if arch(wasm32)

91+ if flag(wasm32)

7892 build-depends:

79− jsaddle,

80− jsaddle-wasm

93+ jsaddle >= 0.9.6 && < 0.10,

94+ jsaddle-wasm >= 0.1 && < 0.2

8195 else

8296 if flag(webkit2gtk)

8397 build-depends:

84− jsaddle-webkit2gtk

98+ jsaddle-webkit2gtk >= 0.9.6 && < 0.10

8599 else

86100 if !os(android)

87101 build-depends:

88− jsaddle-webkit2gtk

102+ jsaddle-webkit2gtk >= 0.9.6 && < 0.10

89103

90104 exposed-modules:

91105 Reflex.Dom

92106 Reflex.Dom.Internal

93107 reexported-modules:

94− Foreign.JavaScript.TH

95− , Foreign.JavaScript.Orphans

108+ Foreign.JavaScript.Orphans

109+ , Foreign.JavaScript.TH

110+ , Foreign.JavaScript.Utils

96111 , Reflex.Dom.Builder.Class

97112 , Reflex.Dom.Builder.Class.Events

113+ , Reflex.Dom.Builder.Hydratable

98114 , Reflex.Dom.Builder.Immediate

99115 , Reflex.Dom.Builder.InputDisabled

100116 , Reflex.Dom.Builder.Static

@@ -102,14 +118,19 @@ library

102118 , Reflex.Dom.Core

103119 , Reflex.Dom.Location

104120 , Reflex.Dom.Main

121+ , Reflex.Dom.Modals.Class

105122 , Reflex.Dom.Old

123+ , Reflex.Dom.Prerender

124+ , Reflex.Dom.Time

106125 , Reflex.Dom.WebSocket

126+ , Reflex.Dom.WebSocket.Query

107127 , Reflex.Dom.Widget

108128 , Reflex.Dom.Widget.Basic

109129 , Reflex.Dom.Widget.Input

110130 , Reflex.Dom.Widget.Lazy

111131 , Reflex.Dom.Widget.Resize

112132 , Reflex.Dom.Xhr

133+ , Reflex.Dom.Xhr.FormData

113134 ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2 -ferror-spans

114135 if flag(expose-all-unfoldings)

115136 ghc-options: -fexpose-all-unfoldings

@@ -141,7 +162,19 @@ executable sortableList

141162 default-language: Haskell2010

142163

143164executable benchmark

144− build-depends: base, reflex, reflex-dom, text, prim-uniq, dependent-map, containers, transformers, mtl, ghcjs-dom, ghc-prim, random, dependent-sum

165+ build-depends: base

166+ , containers

167+ , dependent-map

168+ , dependent-sum

169+ , ghc-prim

170+ , ghcjs-dom

171+ , mtl

172+ , prim-uniq

173+ , random

174+ , reflex

175+ , reflex-dom

176+ , text

177+ , transformers

145178 hs-source-dirs: .

146179 main-is: benchmark.hs

147180 ghc-options: -O2 -fspecialise-aggressively

@@ -150,7 +183,20 @@ executable benchmark

150183 default-language: Haskell2010

151184

152185executable krausest

153− build-depends: base, reflex, reflex-dom, text, prim-uniq, dependent-map, containers, transformers, mtl, ghcjs-dom, ghc-prim, random, dependent-sum, vector

186+ build-depends: base

187+ , containers

188+ , dependent-map

189+ , dependent-sum

190+ , ghc-prim

191+ , ghcjs-dom

192+ , mtl

193+ , prim-uniq

194+ , random

195+ , reflex

196+ , reflex-dom

197+ , text

198+ , transformers

199+ , vector

154200 hs-source-dirs: benchmarks

155201 main-is: krausest.hs

156202 ghc-options: -O2 -fspecialise-aggressively

release.nix+13−4

@@ -1,12 +1,14 @@

11{ reflex-platform-fun ? import ./dep/reflex-platform

2+, supportedSystems ? ["x86_64-linux" "x86_64-darwin"]

23}:

45let

56 native-reflex-platform = reflex-platform-fun {};

67 inherit (native-reflex-platform.nixpkgs) lib;

7− systems = ["x86_64-linux" "x86_64-darwin"];

9− perPlatform = lib.genAttrs systems (system: let

9+ tests = system: import ./test { pkgs = (reflex-platform-fun { inherit system; }).nixpkgs; };

10+

11+ perPlatform = lib.genAttrs supportedSystems (system: let

1012 reflex-platform = reflex-platform-fun { inherit system; };

1113 compilers = [

1214 "ghc"

@@ -25,15 +27,22 @@ let

2527 (self: super: {

2628 _dep = super._dep // {

2729 reflex-dom = builtins.filterSource (path: type: !(builtins.elem (baseNameOf path) [

28− "release.nix"

2930 ".git"

3031 "dist"

32+ "dist-newstyle"

33+ ]) && !(builtins.elem path [

34+ ./CONTRIBUTING.md

35+ ./FAQ.md

36+ ./Quickref.md

37+ ./README.md

38+ ./release.nix

39+ ./test

3140 ])) ./.;

3241 };

3342 })

3443 ];

3544 };

36− all = {

45+ all = tests system // {

3746 inherit (reflex-platform.${ghc})

3847 reflex-dom-core

3948 reflex-dom

test/default.nixnew file+10

@@ -0,0 +1,10 @@

1+{ pkgs ? (import ../dep/reflex-platform {}).nixpkgs }:

2+{

3+ test-reflex-dom-reexports = pkgs.runCommand "test-reflex-dom-reexports" {} (

4+ let

5+ ghc = pkgs.haskellPackages.ghcWithPackages (p: [p.Cabal]);

6+ in ''

7+ ${ghc}/bin/runhaskell ${./reflex-dom-reexports.hs} ${../reflex-dom/reflex-dom.cabal} ${../reflex-dom-core/reflex-dom-core.cabal}

8+ touch "$out"

9+ '');

10+}

test/prebuild.hsdeleted−127

@@ -1,127 +0,0 @@

1−{-# LANGUAGE CPP #-}

2−{-# LANGUAGE OverloadedStrings #-}

3−{-# LANGUAGE ScopedTypeVariables #-}

4−{-# LANGUAGE TypeFamilies #-}

5−{-# LANGUAGE LambdaCase #-}

6−{-# LANGUAGE FlexibleInstances #-}

7−{-# LANGUAGE MultiParamTypeClasses #-}

8−import Control.Monad

9−import Control.Monad.Identity

10−import Control.Monad.Trans

11−import Reflex.Dom

12−import qualified Data.Text as T

13−import Control.Concurrent

14−

15−import Control.Monad.State.Strict

16−import Data.Functor.Misc

17−import Data.Monoid

18−import Data.Word

19−import qualified Data.Map as Map

20−import qualified Data.Dependent.Map as DMap

21−import Data.Dependent.Sum

22−import qualified Reflex.Patch.DMapWithMove as PatchDMapWithMove

23−

24−main :: IO ()

25−main = mainWidget w

26−

27−w :: forall t m. (MonadWidget t m, DomRenderHook t m, MountableDomBuilder t m) => m ()

28−w = do

29− let slow :: forall m'. (MonadWidget t m', DomRenderHook t m') => m' ()

30− {-

31− performEventChain = do

32− postBuild <- delay 0 =<< getPostBuild

33− rec let maxN = 10000

34− n = leftmost [0 <$ postBuild, ffilter (<=maxN) $ succ <$> n']

35− n' <- performEvent $ return <$> n

36− pausedUntil $ ffilter (==maxN) n'

37− _ <- widgetHold (text "Starting") $ text . T.pack . show <$> n

38− return ()

39− -}

40−-- {- Many dyns

41− slow = elAttr "div" ("style" =: "position:relative;width:256px;height:256px") $ go maxDepth

42− where maxDepth = 6 :: Int

43− go 0 = blank

44− go n = void $ dyn $ pure $ do

45− let bgcolor = "rgba(0,0,0," <> T.pack (show (1 - (fromIntegral n / fromIntegral maxDepth) :: Double)) <> ")"

46− s pos = pos <> ";position:absolute;border:1px solid white;background-color:" <> bgcolor

47− elAttr "div" ("style" =: s "left:0;right:50%;top:0;bottom:50%") $ go $ pred n

48− elAttr "div" ("style" =: s "left:50%;right:0;top:0;bottom:50%") $ go $ pred n

49− elAttr "div" ("style" =: s "left:50%;right:0;top:50%;bottom:0") $ go $ pred n

50− elAttr "div" ("style" =: s "left:0;right:50%;top:50%;bottom:0") $ go $ pred n

51−-- -}

52− {- Many elDynAttrs

53− slow = do

54− let size = 64

55− replicateM_ size $ elAttr "div" ("style" =: ("height:4px;width:" <> T.pack (show (size*4)) <> "px;line-height:0;background-color:gray")) $ do

56− replicateM_ size $ elDynAttr "div" (pure $ "style" =: "display:inline-block;width:4px;height:4px;background-color:black") blank

57− -}

58− {- Many dynTexts

59− slow = el "table" $ do

60− let size = 64

61− replicateM_ size $ el "tr" $ do

62− replicateM_ size $ el "td" $ do

63− dynText $ pure "."

64− -}

65− {- Many simultaneous performEvents

66− slow = do

67− postBuild <- getPostBuild

68− replicateM_ ((2 :: Int) ^ (14 :: Int)) $ performEvent_ $ return () <$ postBuild

69− done <- performEvent $ return () <$ postBuild

70− _ <- widgetHold (text "Doing performEvent") $ text "Done" <$ done

71− return ()

72− -}

73− {-

74− slow = do

75− postBuild <- getPostBuild

76− postBuild' <- performEvent . (return () <$) =<< performEvent . (return () <$) =<< getPostBuild

77− let f x = Map.fromList [(n, x) | n <- [1 :: Int .. 4096]]

78− listHoldWithKey (f False) (f (Just True) <$ postBuild') $ \k -> \case

79− False -> do

80− text "X "

81− notReadyUntil =<< getPostBuild

82− True -> do

83− text ". "

84− return ()

85− -}

86− {-

87− slow = do

88− let f :: forall a. EitherTag () () a -> Const2 () () a -> m' (Const2 () () a)

89− f _ (Const2 ()) = do

90− notReadyUntil =<< delay 0.5 =<< getPostBuild

91− text "Done"

92− return $ Const2 ()

93− postBuild <- getPostBuild

94− traverseDMapWithKeyWithAdjustWithMove f (DMap.singleton LeftTag $ Const2 ()) $ (PatchDMapWithMove.moveDMapKey LeftTag RightTag) <$ postBuild

95− return ()

96− -}

97− {-

98− slow = do

99− let h x = do

100− liftIO $ putStrLn "render hook"

101− result <- x

102− liftIO $ putStrLn "render hook done"

103− return result

104− f :: forall a. Const2 () () a -> Identity a -> m' (Identity a)

105− f (Const2 ()) (Identity ()) = do

106− liftIO $ putStrLn "f"

107− widgetHold notReady . (blank <$) =<< delay 0.1 =<< getPostBuild

108− liftIO $ putStrLn "f done"

109− return $ Identity ()

110− withRenderHook h $ do

111− postBuild <- getPostBuild

112− _ <- traverseDMapWithKeyWithAdjust f mempty $ PatchDMap (DMap.singleton (Const2 () :: Const2 () () ()) (ComposeMaybe $ Just $ Identity ())) <$ postBuild

113− return ()

114− -}

115− el "div" $ do

116− draw <- button "Draw"

117− widgetHold blank $ ffor draw $ \_ -> do

118− _ <- untilReady (text "Loading...") slow

119− return ()

120− return ()

121−

122−#ifdef EXPERIMENTAL_DEPENDENT_SUM_INSTANCES

123−instance {-# INCOHERENT #-} (Show (f a), Show (f b)) => ShowTag (EitherTag a b) f where

124− showTagToShow e _ = case e of

125− LeftTag -> id

126− RightTag -> id

127−#endif

test/reflex-dom-reexports.hsnew file+72

@@ -0,0 +1,72 @@

1+-- This tests that reflex-dom re-exports all of reflex-dom-core's modules.

2+-- Without this test they easily drift.

3+module Main where

5+import Control.Monad (when)

6+import Data.List (intercalate)

7+import Data.Maybe (fromMaybe, isNothing, mapMaybe)

8+import qualified Data.Set as Set

9+import Distribution.Types.PackageName (mkPackageName)

10+import Distribution.Compiler (CompilerFlavor (GHC))

11+import Distribution.ModuleName (ModuleName, components)

12+import Distribution.PackageDescription.Parsec (parseGenericPackageDescription)

13+import qualified Distribution.Parsec.Common as Dist

14+import Distribution.Parsec.ParseResult (runParseResult)

15+import qualified Distribution.System as Dist

16+import Distribution.Types.BuildInfo (buildable, defaultExtensions, defaultLanguage, hsSourceDirs, options)

17+import Distribution.Types.CondTree (simplifyCondTree)

18+import Distribution.Types.GenericPackageDescription (ConfVar (Arch, Impl, OS), condLibrary)

19+import Distribution.Types.Library (exposedModules, libBuildInfo, reexportedModules)

20+import Distribution.Types.ModuleReexport (ModuleReexport, moduleReexportOriginalName, moduleReexportOriginalPackage)

21+import Distribution.Utils.Generic (toUTF8BS, readUTF8File)

22+import System.Environment (getArgs)

23+import qualified System.Info

24+

25+main :: IO ()

26+main = do

27+ [reflexDomFile, reflexDomCoreFile] <- getArgs

28+ (_, reflexDomReexports) <- parseCabalExports reflexDomFile

29+ (reflexDomCoreExports', _) <- parseCabalExports reflexDomCoreFile

30+

31+ let

32+ reflexDomCoreExports = Set.fromList reflexDomCoreExports'

33+ reflexDomCorePackageName = mkPackageName "reflex-dom-core"

34+ reflexDomReexportsFromCore

35+ = Set.fromList

36+ $ mapMaybe (\x -> if let origPackage = moduleReexportOriginalPackage x

37+ in isNothing origPackage || origPackage == Just reflexDomCorePackageName

38+ then Just $ moduleReexportOriginalName x

39+ else Nothing

40+ )

41+ reflexDomReexports

42+

43+ when (reflexDomCoreExports /= reflexDomReexportsFromCore) $ do

44+ error $ intercalate "\n\t"

45+ $ "reflex-dom does not re-export the following modules from reflex-dom-core:"

46+ : map

47+ (intercalate "." . components)

48+ (Set.toAscList $ reflexDomCoreExports `Set.difference` reflexDomReexportsFromCore)

49+

50+ putStrLn "Test passed."

51+

52+parseCabalExports :: FilePath -> IO ([ModuleName], [ModuleReexport])

53+parseCabalExports file = do

54+ contents <- readUTF8File file

55+ let

56+ (warnings, result) = runParseResult $ parseGenericPackageDescription $ toUTF8BS contents

57+ osConfVar = case System.Info.os of

58+ "linux" -> Just Dist.Linux

59+ "darwin" -> Just Dist.OSX

60+ _ -> error "Unrecognized System.Info.os"

61+ archConfVar = Just Dist.X86_64

62+ evalConfVar v = Right $ case v of

63+ OS osVar -> Just osVar == osConfVar

64+ Arch archVar -> Just archVar == archConfVar

65+ Impl GHC _ -> True

66+ _ -> False

67+ pure $ case condLibrary <$> result of

68+ Right (Just condLib) ->

69+ let (_, lib) = simplifyCondTree evalConfVar condLib

70+ in (exposedModules lib, reexportedModules lib)

71+ Right Nothing -> error $ "Haskell package has no library component: " <> file

72+ Left (_, errors) -> error $ "Failed to parse " <> file <> ":\n" <> unlines (map show errors)