-- Hoogle documentation, generated by Haddock -- See Hoogle, http://www.haskell.org/hoogle/ -- | A minimalist web framework for the WAI server interface -- -- Simple is "framework-less" web framework for Haskell web applications -- using the WAI server interface (e.g. for use with the warp server). -- Unlike other frameoworks, Simple does not enforce a particular -- structure or paradigm for web applications. Rather, Simple makes it -- easier for you, the developer, to use whichever paradigm or structure -- you like. This package includes: -- -- -- -- To get started using the warp web server: -- -- 
--   $ cabal install simple warp
--
-- -- helloworld.hs: -- -- 
--   import Web.Simple
--   import Network.Wai.Handler.Warp
--   
--   main :: IO ()
--   main = runSettings defaultSettings $ mkRouter $
--           okHtml "Hello World"
--
-- -- 
--   $ runghc -XOverloadedStrings helloworld.hs
--
-- -- See Web.Simple for a more detailed introduction. @package simple @version 0.4.1 -- | This module defines some convenience functions for creating responses. module Web.Simple.Responses -- | Creates a 200 (OK) Response with the given content-type and -- resposne body ok :: ContentType -> ByteString -> Response -- | Creates a 200 (OK) Response with content-type "text/html" and -- the given resposne body okHtml :: ByteString -> Response -- | Creates a 200 (OK) Response with content-type -- "application/json" and the given resposne body okJson :: ByteString -> Response -- | Given a URL returns a 301 (Moved Permanently) Response -- redirecting to that URL. movedTo :: String -> Response -- | Given a URL returns a 303 (See Other) Response redirecting to -- that URL. redirectTo :: String -> Response -- | Returns a 400 (Bad Request) Response. badRequest :: Response -- | Returns a 401 (Authorization Required) Response requiring basic -- authentication in the given realm. requireBasicAuth :: String -> Response -- | Returns a 403 (Forbidden) Response. forbidden :: Response -- | Returns a 404 (Not Found) Response. notFound :: Response -- | Returns a 500 (Server Error) Response. serverError :: Response -- | Conceptually, a route is function that, given an HTTP request, may -- return an action (something that would return a response for the -- client if run). Routes can be concatenated--where each route is -- evaluated until one matches--and nested. Routes are expressed through -- the Routeable type class. runRoute transforms an -- instance of Routeable to a function from Request to a -- monadic action (in the ResourceT monad) that returns a -- Maybe Response. The return type was chosen to be monadic -- so routing decisions can depend on side-effects (e.g. a random number -- or counter for A/B testing, IP geolocation lookup etc'). module Web.Simple.Router -- | Routeable types can be converted into a route function using -- runRoute. If the route is matched it returns a Response, -- otherwise Nothing. -- -- In general, Routeables are data-dependant (on the -- Request), but don't have to be. For example, Application -- is an instance of Routeable that always returns a -- Response: -- -- 
--   instance Routeable Application where
--     runRoute app req = app req >>= return . Just
--
class Routeable r runRoute :: Routeable r => r -> Request -> ResourceT IO (Maybe Response) -- | Converts any Routeable into an Application that can be -- passed directly to a WAI server. mkRouter :: Routeable r => r -> Application -- | The Route type is a basic instance of Routeable that -- simply holds the routing function and an arbitrary additional data -- parameter. The power is derived from the instances of Monad and -- Monoid, which allow the simple construction of complex routing -- rules using either lists (Monoid) or do-notation. Moreover, -- because of it's simple type, any Routeable can be used as a -- Route (using routeAll or by applying it to -- runRoute), making it possible to leverage the monadic or monoid -- syntax for any Routeable. -- -- Commonly, route functions that construct a Route only inspect -- the Request and other parameters. For example, routeHost -- looks at the hostname: -- -- 
--   routeHost :: Routeable r => S.ByteString -> r -> Route ()
--   routeHost host route = Route func ()
--     where func req = if host == serverName req
--                        then runRoute route req
--                        else return Nothing
--
-- -- However, because the result of a route is in the ResourceT -- monad, routes have all the power of an Application and can make -- state-dependant decisions. For example, it is trivial to implement a -- route that succeeds for every other request (perhaps for A/B testing): -- -- 
--   routeEveryOther :: (Routeable r1, Routeable r2)
--                   => TVar Int -> r1 -> r2 -> Route ()
--   routeEveryOther counter r1 r2 = Route func ()
--     where func req = do
--             i <- liftIO . atomically $ do
--                     i' <- readTVar counter
--                     writeTVar counter (i' + 1)
--                     return i'
--             if i mod 2 == 0
--               then runRoute r1 req
--               else runRoute r2 req
--
data Route a Route :: (Request -> ResourceT IO (Maybe Response)) -> a -> Route a -- | A route that always matches (useful for converting a Routeable -- into a Route). routeAll :: Routeable r => r -> Route () -- | Matches on the hostname from the Request. The route only -- successeds on exact matches. routeHost :: Routeable r => ByteString -> r -> Route () -- | Matches if the path is empty. Note that this route checks that -- pathInfo is empty, so it works as expected when nested under -- namespaces or other routes that pop the pathInfo list. routeTop :: Routeable r => r -> Route () -- | Matches on the HTTP request method (e.g. GET, POST, -- PUT) routeMethod :: Routeable r => StdMethod -> r -> Route () -- | Routes the given URL pattern. Patterns can include directories as well -- as variable patterns (prefixed with :) to be added to -- queryString (see routeVar) -- -- routePattern :: Routeable r => ByteString -> r -> Route () -- | Matches if the first directory in the path matches the given -- ByteString routeName :: Routeable r => ByteString -> r -> Route () -- | Always matches if there is at least one directory in pathInfo -- but and adds a parameter to queryString where the key is the -- first parameter and the value is the directory consumed from the path. routeVar :: Routeable r => ByteString -> r -> Route () instance Routeable (Route a) instance Monoid (Route ()) instance Monad Route instance Routeable Response instance Routeable Application -- | Controller provides a convenient syntax for writting -- Application code as a Monadic action with access to an HTTP -- request, rather than a function that takes the request as an argument. -- This module also defines some helper functions that leverage this -- feature. For example, redirectBack reads the underlying request -- to extract the referer and returns a redirect response: -- -- 
--   myController = do
--     ...
--     if badLogin then
--       redirectBack
--       else
--         ...
--
module Web.Simple.Controller -- | A Controller is a Reader monad that contains the HTTP -- request in its environment. A Controller is Routeable -- simply by running the Reader. type Controller = ReaderT ControllerState (ResourceT IO) -- | Redirect back to the referer. If the referer header is not present -- redirect to root (i.e., /). redirectBack :: Controller Response -- | Redirect back to the referer. If the referer header is not present -- fallback on the given Response. redirectBackOr :: Response -> Controller Response -- | Looks up the parameter name in the request's query string and returns -- the value as a ByteString or Nothing. -- -- For example, for a request with query string: "?foo=bar&baz=7", -- queryParam "foo" -- -- would return Just "bar", but -- -- 
--   queryParam "zap"
--
-- -- would return Nothing queryParam :: Parseable a => ByteString -> Controller (Maybe a) -- | Parses a HTML form from the request body. It returns a list of -- Params as well as a list of Files, which are pairs -- mapping the name of a file form field to a FileInfo -- pointing to a temporary file with the contents of the upload. -- -- 
--   myController = do
--     (prms, files) <- parseForm
--     let mPicFile = lookup "profile_pic" files
--     case mPicFile of
--       Just (picFile) -> do
--         sourceFile (fileContent picFile) $$
--           sinkFile ("images/" ++ (fileName picFile))
--         respond $ redirectTo "/"
--       Nothing -> redirectBack
--
parseForm :: Controller ([Param], [(ByteString, FileInfo FilePath)]) -- | An alias for return that's helps the the compiler type a code -- block as a Controller. For example, when using the Frank -- routing DSL to define a simple route that justs returns a -- Response, respond can be used to avoid explicit typing -- of the argument: -- -- 
--   get "/" $ do
--     someSideEffect
--     respond $ okHtml "Hello World"
--
-- -- instead of: -- -- 
--   get "/" $ (do
--     someSideEffect
--     return $ okHtml "Hello World") :: Controller Response
--
respond :: Routeable r => r -> Controller r -- | Reads the underlying Request request :: Controller Request -- | Reads and returns the body of the HTTP request. body :: Controller ByteString instance Parseable Integer instance Parseable String instance Parseable ByteString instance Routeable (Controller Response) module Web.Simple.Auth -- | An AuthRouter authenticates a Request and, if -- successful, forwards the Request to the Routeable. type AuthRouter r = Routeable r => (Request -> ByteString -> ByteString -> IO (Maybe Request)) -> r -> Route () -- | An AuthRouter that uses HTTP basic authentication to -- authenticate a request in a particular realm. basicAuthRoute :: String -> AuthRouter r -- | Wraps an AuthRouter to take a simpler authentication function -- (that just just takes a username and password, and returns True -- or False). It also adds an "X-User" header to the -- Request with the authenticated user's name (the first argument -- to the authentication function). authRewriteReq :: Routeable r => AuthRouter r -> (ByteString -> ByteString -> IO Bool) -> r -> Route () -- | A Route that uses HTTP basic authentication to authenticate a -- request for a realm with the given username ans password. The request -- is rewritten with an 'X-User' header containing the authenticated -- username before being passed to the next next Route. basicAuth :: Routeable r => String -> ByteString -> ByteString -> r -> Route () -- | Frank is a Sinatra-inspired DSL (see http://www.sinatrarb.com) -- for creating routes. It is composable with all Routeable types, -- but is designed to be used with Controllers. Each verb -- (get, post, put, etc') takes a URL pattern of the -- form "/dir/:paramname/dir" (see routePattern for details) and a -- Routeable: -- -- 
--   main :: IO ()
--   main = runSettings defaultSettings $ mkRouter $ do
--     get "/" $ do
--       req <- request
--       return $ okHtml $ fromString $
--         "Welcome Home " ++ (show $ serverName req)
--     get "/user/:id" $ do
--       userId <- queryParam "id" >>= fromMaybe ""
--       return $ ok "text/json" $ fromString $
--         "{\"myid\": " ++ (show userId) ++ "}"
--     put "/user/:id" $ do
--       ...
--
module Web.Frank -- | Matches the GET method on the given URL pattern get :: Routeable r => ByteString -> r -> Route () -- | Matches the POST method on the given URL pattern post :: Routeable r => ByteString -> r -> Route () -- | Matches the PUT method on the given URL pattern put :: Routeable r => ByteString -> r -> Route () -- | Matches the DELETE method on the given URL pattern delete :: Routeable r => ByteString -> r -> Route () -- | Matches the OPTIONS method on the given URL pattern options :: Routeable r => ByteString -> r -> Route () module Web.REST data REST REST :: Route () -> Route () -> Route () -> Route () -> Route () -> Route () -> Route () -> REST restIndex :: REST -> Route () restShow :: REST -> Route () restCreate :: REST -> Route () restUpdate :: REST -> Route () restDelete :: REST -> Route () restEdit :: REST -> Route () restNew :: REST -> Route () type RESTController = RESTControllerM () rest :: RESTControllerM a -> REST index :: Routeable r => r -> RESTController show :: Routeable r => r -> RESTController create :: Routeable r => r -> RESTController update :: Routeable r => r -> RESTController delete :: Routeable r => r -> RESTController edit :: Routeable r => r -> RESTController new :: Routeable r => r -> RESTController instance Routeable (RESTControllerM a) instance Routeable REST module Web.Simple.Migrations type Migration = String -> String -> IO Bool newMigration :: String -> IO () module Web.Simple module Database.PostgreSQL.Sequel data Sequel a Sequel :: (Connection -> IO a) -> Sequel a runSequel :: Sequel a -> Connection -> IO a drop_table :: String -> Sequel () create_table :: String -> CreateTable a -> Sequel () type ColumnType = String serial :: ColumnType integer :: ColumnType time :: ColumnType timestamp :: ColumnType varchar :: Integer -> ColumnType string :: ColumnType text :: ColumnType boolean :: ColumnType data ColumnConstraint NOT_NULL :: ColumnConstraint UNIQUE :: ColumnConstraint PRIMARY_KEY :: ColumnConstraint DEFAULT :: String -> ColumnConstraint REFERENCES :: String -> String -> ColumnConstraint stringifyConstraint :: ColumnConstraint -> String drop_column :: String -> String -> Sequel () add_column :: String -> String -> ColumnType -> [ColumnConstraint] -> Sequel () rename_column :: String -> String -> String -> Sequel () type CreateTable = StateT [(ColumnType, String, [ColumnConstraint])] Identity runCreateTable :: CreateTable a -> String column :: String -> ColumnType -> [ColumnConstraint] -> CreateTable () sqlQuery :: (ToRow q, FromRow r) => Query -> q -> Sequel [r] sqlQuery_ :: FromRow r => Query -> Sequel [r] sqlExecute :: ToRow q => Query -> q -> Sequel () sqlExecute_ :: Query -> Sequel () instance MonadIO Sequel instance Monad Sequel module Database.PostgreSQL.Connection conns :: Pool Connection createConnection :: ConnectInfo -> IO Connection parseDbURL :: String -> ConnectInfo withConnection :: (MonadIO m, MonadBaseControl IO m) => (Connection -> m b) -> m b module Database.PostgreSQL.Migrations runDb :: Sequel a -> IO a dbUp :: Sequel a -> Migration dbDown :: Sequel a -> Migration initDb :: Migration -- | Type classes for PostgreSQL-backed data models. module Database.PostgreSQL.Models class FromParams p fromParams :: FromParams p => [Param] -> Maybe p -- | Post parameter name and value. type Param = (ByteString, ByteString) -- | Basis type for PostgreSQL-backed data-models. Instances must, at -- minimum, implement primaryKey, tableName and -- columns. /Note: the column ordering must match that used in the -- type's implementation of FromRow and ToRow/ class (FromRow p, ToRow p, ToField (PrimaryKey p), FromField (PrimaryKey p)) => PostgreSQLModel p where type family PrimaryKey p :: * primaryKeyName _ = "id" columns_ tName = (primaryKeyName tName) : (columns tName) orderBy _ = Nothing insert model conn = do { query conn template fields >>= return . head . head } where template = fromString $ concat ["insert into ", fromTableName tName, " (" ++ cols ++ ")", " VALUES (" ++ qs ++ ") RETURNING ", primaryKeyName tName] tName = tableName model qs = concat $ intersperse ", " $ map (const "?") $ colNames cols = concat $ intersperse ", " $ colNames colNameFields = case primaryKey model of { Nothing -> (columns tName, toRow model) Just pkey -> (columns_ tName, (toField pkey) : (toRow model)) } (_, fields) = colNameFields (colNames, _) = colNameFields upsert model conn = do { case primaryKey model of { Nothing -> insert model conn Just pkey -> do { execute conn template $ toRow model ++ [toField pkey]; return pkey } } } where template = fromString $ concat ["update ", fromTableName tName, " SET ", cols, " where ", primaryKeyName tName, " = ?"] tName = tableName model cols = concat $ intersperse ", " $ map (++ " =?") (columns tName) destroy model conn = do { case primaryKey model of { Nothing -> return False Just pkey -> do { fmap (> 0) $ execute conn template (Only pkey) } } } where template = fromString $ concat ["delete from ", fromTableName tName, " where ", primaryKeyName tName, " = ?;"] tName = tableName model find tn = findFirst tn (primaryKeyName tn) findFirst tName col val conn = do { models <- query conn template (Only val); case models of { (model : _) -> return $ Just model [] -> return Nothing } } where template = fromString $ concat ["select ", cols, " from ", fromTableName tName, " where ", col, " = ?", maybe "" (" order by " ++) $ orderBy tName, " limit 1"] cols = concat $ intersperse ", " $ columns_ tName findAll tName conn = query_ conn template where template = fromString $ concat ["select ", cols, " from ", fromTableName tName, maybe "" (" order by " ++) $ orderBy tName] cols = concat $ intersperse ", " $ columns_ tName findAllBy tName col val conn = query conn template (Only val) where template = fromString $ concat ["select ", cols, " from ", fromTableName tName, " where ", col, " = ?", maybe "" (" order by " ++) $ orderBy tName] cols = concat $ intersperse ", " $ columns_ tName primaryKey :: PostgreSQLModel p => p -> Maybe (PrimaryKey p) tableName :: PostgreSQLModel p => p -> TableName p columns :: PostgreSQLModel p => TableName p -> [String] primaryKeyName :: PostgreSQLModel p => TableName p -> String columns_ :: PostgreSQLModel p => TableName p -> [String] orderBy :: PostgreSQLModel p => TableName p -> Maybe String insert :: PostgreSQLModel p => p -> Connection -> IO (PrimaryKey p) upsert :: PostgreSQLModel p => p -> Connection -> IO (PrimaryKey p) destroy :: PostgreSQLModel p => p -> Connection -> IO Bool find :: PostgreSQLModel p => TableName p -> PrimaryKey p -> Connection -> IO (Maybe p) findFirst :: (PostgreSQLModel p, ToField f) => TableName p -> String -> f -> Connection -> IO (Maybe p) findAll :: PostgreSQLModel p => TableName p -> Connection -> IO [p] findAllBy :: (PostgreSQLModel p, ToField f) => TableName p -> String -> f -> Connection -> IO [p] -- | Defines a "has-many" relationship between two models, where the -- parent model may be associated with zero or more of the -- child model. Specifically, the child table has a -- foreign key column pointing to the parent model. class (PostgreSQLModel parent, PostgreSQLModel child) => HasMany parent child where foreignKey tName _ = fromTableName tName ++ "_" ++ (primaryKeyName tName) childrenOf parent ctName conn = query conn template (Only $ primaryKey parent) where template = fromString $ concat $ ["select ", childColumns, " from ", fromTableName ctName, " where ", foreignKey ptName ctName, " = ?", maybe "" (" order by " ++) $ orderBy ctName] ptName = tableName parent childColumns = concat $ intersperse ", " $ columns_ ctName childOf parent ctName v = childOfBy parent ctName (primaryKeyName ctName) v childOfBy parent ctName col pkeyc conn = do { mchildren <- query conn template (primaryKey parent, pkeyc); case mchildren of { [] -> return Nothing (c : _) -> return $ Just c } } where template = fromString $ concat $ ["select ", childColumns, " from ", fromTableName ctName, " where ", foreignKey ptName ctName, " = ?", " and ", col, " = ?", maybe "" (" order by " ++) $ orderBy ctName, " limit 1"] ptName = tableName parent childColumns = concat $ intersperse ", " $ columns_ ctName childrenOfBy parent ctName col val conn = query conn template (primaryKey parent, val) where template = fromString $ concat $ ["select ", childColumns, " from ", fromTableName ctName, " where ", foreignKey ptName ctName, " = ? and ", col, " = ?", maybe "" (" order by " ++) $ orderBy ctName] ptName = tableName parent childColumns = concat $ intersperse ", " $ columns_ ctName insertFor parent chld conn = do { query conn template (fields ++ [toField $ primaryKey parent]) >>= return . head . head } where template = fromString $ concat ["insert into ", fromTableName ctName, " (", cols, ", ", foreignKey ptName ctName, ")", " VALUES (", qs, ", ?) ", " RETURNING ", primaryKeyName ctName] ctName = tableName chld ptName = tableName parent qs = concat $ intersperse ", " $ map (const "?") $ colNames cols = concat $ intersperse ", " $ colNames colNameFields = case primaryKey chld of { Nothing -> (columns ctName, toRow chld) Just pkey -> (columns_ ctName, (toField pkey) : (toRow chld)) } (_, fields) = colNameFields (colNames, _) = colNameFields foreignKey :: HasMany parent child => TableName parent -> TableName child -> String childrenOf :: HasMany parent child => parent -> TableName child -> Connection -> IO [child] childOf :: HasMany parent child => parent -> TableName child -> PrimaryKey child -> Connection -> IO (Maybe child) childOfBy :: (HasMany parent child, ToField v) => parent -> TableName child -> String -> v -> Connection -> IO (Maybe child) childrenOfBy :: (HasMany parent child, ToField f) => parent -> TableName child -> String -> f -> Connection -> IO [child] insertFor :: HasMany parent child => parent -> child -> Connection -> IO (PrimaryKey child) -- | Wrapper type representing PostgreSQL table names newtype TableName p TableName :: String -> TableName p -- | Unwraps a TableName fromTableName :: TableName p -> String fromString :: IsString a => String -> a -- | Class for string-like datastructures; used by the overloaded string -- extension (-foverloaded-strings in GHC). class IsString a fromString :: IsString a => String -> a instance Show (TableName p) instance Eq (TableName p) instance (FromParams a, FromParams b) => FromParams (a, b)