transient 0.5.9.1 → 0.5.9.2

raw patch · 2 files changed

+45/−37 lines, 2 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• src/Transient/Internals.hs +44/−36
• transient.cabal +1/−1

@@ -987,7 +987,7 @@          $ \me -> do             case  me of-            Left e -> exceptBack cont e >> return ()+            Left e -> exceptBack cont e >> return ()     !> "exceptBack 2"        @@ -1243,7 +1243,7 @@ -- | Runs the transient computation in a child thread and keeps the main thread -- running until all the user threads exit or some thread invokes 'exit'. ----- The main thread provides facilities to accept keyboard input in a+-- The main thread provides facilities for accepting keyboard input in a -- non-blocking but line-oriented manner. The program reads the standard input -- and feeds it to all the async input consumers (e.g. 'option' and 'input'). -- All async input consumers contend for each line entered on the standard@@ -1259,7 +1259,7 @@ -- provided by transient. -- -- A built-in interactive command handler also reads the stdin asynchronously.--- All available commands handled by the command handler are displayed when the+-- All available options waiting for input are displayed when the -- program is run.  The following commands are available: -- -- 1. @ps@: show threads@@ -1330,7 +1330,7 @@               setData $ Exit rexit               mx -           return ()+           return ()     threadDelay 10000    forkIO $ execCommandLine    stay rexit@@ -1398,7 +1398,7 @@ {-# NOINLINE onBack #-} onBack :: (Typeable b, Show b) => TransientIO a -> ( b -> TransientIO a) -> TransientIO a onBack ac bac = registerBack (typeof bac) $ Transient $ do-     Backtrack mreason stack  <- getData `onNothing` backStateOf (typeof bac)+     Backtrack mreason stack  <- getData `onNothing` (return $ backStateOf (typeof bac))      runTrans $ case mreason of                   Nothing     -> ac                   Just reason -> do@@ -1421,18 +1421,18 @@ {-# NOINLINE registerUndo #-} registerBack :: (Typeable b, Show b) => b -> TransientIO a -> TransientIO a registerBack witness f  = Transient $ do-   cont@(EventF  _ x _ _ _ _ _ _ _ _ _)  <- get   -- !!> "backregister"--   md <- getData `asTypeOf` (Just <$> backStateOf witness)+   cont@(EventF _ x  _ _ _ _ _ _ _ _ _)  <- get + -- if isJust (event cont) then return Nothing else do +   md <- getData `asTypeOf` (Just <$> return (backStateOf witness))     case md of         Just (Backtrack b []) ->  setData $ Backtrack b  [cont]         Just (bss@(Backtrack b (bs@((EventF _ x'  _ _ _ _ _ _ _ _ _):_)))) ->-          --  when (isNothing b) $ do-          --      addrx  <- addr x-          --      addrx' <- addr x'         -- to avoid duplicate backtracking points-          --      setData $ if addrx == addrx' then bss else  Backtrack mwit (cont:bs)-               setData $ Backtrack b (cont:bs)+          when (isNothing b) $ do+                addrx  <- addr x+                addrx' <- addr x'         -- to avoid duplicate backtracking points+                setData $ if addrx == addrx' then bss else  Backtrack b (cont:bs)+               --setData $ Backtrack b (cont:bs)          Nothing ->  setData $ Backtrack mwit [cont] @@ -1454,7 +1454,7 @@ -- forward :: (Typeable b, Show b) => b -> TransIO () forward reason= Transient $ do-    Backtrack _ stack <- getData `onNothing`  (backStateOf reason)+    Backtrack _ stack <- getData `onNothing`  ( return $ backStateOf reason)     setData $ Backtrack(Nothing `asTypeOf` Just reason)  stack     return $ Just () @@ -1474,31 +1474,31 @@ -- back :: (Typeable b, Show b) => b -> TransientIO a back reason = Transient $ do-  bs <- getData  `onNothing`  backStateOf  reason           -  goBackt  bs                                                   -- !!>"GOBACK"+  bs <- getData  `onNothing`  return (backStateOf  reason)           +  goBackt  bs                                                    !>"GOBACK"    where -  goBackt (Backtrack _ [] )= return Nothing                      -- !!> "END"+  goBackt (Backtrack _ [] )= return Nothing                         goBackt (Backtrack b (stack@(first : bs)) )= do         setData $ Backtrack (Just reason) stack -        mr <-  runClosure first                                  -- !> ("RUNCLOSURE",length stack)+        mr <-  runClosure first                                 --  !> ("RUNCLOSURE",length stack) -        Backtrack back _ <- getData `onNothing`  backStateOf  reason-                                                                 -- !> "END RUNCLOSURE"+        Backtrack back _ <- getData `onNothing`  return (backStateOf  reason)+                                                                --  !> "END RUNCLOSURE"          case mr of-           Nothing -> return Nothing                                     --  !> "END EXECUTION"+           Nothing -> return Nothing                                  --     !> "END EXECUTION"            Just x -> case back of-                 Nothing -> runContinuation first x                    --  !> "FORWARD EXEC"+                 Nothing -> runContinuation first x                   --     !> "FORWARD EXEC"                  justreason ->do                         setData $ Backtrack justreason bs-                        goBackt $ Backtrack justreason bs-                        return Nothing       --  !> ("BACK AGAIN",back)+                        goBackt $ Backtrack justreason bs      !> ("BACK AGAIN",back)+                        return Nothing       -backStateOf :: (Monad m, Show a, Typeable a) => a -> m (Backtrack a)-backStateOf reason= return $ Backtrack (Nothing `asTypeOf` (Just reason)) []+backStateOf :: (Show a, Typeable a) => a -> Backtrack a+backStateOf reason= Backtrack (Nothing `asTypeOf` (Just reason)) []  -- | 'back' for the default undo track; equivalent to @back ()@. --@@ -1569,15 +1569,16 @@        Just e'  -> f e'   where   onAnyException :: TransIO a -> (SomeException ->TransIO a) -> TransIO a-  onAnyException mx f= ioexp  `onBack` f+  onAnyException mx f= ioexp f  `onBack` f -  ioexp  = Transient $ do+  ioexp  f = Transient $ do     st <- get-    (mx,st') <- liftIO $ (runStateT (do+    (mx,st') <- liftIO $ (runStateT +      (do          case event st of            Nothing -> do-                r <- runTrans   mx  -- !> "mx"+                r <- runTrans   mx                    modify $ \s -> s{event= Just $ unsafeCoerce r}                 @@ -1591,17 +1592,24 @@           Just r -> do                 modify $ \s ->  s{event=Nothing}                   return  $ unsafeCoerce r) st)-                   `catch` exceptBack st+                   `catch` exceptBack st      put st'     return mx      exceptBack st = \(e ::SomeException) -> do  -- recursive catch itself-                      -- return () !> "CATCH"                        runStateT ( runTrans $  back e ) st-                `catch` exceptBack st-+                  `catch` exceptBack (stex st) -  +   where+   -- drop the current exception handler from the stack+   stex st = +        let list = mfData st+            emptyback=backStateOf(undefined :: SomeException)+            Backtrack b stack = case M.lookup (typeOf  emptyback) list of+                              Just x  -> unsafeCoerce x+                              Nothing -> emptyback+       +        in st { mfData = M.insert (typeOf emptyback) (unsafeCoerce $ Backtrack b $ tail stack) (mfData st) }  -- | Delete all the exception handlers registered till now. cutExceptions :: TransIO ()@@ -1627,7 +1635,7 @@          return r    where    sandbox  mx= do-     exState <- getState <|> backStateOf (undefined :: SomeException)+     exState <- getState <|> return (backStateOf (undefined :: SomeException))      mx        <*** do setState exState  

@@ -1,5 +1,5 @@ name: transient-version: 0.5.9.1+version: 0.5.9.2 author: Alberto G. Corona extra-source-files:     ChangeLog.md README.md