From a11cedfa6038e8d3cca513dab465eb8ffc90b455 Mon Sep 17 00:00:00 2001 From: Tom Smalley Date: Mon, 7 Jun 2021 13:50:28 +0100 Subject: [PATCH 1/5] Fix hlint for GHC 8.10, apply suggestions --- reflex-dom-core/reflex-dom-core.cabal | 4 +++- reflex-dom-core/src/Reflex/Dom/Builder/Class.hs | 3 ++- reflex-dom-core/src/Reflex/Dom/Builder/Immediate.hs | 5 ++--- reflex-dom-core/src/Reflex/Dom/Builder/Static.hs | 2 +- reflex-dom-core/src/Reflex/Dom/Main.hs | 1 - reflex-dom-core/src/Reflex/Dom/Widget/Lazy.hs | 2 +- reflex-dom-core/test/hlint.hs | 2 +- 7 files changed, 10 insertions(+), 9 deletions(-) diff --git a/reflex-dom-core/reflex-dom-core.cabal b/reflex-dom-core/reflex-dom-core.cabal index 1590b1e..3285307 100644 --- a/reflex-dom-core/reflex-dom-core.cabal +++ b/reflex-dom-core/reflex-dom-core.cabal @@ -176,7 +176,9 @@ library Reflex.Dom.Builder.Class.TH test-suite hlint - build-depends: base, hlint + build-depends: + base, + hlint >= 3.0 && < 4.0 hs-source-dirs: test main-is: hlint.hs type: exitcode-stdio-1.0 diff --git a/reflex-dom-core/src/Reflex/Dom/Builder/Class.hs b/reflex-dom-core/src/Reflex/Dom/Builder/Class.hs index 3cb09b8..c791dfb 100644 --- a/reflex-dom-core/src/Reflex/Dom/Builder/Class.hs +++ b/reflex-dom-core/src/Reflex/Dom/Builder/Class.hs @@ -9,11 +9,12 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} #if !MIN_VERSION_base(4,9,0) {-# LANGUAGE ImpredicativeTypes #-} +#else +{-# LANGUAGE Rank2Types #-} -- Implied by ImpredicativeTypes #endif {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PolyKinds #-} -{-# LANGUAGE Rank2Types #-} {-# LANGUAGE RecursiveDo #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} diff --git a/reflex-dom-core/src/Reflex/Dom/Builder/Immediate.hs b/reflex-dom-core/src/Reflex/Dom/Builder/Immediate.hs index af43167..40dbbd6 100644 --- a/reflex-dom-core/src/Reflex/Dom/Builder/Immediate.hs +++ b/reflex-dom-core/src/Reflex/Dom/Builder/Immediate.hs @@ -2,7 +2,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE FlexibleContexts #-} @@ -1877,14 +1876,14 @@ hoistTraverseWithKeyWithAdjust base mapPatch updateChildUnreadiness applyDomUpda getHydrationMode >>= \case HydrationMode_Hydrating -> addHydrationStepWithSetup (holdIncremental children0 children') $ \children -> do dm :: DMap k (Compose (TraverseChild t m (Some k)) v') <- sample $ currentIncremental children - phs <- traverse id $ weakenDMapWith (either _traverseChildHydration_delayed (pure . _traverseChildImmediate_placeholder) . _traverseChild_mode . getCompose) dm + phs <- sequenceA $ weakenDMapWith (either _traverseChildHydration_delayed (pure . _traverseChildImmediate_placeholder) . _traverseChild_mode . getCompose) dm liftIO $ writeIORef placeholders $! phs insertAfterPreviousNode lastPlaceholder HydrationMode_Immediate -> do let activate i = do append $ toNode $ _traverseChildImmediate_fragment i pure $ _traverseChildImmediate_placeholder i - phs <- traverse id $ weakenDMapWith (either (error "impossible") activate . _traverseChild_mode . getCompose) children0 + phs <- sequenceA $ weakenDMapWith (either (error "impossible") activate . _traverseChild_mode . getCompose) children0 liftIO $ writeIORef placeholders $! phs append $ toNode lastPlaceholder requestDomAction_ $ ffor children' $ \p -> do diff --git a/reflex-dom-core/src/Reflex/Dom/Builder/Static.hs b/reflex-dom-core/src/Reflex/Dom/Builder/Static.hs index c5ba4ce..140c25a 100644 --- a/reflex-dom-core/src/Reflex/Dom/Builder/Static.hs +++ b/reflex-dom-core/src/Reflex/Dom/Builder/Static.hs @@ -274,7 +274,7 @@ instance SupportsStaticDomBuilder t m => DomBuilder t (StaticDomBuilderT t m) wh --TODO: Do not escape quotation marks; see https://stackoverflow.com/questions/25612166/what-characters-must-be-escaped-in-html-5 shouldEscape <- asks _staticDomBuilderEnv_shouldEscape let escape = if shouldEscape then fromHtmlEscapedText else byteString . encodeUtf8 - modify . (:) =<< (\c -> "") <$> case mSetContents of + (modify . (:)) . (\c -> "") =<< case mSetContents of Nothing -> return (pure (escape initialContents)) Just setContents -> hold (escape initialContents) $ fmapCheap escape setContents --Only because it doesn't get optimized when profiling is on return $ CommentNode () diff --git a/reflex-dom-core/src/Reflex/Dom/Main.hs b/reflex-dom-core/src/Reflex/Dom/Main.hs index 54dab88..24219c7 100644 --- a/reflex-dom-core/src/Reflex/Dom/Main.hs +++ b/reflex-dom-core/src/Reflex/Dom/Main.hs @@ -5,7 +5,6 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NoMonomorphismRestriction #-} -{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecursiveDo #-} {-# LANGUAGE ScopedTypeVariables #-} diff --git a/reflex-dom-core/src/Reflex/Dom/Widget/Lazy.hs b/reflex-dom-core/src/Reflex/Dom/Widget/Lazy.hs index dabcdab..709bfe4 100644 --- a/reflex-dom-core/src/Reflex/Dom/Widget/Lazy.hs +++ b/reflex-dom-core/src/Reflex/Dom/Widget/Lazy.hs @@ -117,7 +117,7 @@ virtualList heightPx rowPx maxIndex i0 setI keyToIndex items0 itemsUpdate itemBu "overflow" =: "hidden" <> "position" =: "relative" mkRow k = toStyleAttr $ "height" =: (T.pack (show rowPx) <> "px") <> - "top" =: ((<>"px") $ T.pack $ show $ keyToIndex k * rowPx) <> + "top" =: (<> "px") (T.pack $ show $ keyToIndex k * rowPx) <> "position" =: "absolute" <> "width" =: "100%" findWindow sizeIncrement windowSize startingPosition = diff --git a/reflex-dom-core/test/hlint.hs b/reflex-dom-core/test/hlint.hs index a901d72..ae3f858 100644 --- a/reflex-dom-core/test/hlint.hs +++ b/reflex-dom-core/test/hlint.hs @@ -1,4 +1,4 @@ -import Language.Haskell.HLint3 (hlint) +import Language.Haskell.HLint (hlint) import System.Exit (exitFailure, exitSuccess) main :: IO () From 47ebe3f51b2a952240924398e84023ec4b9fea0a Mon Sep 17 00:00:00 2001 From: Tom Smalley Date: Wed, 9 Jun 2021 12:10:44 +0100 Subject: [PATCH 2/5] Add warning to hydration test suite --- reflex-dom-core/test/hydration.hs | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/reflex-dom-core/test/hydration.hs b/reflex-dom-core/test/hydration.hs index f0a62ee..694dba9 100644 --- a/reflex-dom-core/test/hydration.hs +++ b/reflex-dom-core/test/hydration.hs @@ -20,6 +20,14 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} +-- Notice to those working on this test suite: +-- It doesn't appear to be possible to use --match to run a particular test, in +-- this situation the test may hang before reaching our code. This seems to +-- happen when the test is not the first test in the block. As a workaround, you +-- can just comment out the other tests. Also, using `xit` will cause the same +-- issue. `xit` tests must be the last tests in the session, or the session will +-- hang in the following test. + import Prelude hiding (fail) import Control.Concurrent import qualified Control.Concurrent.Async as Async From aeea13ef90883c5af371c1a921aef7320e31d2ef Mon Sep 17 00:00:00 2001 From: Tom Smalley Date: Wed, 9 Jun 2021 12:16:27 +0100 Subject: [PATCH 3/5] Slightly clean up test messages --- reflex-dom-core/test/hydration.hs | 51 +++++++++++++++---------------- 1 file changed, 25 insertions(+), 26 deletions(-) diff --git a/reflex-dom-core/test/hydration.hs b/reflex-dom-core/test/hydration.hs index 694dba9..14ed397 100644 --- a/reflex-dom-core/test/hydration.hs +++ b/reflex-dom-core/test/hydration.hs @@ -154,13 +154,13 @@ main = do withDebugging <- isNothing <$> lookupEnv "NO_DEBUG" let wdConfig = WD.defaultConfig { WD.wdPort = fromIntegral $ _selenium_portNumber selenium } chromeCaps' = WD.getCaps $ chromeConfig browserPath chromeFlags - hspec (tests withDebugging wdConfig [chromeCaps'] selenium) `finally` _selenium_stopServer selenium + hspec (tests withDebugging wdConfig [(chromeCaps', "chrome")] selenium) `finally` _selenium_stopServer selenium -tests :: Bool -> WD.WDConfig -> [Capabilities] -> Selenium -> Spec +tests :: Bool -> WD.WDConfig -> [(Capabilities, String)] -> Selenium -> Spec tests withDebugging wdConfig caps _selenium = do let putStrLnDebug :: MonadIO m => Text -> m () putStrLnDebug m = when withDebugging $ liftIO $ putStrLn $ T.unpack m - session' = sessionWith wdConfig "" . using (map (,"") caps) + session' t = sessionWith wdConfig t . using caps runWD m = runWDOptions (WdOptions False) $ do putStrLnDebug "before" r <- m @@ -172,7 +172,7 @@ tests withDebugging wdConfig caps _selenium = do testWidget = testWidgetDebug True withDebugging testWidget' :: WD a -> (a -> WD b) -> (forall m js. TestWidget js (SpiderTimeline Global) m => m ()) -> WD b testWidget' = testWidgetDebug' True withDebugging - describe "text" $ session' $ do + session' "text" $ do it "works" $ runWD $ do testWidgetStatic (checkBodyText "hello world") $ do text "hello world" @@ -233,7 +233,7 @@ tests withDebugging wdConfig caps _selenium = do click <- button "" void $ textNode $ TextNodeConfig "initial" $ Just $ "after" <$ click - describe "element" $ session' $ do + session' "element" $ do it "works with domEvent Click" $ runWD $ do clickedRef <- liftIO $ newRef False testWidget' (findElemWithRetry $ WD.ByTag "div") WD.click $ do @@ -297,8 +297,8 @@ tests withDebugging wdConfig caps _selenium = do let click = domEvent Click e return () - describe "inputElement" $ do - describe "static renderer" $ session' $ do + session' "inputElement" $ do + describe "static renderer" $ do it "sets value attribute" $ runWD $ do let checkStatic = do e <- findElemWithRetry $ WD.ByTag "input" @@ -355,7 +355,7 @@ tests withDebugging wdConfig caps _selenium = do & inputElementConfig_initialChecked .~ False & inputElementConfig_setChecked .~ (True <$ pb) pure () - describe "hydration" $ session' $ do + describe "hydration" $ do it "doesn't wipe user input when switching over" $ runWD $ do inputRef <- newRef ("hello " :: Text) testWidget' @@ -593,8 +593,7 @@ tests withDebugging wdConfig caps _selenium = do el "p" $ dynText $ _inputElement_value e performEvent_ $ consRef valRef <$> updated (_inputElement_value e) performEvent_ $ consRef inputRef <$> _inputElement_input e - - describe "hydration/immediate" $ session' $ do + describe "hydration/immediate" $ do it "captures user input after switchover" $ runWD $ do inputRef :: IORef Text <- newRef "" let checkValue = do @@ -674,8 +673,8 @@ tests withDebugging wdConfig caps _selenium = do names <- liftJSM $ traverse File.getName fs liftIO $ writeRef filesRef names - describe "textAreaElement" $ do - describe "static renderer" $ session' $ do + session' "textAreaElement" $ do + describe "static renderer" $ do it "sets value attribute" $ runWD $ do let checkStatic = do e <- findElemWithRetry $ WD.ByTag "textarea" @@ -698,7 +697,7 @@ tests withDebugging wdConfig caps _selenium = do & textAreaElementConfig_initialValue .~ "test" & textAreaElementConfig_setValue .~ ("test-updated" <$ pb) pure () - describe "hydration" $ session' $ do + describe "hydration" $ do it "doesn't wipe user input when switching over" $ runWD $ do inputRef <- newRef ("" :: Text) testWidget' @@ -847,7 +846,7 @@ tests withDebugging wdConfig caps _selenium = do e <- textAreaElement $ def & textAreaElementConfig_setValue .~ ("pb" <$ pb) el "p" $ dynText $ _textAreaElement_value e - describe "hydration/immediate" $ session' $ do + describe "hydration/immediate" $ do it "captures user input after switchover" $ runWD $ do inputRef :: IORef Text <- newRef "" let checkValue = do @@ -889,13 +888,13 @@ tests withDebugging wdConfig caps _selenium = do performEvent_ $ liftIO . writeRef valueByUIRef <$> _textAreaElement_input e performEvent_ $ liftIO . writeRef valueRef <$> updated (value e) - describe "selectElement" $ do + session' "selectElement" $ do let options :: DomBuilder t m => m () options = do elAttr "option" ("value" =: "one" <> "id" =: "one") $ text "one" elAttr "option" ("value" =: "two" <> "id" =: "two") $ text "two" elAttr "option" ("value" =: "three" <> "id" =: "three") $ text "three" - describe "hydration" $ session' $ do + describe "hydration" $ do it "sets initial value correctly" $ runWD $ do inputRef <- newRef ("" :: Text) let setup = do @@ -969,7 +968,7 @@ tests withDebugging wdConfig caps _selenium = do performEvent_ $ liftIO . writeRef valueByUIRef <$> _selectElement_change e performEvent_ $ liftIO . writeRef valueRef <$> updated (_selectElement_value e) - describe "hydration/immediate" $ session' $ do + describe "hydration/immediate" $ do it "captures user input after switchover" $ runWD $ do inputRef :: IORef Text <- newRef "" let checkValue = do @@ -1015,7 +1014,7 @@ tests withDebugging wdConfig caps _selenium = do performEvent_ $ liftIO . writeRef valueByUIRef <$> _selectElement_change e performEvent_ $ liftIO . writeRef valueRef <$> updated (_selectElement_value e) - describe "prerender" $ session' $ do + session' "prerender" $ do it "works in simple case" $ runWD $ do testWidget (checkBodyText "One") (checkBodyText "Two") $ do prerender_ (text "One") (text "Two") @@ -1084,7 +1083,7 @@ tests withDebugging wdConfig caps _selenium = do prerender_ (pure ()) (liftIO $ trigger "Client") textNode $ TextNodeConfig "Initial" $ Just e - describe "namespaces" $ session' $ do + session' "namespaces" $ do it "dyn can be nested in namespaced widget" $ runWD $ do testWidget (pure ()) (checkTextInTag "svg" "one") $ do let svgRootCfg = def @@ -1093,7 +1092,7 @@ tests withDebugging wdConfig caps _selenium = do void $ element "svg" svgRootCfg $ do dyn_ $ text "one" <$ pure () - describe "runWithReplace" $ session' $ do + session' "runWithReplace" $ do it "works" $ runWD $ do replaceChan :: Chan Text <- liftIO newChan let setup = findElemWithRetry $ WD.ByTag "div" @@ -1291,7 +1290,7 @@ tests withDebugging wdConfig caps _selenium = do _ <- runWithReplace (text "inner1") $ el "p" (text "inner2") <$ replace text "|after" - describe "traverseDMapWithKeyWithAdjust" $ session' $ do + session' "traverseDMapWithKeyWithAdjust" $ do let widget :: DomBuilder t m => DKey a -> Identity a -> m (Identity a) widget k (Identity v) = elAttr "li" ("id" =: textKey k) $ do elClass "span" "key" $ text $ textKey k @@ -1394,7 +1393,7 @@ tests withDebugging wdConfig caps _selenium = do (dmap, _evt) <- traverseDMapWithKeyWithAdjust widget keyMap $ leftmost [postBuildPatch <$ pb, replace] liftIO $ dmap `H.shouldBe` keyMap - describe "traverseIntMapWithKeyWithAdjust" $ session' $ do + session' "traverseIntMapWithKeyWithAdjust" $ do let textKeyInt k = "key" <> T.pack (show k) intMap = IntMap.fromList [ (1, "one") @@ -1501,7 +1500,7 @@ tests withDebugging wdConfig caps _selenium = do (dmap, _evt) <- traverseIntMapWithKeyWithAdjust widget intMap $ leftmost [postBuildPatch <$ pb, replace] liftIO $ dmap `H.shouldBe` intMap - describe "traverseDMapWithKeyWithAdjustWithMove" $ session' $ do + session' "traverseDMapWithKeyWithAdjustWithMove" $ do let widget :: DomBuilder t m => Key2 a -> Identity a -> m (Identity a) widget k (Identity v) = elAttr "li" ("id" =: textKey2 k) $ do elClass "span" "key" $ text $ textKey2 k @@ -1581,8 +1580,8 @@ tests withDebugging wdConfig caps _selenium = do (dmap, _evt) <- traverseDMapWithKeyWithAdjustWithMove widget initMap =<< triggerEventWithChan chan liftIO $ assertEqual "DMap" initMap dmap - describe "hydrating invalid HTML" $ session' $ do - it "can hydrate list in paragraph" $ runWD $ do + session' "hydrating invalid HTML" $ do + xit "can hydrate list in paragraph" $ runWD $ do let preSwitchover = do checkBodyText "before\ninner\nafter" -- Two

tags should be present @@ -1611,7 +1610,7 @@ tests withDebugging wdConfig caps _selenium = do -- TODO: This test presupposes the exact set of labels that "dropdown" places in the "value" fields to distinguish options. -- This dependence on internal implementation details is undesirable in a test case, but seems fairly tricky to avoid. -- It seems expedient for the time being to expect this test case to be updated, should those implementation details ever change. - describe "dropdown" $ session' $ do + session' "dropdown" $ do let doTest expectedOpts (initialValue :: Text) = do let doCheck = do es <- findElemsWithRetry $ WD.ByTag "option" From 06ac0a83b680e497b0afe0a1dc863b9aa153834b Mon Sep 17 00:00:00 2001 From: Tom Smalley Date: Wed, 9 Jun 2021 14:16:40 +0100 Subject: [PATCH 4/5] More permissive hlint version This should work for old (current at time of commit) reflex-platform and the nixos-20.09 version --- reflex-dom-core/reflex-dom-core.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/reflex-dom-core/reflex-dom-core.cabal b/reflex-dom-core/reflex-dom-core.cabal index 3285307..c85b200 100644 --- a/reflex-dom-core/reflex-dom-core.cabal +++ b/reflex-dom-core/reflex-dom-core.cabal @@ -178,7 +178,7 @@ library test-suite hlint build-depends: base, - hlint >= 3.0 && < 4.0 + hlint >= 2.0 && < 4.0 hs-source-dirs: test main-is: hlint.hs type: exitcode-stdio-1.0 From 94e449b4c207fe0eed3c29f20e330d23395c0fd9 Mon Sep 17 00:00:00 2001 From: John Ericson Date: Fri, 10 Sep 2021 17:08:03 -0400 Subject: [PATCH 5/5] Add change log entry --- reflex-dom-core/ChangeLog.md | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/reflex-dom-core/ChangeLog.md b/reflex-dom-core/ChangeLog.md index 3b11356..72fbd11 100644 --- a/reflex-dom-core/ChangeLog.md +++ b/reflex-dom-core/ChangeLog.md @@ -1,5 +1,9 @@ # Revision history for reflex-dom-core +## 0.6.2.1 + +* Fix hlint complaints with newer GHC. + ## 0.6.2.0 * ([#400](https://github.com/reflex-frp/reflex-dom/pull/400/files)) Set value of input elements in static renderer