packages feed

reflex 0.6.2.1 → 0.6.2.3

raw patch · 33 files changed

+307/−151 lines, 33 filesdep +semialigndep +these-lensdep −semigroupsdep −transformers-compatdep ~comonaddep ~constraints-extrasdep ~containers

Dependencies added: semialign, these-lens

Dependencies removed: semigroups, transformers-compat

Dependency ranges changed: comonad, constraints-extras, containers, criterion, deepseq, hlint, monoidal-containers, primitive, profunctors, these, transformers, witherable

Files

ChangeLog.md view
@@ -1,16 +1,33 @@ # Revision history for reflex -## Unreleased+## 0.6.2.3 +* Add an upper-bound to witherable++## 0.6.2.2++* Support these >= 1. Add `split-these` flag to control whether to use new these/semialign combination or not.+* Update version bounds to fix some CI failures+* Add travis CI configuration++## 0.6.2.1+ * Generalize `fan` to `fanG` to take a `DMap` with non-`Identity`-  values.+  functor:+    * `fan` to `fanG`+    * `EventSelectorG` for `fanG` result selector. +* Reduce the amount of unsafeCoerce in coercing newtypes under Event/Dynamic/Behavior.+    * Add fused ReaderIO for the purpose of coercion (ReaderT's third argument has nominal role preventing automated coerce)+    * Add incrementalCoercion/coerceIncremental to go with dynamicCoercion/coerceDynamic+ * Generalize merging functions:   `merge` to `mergeG`,    `mergeIncremental` to `mergeIncrementalG`, -  `distributeDMapOverDynPure` to `distributeDMapOverDynPureG`,   `mergeIncrementalWithMove` to `mergeIncrementalWithMoveG`.   +* Generalize distribute function:+    `distributeDMapOverDynPure` to `distributeDMapOverDynPureG`,  ## 0.6.2.0
reflex.cabal view
@@ -1,5 +1,5 @@ Name: reflex-Version: 0.6.2.1+Version: 0.6.2.3 Synopsis: Higher-order Functional Reactive Programming Description: Reflex is a high-performance, deterministic, higher-order Functional Reactive Programming system License: BSD3@@ -17,6 +17,10 @@   Quickref.md   ChangeLog.md +tested-with:+  GHC  ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5,+  GHCJS ==8.4+ flag use-reflex-optimizer   description: Use the GHC plugin Reflex.Optimizer on some of the modules in the package.  This is still experimental.   default: False@@ -37,40 +41,51 @@   default: False   manual: True +flag split-these+  description: Use split these/semialign packages+  manual:      False+  default:     True+ library   hs-source-dirs: src   build-depends:     MemoTrie == 0.6.*,     base >= 4.9 && < 4.13,     bifunctors >= 5.2 && < 5.6,-    comonad,-    constraints-extras >= 0.2,-    containers >= 0.5 && < 0.7,+    comonad >= 5.0.4 && < 5.1,+    constraints-extras >= 0.3 && < 0.4,+    containers >= 0.6 && < 0.7,     data-default >= 0.5 && < 0.8,     dependent-map >= 0.3 && < 0.4,     exception-transformers == 0.4.*,-    profunctors,+    profunctors >= 5.3 && < 5.5,     lens >= 4.7 && < 5,     monad-control >= 1.0.1 && < 1.1,-    monoidal-containers >= 0.4 && < 0.6,     mtl >= 2.1 && < 2.3,     prim-uniq >= 0.1.0.1 && < 0.2,-    primitive >= 0.5 && < 0.7,+    primitive >= 0.5 && < 0.8,+    profunctors,     random == 1.1.*,     ref-tf == 0.4.*,     reflection == 2.1.*,     semigroupoids >= 4.0 && < 6,-    semigroups >= 0.16 && < 0.19,     stm >= 2.4 && < 2.6,     syb >= 0.5 && < 0.8,-    these >= 0.4 && < 0.9,     time >= 1.4 && < 1.9,-    transformers >= 0.2,-    transformers-compat >= 0.3,+    transformers >= 0.5.6.0 && < 0.6,     unbounded-delays >= 0.1.0.0 && < 0.2,-    witherable >= 0.2 && < 0.4+    witherable >= 0.3 && < 0.3.2 +  if flag(split-these)+    build-depends:     these >= 1 && <1.1,+                       semialign >=1 && <1.1,+                       monoidal-containers >= 0.5.0.1 && < 0.6+  else+    build-depends:     these >= 0.4 && <0.9,+                       monoidal-containers == 0.5.0.0+   exposed-modules:+    Control.Monad.ReaderIO     Data.AppendMap,     Data.FastMutableIntMap,     Data.FastWeakBag,@@ -144,7 +159,7 @@     other-extensions: TemplateHaskell   else     build-depends:-      dependent-sum == 0.6.*+      dependent-sum >= 0.6 && < 0.7    if flag(fast-weak) && impl(ghcjs)     cpp-options: -DGHCJS_FAST_WEAK@@ -161,14 +176,14 @@     base,     bifunctors,     containers,-    deepseq >= 1.3 && < 1.5,+    deepseq,     dependent-map,     dependent-sum,     mtl,     ref-tf,     reflex,     split,-    transformers >= 0.3+    transformers   other-modules:     Reflex.Bench.Focused     Reflex.Plan.Pure@@ -187,7 +202,7 @@     containers,     dependent-map,     dependent-sum,-    deepseq >= 1.3 && < 1.5,+    deepseq,     mtl,     transformers,     ref-tf,@@ -206,7 +221,7 @@                , directory                , filepath                , filemanip-               , hlint+               , hlint < 2.1 || >= 2.2.2   if impl(ghcjs)     buildable: False @@ -216,7 +231,7 @@   hs-source-dirs: test   build-depends: base                , containers-               , deepseq >= 1.3 && < 1.5+               , deepseq                , dependent-map                , dependent-sum                , lens@@ -225,6 +240,10 @@                , transformers                , reflex                , ref-tf++  if flag(split-these)+    build-depends: these-lens+   other-modules:     Reflex.Test     Reflex.TestPlan@@ -232,13 +251,14 @@     Reflex.Plan.Pure     Test.Run + test-suite RequesterT   type: exitcode-stdio-1.0   main-is: RequesterT.hs   hs-source-dirs: test   build-depends: base                , containers-               , deepseq >= 1.3 && < 1.5+               , deepseq                , dependent-sum                , dependent-map                , lens@@ -247,9 +267,14 @@                , transformers                , reflex                , ref-tf++  if flag(split-these)+    build-depends: these-lens+   other-modules:     Reflex.TestPlan     Reflex.Plan.Pure+    Test.Run  test-suite QueryT   type: exitcode-stdio-1.0@@ -259,15 +284,18 @@                , containers                , dependent-map                , dependent-sum-               , deepseq >= 1.3 && < 1.5+               , deepseq                , lens                , monoidal-containers                , mtl                , ref-tf                , reflex-               , semigroups                , these                , transformers++  if flag(split-these)+    build-depends: semialign, these-lens+   other-modules:     Test.Run     Reflex.TestPlan@@ -282,14 +310,16 @@                , containers                , dependent-sum                , dependent-map-               , deepseq >= 1.3 && < 1.5+               , deepseq                , mtl                , these                , transformers                , reflex                , ref-tf-  if impl(ghc < 8)-    build-depends: semigroups++  if flag(split-these)+    build-depends: semialign+   other-modules:     Reflex.Plan.Pure     Reflex.Plan.Reflex@@ -302,7 +332,7 @@   hs-source-dirs: test   build-depends: base                , containers-               , deepseq >= 1.3 && < 1.5+               , deepseq                , dependent-sum                , mtl                , reflex@@ -321,8 +351,8 @@   build-depends:     base,     containers,-    criterion >= 1.1 && < 1.6,-    deepseq >= 1.3 && < 1.5,+    criterion,+    deepseq,     dependent-map,     dependent-sum,     ref-tf,@@ -331,7 +361,7 @@     reflex,     split,     stm,-    transformers >= 0.3+    transformers   other-modules:     Reflex.TestPlan     Reflex.Plan.Reflex@@ -345,9 +375,9 @@   ghc-options: -Wall -O2 -rtsopts -threaded   build-depends:     base,-    containers >= 0.5 && < 0.7,-    criterion >= 1.1 && < 1.6,-    deepseq >= 1.3 && < 1.5,+    containers,+    criterion,+    deepseq,     dependent-map,     dependent-sum,     loch-th,@@ -359,7 +389,7 @@     split,     stm,     time,-    transformers >= 0.3+    transformers   other-modules:     Reflex.TestPlan     Reflex.Plan.Reflex
+ src/Control/Monad/ReaderIO.hs view
@@ -0,0 +1,60 @@+{-# language RoleAnnotations #-}+{-# language MultiParamTypeClasses #-}+{-# language FlexibleInstances #-}+{-# language CPP #-}+module Control.Monad.ReaderIO+  (+    ReaderIO (..)+  )+  where++import Control.Monad.Fix+#if MIN_VERSION_base(4,10,0)+import Control.Applicative+#endif+import Control.Monad+import Control.Monad.Reader.Class+import Control.Monad.IO.Class++-- | An approximate clone of @RIO@ from the @rio@ package, but not based on+-- @ReaderT@. The trouble with @ReaderT@ is that its third type argument has a+-- @nominal@ role, so we can't coerce through it when it's wrapped in some+-- other @data@ type. Ugh.+newtype ReaderIO e a = ReaderIO { runReaderIO :: e -> IO a }+type role ReaderIO representational representational++instance Functor (ReaderIO e) where+  fmap = liftM+  {-# INLINE fmap #-}+  a <$ m = m >> pure a+  {-# INLINE (<$) #-}++instance Applicative (ReaderIO e) where+  pure a = ReaderIO $ \_ -> pure a+  {-# INLINE pure #-}+  (<*>) = ap+  {-# INLINE (<*>) #-}+#if MIN_VERSION_base(4,10,0)+  liftA2 = liftM2+  {-# INLINE liftA2 #-}+#endif  +  (*>) = (>>)+  {-# INLINE (*>) #-}++instance Monad (ReaderIO e) where+  ReaderIO q >>= f = ReaderIO $ \e -> q e >>= \a -> runReaderIO (f a) e+  {-# INLINE (>>=) #-}++instance MonadFix (ReaderIO e) where+  mfix f = ReaderIO $ \e -> mfix $ \r -> runReaderIO (f r) e+  {-# INLINE mfix #-}++instance MonadIO (ReaderIO e) where+  liftIO m = ReaderIO $ \_ -> m+  {-# INLINE liftIO #-}++instance MonadReader e (ReaderIO e) where+  ask = ReaderIO pure+  {-# INLINE ask #-}+  local f (ReaderIO m) = ReaderIO (m . f)+  {-# INLINE local #-}
src/Data/AppendMap.hs view
@@ -46,8 +46,10 @@ pattern AppendMap :: Map k v -> MonoidalMap k v pattern AppendMap m = MonoidalMap m +#if !MIN_VERSION_witherable(0,3,2) instance W.Filterable (MonoidalMap k) where   mapMaybe = mapMaybe+#endif  -- | Deletes a key, returning 'Nothing' if the result is empty. nonEmptyDelete :: Ord k => k -> MonoidalMap k a -> Maybe (MonoidalMap k a)
src/Data/Functor/Misc.hs view
@@ -4,7 +4,6 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-}-{-# LANGUAGE KindSignatures #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE PatternSynonyms #-}
src/Reflex/Adjustable/Class.hs view
@@ -3,7 +3,6 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE LambdaCase #-}-{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-}
src/Reflex/BehaviorWriter/Class.hs view
@@ -5,7 +5,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE UndecidableInstances #-} #ifdef USE_REFLEX_OPTIMIZER {-# OPTIONS_GHC -fplugin=Reflex.Optimizer #-}
src/Reflex/Class.hs view
@@ -7,7 +7,6 @@ {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-}-{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE RankNTypes #-}@@ -37,6 +36,7 @@   , coerceBehavior   , coerceEvent   , coerceDynamic+  , coerceIncremental   , MonadSample (..)   , MonadHold (..)     -- ** 'fan' related types@@ -173,6 +173,14 @@   , slowHeadE   ) where +#if defined(MIN_VERSION_semialign)+import Prelude hiding (zip, zipWith)++#if MIN_VERSION_these(0,8,0)+import Data.These.Combinators (justThese)+#endif+#endif+ import Control.Applicative import Control.Monad.Identity import Control.Monad.Reader@@ -312,6 +320,10 @@   -- | Construct a 'Coercion' for a 'Dynamic' given an 'Coercion' for its   -- occurrence type   dynamicCoercion :: Coercion a b -> Coercion (Dynamic t a) (Dynamic t b)+  -- | Construct a 'Coercion' for an 'Incremental' given 'Coercion's for its+  -- patch target and patch types.+  incrementalCoercion+    :: Coercion (PatchTarget a) (PatchTarget b) -> Coercion a b -> Coercion (Incremental t a) (Incremental t b)   mergeIntIncremental :: Incremental t (PatchIntMap (Event t a)) -> Event t (IntMap a)   fanInt :: Event t (IntMap a) -> EventSelectorInt t a @@ -345,6 +357,12 @@ coerceDynamic :: (Reflex t, Coercible a b) => Dynamic t a -> Dynamic t b coerceDynamic = coerceWith $ dynamicCoercion Coercion +-- | Coerce an 'Incremental' between representationally-equivalent value types+coerceIncremental+  :: (Reflex t, Coercible a b, Coercible (PatchTarget a) (PatchTarget b))+  => Incremental t a -> Incremental t b+coerceIncremental = coerceWith $ incrementalCoercion Coercion Coercion+ -- | Construct a 'Dynamic' from a 'Behavior' and an 'Event'.  The 'Behavior' -- __must__ change when and only when the 'Event' fires, such that the -- 'Behavior''s value is always equal to the most recent firing of the 'Event';@@ -669,11 +687,7 @@ instance (Reflex t, Semigroup a) => Semigroup (Behavior t a) where   a <> b = pull $ liftM2 (<>) (sample a) (sample b)   sconcat = pull . fmap sconcat . mapM sample-#if MIN_VERSION_semigroups(0,17,0)   stimes n = fmap $ stimes n-#else-  times1p n = fmap $ times1p n-#endif  -- | Alias for 'mapMaybe' fmapMaybe :: Filterable f => (a -> Maybe b) -> f a -> f b@@ -700,10 +714,13 @@ instance Reflex t => Alt (Event t) where   ev1 <!> ev2 = leftmost [ev1, ev2] --- | 'Event' intersection (convenient interface to 'coincidence').+-- | 'Event' intersection. Only occurs when both events are co-incident. instance Reflex t => Apply (Event t) where-  evf <.> evx = coincidence (fmap (<$> evx) evf)+  evf <.> evx = mapMaybe f (align evf evx) where+    f (These g a) = Just (g a)+    f _           = Nothing + -- | 'Event' intersection (convenient interface to 'coincidence'). instance Reflex t => Bind (Event t) where   evx >>- f = coincidence (f <$> evx)@@ -871,11 +888,7 @@ instance (Semigroup a, Reflex t) => Semigroup (Event t a) where   (<>) = alignWith (mergeThese (<>))   sconcat = fmap sconcat . mergeList . toList-#if MIN_VERSION_semigroups(0,17,0)   stimes n = fmap $ stimes n-#else-  times1p n = fmap $ times1p n-#endif  instance (Semigroup a, Reflex t) => Monoid (Event t a) where   mempty = never@@ -1064,7 +1077,11 @@ #endif   align = alignEventWithMaybe Just +#if defined(MIN_VERSION_semialign)+  zip x y = mapMaybe justThese $ align x y+#endif + -- | Create a new 'Event' that only occurs if the supplied 'Event' occurs and -- the 'Behavior' is true at the time of occurrence. gate :: Reflex t => Behavior t Bool -> Event t a -> Event t a@@ -1104,11 +1121,7 @@  instance (Reflex t, Semigroup a) => Semigroup (Dynamic t a) where   (<>) = zipDynWith (<>)-#if MIN_VERSION_semigroups(0,17,0)   stimes n = fmap $ stimes n-#else-  times1p n = fmap $ times1p n-#endif  instance (Reflex t, Monoid a) => Monoid (Dynamic t a) where   mconcat = distributeListOverDynWith mconcat
src/Reflex/Collection.hs view
@@ -27,6 +27,10 @@   , simpleList   ) where +#if defined(MIN_VERSION_semialign)+import Prelude hiding (zip, zipWith)+#endif+ import Control.Monad.Identity import Data.Align import Data.Functor.Misc
src/Reflex/Dynamic/TH.hs view
@@ -81,7 +81,7 @@   }  mkDynExp :: String -> Q Exp-mkDynExp s = case Hs.parseExpWithMode (Hs.defaultParseMode { Hs.extensions = [ Hs.EnableExtension Hs.TemplateHaskell ] }) s of+mkDynExp s = case Hs.parseExpWithMode Hs.defaultParseMode { Hs.extensions = [ Hs.EnableExtension Hs.TemplateHaskell ] } s of   Hs.ParseFailed (Hs.SrcLoc _ l c) err -> fail $ "mkDyn:" <> show l <> ":" <> show c <> ": " <> err   Hs.ParseOk e -> qDynPure $ return $ everywhere (id `extT` reinstateUnqDyn) $ Hs.toExp $ everywhere (id `extT` antiE) e     where TH.Name (TH.OccName occName) (TH.NameG _ _ (TH.ModName modName)) = 'unqMarker
src/Reflex/DynamicWriter/Class.hs view
@@ -3,7 +3,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE UndecidableInstances #-} #ifdef USE_REFLEX_OPTIMIZER {-# OPTIONS_GHC -fplugin=Reflex.Optimizer #-}
src/Reflex/EventWriter/Base.hs view
@@ -52,7 +52,7 @@ import Data.Semigroup import Data.Some (Some) import Data.Tuple-import Data.Type.Equality hiding (apply)+import Data.Type.Equality  import Unsafe.Coerce
src/Reflex/EventWriter/Class.hs view
@@ -2,7 +2,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE UndecidableInstances #-} #ifdef USE_REFLEX_OPTIMIZER {-# OPTIONS_GHC -fplugin=Reflex.Optimizer #-}
src/Reflex/Host/Class.hs view
@@ -4,7 +4,6 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE GADTs #-}-{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RoleAnnotations #-} {-# LANGUAGE ScopedTypeVariables #-}
src/Reflex/NotReady/Class.hs view
@@ -3,7 +3,6 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} #ifdef USE_REFLEX_OPTIMIZER
src/Reflex/Patch/IntMap.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveTraversable #-}@@ -33,14 +32,7 @@ instance Semigroup (PatchIntMap v) where   PatchIntMap a <> PatchIntMap b = PatchIntMap $ a `mappend` b --TODO: Add a semigroup instance for Map   -- PatchMap is idempotent, so stimes n is id for every n-#if MIN_VERSION_semigroups(0,17,0)   stimes = stimesIdempotentMonoid-#else-  times1p n x = case compare n 0 of-    LT -> error "stimesIdempotentMonoid: negative multiplier"-    EQ -> mempty-    GT -> x-#endif  -- | Map a function @Int -> a -> b@ over all @a@s in the given @'PatchIntMap' a@ -- (that is, all inserts/updates), producing a @PatchIntMap b@.
src/Reflex/Patch/Map.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE TypeFamilies #-} -- | 'Patch'es on 'Map' that consist only of insertions (including overwrites)@@ -35,14 +34,7 @@ instance Ord k => Semigroup (PatchMap k v) where   PatchMap a <> PatchMap b = PatchMap $ a `mappend` b --TODO: Add a semigroup instance for Map   -- PatchMap is idempotent, so stimes n is id for every n-#if MIN_VERSION_semigroups(0,17,0)   stimes = stimesIdempotentMonoid-#else-  times1p n x = case compare n 0 of-    LT -> error "stimesIdempotentMonoid: negative multiplier"-    EQ -> mempty-    GT -> x-#endif  -- | The empty 'PatchMap' contains no insertions or deletions instance Ord k => Monoid (PatchMap k v) where
src/Reflex/PerformEvent/Base.hs view
@@ -141,7 +141,7 @@           case mToPerform of             Nothing -> return [result']             Just toPerform -> do-              responses <- runHostFrame $ traverseRequesterData (\v -> Identity <$> v) toPerform+              responses <- runHostFrame $ traverseRequesterData (Identity <$>) toPerform               mrt <- readRef responseTrigger               let followupEventTriggers = case mrt of                     Just rt -> [rt :=> Identity responses]
src/Reflex/PerformEvent/Class.hs view
@@ -5,7 +5,6 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-}
src/Reflex/PostBuild/Class.hs view
@@ -4,7 +4,6 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-}
src/Reflex/Profiled.hs view
@@ -9,6 +9,7 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE PolyKinds #-}+{-# LANGUAGE TypeApplications #-} {-# LANGUAGE RankNTypes #-} -- | -- Module:@@ -79,9 +80,9 @@           go (cc : l) parent  toCostCentreTree :: Ptr CostCentreStack -> Int -> IO CostCentreTree-toCostCentreTree ccs n = do-  ccList <- getCostCentreStack ccs-  return $ foldr (\cc child -> CostCentreTree 0 n $ Map.singleton cc child) (CostCentreTree n n mempty) ccList+toCostCentreTree ccs n =+  foldr (\cc child -> CostCentreTree 0 n $ Map.singleton cc child) (CostCentreTree n n mempty)+    <$> getCostCentreStack ccs  getCostCentreTree :: IO CostCentreTree getCostCentreTree = do@@ -151,13 +152,16 @@   currentIncremental (Incremental_Profiled i) = coerce $ currentIncremental i   updatedIncremental (Incremental_Profiled i) = coerce $ profileEvent $ updatedIncremental i   incrementalToDynamic (Incremental_Profiled i) = coerce $ incrementalToDynamic i-  behaviorCoercion (c :: Coercion a b) = case behaviorCoercion c :: Coercion (Behavior t a) (Behavior t b) of-    Coercion -> unsafeCoerce (Coercion :: Coercion (Behavior (ProfiledTimeline t) a) (Behavior (ProfiledTimeline t) a)) --TODO: Figure out how to make this typecheck without the unsafeCoerce-  eventCoercion (c :: Coercion a b) = case eventCoercion c :: Coercion (Event t a) (Event t b) of-    Coercion -> unsafeCoerce (Coercion :: Coercion (Event (ProfiledTimeline t) a) (Event (ProfiledTimeline t) a)) --TODO: Figure out how to make this typecheck without the unsafeCoerce-  dynamicCoercion (c :: Coercion a b) = case dynamicCoercion c :: Coercion (Dynamic t a) (Dynamic t b) of-    Coercion -> unsafeCoerce (Coercion :: Coercion (Dynamic (ProfiledTimeline t) a) (Dynamic (ProfiledTimeline t) a)) --TODO: Figure out how to make this typecheck without the unsafeCoerce-  mergeIntIncremental = Event_Profiled . mergeIntIncremental . (unsafeCoerce :: Incremental (ProfiledTimeline t) (PatchIntMap (Event (ProfiledTimeline t) a)) -> Incremental t (PatchIntMap (Event t a)))+  behaviorCoercion c =+    Coercion `trans` behaviorCoercion @t c `trans` Coercion+  eventCoercion c =+    Coercion `trans` eventCoercion @t c `trans` Coercion+  dynamicCoercion c =+    Coercion `trans` dynamicCoercion @t c `trans` Coercion+  incrementalCoercion c d =+    Coercion `trans` incrementalCoercion @t c d `trans` Coercion+  mergeIntIncremental = Event_Profiled . mergeIntIncremental .+    coerceWith (Coercion `trans` incrementalCoercion Coercion Coercion `trans` Coercion)   fanInt (Event_Profiled e) = coerce $ fanInt $ profileEvent e  deriving instance Functor (Dynamic t) => Functor (Dynamic (ProfiledTimeline t))
src/Reflex/Pure.hs view
@@ -31,14 +31,9 @@   , Incremental (..)   ) where -#if !MIN_VERSION_base(4,8,0)-import Control.Applicative-#endif- import Control.Monad import Data.Dependent.Map (DMap, GCompare) import qualified Data.Dependent.Map as DMap-import Data.Functor.Identity import Data.IntMap (IntMap) import qualified Data.IntMap as IntMap import Data.Maybe@@ -93,7 +88,8 @@        then Nothing        else Just currentOccurrences -  -- fanG :: GCompare k => Event (Pure t) (DMap k v) -> EventSelectorG (Pure t) k v+--  The instance signature doeesn't compile, leave commented for documentation+--  fanG :: GCompare k => Event (Pure t) (DMap k v) -> EventSelectorG (Pure t) k v   fanG e = EventSelectorG $ \k -> Event $ \t -> unEvent e t >>= DMap.lookup k    switch :: Behavior (Pure t) (Event (Pure t) a) -> Event (Pure t) a@@ -133,6 +129,7 @@   behaviorCoercion Coercion = Coercion   eventCoercion Coercion = Coercion   dynamicCoercion Coercion = Coercion+  incrementalCoercion Coercion Coercion = Coercion    fanInt e = EventSelectorInt $ \k -> Event $ \t -> unEvent e t >>= IntMap.lookup k
src/Reflex/Query/Base.hs view
@@ -1,7 +1,6 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE InstanceSigs #-}-{-# LANGUAGE KindSignatures #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-}
src/Reflex/Query/Class.hs view
@@ -3,7 +3,6 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} -- |
src/Reflex/Requester/Class.hs view
@@ -6,7 +6,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RecursiveDo #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-}
src/Reflex/Spider/Internal.hs view
@@ -9,7 +9,6 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-}-{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RoleAnnotations #-}@@ -18,6 +17,8 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE PolyKinds #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE InstanceSigs #-}  #ifdef USE_REFLEX_OPTIMIZER@@ -37,7 +38,10 @@ import Control.Monad.Exception import Control.Monad.Identity hiding (forM, forM_, mapM, mapM_) import Control.Monad.Primitive-import Control.Monad.Reader hiding (forM, forM_, mapM, mapM_)+--import Control.Monad.Reader hiding (forM, forM_, mapM, mapM_)+import Control.Monad.Reader.Class+import Control.Monad.IO.Class+import Control.Monad.ReaderIO import Control.Monad.Ref import Data.Align import Data.Coerce@@ -68,6 +72,12 @@ import System.Mem.Weak import Unsafe.Coerce +#if defined(MIN_VERSION_semialign)+#if MIN_VERSION_these(0,8,0)+import Data.These.Combinators (justThese)+#endif+#endif+ #ifdef DEBUG_CYCLES import Control.Monad.State hiding (forM, forM_, mapM, mapM_, sequence) import Data.List.NonEmpty (NonEmpty (..), nonEmpty)@@ -545,6 +555,11 @@ toAny :: a -> Any toAny = unsafeCoerce +-- Why do we use Any here, instead of just giving eventSubscribedRetained an+-- existential type? Sadly, GHC does not currently know how to unbox types+-- with existentially quantified fields. So instead we just coerce values+-- to type Any on the way in. Since we never coerce them back, this is+-- perfectly safe. data EventSubscribed x = EventSubscribed   { eventSubscribedHeightRef :: {-# UNPACK #-} !(IORef Height)   , eventSubscribedRetained :: {-# NOUNPACK #-} !Any@@ -668,7 +683,7 @@         wi <- liftIO $ mkWeakPtrWithDebug i "InvalidatorPull"         parentsRef <- liftIO $ newIORef []         holdInits <- askBehaviorHoldInits-        a <- liftIO $ runReaderT (unBehaviorM $ pullCompute p) (Just (wi, parentsRef), holdInits)+        a <- liftIO $ runReaderIO (unBehaviorM $ pullCompute p) (Just (wi, parentsRef), holdInits)         invsRef <- liftIO . newIORef . maybeToList =<< askInvalidator         parents <- liftIO $ readIORef parentsRef         let subscribed = PullSubscribed@@ -703,42 +718,46 @@ -- Dynamic -------------------------------------------------------------------------------- -data Dynamic x p = Dynamic-  { dynamicCurrent :: !(Behavior x (PatchTarget p))+type DynamicS x p = Dynamic x (PatchTarget p) p++data Dynamic x target p = Dynamic+  { dynamicCurrent :: !(Behavior x target)   , dynamicUpdated :: Event x p -- This must be lazy; see the comment on holdEvent --TODO: Would this let us eliminate `Dyn`?   } -dynamicHold :: Hold x p -> Dynamic x p+deriving instance (HasSpiderTimeline x) => Functor (Dynamic x target)+++++dynamicHold :: Hold x p -> DynamicS x p dynamicHold !h = Dynamic   { dynamicCurrent = behaviorHold h   , dynamicUpdated = eventHold h   } -dynamicHoldIdentity :: Hold x (Identity a) -> Dynamic x (Identity a)+dynamicHoldIdentity :: Hold x (Identity a) -> DynamicS x (Identity a) dynamicHoldIdentity = dynamicHold -dynamicConst :: PatchTarget p -> Dynamic x p+dynamicConst :: PatchTarget p -> DynamicS x p dynamicConst !a = Dynamic   { dynamicCurrent = behaviorConst a   , dynamicUpdated = eventNever   } -dynamicDyn :: (HasSpiderTimeline x, Patch p) => Dyn x p -> Dynamic x p+dynamicDyn :: (HasSpiderTimeline x, Patch p) => Dyn x p -> DynamicS x p dynamicDyn !d = Dynamic   { dynamicCurrent = behaviorDyn d   , dynamicUpdated = eventDyn d   } -dynamicDynIdentity :: HasSpiderTimeline x => Dyn x (Identity a) -> Dynamic x (Identity a)+dynamicDynIdentity :: HasSpiderTimeline x => Dyn x (Identity a) -> DynamicS x (Identity a) dynamicDynIdentity = dynamicDyn  -------------------------------------------------------------------------------- -- Combinators -------------------------------------------------------------------------------- ---TODO: Figure out why certain things are not 'representational', then make them---representational so we can use coerce- --type role Hold representational data Hold x p    = Hold { holdValue :: !(IORef (PatchTarget p))@@ -759,20 +778,25 @@  -- | Stores all global data relevant to a particular Spider timeline; only one -- value should exist for each type @x@-data SpiderTimelineEnv x = SpiderTimelineEnv+newtype SpiderTimelineEnv x = STE {unSTE :: SpiderTimelineEnv' x}+-- We implement SpiderTimelineEnv with a newtype wrapper so+-- we can get the coercions we want safely.+type role SpiderTimelineEnv nominal++data SpiderTimelineEnv' x = SpiderTimelineEnv   { _spiderTimeline_lock :: {-# UNPACK #-} !(MVar ())   , _spiderTimeline_eventEnv :: {-# UNPACK #-} !(EventEnv x) #ifdef DEBUG   , _spiderTimeline_depth :: {-# UNPACK #-} !(IORef Int) #endif   }-type role SpiderTimelineEnv nominal+type role SpiderTimelineEnv' phantom  instance Eq (SpiderTimelineEnv x) where   _ == _ = True -- Since only one exists of each type  instance GEq SpiderTimelineEnv where-  a `geq` b = if _spiderTimeline_lock a == _spiderTimeline_lock b+  a `geq` b = if _spiderTimeline_lock (unSTE a) == _spiderTimeline_lock (unSTE b)               then Just $ unsafeCoerce Refl -- This unsafeCoerce is safe because the same SpiderTimelineEnv can't have two different 'x' arguments               else Nothing @@ -795,7 +819,7 @@ runEventM = unEventM  asksEventEnv :: forall x a. HasSpiderTimeline x => (EventEnv x -> a) -> EventM x a-asksEventEnv f = return $ f $ _spiderTimeline_eventEnv (spiderTimeline :: SpiderTimelineEnv x)+asksEventEnv f = return $ f $ _spiderTimeline_eventEnv (unSTE (spiderTimeline :: SpiderTimelineEnv x))  class MonadIO m => Defer a m where   getDeferralQueue :: m (IORef [a])@@ -933,9 +957,9 @@  type BehaviorEnv x = (Maybe (Weak (Invalidator x), IORef [SomeBehaviorSubscribed x]), IORef [SomeHoldInit x]) ---type role BehaviorM representational -- BehaviorM can sample behaviors-newtype BehaviorM x a = BehaviorM { unBehaviorM :: ReaderT (BehaviorEnv x) IO a } deriving (Functor, Applicative, MonadIO, MonadFix)+newtype BehaviorM x a = BehaviorM { unBehaviorM :: ReaderIO (BehaviorEnv x) a }+  deriving (Functor, Applicative, MonadIO, MonadFix, MonadReader (BehaviorEnv x))  instance Monad (BehaviorM x) where   {-# INLINE (>>=) #-}@@ -1139,17 +1163,21 @@   align ea eb = mapMaybe dmapToThese $ mergeG coerce $ dynamicConst $      DMap.fromDistinctAscList [LeftTag :=> ea, RightTag :=> eb] +#if defined(MIN_VERSION_semialign)+  zip x y = mapMaybe justThese $ align x y+#endif+ data DynType x p = UnsafeDyn !(BehaviorM x (PatchTarget p), Event x p)                  | BuildDyn  !(EventM x (PatchTarget p), Event x p)                  | HoldDyn   !(Hold x p)  newtype Dyn (x :: Type) p = Dyn { unDyn :: IORef (DynType x p) } -newMapDyn :: HasSpiderTimeline x => (a -> b) -> Dynamic x (Identity a) -> Dynamic x (Identity b)+newMapDyn :: HasSpiderTimeline x => (a -> b) -> DynamicS x (Identity a) -> DynamicS x (Identity b) newMapDyn f d = dynamicDynIdentity $ unsafeBuildDynamic (fmap f $ readBehaviorTracked $ dynamicCurrent d) (Identity . f . runIdentity <$> dynamicUpdated d)  --TODO: Avoid the duplication between this and R.zipDynWith-zipDynWith :: HasSpiderTimeline x => (a -> b -> c) -> Dynamic x (Identity a) -> Dynamic x (Identity b) -> Dynamic x (Identity c)+zipDynWith :: HasSpiderTimeline x => (a -> b -> c) -> DynamicS x (Identity a) -> DynamicS x (Identity b) -> DynamicS x (Identity c) zipDynWith f da db =   let eab = align (dynamicUpdated da) (dynamicUpdated db)       ec = flip push eab $ \o -> do@@ -1225,7 +1253,7 @@ run roots after = do   tracePropagate (Proxy :: Proxy x) $ "Running an event frame with " <> show (length roots) <> " events"   let t = spiderTimeline :: SpiderTimelineEnv x-  result <- SpiderHost $ withMVar (_spiderTimeline_lock t) $ \_ -> unSpiderHost $ runFrame $ do+  result <- SpiderHost $ withMVar (_spiderTimeline_lock (unSTE t)) $ \_ -> unSpiderHost $ runFrame $ do     rootsToPropagate <- forM roots $ \r@(RootTrigger (_, occRef, k) :=> a) -> do       occBefore <- liftIO $ do         occBefore <- readIORef occRef@@ -1289,9 +1317,9 @@ withIncreasedDepth :: CanTrace x m => m a -> m a withIncreasedDepth a = do   spiderTimeline <- askSpiderTimelineEnv-  liftIO $ modifyIORef' (_spiderTimeline_depth spiderTimeline) succ+  liftIO $ modifyIORef' (_spiderTimeline_depth (unSTE spiderTimeline)) succ   result <- a-  liftIO $ modifyIORef' (_spiderTimeline_depth spiderTimeline) pred+  liftIO $ modifyIORef' (_spiderTimeline_depth (unSTE spiderTimeline)) pred   return result #else withIncreasedDepth :: m a -> m a@@ -1318,7 +1346,7 @@   message <- getMessage #ifdef DEBUG   spiderTimeline <- askSpiderTimelineEnv-  d <- liftIO $ readIORef $ _spiderTimeline_depth spiderTimeline+  d <- liftIO $ readIORef $ _spiderTimeline_depth $ unSTE spiderTimeline #else   let d = 0 #endif@@ -1359,25 +1387,25 @@ data SomeResetCoincidence x = forall a. SomeResetCoincidence !(EventSubscription x) !(Maybe (CoincidenceSubscribed x a)) -- The CoincidenceSubscriber will be present only if heights need to be reset  runBehaviorM :: BehaviorM x a -> Maybe (Weak (Invalidator x), IORef [SomeBehaviorSubscribed x]) -> IORef [SomeHoldInit x] -> IO a-runBehaviorM a mwi holdInits = runReaderT (unBehaviorM a) (mwi, holdInits)+runBehaviorM a mwi holdInits = runReaderIO (unBehaviorM a) (mwi, holdInits)  askInvalidator :: BehaviorM x (Maybe (Weak (Invalidator x))) askInvalidator = do-  (!m, _) <- BehaviorM ask+  (!m, _) <- ask   case m of     Nothing -> return Nothing     Just (!wi, _) -> return $ Just wi  askParentsRef :: BehaviorM x (Maybe (IORef [SomeBehaviorSubscribed x])) askParentsRef = do-  (!m, _) <- BehaviorM ask+  (!m, _) <- ask   case m of     Nothing -> return Nothing     Just (_, !p) -> return $ Just p  askBehaviorHoldInits :: BehaviorM x (IORef [SomeHoldInit x]) askBehaviorHoldInits = do-  (_, !his) <- BehaviorM ask+  (_, !his) <- ask   return his  {-# INLINE getDynHold #-}@@ -1701,20 +1729,20 @@ {-# INLINE mergeG #-} mergeG :: forall k q x v. (HasSpiderTimeline x, GCompare k)   => (forall a. q a -> Event x (v a))-  -> Dynamic x (PatchDMap k q) -> Event x (DMap k v)+  -> DynamicS x (PatchDMap k q) -> Event x (DMap k v) mergeG nt d = cacheEvent (mergeCheap nt d)  {-# INLINE mergeWithMove #-} mergeWithMove :: forall k v q x. (HasSpiderTimeline x, GCompare k)   => (forall a. q a -> Event x (v a))-  -> Dynamic x (PatchDMapWithMove k q) -> Event x (DMap k v)+  -> DynamicS x (PatchDMapWithMove k q) -> Event x (DMap k v) mergeWithMove nt d = cacheEvent (mergeCheapWithMove nt d)  {-# INLINE [1] mergeCheap #-} mergeCheap   :: forall k x q v. (HasSpiderTimeline x, GCompare k)   => (forall a. q a -> Event x (v a))-  -> Dynamic x (PatchDMap k q)+  -> DynamicS x (PatchDMap k q)   -> Event x (DMap k v) mergeCheap nt = mergeGCheap' getInitialSubscribers updateMe destroy   where@@ -1742,7 +1770,7 @@           let s = subscriber $ return k           (subscription@(EventSubscription _ parentSubd), parentOcc) <- subscribeAndRead (nt e) s           height <- liftIO $ getEventSubscribedHeight parentSubd-          return (fmap (\x -> k :=> x) parentOcc, height, k :=> MergeSubscribedParent subscription)+          return (fmap (k :=>) parentOcc, height, k :=> MergeSubscribedParent subscription)         return ( DMap.fromDistinctAscList $ mapMaybe (\(x, _, _) -> x) subscribers                , fmap (\(_, h, _) -> h) subscribers --TODO: Assert that there's no invalidHeight in here                , DMap.fromDistinctAscList $ map (\(_, _, x) -> x) subscribers@@ -1754,7 +1782,7 @@ {-# INLINE [1] mergeCheapWithMove #-} mergeCheapWithMove :: forall k x v q. (HasSpiderTimeline x, GCompare k)   => (forall a. q a -> Event x (v a))-  -> Dynamic x (PatchDMapWithMove k q)+  -> DynamicS x (PatchDMapWithMove k q)   -> Event x (DMap k v) mergeCheapWithMove nt = mergeGCheap' getInitialSubscribers updateMe destroy   where@@ -1790,7 +1818,7 @@           let s = subscriber $ liftIO $ readIORef keyRef           (subscription@(EventSubscription _ parentSubd), parentOcc) <- subscribeAndRead (nt e) s           height <- liftIO $ getEventSubscribedHeight parentSubd-          return (fmap (\x -> k :=> x) parentOcc, height, k :=> MergeSubscribedParentWithMove subscription keyRef)+          return (fmap (k :=>) parentOcc, height, k :=> MergeSubscribedParentWithMove subscription keyRef)         return ( DMap.fromDistinctAscList $ mapMaybe (\(x, _, _) -> x) subscribers                , fmap (\(_, h, _) -> h) subscribers --TODO: Assert that there's no invalidHeight in here                , DMap.fromDistinctAscList $ map (\(_, _, x) -> x) subscribers@@ -1902,7 +1930,7 @@  {-# INLINE mergeGCheap' #-} mergeGCheap' :: forall k v x p s q. (HasSpiderTimeline x, GCompare k, PatchTarget p ~ DMap k q)-  => MergeInitFunc k v q x s -> MergeUpdateFunc k v x p s -> MergeDestroyFunc k s -> Dynamic x p -> Event x (DMap k v)+  => MergeInitFunc k v q x s -> MergeUpdateFunc k v x p s -> MergeDestroyFunc k s -> DynamicS x p -> Event x (DMap k v) mergeGCheap' getInitialSubscribers updateFunc destroy d = Event $ \sub -> do   initialParents <- readBehaviorUntracked $ dynamicCurrent d   accumRef <- liftIO $ newIORef $ error "merge: accumRef not yet initialized"@@ -1951,11 +1979,11 @@          , occ          ) -mergeInt :: forall x a. (HasSpiderTimeline x) => Dynamic x (PatchIntMap (Event x a)) -> Event x (IntMap a)+mergeInt :: forall x a. (HasSpiderTimeline x) => DynamicS x (PatchIntMap (Event x a)) -> Event x (IntMap a) mergeInt = cacheEvent . mergeIntCheap  {-# INLINABLE mergeIntCheap #-}-mergeIntCheap :: forall x a. (HasSpiderTimeline x) => Dynamic x (PatchIntMap (Event x a)) -> Event x (IntMap a)+mergeIntCheap :: forall x a. (HasSpiderTimeline x) => DynamicS x (PatchIntMap (Event x a)) -> Event x (IntMap a) mergeIntCheap d = Event $ \sub -> do   initialParents <- readBehaviorUntracked $ dynamicCurrent d   accum <- liftIO $ FastMutableIntMap.newEmpty@@ -2115,7 +2143,7 @@ -- | Run an event action outside of a frame runFrame :: forall x a. HasSpiderTimeline x => EventM x a -> SpiderHost x a --TODO: This function also needs to hold the mutex runFrame a = SpiderHost $ do-  let env = _spiderTimeline_eventEnv (spiderTimeline :: SpiderTimelineEnv x)+  let env = _spiderTimeline_eventEnv $ unSTE (spiderTimeline :: SpiderTimelineEnv x)   let go = do         result <- a         runHoldInits (eventEnvHoldInits env) (eventEnvDynInits env) (eventEnvMergeInits env) -- This must happen before doing the assignments, in case subscribing a Hold causes existing Holds to be read by the newly-propagated events@@ -2326,7 +2354,7 @@   fail _ = error "Dynamic does not support 'fail'"  {-# INLINABLE newJoinDyn #-}-newJoinDyn :: HasSpiderTimeline x => Reflex.Spider.Internal.Dynamic x (Identity (Reflex.Spider.Internal.Dynamic x (Identity a))) -> Reflex.Spider.Internal.Dyn x (Identity a)+newJoinDyn :: HasSpiderTimeline x => DynamicS x (Identity (DynamicS x (Identity a))) -> Reflex.Spider.Internal.Dyn x (Identity a) newJoinDyn d =   let readV0 = readBehaviorTracked . dynamicCurrent =<< readBehaviorTracked (dynamicCurrent d)       eOuter = Reflex.Spider.Internal.push (fmap (Just . Identity) . readBehaviorUntracked . dynamicCurrent . runIdentity) $ dynamicUpdated d@@ -2476,7 +2504,7 @@ #ifdef DEBUG   depthRef <- newIORef 0 #endif-  return $ SpiderTimelineEnv+  return $ STE $ SpiderTimelineEnv     { _spiderTimeline_lock = lock     , _spiderTimeline_eventEnv = env #ifdef DEBUG@@ -2492,13 +2520,13 @@  instance Reifies s (SpiderTimelineEnv x) =>          HasSpiderTimeline (LocalSpiderTimeline x s) where-  spiderTimeline = localSpiderTimeline (Proxy :: Proxy s) $ reflect (Proxy :: Proxy s)+  spiderTimeline = localSpiderTimeline Proxy $ reflect (Proxy :: Proxy s)  localSpiderTimeline-  :: Proxy s+  :: proxy s   -> SpiderTimelineEnv x   -> SpiderTimelineEnv (LocalSpiderTimeline x s)-localSpiderTimeline _ = unsafeCoerce+localSpiderTimeline _ = coerce  -- | Pass a new timeline to the given function. withSpiderTimeline :: (forall x. HasSpiderTimeline x => SpiderTimelineEnv x -> IO r) -> IO r@@ -2516,8 +2544,8 @@   {-# SPECIALIZE instance R.Reflex (SpiderTimeline Global) #-}   newtype Behavior (SpiderTimeline x) a = SpiderBehavior { unSpiderBehavior :: Behavior x a }   newtype Event (SpiderTimeline x) a = SpiderEvent { unSpiderEvent :: Event x a }-  newtype Dynamic (SpiderTimeline x) a = SpiderDynamic { unSpiderDynamic :: Dynamic x (Identity a) } -- deriving (Functor, Applicative, Monad)-  newtype Incremental (SpiderTimeline x) p = SpiderIncremental { unSpiderIncremental :: Dynamic x p }+  newtype Dynamic (SpiderTimeline x) a = SpiderDynamic { unSpiderDynamic :: DynamicS x (Identity a) } -- deriving (Functor, Applicative, Monad)+  newtype Incremental (SpiderTimeline x) p = SpiderIncremental { unSpiderIncremental :: DynamicS x p }   type PullM (SpiderTimeline x) = SpiderPullM x   type PushM (SpiderTimeline x) = SpiderPushM x   {-# INLINABLE never #-}@@ -2546,7 +2574,7 @@   {-# INLINABLE current #-}   current = SpiderBehavior . dynamicCurrent . unSpiderDynamic   {-# INLINABLE updated #-}-  updated = coerce $ SpiderEvent . dynamicUpdated . unSpiderDynamic+  updated = SpiderEvent #. dynamicUpdated .# fmap coerce . unSpiderDynamic   {-# INLINABLE unsafeBuildDynamic #-}   unsafeBuildDynamic readV0 v' = SpiderDynamic $ dynamicDynIdentity $ unsafeBuildDynamic (coerce readV0) $ coerce $ unSpiderEvent v'   {-# INLINABLE unsafeBuildIncremental #-}@@ -2565,9 +2593,10 @@     return $ Identity <$> apply p c --TODO: Avoid the redundant 'apply'   eventCoercion Coercion = Coercion   behaviorCoercion Coercion = Coercion-  dynamicCoercion = unsafeCoerce --TODO: How can we avoid this unsafeCoerce?  This is safe only because we know how Identity works as a Patch instance+  dynamicCoercion Coercion = Coercion+  incrementalCoercion Coercion Coercion = Coercion   {-# INLINABLE mergeIntIncremental #-}-  mergeIntIncremental = SpiderEvent . mergeInt . (unsafeCoerce :: Dynamic x (PatchIntMap (R.Event (SpiderTimeline x) a)) -> Dynamic x (PatchIntMap (Event x a))) . unSpiderIncremental+  mergeIntIncremental = SpiderEvent . mergeInt . coerce   {-# INLINABLE fanInt #-}   fanInt e = R.EventSelectorInt $ SpiderEvent . selectInt (fanInt (unSpiderEvent e))
src/Reflex/TriggerEvent/Class.hs view
@@ -2,7 +2,6 @@ -- new 'Event's that can be triggered from 'IO'. {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE UndecidableInstances #-} module Reflex.TriggerEvent.Class   ( TriggerEvent (..)
test/EventWriterT.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-}@@ -13,6 +14,10 @@ import qualified Data.Map as M import Data.These +#if defined(MIN_VERSION_these_lens) || (MIN_VERSION_these(0,8,0) && !MIN_VERSION_these(0,9,0))+import Data.These.Lens+#endif+ import Reflex import Reflex.EventWriter.Base import Test.Run@@ -48,16 +53,13 @@   return e  testOrdering :: (Reflex t, Monad m) => Event t () -> EventWriterT t [Int] m ()-testOrdering pulse = do-  forM_ [10,9..1] $ \i -> tellEvent ([i] <$ pulse)-  return ()+testOrdering pulse = forM_ [10,9..1] $ \i -> tellEvent ([i] <$ pulse)  testSimultaneous :: (Reflex t, Adjustable t m, MonadHold t m) => Event t (These () ()) -> EventWriterT t [Int] m () testSimultaneous pulse = do   let e0 = fmapMaybe (^? here) pulse       e1 = fmapMaybe (^? there) pulse   forM_ [1,3..9] $ \i -> runWithReplace (tellEvent ([i] <$ e0)) $ ffor e1 $ \_ -> tellEvent ([i+1] <$ e0)-  return ()  -- | Test that a widget telling and event which fires at the same time it has been replaced -- doesn't count along with the new widget.
test/QueryT.hs view
@@ -19,6 +19,10 @@ import Data.Semigroup import Data.These +#if defined(MIN_VERSION_these_lens) || (MIN_VERSION_these(0,8,0) && !MIN_VERSION_these(0,9,0))+import Data.These.Lens+#endif+ import Reflex import Reflex.Patch.MapWithMove import Test.Run
test/Reflex/Bench/Focused.hs view
@@ -130,6 +130,16 @@ joinDynChain :: (Reflex t, MonadHold t m) => Word -> Dynamic t Word -> m (Dynamic t Word) joinDynChain = iterM (\d -> return $ join $ fmap (const d) d) +holdDynChain :: (Reflex t, MonadHold t m) => Word -> Dynamic t Word -> m (Dynamic t Word)+holdDynChain = iterM (\d -> sample (current d) >>= flip holdDyn (updated d))++buildDynChain :: (Reflex t, MonadHold t m) => Word -> Dynamic t Word -> m (Dynamic t Word)+buildDynChain = iterM (\d -> do +    let b = fmap (+1) (current d)+        e = fmap (*2) (updated d)+    buildDynamic (sample b) e)++ combineDynChain :: (Reflex t, MonadHold t m) => Word -> Dynamic t Word -> m (Dynamic t Word) combineDynChain = iterM (\d -> return $ zipDynWith (+) d d) @@ -308,6 +318,8 @@ dynamics n =   [ testE "mapDynChain"         $ fmap updated $ mapDynChain n =<< d   , testE "joinDynChain"        $ fmap updated $ joinDynChain n =<< d+  , testE "holdDynChain"        $ fmap updated $ holdDynChain n =<< d+  , testE "buildDynChain"        $ fmap updated $ buildDynChain n =<< d   , testE "combineDynChain"     $ fmap updated $ combineDynChain n =<< d   , testE "dense mergeTree"     $ fmap (updated . mergeTreeDyn 8) dense   , testE "sparse mergeTree"    $ fmap (updated . mergeTreeDyn 8) sparse
test/Reflex/Test/CrossImpl.hs view
@@ -218,6 +218,11 @@        bb <- hold b $ pushAlways (const $ hold "asdf" eo) eo        let b' = pull $ sample =<< sample bb        return (b', e)+  , (,) "foldDynWhileFiring" $ TestCase (Map.singleton 0 "zxc", Map.fromList [(1, "qwer"), (2, "lkj")]) $ \(_, e) -> do+       d <- foldDyn (:) [] $+         pushAlways (\a -> foldDyn (:) [a] e) e+       let b = current (join (fmap distributeListOverDynPure d))+       return (b, e)   , (,) "joinDyn" $ TestCase (Map.singleton 0 (0 :: Int), Map.fromList [(1, "qwer"), (2, "lkj")]) $ \(b, e) -> do        bb <- hold "b" e        bd <- hold never . fmap (const e) =<< headE e
test/RequesterT.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-}@@ -14,6 +15,10 @@ import Data.Functor.Misc import qualified Data.Map as M import Data.These++#if defined(MIN_VERSION_these_lens) || (MIN_VERSION_these(0,8,0) && !MIN_VERSION_these(0,9,0))+import Data.These.Lens+#endif  import Reflex import Reflex.Requester.Base
test/hlint.hs view
@@ -22,6 +22,7 @@         , "--ignore=Use unless"         , "--ignore=Reduce duplication"         , "--cpp-define=USE_TEMPLATE_HASKELL"+        , "--ignore=Use tuple-section"         ]       recurseInto = and <$> sequence         [ fileType ==? Directory