simple 0.8.1.0 → 0.9.0.0

raw patch · 8 files changed

+32/−24 lines, 8 filesdep +monad-controldep +transformers-basedep −monad-peel

Dependencies added: monad-control, transformers-base

Dependencies removed: monad-peel

Files

• simple.cabal +4/−3
• src/Web/Simple/Controller.hs +0/−2
• src/Web/Simple/Controller/Trans.hs +13/−10
• src/Web/Simple/Responses.hs +6/−1
• src/smpl.hs +0/−1
• template/Common_hs.tmpl +1/−1
• template/package_cabal.tmpl +2/−1
• test/Spec.hs +6/−5

@@ -1,5 +1,5 @@ name:                simple-version:             0.8.1.0+version:             0.9.0.0 synopsis: A minimalist web framework for the WAI server interface description: @@ -67,7 +67,7 @@     , directory     , filepath     , mime-types-    , monad-peel+    , monad-control     , mtl     , simple-templates >= 0.7.0     , wai >= 2.0@@ -75,6 +75,7 @@     , http-types     , text     , transformers+    , transformers-base     , unordered-containers     , vector @@ -100,7 +101,7 @@       base < 6     , hspec     , HUnit-    , monad-peel+    , monad-control     , mtl     , simple     , transformers

@@ -41,7 +41,6 @@   , redirectBackOr   -- * Exception handling   , T.ControllerException-  , module Control.Exception.Peel   -- * Integrating other WAI components   , fromApp   -- * Low-level utilities@@ -49,7 +48,6 @@   , hoistEither   ) where -import           Control.Exception.Peel import           Control.Monad.IO.Class import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as S8

@@ -3,6 +3,7 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}  {- | 'ControllerT' provides a convenient syntax for writting 'Application'   code as a Monadic action with access to an HTTP request as well as app@@ -23,14 +24,15 @@ -} module Web.Simple.Controller.Trans where +import           Control.Exception import           Control.Monad hiding (guard)+import           Control.Monad.Base import           Control.Monad.IO.Class-import           Control.Monad.IO.Peel import           Control.Monad.Reader.Class import           Control.Monad.State.Class import           Control.Monad.Trans.Class+import           Control.Monad.Trans.Control import           Control.Applicative-import           Control.Exception.Peel import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as S8 import           Data.List (find)@@ -43,7 +45,6 @@ import           Network.Wai import           Web.Simple.Responses - -- | The ControllerT Monad is both a State-like monad which, when run, computes -- either a 'Response' or a result. Within the ControllerT Monad, the remainder -- of the computation can be short-circuited by 'respond'ing with a 'Response'.@@ -94,13 +95,15 @@ instance MonadIO m => MonadIO (ControllerT s m) where   liftIO = lift . liftIO -instance MonadPeelIO (ControllerT s IO) where-  peelIO = do-    s <- controllerState-    req <- request-    return $ \ctrl -> do-      res <- runController ctrl s req-      return $ ControllerT $ \_ _ -> return res+instance (Applicative m, Monad m, MonadBase m m) => MonadBase m (ControllerT s m) where+  liftBase = liftBaseDefault++instance MonadBaseControl m m => MonadBaseControl m (ControllerT s m) where+  newtype StM (ControllerT s m) a = StCtrl (Either Response a, s)+  liftBaseWith fn = ControllerT $ \st req -> do+    res <- fn $ \act -> liftM StCtrl $ runController act st req+    return (Right res, st)+  restoreM (StCtrl (a, s)) = ControllerT $ \_ _ -> return (a, s)  hoistEither :: Monad m => Either Response a -> ControllerT s m a hoistEither eith = ControllerT $ \st _ -> return (eith, st)

@@ -3,7 +3,7 @@  -- | This module defines some convenience functions for creating responses. module Web.Simple.Responses-  ( ok, okHtml, okJson+  ( ok, okHtml, okJson, okXml   , movedTo, redirectTo   , badRequest, requireBasicAuth, forbidden   , notFound@@ -39,6 +39,11 @@ -- given resposne body okJson :: L8.ByteString -> Response okJson = ok (S8.pack "application/json")++-- | Creates a 200 (OK) 'Response' with content-type \"application/xml\" and the+-- given resposne body+okXml :: L8.ByteString -> Response+okXml = ok (S8.pack "application/xml")  -- | Given a URL returns a 301 (Moved Permanently) 'Response' redirecting to -- that URL.

@@ -17,7 +17,6 @@ import System.FilePath import System.Environment import System.Exit-import System.SetEnv import System.Process import Web.Simple.Templates.Language 

@@ -7,7 +7,7 @@ $if(include_sessions)$import Web.Simple.Session$endif$ $if(include_postgresql)$import Web.Simple.PostgreSQL$endif$ -data AppSettings = AppSettings { $if(include_postgresql)$appDB :: PostgreSQLConn$if(include_postgresql)$+data AppSettings = AppSettings { $if(include_postgresql)$appDB :: PostgreSQLConn$if(include_sessions)$                                , appSession :: Maybe Session$endif$$else$$if(include_sessions)$appSession :: Maybe Session$endif$$endif$ }  newAppSettings :: IO AppSettings

@@ -16,5 +16,6 @@     , wai-extra     , warp$if(include_sessions)$     , simple-session >= 0.8.0$endif$$if(include_postgresql)$-    , simple-postgresql-orm >= 0.8.0$endif$+    , simple-postgresql-orm >= 0.8.0+    , postgresql-orm$endif$ 

@@ -3,8 +3,8 @@  import Control.Monad import Control.Monad.IO.Class-import Control.Monad.IO.Peel import Control.Monad.Trans+import Control.Monad.Trans.Control import Test.Hspec import Test.Hspec.HUnit import Network.Wai@@ -110,13 +110,14 @@         defaultRequest { requestHeaderHost = Nothing }       return () -  describe "MonadPeelIO instance" $ do+  describe "MonadBaseControl instance" $ do     it "Preserves state changes in inner block" $ do       let expected = 1234           ctrl = do-                  k <- peelIO-                  join $ liftIO $ k $ do-                    putState expected+                  putState 555+                  res <- liftBaseWith $ \f -> do+                      f $ putState expected+                  restoreM res       s <- snd `fmap` runController ctrl 0 defaultRequest       s `shouldBe` expected