packages feed

reflex 0.3 → 0.3.1

raw patch · 5 files changed

+112/−12 lines, 5 filesdep +haskell-src-extsdep +haskell-src-metadep +syb

Dependencies added: haskell-src-exts, haskell-src-meta, syb

Files

reflex.cabal view
@@ -1,5 +1,5 @@ Name: reflex-Version: 0.3+Version: 0.3.1 Synopsis: Higher-order Functional Reactive Programming Description: Reflex is a high-performance, deterministic, higher-order Functional Reactive Programming system License: BSD3@@ -22,13 +22,16 @@     semigroups == 0.16.*,     mtl >= 2.1 && < 2.3,     containers == 0.5.*,-    these == 0.4.*,+    these >= 0.4 && < 0.7,     primitive >= 0.5 && < 0.7,     template-haskell >= 2.9 && < 2.11,     ref-tf == 0.4.*,     exception-transformers == 0.4.*,     transformers >= 0.2,-    transformers-compat >= 0.3+    transformers-compat >= 0.3,+    haskell-src-exts == 1.16.*,+    haskell-src-meta == 0.6.*,+    syb == 0.5.*    exposed-modules:     Reflex,
src/Reflex/Dynamic.hs view
@@ -17,6 +17,8 @@                       , mapDynM                       , foldDyn                       , foldDynM+                      , foldDynMaybe+                      , foldDynMaybeM                       , combineDyn                       , collectDyn                       , mconcatDyn
src/Reflex/Dynamic/TH.hs view
@@ -1,11 +1,17 @@ {-# LANGUAGE TemplateHaskell, ScopedTypeVariables, TypeOperators, GADTs, EmptyDataDecls, PatternGuards #-}-module Reflex.Dynamic.TH (qDyn, unqDyn) where+module Reflex.Dynamic.TH (qDyn, unqDyn, mkDyn) where  import Reflex.Dynamic  import Language.Haskell.TH+import qualified Language.Haskell.TH.Syntax as TH+import Language.Haskell.TH.Quote import Data.Data import Control.Monad.State+import qualified Language.Haskell.Exts as Hs+import qualified Language.Haskell.Meta.Syntax.Translate as Hs+import Data.Monoid+import Data.Generics  -- | Quote a Dynamic expression.  Within the quoted expression, you can use '$(unqDyn [| x |])' to refer to any expression 'x' of type 'Dynamic t a'; the unquoted result will be of type 'a' qDyn :: Q Exp -> Q Exp@@ -36,3 +42,26 @@ --TODO: It would be much nicer if the TH AST was extensible to support this kind of thing without trickery unqMarker :: a -> UnqDyn unqMarker = error "An unqDyn expression was used outside of a qDyn expression"++mkDyn :: QuasiQuoter+mkDyn = QuasiQuoter+  { quoteExp = mkDynExp+  , quotePat = error "mkDyn: pattern splices are not supported"+  , quoteType = error "mkDyn: type splices are not supported"+  , quoteDec = error "mkDyn: declaration splices are not supported"+  }++mkDynExp :: String -> Q Exp+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 -> 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+          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+          reinstateUnqDyn (TH.Name (TH.OccName occName') (TH.NameQ (TH.ModName modName')))+            | modName == modName' && occName == occName' = 'unqMarker+          reinstateUnqDyn x = x
src/Reflex/Host/Class.hs view
@@ -4,6 +4,7 @@ import Reflex.Class  import Control.Applicative+import Control.Monad import Control.Monad.Fix import Control.Monad.Trans import Control.Monad.Trans.Reader (ReaderT())@@ -12,7 +13,8 @@ import Control.Monad.Trans.Except (ExceptT()) import Control.Monad.Trans.RWS    (RWST()) import Control.Monad.Trans.State  (StateT())-import Data.Dependent.Sum (DSum)+import qualified Control.Monad.Trans.State.Strict as Strict+import Data.Dependent.Sum (DSum (..)) import Data.Monoid import Data.GADT.Compare import Control.Monad.Ref@@ -113,6 +115,25 @@   return (e, rt) {-# INLINE newEventWithTriggerRef #-} +fireEventRef :: (MonadReflexHost t m, MonadRef m, Ref m ~ Ref IO) => Ref m (Maybe (EventTrigger t a)) -> a -> m ()+fireEventRef mtRef input = do+  mt <- readRef mtRef+  case mt of+    Nothing -> return ()+    Just trigger -> fireEvents [trigger :=> input]++fireEventRefAndRead :: (MonadReflexHost t m, MonadRef m, Ref m ~ Ref IO) => Ref m (Maybe (EventTrigger t a)) -> a -> EventHandle t b -> m (Maybe b)+fireEventRefAndRead mtRef input e = do+  mt <- readRef mtRef+  case mt of+    Nothing -> return Nothing -- Since we aren't firing the input, the output can't fire+    Just trigger -> fireEventsAndRead [trigger :=> input] $ do+      mGetValue <- readEvent e+      case mGetValue of+        Nothing -> return Nothing+        Just getValue -> liftM Just getValue++ -------------------------------------------------------------------------------- -- Instances --------------------------------------------------------------------------------@@ -152,6 +173,21 @@   type ReadPhase (StateT s m) = ReadPhase m   fireEventsAndRead dm a = lift $ fireEventsAndRead dm a   runHostFrame = lift . runHostFrame+  +  +instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (Strict.StateT s m) where+  newEventWithTrigger = lift . newEventWithTrigger+  newFanEventWithTrigger initializer = lift $ newFanEventWithTrigger initializer++instance MonadSubscribeEvent t m => MonadSubscribeEvent t (Strict.StateT r m) where+  subscribeEvent = lift . subscribeEvent++instance MonadReflexHost t m => MonadReflexHost t (Strict.StateT s m) where+  type ReadPhase (Strict.StateT s m) = ReadPhase m+  fireEventsAndRead dm a = lift $ fireEventsAndRead dm a+  runHostFrame = lift . runHostFrame  +  +    instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (ContT r m) where   newEventWithTrigger = lift . newEventWithTrigger
test/Reflex/Pure.hs view
@@ -1,6 +1,10 @@-{- | This module provides a pure implementation of Reflex, which is intended to serve as a reference for the semantics of the Reflex class.  All implementations of Reflex should produce the same results as this implementation, although performance and laziness/strictness may differ.+{- | This module provides a pure implementation of Reflex, which is intended+to serve as a reference for the semantics of the Reflex class.  All implementations+of Reflex should produce the same results as this implementation, although performance+and laziness/strictness may differ. -}-{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, EmptyDataDecls #-}++{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, EmptyDataDecls, InstanceSigs #-} module Reflex.Pure where  import Reflex.Class@@ -8,39 +12,65 @@  import Control.Monad import Data.MemoTrie+import Data.Dependent.Map (DMap, GCompare) import qualified Data.Dependent.Map as DMap  data Pure t --- | The Enum instance of t must be dense: for all x :: t, there must not exist any y :: t such that pred x < y < x---   The HasTrie instance will be used exclusively to memoize functions of t, not for any of its other capabilities+-- | The Enum instance of t must be dense: for all x :: t, there must not exist+--   any y :: t such that pred x < y < x. The HasTrie instance will be used exclusively+--   to memoize functions of t, not for any of its other capabilities. instance (Enum t, HasTrie t, Ord t) => Reflex (Pure t) where+   newtype Behavior (Pure t) a = Behavior { unBehavior :: t -> a }-  newtype Event (Pure t) a = Event { unEvent :: t -> Maybe a }+  newtype Event (Pure t) a    = Event { unEvent :: t -> Maybe a }+   type PushM (Pure t) = (->) t   type PullM (Pure t) = (->) t++  never :: Event (Pure t) a   never = Event $ \_ -> Nothing++  constant :: a -> Behavior (Pure t) a   constant x = Behavior $ \_ -> x++  push :: (a -> PushM (Pure t) (Maybe b)) -> Event (Pure t) a -> Event (Pure t) b   push f e = Event $ memo $ \t -> unEvent e t >>= \o -> f o t++  pull :: PullM (Pure t) a -> Behavior (Pure t) a   pull = Behavior . memo++  merge :: GCompare k => DMap (WrapArg (Event (Pure t)) k) -> Event (Pure t) (DMap k)   merge events = Event $ memo $ \t ->     let currentOccurrences = unwrapDMapMaybe (($ t) . unEvent) events     in if DMap.null currentOccurrences        then Nothing        else Just currentOccurrences++  fan :: GCompare k => Event (Pure t) (DMap k) -> EventSelector (Pure t) k   fan e = EventSelector $ \k -> Event $ \t -> unEvent e t >>= DMap.lookup k++  switch :: Behavior (Pure t) (Event (Pure t) a) -> Event (Pure t) a   switch b = Event $ memo $ \t -> unEvent (unBehavior b t) t++  coincidence :: Event (Pure t) (Event (Pure t) a) -> Event (Pure t) a   coincidence e = Event $ memo $ \t -> unEvent e t >>= \o -> unEvent o t  instance Ord t => MonadSample (Pure t) ((->) t) where++  sample :: Behavior (Pure t) a -> (t -> a)   sample = unBehavior  instance (Enum t, HasTrie t, Ord t) => MonadHold (Pure t) ((->) t) where++  hold :: a -> Event (Pure t) a -> (t -> (Behavior (Pure t) a))   hold initialValue e initialTime = Behavior f     where f = memo $ \sampleTime ->-            if sampleTime <= initialTime -- Really, the sampleTime should never be prior to the initialTime, because that would mean the Behavior is being sampled before being created+            -- Really, the sampleTime should never be prior to the initialTime,+            -- because that would mean the Behavior is being sampled before being created.+            if sampleTime <= initialTime             then initialValue             else let lastTime = pred sampleTime                  in case unEvent e lastTime of                    Nothing -> f lastTime-                   Just x -> x+                   Just x  -> x