diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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/. +[![Build Status](https://travis-ci.org/snapframework/snap-loader-dynamic.svg?branch=master)](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/`. - diff --git a/snap-loader-dynamic.cabal b/snap-loader-dynamic.cabal --- a/snap-loader-dynamic.cabal +++ b/snap-loader-dynamic.cabal @@ -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 diff --git a/src/Snap/Loader/Dynamic.hs b/src/Snap/Loader/Dynamic.hs --- a/src/Snap/Loader/Dynamic.hs +++ b/src/Snap/Loader/Dynamic.hs @@ -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 diff --git a/src/Snap/Loader/Dynamic/Evaluator.hs b/src/Snap/Loader/Dynamic/Evaluator.hs --- a/src/Snap/Loader/Dynamic/Evaluator.hs +++ b/src/Snap/Loader/Dynamic/Evaluator.hs @@ -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