Switched to Enumerable

This commit is contained in:
Michael Snoyman 2009-09-30 22:22:53 +02:00
parent 5addbf8465
commit e2f217f981
5 changed files with 24 additions and 23 deletions

1
TODO
View File

@ -0,0 +1 @@
Catch exceptions and return as 500 errors

View File

@ -25,6 +25,7 @@ module Web.Restful.Application
import Web.Encodings import Web.Encodings
import qualified Data.ByteString.Lazy as B import qualified Data.ByteString.Lazy as B
import Data.Object import Data.Object
import Data.Enumerable
import qualified Hack import qualified Hack
import Hack.Middleware.CleanPath import Hack.Middleware.CleanPath
@ -95,7 +96,7 @@ toHackApp a = do
findResourceNames :: ResourceName a model findResourceNames :: ResourceName a model
=> Resource => Resource
-> [(a, [(String, String)])] -> [(a, [(String, String)])]
findResourceNames r = takeJusts $ map (checkPatternHelper r) allValues findResourceNames r = takeJusts $ map (checkPatternHelper r) enumerate
checkPatternHelper :: ResourceName a model checkPatternHelper :: ResourceName a model
=> Resource => Resource

View File

@ -21,6 +21,7 @@ import qualified Hack
import Web.Encodings import Web.Encodings
import qualified Web.Authenticate.Rpxnow as Rpxnow import qualified Web.Authenticate.Rpxnow as Rpxnow
import qualified Web.Authenticate.OpenId as OpenId import qualified Web.Authenticate.OpenId as OpenId
import Data.Enumerable
import Web.Restful import Web.Restful
import Web.Restful.Constants import Web.Restful.Constants
@ -39,17 +40,8 @@ data AuthResource =
| LoginRpxnow | LoginRpxnow
deriving Show deriving Show
type RpxnowApiKey = String -- FIXME newtype instance Enumerable AuthResource where
instance ResourceName AuthResource (Maybe RpxnowApiKey) where enumerate =
getHandler _ Check Get = authCheck
getHandler _ Logout Get = authLogout
getHandler _ Openid Get = authOpenidForm
getHandler _ OpenidForward Get = authOpenidForward
getHandler _ OpenidComplete Get = authOpenidComplete
getHandler (Just key) LoginRpxnow Get = rpxnowLogin key
getHandler _ _ _ = notFound
allValues =
Check Check
: Logout : Logout
: Openid : Openid
@ -58,6 +50,16 @@ instance ResourceName AuthResource (Maybe RpxnowApiKey) where
: LoginRpxnow : LoginRpxnow
: [] : []
type RpxnowApiKey = String -- FIXME newtype
instance ResourceName AuthResource (Maybe RpxnowApiKey) where
getHandler _ Check Get = authCheck
getHandler _ Logout Get = authLogout
getHandler _ Openid Get = authOpenidForm
getHandler _ OpenidForward Get = authOpenidForward
getHandler _ OpenidComplete Get = authOpenidComplete
getHandler (Just key) LoginRpxnow Post = rpxnowLogin key
getHandler _ _ _ = notFound
resourcePattern Check = "/auth/check/" resourcePattern Check = "/auth/check/"
resourcePattern Logout = "/auth/logout/" resourcePattern Logout = "/auth/logout/"
resourcePattern Openid = "/auth/openid/" resourcePattern Openid = "/auth/openid/"
@ -130,8 +132,8 @@ authOpenidComplete = do
data RpxnowRequest = RpxnowRequest String (Maybe String) data RpxnowRequest = RpxnowRequest String (Maybe String)
instance Request RpxnowRequest where instance Request RpxnowRequest where
parseRequest = do parseRequest = do
token <- getParam "token" token <- postParam "token"
dest <- getParam "dest" dest <- postParam "dest"
return $! RpxnowRequest token $ chopHash `fmap` dest return $! RpxnowRequest token $ chopHash `fmap` dest
chopHash :: String -> String chopHash :: String -> String

View File

@ -30,6 +30,7 @@ import Data.List.Split (splitOn)
import Web.Restful.Definitions import Web.Restful.Definitions
import Web.Restful.Handler import Web.Restful.Handler
import Data.List (intercalate) import Data.List (intercalate)
import Data.Enumerable
import Test.Framework (testGroup, Test) import Test.Framework (testGroup, Test)
import Test.Framework.Providers.HUnit import Test.Framework.Providers.HUnit
@ -64,7 +65,7 @@ fromString' ('$':rest) = Dynamic rest
fromString' ('*':rest) = Slurp rest fromString' ('*':rest) = Slurp rest
fromString' x = Static x fromString' x = Static x
class Show a => ResourceName a b | a -> b where class (Show a, Enumerable a) => ResourceName a b | a -> b where
-- | Get the URL pattern for each different resource name. -- | Get the URL pattern for each different resource name.
-- Something like /foo/$bar/baz/ will match the regular expression -- Something like /foo/$bar/baz/ will match the regular expression
-- /foo/(\\w*)/baz/, matching the middle part with the urlParam bar. -- /foo/(\\w*)/baz/, matching the middle part with the urlParam bar.
@ -73,11 +74,6 @@ class Show a => ResourceName a b | a -> b where
-- into the bar urlParam. -- into the bar urlParam.
resourcePattern :: a -> String resourcePattern :: a -> String
-- | Get all possible values for resource names.
-- Remember, if you use variables ($foo) in your resourcePatterns you
-- can get an unlimited number of resources for each resource name.
allValues :: [a]
-- | Find the handler for each resource name/verb pattern. -- | Find the handler for each resource name/verb pattern.
getHandler :: b -> a -> Verb -> Handler getHandler :: b -> a -> Verb -> Handler
@ -123,7 +119,7 @@ overlaps (Static a:x) (Static b:y) = a == b && overlaps x y
checkResourceName :: (Monad m, ResourceName rn model) => rn -> m () checkResourceName :: (Monad m, ResourceName rn model) => rn -> m ()
checkResourceName rn = do checkResourceName rn = do
let avs@(y:_) = allValues let avs@(y:_) = enumerate
_ignore = asTypeOf rn y _ignore = asTypeOf rn y
let patterns = map (fromString . resourcePattern) avs let patterns = map (fromString . resourcePattern) avs
case validatePatterns patterns of case validatePatterns patterns of

View File

@ -1,5 +1,5 @@
name: restful name: restful
version: 0.1.2 version: 0.1.3
license: BSD3 license: BSD3
license-file: LICENSE license-file: LICENSE
author: Michael Snoyman <michael@snoyman.com> author: Michael Snoyman <michael@snoyman.com>
@ -35,7 +35,8 @@ library
test-framework-quickcheck, test-framework-quickcheck,
test-framework-hunit, test-framework-hunit,
HUnit, HUnit,
QuickCheck == 1.* QuickCheck == 1.*,
enumerable >= 0.0.3
exposed-modules: Web.Restful, exposed-modules: Web.Restful,
Web.Restful.Constants, Web.Restful.Constants,
Web.Restful.Request, Web.Restful.Request,