Replaced ApplicationMonad with RestfulApp, version bump

Web/Restful/Application.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FunctionalDependencies #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 {-# LANGUAGE ExistentialQuantification #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -16,29 +18,21 @@
 ---------------------------------------------------------
 module Web.Restful.Application
     (
-      -- * Defining an application
+      toHackApp
-      ApplicationMonad
+    , RestfulApp (..)
-      -- ** Settings
-    , setHtmlWrapper
-      -- ** Engage
-    , toHackApp
     ) where
 
--- hideously long import list
-import qualified Hack
-import Control.Monad.State hiding (gets)
 import Web.Encodings
 import Data.Maybe (isJust)
-import Data.ByteString.Class
-import qualified Data.ByteString.Lazy as BS
 import Data.Function.Predicate (equals)
-import Data.Default
+import Data.ByteString.Class
-import Control.Applicative ( Applicative (..))
+import qualified Data.ByteString.Lazy as B
 
-import Hack.Middleware.Gzip
+import qualified Hack
 import Hack.Middleware.CleanPath
-import Hack.Middleware.Jsonp
 import Hack.Middleware.ClientSession
+import Hack.Middleware.Gzip
+import Hack.Middleware.Jsonp
 import Hack.Middleware.MethodOverride
 
 import Web.Restful.Request
@@ -49,61 +43,45 @@ import Web.Restful.Definitions
 import Web.Restful.Constants
 import Web.Restful.Resource
 
--- | Contains settings and a list of resources.
+-- | A data type that can be turned into a Hack application.
-type ApplicationMonad a = State (ApplicationSettings a)
+class ResourceName a b => RestfulApp a b | a -> b where
-instance Applicative (ApplicationMonad a) where
+    -- | Load up the model, ie the data which use passed to each handler.
-    pure = return
+    getModel :: a -> IO b
-    f <*> a = do
-        f' <- f
-        a' <- a
-        return $! f' a'
-data ApplicationSettings rn = ApplicationSettings
-    { encryptKey :: Either FilePath Word256
-    , hackMiddleware :: [Hack.Middleware]
-    , response404 :: Hack.Env -> IO Hack.Response
-    , htmlWrapper :: BS.ByteString -> BS.ByteString
-    }
 
-instance Default (ApplicationSettings a) where
+    -- | The encryption key to be used for encrypting client sessions.
-    def = ApplicationSettings
+    encryptKey :: a -> IO Word256
-            { encryptKey = Left defaultKeyFile
+    encryptKey _ = getKey defaultKeyFile
-            , hackMiddleware =
+
+    -- | All of the middlewares to install.
+    hackMiddleware :: a -> [Hack.Middleware]
+    hackMiddleware _ =
                 [ gzip
                 , cleanPath
                 , jsonp
                 , methodOverride
                 ]
-            , response404 = default404
-            , htmlWrapper = id
-            }
 
-default404 :: Hack.Env -> IO Hack.Response
+    -- | How to generate 404 pages. FIXME make more user-friendly.
-default404 env = return $
+    response404 :: a -> Hack.Env -> IO Hack.Response
-    Hack.Response
+    response404 _ = default404
-        404
-        [("Content-Type", "text/plain")]
-        $ toLazyByteString $ "Not found: " ++ Hack.pathInfo env
 
--- FIXME document below here
+    -- | Wrappers for cleaning up responses. Especially intended for
+    -- beautifying static HTML. FIXME more user friendly.
+    responseWrapper :: a -> String -> B.ByteString -> IO B.ByteString
+    responseWrapper _ _ = return
 
-setHtmlWrapper :: (BS.ByteString -> BS.ByteString) -> ApplicationMonad a ()
+-- | Given a sample resource name (purely for typing reasons), generating
-setHtmlWrapper f = do
+-- a Hack application.
-    s <- get
+toHackApp :: RestfulApp resourceName modelType
-    put $ s { htmlWrapper = f }
+          => resourceName
-
-toHackApp :: ResourceName a b
-          => ApplicationMonad a ()
-          -> b
           -> IO Hack.Application
-toHackApp am model = do
+toHackApp a = do
-    let settings = execState am def
+    model <- getModel a
-    key <- case encryptKey settings of
+    key <- encryptKey a
-            Left f -> getKey f
-            Right k -> return k
     let handlers = getHandler model
-        app' = toHackApplication handlers settings
+        app' = toHackApplication a handlers
         clientsession' = clientsession [authCookieName] key -- FIXME gotta be a better way...
-        app = foldr ($) app' $ hackMiddleware settings ++ [clientsession']
+        app = foldr ($) app' $ hackMiddleware a ++ [clientsession']
     return app
 
 findResourceNames :: ResourceName a model
@@ -125,14 +103,14 @@ takeJusts [] = []
 takeJusts (Nothing:rest) = takeJusts rest
 takeJusts (Just x:rest) = x : takeJusts rest
 
-toHackApplication :: ResourceName resourceName model
+toHackApplication :: RestfulApp resourceName model
-                  => HandlerMap resourceName
+                  => resourceName
-                  -> ApplicationSettings resourceName
+                  -> HandlerMap resourceName
                   -> Hack.Application
-toHackApplication hm settings env = do
+toHackApplication sampleRN hm env = do
     let (Right resource) = splitPath $ Hack.pathInfo env
     case findResourceNames resource of
-      [] -> response404 settings $ env
+      [] -> response404 sampleRN $ env
       [(rn, urlParams')] -> do
         let verb :: Verb
             verb = toVerb $ Hack.requestMethod env
@@ -154,16 +132,15 @@ toHackApplication hm settings env = do
                             [] -> Nothing
                             _ -> error "Overlapping reps"
                 case handlerPair of
-                    Nothing -> response404 settings $ env
+                    Nothing -> response404 sampleRN $ env
                     Just (ctype, Hack.Response status headers content) -> do
-                        let wrapper =
+                        content' <- responseWrapper sampleRN ctype content
-                                case ctype of
+                        let response' = Hack.Response
-                                    "text/html" -> htmlWrapper settings
+                                            status
-                                    _ -> id
+                                            (("Content-Type", ctype) : headers)
-                        return $ Hack.Response status
+                                            content'
-                                 (("Content-Type", ctype) : headers)
+                        return response'
-                               $ toLazyByteString $ wrapper content
+            Nothing -> response404 sampleRN $ env
-            Nothing -> response404 settings $ env
       x -> error $ "Invalid matches: " ++ show x
 
 envToRawRequest :: [(ParamName, ParamValue)] -> Hack.Env -> RawRequest
@@ -177,3 +154,10 @@ envToRawRequest urlParams' env =
         rawCookie = tryLookup "" "Cookie" $ Hack.http env
         cookies' = decodeCookies rawCookie :: [(String, String)]
      in RawRequest rawPieces urlParams' gets' posts cookies' files env
+
+default404 :: Hack.Env -> IO Hack.Response
+default404 env = return $
+    Hack.Response
+        404
+        [("Content-Type", "text/plain")]
+        $ toLazyByteString $ "Not found: " ++ Hack.pathInfo env

Web/Restful/Resource.hs

@@ -38,8 +38,17 @@ fromString' ('$':rest) = Dynamic rest
 fromString' x = Static x
 
 class Show a => ResourceName a b | a -> b 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.
     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.
     getHandler :: b -> a -> Verb -> Maybe Handler
 
 -- FIXME add some overlap checking functions

restful.cabal

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