Skip to content

Commit

Permalink
Squashed version of reflex-frp#470
Browse files Browse the repository at this point in the history
  • Loading branch information
alexfmpe committed May 17, 2024
1 parent 5d1dbde commit 34f554e
Show file tree
Hide file tree
Showing 17 changed files with 76 additions and 75 deletions.
5 changes: 0 additions & 5 deletions cabal.project
Original file line number Diff line number Diff line change
Expand Up @@ -3,8 +3,3 @@ packages:
reflex-dom/
chrome-test-utils/
reflex-dom-test-selenium/

source-repository-package
type: git
location: https://github.com/dfordivam/hspec-webdriver-clone
tag: 0d748b7bb7cd74dce0a55a1ec86b01dbb8a71cd8
5 changes: 0 additions & 5 deletions cabal.project-nogtk
Original file line number Diff line number Diff line change
Expand Up @@ -7,8 +7,3 @@ package reflex-dom-core

package reflex-dom
flags: +use-warp -webkit2gtk

source-repository-package
type: git
location: https://github.com/dfordivam/hspec-webdriver-clone
tag: 0d748b7bb7cd74dce0a55a1ec86b01dbb8a71cd8
24 changes: 12 additions & 12 deletions reflex-dom-core/reflex-dom-core.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -67,12 +67,12 @@ flag gc-tests
library
hs-source-dirs: src
build-depends:
aeson >= 0.8 && < 2.2,
base >= 4.7 && < 4.15,
aeson >= 0.8 && < 2.3,
base >= 4.7 && < 4.20,
bifunctors >= 4.2 && < 6,
bimap >= 0.3 && < 0.5,
blaze-builder >= 0.4.1 && < 0.5,
bytestring == 0.10.*,
bytestring >= 0.10 && < 0.13,
case-insensitive < 1.3,
commutative-semigroups >=0.1 && <0.2,
containers >= 0.6 && < 0.7,
Expand All @@ -81,7 +81,7 @@ library
data-default >= 0.5 && < 0.8,
dependent-map >= 0.3 && < 0.5,
dependent-sum >= 0.6 && < 0.8,
dependent-sum-template >= 0.1 && < 0.2,
dependent-sum-template >= 0.2 && < 0.3,
directory >= 1.2 && < 1.4,
exception-transformers == 0.4.*,
ghcjs-dom >= 0.9.1.0 && < 0.10,
Expand All @@ -90,15 +90,15 @@ library
keycode >= 0.2.1 && < 0.3,
lens >= 4.7 && < 5.3,
monad-control >= 1.0.1 && < 1.1,
mtl >= 2.1 && < 2.3,
primitive >= 0.5 && < 0.8,
mtl >= 2.1 && < 2.4,
primitive >= 0.5 && < 0.9,
random >= 1.1 && < 1.3,
ref-tf >= 0.4 && < 0.6,
reflex >= 0.8.2.1 && < 1,
semigroups >= 0.16 && < 0.20,
stm >= 2.4 && < 2.6,
text == 1.2.*,
transformers >= 0.3 && < 0.6,
transformers >= 0.3 && < 0.7,
network-uri >= 2.6.1 && < 2.7,
zenc == 0.1.*

Expand All @@ -110,11 +110,11 @@ library
else
hs-source-dirs: src-ghc
if !os(windows)
build-depends: unix == 2.7.*
build-depends: unix >= 2.7 && < 2.9

if flag(split-these)
build-depends:
semialign >= 1 && < 1.3,
semialign >= 1 && < 1.4,
these >= 1 && < 1.3
else
build-depends:
Expand Down Expand Up @@ -169,8 +169,8 @@ library

if flag(use-template-haskell)
build-depends:
dependent-sum-template >= 0.1 && < 0.2,
template-haskell >= 2.12.0 && < 2.17
dependent-sum-template >= 0.2 && < 0.3,
template-haskell >= 2.12.0 && < 2.22
other-extensions: TemplateHaskell
cpp-options: -DUSE_TEMPLATE_HASKELL
other-modules:
Expand Down Expand Up @@ -226,7 +226,7 @@ test-suite hydration
, websockets
, which
hs-source-dirs: test
ghc-options: -rtsopts -with-rtsopts=-T -Wall -fwarn-tabs -funbox-strict-fields -O2 -ferror-spans
ghc-options: -rtsopts "-with-rtsopts=-T -V0" -Wall -fwarn-tabs -funbox-strict-fields -O2 -ferror-spans
ghc-prof-options: -fprof-auto -optP-DPROFILING
main-is: hydration.hs
type: exitcode-stdio-1.0
Expand Down
21 changes: 11 additions & 10 deletions reflex-dom-core/src/Reflex/Dom/Builder/Class.hs
Original file line number Diff line number Diff line change
Expand Up @@ -47,6 +47,7 @@ import Reflex.Requester.Base

import qualified Control.Category
import Control.Lens hiding (element)
import Control.Monad.Fix
import Control.Monad.Reader
import qualified Control.Monad.State as Lazy
import Control.Monad.State.Strict
Expand Down Expand Up @@ -278,6 +279,15 @@ elementConfig_eventSpec f (ElementConfig a b c d) = (\d' -> ElementConfig a b c
{-# INLINE elementConfig_eventSpec #-}
#endif

instance (Reflex t, er ~ EventResult, DomSpace s) => Default (ElementConfig er t s) where
{-# INLINABLE def #-}
def = ElementConfig
{ _elementConfig_namespace = Nothing
, _elementConfig_initialAttributes = mempty
, _elementConfig_modifyAttributes = Nothing
, _elementConfig_eventSpec = def
}

data Element er d t
= Element { _element_events :: EventSelector t (WrapArg er EventName) --TODO: EventSelector should have two arguments
, _element_raw :: RawElement d
Expand Down Expand Up @@ -542,15 +552,6 @@ instance HasNamespace (ElementConfig er t m) where
{-# INLINABLE namespace #-}
namespace = elementConfig_namespace

instance (Reflex t, er ~ EventResult, DomSpace s) => Default (ElementConfig er t s) where
{-# INLINABLE def #-}
def = ElementConfig
{ _elementConfig_namespace = Nothing
, _elementConfig_initialAttributes = mempty
, _elementConfig_modifyAttributes = Nothing
, _elementConfig_eventSpec = def
}

instance (DomBuilder t m, PerformEvent t m, MonadFix m, MonadHold t m) => DomBuilder t (PostBuildT t m) where
type DomBuilderSpace (PostBuildT t m) = DomBuilderSpace m
wrapRawElement e = lift . wrapRawElement e
Expand Down Expand Up @@ -750,7 +751,7 @@ instance HasDocument m => HasDocument (QueryT t q m)
class HasSetValue a where
type SetValue a :: *
setValue :: Lens' a (SetValue a)

instance Reflex t => HasSetValue (TextAreaElementConfig er t m) where
type SetValue (TextAreaElementConfig er t m) = Event t Text
setValue = textAreaElementConfig_setValue
2 changes: 2 additions & 0 deletions reflex-dom-core/src/Reflex/Dom/Builder/Immediate.hs
Original file line number Diff line number Diff line change
Expand Up @@ -120,7 +120,9 @@ module Reflex.Dom.Builder.Immediate
import Control.Concurrent
import Control.Exception (bracketOnError)
import Control.Lens (Identity(..), imapM_, iforM_, (^.), makeLenses)
import Control.Monad
import Control.Monad.Exception
import Control.Monad.Fix
import Control.Monad.Primitive
import Control.Monad.Reader
import Control.Monad.Ref
Expand Down
2 changes: 2 additions & 0 deletions reflex-dom-core/src/Reflex/Dom/Builder/Static.hs
Original file line number Diff line number Diff line change
Expand Up @@ -19,6 +19,8 @@ import Data.IORef (IORef)
import Blaze.ByteString.Builder.Html.Utf8
import Control.Lens hiding (element)
import Control.Monad.Exception
import Control.Monad
import Control.Monad.Fix
import Control.Monad.Identity
import Control.Monad.Primitive
import Control.Monad.Ref
Expand Down
6 changes: 3 additions & 3 deletions reflex-dom-core/src/Reflex/Dom/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -58,7 +58,7 @@ import Reflex.Profiled

{-# INLINE mainHydrationWidgetWithHead #-}
mainHydrationWidgetWithHead :: (forall x. HydrationWidget x ()) -> (forall x. HydrationWidget x ()) -> JSM ()
mainHydrationWidgetWithHead = mainHydrationWidgetWithHead'
mainHydrationWidgetWithHead head' body = mainHydrationWidgetWithHead' head' body

{-# INLINABLE mainHydrationWidgetWithHead' #-}
-- | Warning: `mainHydrationWidgetWithHead'` is provided only as performance tweak. It is expected to disappear in future releases.
Expand All @@ -67,7 +67,7 @@ mainHydrationWidgetWithHead' = mainHydrationWidgetWithSwitchoverAction' (pure ()

{-# INLINE mainHydrationWidgetWithSwitchoverAction #-}
mainHydrationWidgetWithSwitchoverAction :: JSM () -> (forall x. HydrationWidget x ()) -> (forall x. HydrationWidget x ()) -> JSM ()
mainHydrationWidgetWithSwitchoverAction = mainHydrationWidgetWithSwitchoverAction'
mainHydrationWidgetWithSwitchoverAction switchoverAction head' body = mainHydrationWidgetWithSwitchoverAction' switchoverAction head' body

{-# INLINABLE mainHydrationWidgetWithSwitchoverAction' #-}
-- | Warning: `mainHydrationWidgetWithSwitchoverAction'` is provided only as performance tweak. It is expected to disappear in future releases.
Expand Down Expand Up @@ -187,7 +187,7 @@ runHydrationWidgetWithHeadAndBodyWithFailure onFailure switchoverAction app = wi

{-# INLINE mainWidget #-}
mainWidget :: (forall x. Widget x ()) -> JSM ()
mainWidget = mainWidget'
mainWidget w = mainWidget' w

{-# INLINABLE mainWidget' #-}
-- | Warning: `mainWidget'` is provided only as performance tweak. It is expected to disappear in future releases.
Expand Down
2 changes: 2 additions & 0 deletions reflex-dom-core/src/Reflex/Dom/Prerender.hs
Original file line number Diff line number Diff line change
Expand Up @@ -22,6 +22,8 @@ module Reflex.Dom.Prerender
, PrerenderBaseConstraints
) where

import Control.Monad
import Control.Monad.Fix
import Control.Monad.Primitive (PrimMonad(..))
import Control.Monad.Reader
import Control.Monad.Ref (MonadRef(..), MonadAtomicRef(..))
Expand Down
4 changes: 1 addition & 3 deletions reflex-dom-core/src/Reflex/Dom/WebSocket.hs
Original file line number Diff line number Diff line change
Expand Up @@ -8,7 +8,6 @@
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE JavaScriptFFI #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
Expand Down Expand Up @@ -40,9 +39,8 @@ import Control.Concurrent
import Control.Concurrent.STM
import Control.Exception
import Control.Lens
import Control.Monad hiding (forM, forM_, mapM, mapM_, sequence)
import Control.Monad hiding (forM, mapM, mapM_, sequence)
import Control.Monad.IO.Class
import Control.Monad.State
import Data.Aeson
import Data.ByteString (ByteString)
import Data.ByteString.Lazy (toStrict)
Expand Down
1 change: 1 addition & 0 deletions reflex-dom-core/src/Reflex/Dom/Widget/Basic.hs
Original file line number Diff line number Diff line change
Expand Up @@ -72,6 +72,7 @@ import Reflex.Workflow

import Control.Arrow
import Control.Lens hiding (children, element)
import Control.Monad.Fix
import Control.Monad.Reader hiding (forM, forM_, mapM, mapM_, sequence, sequence_)
import Data.Align
import Data.Default
Expand Down
1 change: 1 addition & 0 deletions reflex-dom-core/src/Reflex/Dom/Widget/Input.hs
Original file line number Diff line number Diff line change
Expand Up @@ -19,6 +19,7 @@ module Reflex.Dom.Widget.Input (module Reflex.Dom.Widget.Input, def, (&), (.~))
import Prelude

import Control.Lens hiding (element, ix)
import Control.Monad
import Control.Monad.Fix
import Control.Monad.IO.Class
import Control.Monad.Reader
Expand Down
1 change: 0 additions & 1 deletion reflex-dom-core/src/Reflex/Dom/Xhr/Foreign.hs
Original file line number Diff line number Diff line change
@@ -1,5 +1,4 @@
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE JavaScriptFFI #-}
{-# LANGUAGE OverloadedStrings #-}

module Reflex.Dom.Xhr.Foreign (
Expand Down
1 change: 1 addition & 0 deletions reflex-dom-core/test/hlint.hs
Original file line number Diff line number Diff line change
Expand Up @@ -20,6 +20,7 @@ main = do
, "--ignore=Unnecessary hiding" -- Interferes with cross-version compatibility
, "--ignore=Use <$>"
, "--ignore=Reduce duplication" --TODO: Re-enable this test
, "--ignore=Eta reduce" -- simplified subsumption
, "--ignore=Use list comprehension"
, "--ignore=Evaluate"
, "--cpp-define=USE_TEMPLATE_HASKELL"
Expand Down
48 changes: 25 additions & 23 deletions reflex-dom-core/test/hydration.hs
Original file line number Diff line number Diff line change
@@ -1,4 +1,5 @@
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
Expand Down Expand Up @@ -89,8 +90,10 @@ import qualified Test.WebDriver.Capabilities as WD
import Test.Util.ChromeFlags
import Test.Util.UnshareNetwork

-- ORPHAN: https://github.com/kallisti-dev/hs-webdriver/pull/167

#if !MIN_VERSION_webdriver(0,10,0)
deriving instance MonadMask WD
#endif

chromium :: FilePath
chromium = $(staticWhich "chromium")
Expand Down Expand Up @@ -118,18 +121,11 @@ assertBool msg bool = liftIO $ HUnit.assertBool msg bool
chromeConfig :: Text -> [Text] -> WD.WDConfig
chromeConfig fp flags = WD.useBrowser (WD.chrome { WD.chromeBinary = Just $ T.unpack fp, WD.chromeOptions = T.unpack <$> flags }) WD.defaultConfig

keyMap :: DMap DKey Identity
keyMap = DMap.fromList
[ Key_Int ==> 0
, Key_Char ==> 'A'
]

data DKey a where
Key_Int :: DKey Int
Key_Char :: DKey Char
Key_Bool :: DKey Bool


textKey :: DKey a -> Text
textKey = \case
Key_Int -> "Key_Int"
Expand All @@ -141,6 +137,21 @@ deriveGEq ''DKey
deriveGCompare ''DKey
deriveGShow ''DKey

keyMap :: DMap DKey Identity
keyMap = DMap.fromList
[ Key_Int ==> 0
, Key_Char ==> 'A'
]

data Key2 a where
Key2_Int :: Int -> Key2 Int
Key2_Char :: Char -> Key2 Char

deriveGEq ''Key2
deriveGCompare ''Key2
deriveGShow ''Key2
deriveArgDict ''Key2

deriving instance MonadFail WD

main :: IO ()
Expand All @@ -166,11 +177,11 @@ tests withDebugging wdConfig caps _selenium = do
r <- m
putStrLnDebug "after"
return r
testWidgetStatic :: WD b -> (forall m js. TestWidget (SpiderTimeline Global) m => m ()) -> WD b
testWidgetStatic :: WD b -> (forall m. TestWidget (SpiderTimeline Global) m => m ()) -> WD b
testWidgetStatic = testWidgetStaticDebug withDebugging
testWidget :: WD () -> WD b -> (forall m js. TestWidget (SpiderTimeline Global) m => m ()) -> WD b
testWidget :: WD () -> WD b -> (forall m. TestWidget (SpiderTimeline Global) m => m ()) -> WD b
testWidget = testWidgetDebug True withDebugging
testWidget' :: WD a -> (a -> WD b) -> (forall m js. TestWidget (SpiderTimeline Global) m => m ()) -> WD b
testWidget' :: WD a -> (a -> WD b) -> (forall m. TestWidget (SpiderTimeline Global) m => m ()) -> WD b
testWidget' = testWidgetDebug' True withDebugging
session' "text" $ do
it "works" $ runWD $ do
Expand Down Expand Up @@ -1722,7 +1733,7 @@ testWidgetStaticDebug
:: Bool
-> WD b
-- ^ Webdriver commands to run before JS runs and after hydration switchover
-> (forall m js. TestWidget (SpiderTimeline Global) m => m ())
-> (forall m. TestWidget (SpiderTimeline Global) m => m ())
-- ^ Widget we are testing
-> WD b
testWidgetStaticDebug withDebugging w = testWidgetDebug True withDebugging (void w) w
Expand All @@ -1735,7 +1746,7 @@ testWidgetDebug
-- ^ Webdriver commands to run before the JS runs (i.e. on the statically rendered page)
-> WD b
-- ^ Webdriver commands to run after hydration switchover
-> (forall m js. TestWidget (SpiderTimeline Global) m => m ())
-> (forall m. TestWidget (SpiderTimeline Global) m => m ())
-- ^ Widget we are testing
-> WD b
testWidgetDebug hardFailure withDebugging beforeJS afterSwitchover =
Expand All @@ -1752,7 +1763,7 @@ testWidgetDebug'
-- ^ Webdriver commands to run before the JS runs (i.e. on the statically rendered page)
-> (a -> WD b)
-- ^ Webdriver commands to run after hydration switchover
-> (forall m js. TestWidget (SpiderTimeline Global) m => m ())
-> (forall m. TestWidget (SpiderTimeline Global) m => m ())
-- ^ Widget we are testing (contents of body)
-> WD b
testWidgetDebug' hardFailure withDebugging beforeJS afterSwitchover bodyWidget = do
Expand Down Expand Up @@ -1817,12 +1828,3 @@ withAsync' f g = bracket
(liftIO $ Async.async f)
(liftIO . Async.uninterruptibleCancel)
(const g)

data Key2 a where
Key2_Int :: Int -> Key2 Int
Key2_Char :: Char -> Key2 Char

deriveGEq ''Key2
deriveGCompare ''Key2
deriveGShow ''Key2
deriveArgDict ''Key2
9 changes: 4 additions & 5 deletions reflex-dom-test-selenium/reflex-dom-test-selenium.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -15,13 +15,12 @@ library
hs-source-dirs: src
build-depends:
async,
base >= 4.7 && < 4.15,
bytestring == 0.10.*,
base >= 4.7 && < 4.20,
bytestring >= 0.10 && < 0.13,
chrome-test-utils,
exceptions,
-- Until hspec-webdriver supports newer hspec-core versions
hspec-core < 2.8,
hspec-webdriver >= 1.2.1,
hspec-core < 2.12,
hspec-webdriver >= 1.2.2,
http-types,
jsaddle >= 0.9.0.0 && < 0.10,
jsaddle-warp,
Expand Down
Loading

0 comments on commit 34f554e

Please sign in to comment.