snap-loader-dynamic 0.10.0.2 → 1.0.0.2
raw patch · 4 files changed
Files
- README.md +5/−5
- snap-loader-dynamic.cabal +17/−15
- src/Snap/Loader/Dynamic.hs +6/−3
- src/Snap/Loader/Dynamic/Evaluator.hs +9/−10
README.md view
@@ -1,11 +1,12 @@ Snap Framework ============== -Snap is a web framework for Haskell, based on iteratee I/O (as [popularized by-Oleg Kiselyov](http://okmij.org/ftp/Streams.html#iteratee)). For more-information about Snap, read the `README.SNAP.md` or visit the Snap project-website at http://www.snapframework.com/.+[](https://travis-ci.org/snapframework/snap-loader-dynamic) +Snap is a simple and fast web development framework and server written in+Haskell. For more information about Snap, read the `README.SNAP.md` or visit+the Snap project website at http://www.snapframework.com/.+ ## Library contents This is utility project for the Snap Framework, which contains a@@ -29,4 +30,3 @@ The haddock documentation can be built using 'cabal haddock'. The docs get put in `dist/doc/html/`.-
snap-loader-dynamic.cabal view
@@ -1,15 +1,16 @@ name: snap-loader-dynamic-version: 0.10.0.2-synopsis: Snap: A Haskell Web Framework: dynamic loader-description: Snap Framework dynamic loader+version: 1.0.0.2+synopsis: Snap dynamic loader+description: Snap Framework dynamic code loader for development mode license: BSD3 license-file: LICENSE author: Carl Howells maintainer: snap@snapframework.com build-type: Simple-cabal-version: >= 1.8+cabal-version: >= 1.10 homepage: http://snapframework.com/ category: Web, Snap+Tested-With: GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.5, GHC == 8.8.4, GHC == 8.10.2 extra-source-files: CONTRIBUTORS,@@ -18,6 +19,7 @@ README.SNAP.md Library+ default-language: Haskell2010 hs-source-dirs: src exposed-modules:@@ -30,38 +32,38 @@ build-depends: base >= 4 && < 5,- directory-tree >= 0.10 && < 0.12,- mtl > 2.0 && < 2.2,- snap-core >= 0.9 && < 0.10,- time >= 1.1 && < 1.5,- template-haskell >= 2.2 && < 2.10+ directory-tree >= 0.10 && < 0.13,+ mtl > 2.0 && < 2.3,+ snap-core >= 1.0 && < 1.1,+ time >= 1.1 && < 1.10,+ template-haskell >= 2.2 && < 3 if impl(ghc >= 7.2.0) build-depends:- hint >= 0.3.3.1 && < 0.5+ hint >= 0.3.3.1 && < 0.10 else build-depends: hint >= 0.3.3.1 && < 0.3.3.5 if impl(ghc >= 7.6.0) build-depends:- directory >= 1.2 && < 1.3+ directory >= 1.2 && < 1.4 else build-depends:- directory >= 1.0 && < 1.3,+ directory >= 1.0 && < 1.4, old-time >= 1.0 && < 1.2 if !os(windows) build-depends: unix >= 2.2.0.0 && < 2.8 - extensions: CPP+ default-extensions: CPP if impl(ghc >= 6.12.0)- ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2+ ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -fno-warn-orphans -fno-warn-unused-do-bind else- ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2+ ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -fno-warn-orphans source-repository head
src/Snap/Loader/Dynamic.hs view
@@ -13,7 +13,9 @@ ------------------------------------------------------------------------------ import Control.Concurrent import Control.Monad (liftM2, forever)+#if !MIN_VERSION_base(4,7,0) import Data.Char (isAlphaNum)+#endif import Data.List import Data.Maybe (maybeToList) import Data.Time.Clock (diffUTCTime, getCurrentTime)@@ -84,7 +86,7 @@ getHintOpts args = removeBad opts where --------------------------------------------------------------------------- bad = ["-threaded", "-O", "-main-is", "-o", "--make", "-static"]+ bad = ["-threaded", "-O", "-main-is", "-o", "--make", "-static", "-XHaskell", "-ddump-hi"] -------------------------------------------------------------------------- removeBad = filter (\x -> not $ any (`isPrefixOf` x) bad)@@ -161,8 +163,9 @@ -------------------------------------------------------------------------- dropInternal s = case stripPrefix "Snap.Internal." s of- Nothing -> s- Just x -> "Snap." ++ x+ Nothing -> s+ Just "Types" -> "Snap.Core"+ Just x -> "Snap." ++ x #else -------------------------------------------------------------------------- -- This is somewhat fragile, and probably can be cleaned up with a future
src/Snap/Loader/Dynamic/Evaluator.hs view
@@ -6,12 +6,11 @@ ) where -------------------------------------------------------------------------------import Control.Exception+import qualified Control.Exception as Ex import Control.Monad (when) import Control.Monad.Trans (liftIO) import Control.Concurrent (ThreadId, forkIO, myThreadId) import Control.Concurrent.MVar-import Prelude hiding (catch, init, any) import Snap.Core (Snap) @@ -75,7 +74,7 @@ -- previous state, if there was any, and then begin -- evaluation of the new code and state. when (null readers) $ do- let runAndFill = mask $ \unmask -> do+ let runAndFill = Ex.mask $ \unmask -> do -- run the cleanup action previous <- readMVar resultContainer unmask $ cleanup previous@@ -89,11 +88,11 @@ clearAndNotify unmask (Right res) (flip putMVar a . snd) - killWaiting :: SomeException -> IO ()- killWaiting e = mask $ \unmask -> do+ killWaiting :: Ex.SomeException -> IO ()+ killWaiting e = Ex.mask $ \unmask -> do clearAndNotify unmask (Left e)- (flip throwTo e . fst)- throwIO e+ (flip Ex.throwTo e . fst)+ Ex.throwIO e clearAndNotify unmask r f = do a <- unmask start@@ -101,7 +100,7 @@ allReaders <- swapMVar readerContainer [] mapM_ f allReaders - _ <- forkIO $ runAndFill `catch` killWaiting+ _ <- forkIO $ runAndFill `Ex.catch` killWaiting return () -- Wait for the evaluation of the action to complete,@@ -116,7 +115,7 @@ valid <- test a case (valid, res) of (True, Right (x, _)) -> return x- (True, Left e) -> throwIO e+ (True, Left e) -> Ex.throwIO e (False, _) -> waitForNewResult Nothing -> waitForNewResult getResult@@ -133,7 +132,7 @@ newReaderContainer :: IO (MVar [(ThreadId, MVar (Snap ()))]) newReaderContainer = newMVar [] - newResultContainer :: IO (MVar (Maybe (Either SomeException+ newResultContainer :: IO (MVar (Maybe (Either Ex.SomeException (Snap (), IO ()), a))) newResultContainer = newMVar Nothing