diff --git a/bench/Main.hs b/bench/Main.hs --- a/bench/Main.hs +++ b/bench/Main.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -7,6 +8,7 @@ import Data.Functor.Misc import Control.Monad.Primitive import Control.Monad.IO.Class +import Control.Monad.Identity import Data.Dependent.Sum import Control.Concurrent.STM import Control.Applicative @@ -21,8 +23,6 @@ import System.IO import Criterion.Main -import qualified Data.Traversable as T - import qualified Data.Dependent.Map as DM @@ -30,8 +30,10 @@ main = defaultMain [ bgroup "micro" micros ] +#if !(MIN_VERSION_deepseq(1,4,2)) instance NFData (IORef a) where rnf x = seq x () +#endif instance NFData (TVar a) where rnf x = seq x () @@ -73,7 +75,7 @@ (newEventWithTriggerRef >>= subscribePair) (\(subd, trigger) -> do Just key <- liftIO $ readIORef trigger - fireEvents [key :=> (42 :: Int)]) + fireEvents [key :=> Identity (42 :: Int)]) , withSetupWHNF "fireEventsAndRead(head/merge1)" (setupMerge 1 >>= subscribePair) (\(subd, t:riggers) -> fireAndRead t (42 :: Int) subd) @@ -87,17 +89,17 @@ (setupMerge 100 >>= subscribePair) (\(subd, t:riggers) -> do Just key <- liftIO $ readIORef t - fireEvents [key :=> (42 :: Int)]) + fireEvents [key :=> Identity (42 :: Int)]) , withSetupWHNF "hold" newEventWithTriggerRef $ \(ev,trigger) -> hold (42 :: Int) ev , withSetupWHNF "sample" (newEventWithTriggerRef >>= hold (42 :: Int) . fst) sample ] setupMerge :: Int - -> SpiderHost (Event Spider (DM.DMap (Const2 Int a)), + -> SpiderHost (Event Spider (DM.DMap (Const2 Int a) Identity), [IORef (Maybe (EventTrigger Spider a))]) setupMerge num = do (evs, triggers) <- unzip <$> replicateM 100 newEventWithTriggerRef - let !m = DM.fromList [WrapArg (Const2 i) :=> v | (i,v) <- zip [0..] evs] + let !m = DM.fromList [(Const2 i) :=> v | (i,v) <- zip [0..] evs] pure (merge m, triggers) subscribePair :: (Event Spider a, b) -> SpiderHost (EventHandle Spider a, b) @@ -107,4 +109,4 @@ -> SpiderHost (Maybe b) fireAndRead trigger val subd = do Just key <- liftIO $ readIORef trigger - fireEventsAndRead [key :=> val] $ readEvent subd >>= T.sequence + fireEventsAndRead [key :=> Identity val] $ readEvent subd >>= sequence diff --git a/reflex.cabal b/reflex.cabal --- a/reflex.cabal +++ b/reflex.cabal @@ -1,5 +1,5 @@ Name: reflex -Version: 0.4.0 +Version: 0.4.0.1 Synopsis: Higher-order Functional Reactive Programming Description: Reflex is a high-performance, deterministic, higher-order Functional Reactive Programming system License: BSD3 @@ -10,28 +10,28 @@ Category: FRP Build-type: Simple Cabal-version: >=1.9.2 -homepage: https://github.com/ryantrinkle/reflex -bug-reports: https://github.com/ryantrinkle/reflex/issues +homepage: https://github.com/reflex-frp/reflex +bug-reports: https://github.com/reflex-frp/reflex/issues library hs-source-dirs: src build-depends: - base >= 4.7 && < 4.9, - dependent-sum == 0.3.*, + base >= 4.7 && < 4.10, + dependent-sum >= 0.3 && < 0.5, dependent-map == 0.2.*, semigroups >= 0.16 && < 0.19, mtl >= 2.1 && < 2.3, containers == 0.5.*, - these >= 0.4 && < 0.7, + these >= 0.4 && < 0.8, primitive >= 0.5 && < 0.7, - template-haskell >= 2.9 && < 2.11, + template-haskell >= 2.9 && < 2.13, ref-tf == 0.4.*, exception-transformers == 0.4.*, transformers >= 0.2, transformers-compat >= 0.3, - haskell-src-exts == 1.16.*, - haskell-src-meta == 0.6.*, - syb == 0.5.* + haskell-src-exts >= 1.16 && < 1.20, + haskell-src-meta >= 0.6 && < 0.9, + syb >= 0.4.4 && < 0.8 exposed-modules: Reflex, @@ -71,12 +71,12 @@ base, dependent-sum, dependent-map, - transformers >= 0.3 && < 0.5, + transformers >= 0.3 && < 0.6, stm == 2.4.*, deepseq >= 1.3 && < 1.5, mtl, primitive, - criterion == 1.1.*, + criterion >= 1.1 && < 1.3, reflex benchmark saulzar-bench @@ -87,18 +87,18 @@ build-depends: base, containers == 0.5.*, - ref-tf == 0.4, + ref-tf == 0.4.*, dependent-sum, dependent-map, - transformers >= 0.3 && < 0.5, + transformers >= 0.3 && < 0.6, stm == 2.4.*, deepseq >= 1.3 && < 1.5, mtl, primitive, - criterion == 1.1.*, + criterion >= 1.1 && < 1.3, split, reflex source-repository head type: git - location: https://github.com/ryantrinkle/reflex + location: https://github.com/reflex-frp/reflex diff --git a/src/Reflex/Dynamic/TH.hs b/src/Reflex/Dynamic/TH.hs --- a/src/Reflex/Dynamic/TH.hs +++ b/src/Reflex/Dynamic/TH.hs @@ -1,4 +1,10 @@ -{-# LANGUAGE TemplateHaskell, ScopedTypeVariables, TypeOperators, GADTs, EmptyDataDecls, PatternGuards #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE EmptyDataDecls #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE PatternGuards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeOperators #-} module Reflex.Dynamic.TH (qDyn, unqDyn, mkDyn) where import Reflex.Dynamic @@ -56,12 +62,22 @@ Hs.ParseFailed (Hs.SrcLoc _ l c) err -> fail $ "mkDyn:" <> show l <> ":" <> show c <> ": " <> err Hs.ParseOk e -> qDyn $ return $ everywhere (id `extT` reinstateUnqDyn) $ Hs.toExp $ everywhere (id `extT` antiE) e where TH.Name (TH.OccName occName) (TH.NameG _ _ (TH.ModName modName)) = 'unqMarker +#if MIN_VERSION_haskell_src_exts(1,18,0) + antiE :: Hs.Exp Hs.SrcSpanInfo -> Hs.Exp Hs.SrcSpanInfo antiE x = case x of + Hs.SpliceExp l se -> + Hs.App l (Hs.Var l $ Hs.Qual l (Hs.ModuleName l modName) (Hs.Ident l occName)) $ case se of + Hs.IdSplice l2 v -> Hs.Var l2 $ Hs.UnQual l2 $ Hs.Ident l2 v + Hs.ParenSplice _ ps -> ps + _ -> x +#else + antiE x = case x of Hs.SpliceExp se -> Hs.App (Hs.Var $ Hs.Qual (Hs.ModuleName modName) (Hs.Ident occName)) $ case se of Hs.IdSplice v -> Hs.Var $ Hs.UnQual $ Hs.Ident v Hs.ParenSplice ps -> ps _ -> x +#endif reinstateUnqDyn (TH.Name (TH.OccName occName') (TH.NameQ (TH.ModName modName'))) | modName == modName' && occName == occName' = 'unqMarker reinstateUnqDyn x = x