Removed model bits

Data/Object/Instances.hs

@@ -89,7 +89,7 @@ instance SafeFromObject Html where
                 map helper2 m ++
                 [ toLazyByteString "</dl>" ]
             helper2 :: (B.ByteString, RawObject) -> B.ByteString
-            helper2 (k, v) = B.concat $
+            helper2 (k, v) = B.concat
                 [ toLazyByteString "<dt>"
                 , toLazyByteString k
                 , toLazyByteString "</dt><dd>"

TODO

@@ -1 +1,2 @@
 HTML sitemap generation
+Remove model

Web/Restful/Application.hs

@@ -1,5 +1,4 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE FunctionalDependencies #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 {-# LANGUAGE ExistentialQuantification #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -44,10 +43,7 @@ import Web.Restful.Constants
 import Web.Restful.Resource
 
 -- | A data type that can be turned into a Hack application.
-class ResourceName a b => RestfulApp a b | a -> b where
-    -- | Load up the model, ie the data which use passed to each handler.
-    getModel :: a -> IO b
-
+class ResourceName a => RestfulApp a where
     -- | The encryption key to be used for encrypting client sessions.
     encryptKey :: a -> IO Word256
     encryptKey _ = getKey defaultKeyFile
@@ -87,25 +83,23 @@ class ResourceName a b => RestfulApp a b | a -> b where
 
 -- | Given a sample resource name (purely for typing reasons), generating
 -- a Hack application.
-toHackApp :: RestfulApp resourceName modelType
+toHackApp :: RestfulApp resourceName
           => resourceName
           -> IO Hack.Application
 toHackApp a = do
     when (checkOverlaps a) $ checkResourceName a -- FIXME maybe this should be done compile-time?
-    model <- getModel a
     key <- encryptKey a
-    let handlers = getHandler model
-        app' = toHackApplication a handlers
+    let app' = toHackApplication a getHandler
         clientsession' = clientsession [authCookieName] key -- FIXME gotta be a better way...
         app = foldr ($) app' $ hackMiddleware a ++ [clientsession']
     return app
 
-findResourceNames :: ResourceName a model
+findResourceNames :: ResourceName a
                   => Resource
                   -> [(a, [(String, String)])]
 findResourceNames r = takeJusts $ map (checkPatternHelper r) enumerate
 
-checkPatternHelper :: ResourceName a model
+checkPatternHelper :: ResourceName a
                    => Resource
                    -> a
                    -> Maybe (a, [(String, String)])
@@ -119,7 +113,7 @@ takeJusts [] = []
 takeJusts (Nothing:rest) = takeJusts rest
 takeJusts (Just x:rest) = x : takeJusts rest
 
-toHackApplication :: RestfulApp resourceName model
+toHackApplication :: RestfulApp resourceName
                   => resourceName
                   -> (resourceName -> Verb -> Handler)
                   -> Hack.Application

Web/Restful/Helpers/Auth.hs

@@ -15,6 +15,9 @@
 ---------------------------------------------------------
 module Web.Restful.Helpers.Auth
     ( AuthResource
+    , authHandler
+    , authResourcePattern
+    , RpxnowApiKey (..)
     ) where
 
 import qualified Hack
@@ -50,24 +53,26 @@ instance Enumerable AuthResource where
         , 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
-    -- two different versions of RPX protocol apparently...
-    getHandler (Just key) LoginRpxnow Get = rpxnowLogin key
-    getHandler (Just key) LoginRpxnow Post = rpxnowLogin key
-    getHandler _ _ _ = notFound
+newtype RpxnowApiKey = RpxnowApiKey String
 
-    resourcePattern Check = "/auth/check/"
-    resourcePattern Logout = "/auth/logout/"
-    resourcePattern Openid = "/auth/openid/"
-    resourcePattern OpenidForward  = "/auth/openid/forward/"
-    resourcePattern OpenidComplete = "/auth/openid/complete/"
-    resourcePattern LoginRpxnow = "/auth/login/rpxnow/"
+authHandler :: Maybe RpxnowApiKey -> AuthResource -> Verb -> Handler
+authHandler _ Check Get = authCheck
+authHandler _ Logout Get = authLogout
+authHandler _ Openid Get = authOpenidForm
+authHandler _ OpenidForward Get = authOpenidForward
+authHandler _ OpenidComplete Get = authOpenidComplete
+-- two different versions of RPX protocol apparently...
+authHandler (Just (RpxnowApiKey key)) LoginRpxnow Get = rpxnowLogin key
+authHandler (Just (RpxnowApiKey key)) LoginRpxnow Post = rpxnowLogin key
+authHandler _ _ _ = notFound
+
+authResourcePattern :: AuthResource -> String -- FIXME supply prefix as well
+authResourcePattern Check = "/auth/check/"
+authResourcePattern Logout = "/auth/logout/"
+authResourcePattern Openid = "/auth/openid/"
+authResourcePattern OpenidForward  = "/auth/openid/forward/"
+authResourcePattern OpenidComplete = "/auth/openid/complete/"
+authResourcePattern LoginRpxnow = "/auth/login/rpxnow/"
 
 
 data OIDFormReq = OIDFormReq (Maybe String) (Maybe String)

Web/Restful/Resource.hs

@@ -1,5 +1,4 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE FunctionalDependencies #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 {-# LANGUAGE OverlappingInstances #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
@@ -70,7 +69,7 @@ fromString' ('*':rest) = Slurp rest
 fromString' ('#':rest) = DynInt rest
 fromString' x = Static x
 
-class (Show a, Enumerable a) => ResourceName a b | a -> b where
+class (Show a, Enumerable a) => ResourceName a where
     -- | Get the URL pattern for each different resource name.
     -- Something like /foo/$bar/baz/ will match the regular expression
     -- /foo/(\\w*)/baz/, matching the middle part with the urlParam bar.
@@ -80,7 +79,7 @@ class (Show a, Enumerable a) => ResourceName a b | a -> b where
     resourcePattern :: a -> String
 
     -- | Find the handler for each resource name/verb pattern.
-    getHandler :: b -> a -> Verb -> Handler
+    getHandler :: a -> Verb -> Handler
 
 type SMap = [(String, String)]
 
@@ -135,7 +134,7 @@ overlaps (Static s:x) (DynInt _:y)
     | otherwise = False
 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) => rn -> m ()
 checkResourceName rn = do
     let avs@(y:_) = enumerate
         _ignore = asTypeOf rn y

restful.cabal

@@ -1,5 +1,5 @@
 name:            restful
-version:         0.1.6
+version:         0.1.7
 license:         BSD3
 license-file:    LICENSE
 author:          Michael Snoyman <michael@snoyman.com>