packages feed

loli 2009.6.25 → 2009.6.26

raw patch · 7 files changed

+137/−61 lines, 7 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

- Network.Loli: add_env_filter :: EnvFilter -> AppState -> AppState
- Network.Loli: add_response_filter :: ResponseFilter -> AppState -> AppState
- Network.Loli: application :: AppState -> Application
- Network.Loli: env_filters :: AppState -> [EnvFilter]
- Network.Loli: path :: AppState -> String
- Network.Loli: request :: EnvFilter -> AppUnit
- Network.Loli: response_filters :: AppState -> [ResponseFilter]
- Network.Loli: set_application :: Application -> AppState -> AppState
+ Network.Loli: captured :: AppUnitT [(String, String)]
+ Network.Loli: env :: AppState -> Env
+ Network.Loli: get_env :: AppUnitT Env
+ Network.Loli: get_response :: AppUnitT Response
+ Network.Loli: io :: (MonadIO m) => IO a -> m a
+ Network.Loli: parse_params :: String -> String -> Maybe (String, [(String, String)])
+ Network.Loli: set_response :: Response -> AppUnit
+ Network.Loli: type AppUnitT a = StateT AppState IO a
+ Network.Loli: type UnitT a = State Loli a
+ Network.Loli: update_env :: EnvFilter -> AppUnit
+ Network.Loli: update_response :: ResponseFilter -> AppUnit
- Network.Loli: AppState :: Application -> [EnvFilter] -> [ResponseFilter] -> String -> AppState
+ Network.Loli: AppState :: Env -> Response -> AppState
- Network.Loli: response :: ResponseFilter -> AppUnit
+ Network.Loli: response :: AppState -> Response
- Network.Loli: run_app :: String -> AppUnit -> Application
+ Network.Loli: run_app :: AppUnit -> Application
- Network.Loli: type AppUnit = State AppState ()
+ Network.Loli: type AppUnit = AppUnitT ()
- Network.Loli: type Unit = State Loli ()
+ Network.Loli: type Unit = UnitT ()

Files

changelog.md view
@@ -1,4 +1,11 @@-2009.5.22+2009.6.26+---------++### Feature++* add route++2009.6.25 ---------  Init
loli.cabal view
@@ -1,10 +1,10 @@ Name:                 loli-Version:              2009.6.25+Version:              2009.6.26 Build-type:           Simple-Synopsis:             loli+Synopsis:             A minimum web dev DSL in Haskell Description:-        -    A minimum web dev DSL in Haskell+    +    A simple and easy to use library for fast web prototyping in Haskell.  License:              BSD3 License-file:         LICENSE
readme.md view
@@ -2,12 +2,28 @@      import Network.Loli     import Hack.Handler.Happstack-+    +         main = run . loli $ do -      get "/hello" (text "hello world")-      get "/" (html "<html><body><p>loli power!</p></body></html>")+      -- simple+      get "/hello"    (text "hello world")+      +      -- io+      get "/cabal"    $ text =<< io (readFile "loli.cabal") -      public (Just ".") ["/src"]+      -- route captures+      get "/say/:user/:verb" $ do+        text . show =<< captured +      -- html output+      get "/html"     (html "<html><body><p>loli power!</p></body></html>")++      -- default+      get "/"         (text "at root")++      -- public serve, only allows /src+      public (Just ".") ["/src"]+      +      -- treat .hs extension as text/plain       mime "hs" "text/plain"
src/Network/Loli/Config.hs view
@@ -13,3 +13,6 @@   where     default_content_type :: String     default_content_type = "text/plain; charset=UTF-8"+    +loli_captures_prefix :: String+loli_captures_prefix = "loli_captures_"
src/Network/Loli/DSL.hs view
@@ -1,27 +1,31 @@ module Network.Loli.DSL where --import MPS-import Prelude hiding ((.), (>), (^))-import Network.Loli.Engine+import Control.Monad.State+import Data.ByteString.Lazy.UTF8 (fromString) import Hack import Hack.Contrib.Constants-import Hack.Contrib.Response-import Data.ByteString.Lazy.UTF8 (fromString) import Hack.Contrib.Middleware.Static+import Hack.Contrib.Response+import MPS+import Network.Loli.Engine+import Network.Loli.Config+import Prelude hiding ((.), (>), (^))+import qualified Control.Monad.State as State + app :: Application -> AppUnit-app = set_application > update+app f = do+  get_env >>= (f > io) >>= set_response  text :: String -> AppUnit text x = do-  response $ set_content_type _TextPlain-  response $ set_body (x.fromString)+  update_response $ set_content_type _TextPlain+  update_response $ set_body (x.fromString)  html :: String -> AppUnit html x = do-  response $ set_content_type _TextHtml-  response $ set_body (x.fromString)+  update_response $ set_content_type _TextHtml+  update_response $ set_body (x.fromString)  get, put, delete, post :: String -> AppUnit -> Unit get    = route GET@@ -37,3 +41,14 @@  public :: Maybe String -> [String] -> Unit public r xs = middleware $ static r xs++io :: (MonadIO m) => IO a -> m a+io = liftIO++captured :: AppUnitT [(String, String)]+captured = get_env ^ hackHeaders ^ filter_captured+  where+    filter_captured =+        select (fst > starts_with loli_captures_prefix)+      > map_fst (drop (loli_captures_prefix.length))+
src/Network/Loli/Engine.hs view
@@ -2,46 +2,37 @@  module Network.Loli.Engine where -import Control.Monad.State+import Control.Monad.State hiding (join) import Data.Default import Data.List (find)+import Data.Maybe import Hack-import Hack.Contrib.Middleware.Censor-import Hack.Contrib.Middleware.Config import Hack.Contrib.Middleware.NotFound import Hack.Contrib.Response import Hack.Contrib.Utils hiding (get, put) import MPS import Network.Loli.Config+import Network.Loli.Config import Prelude hiding ((.), (/), (>), (^)) - type RoutePath = (RequestMethod, String, AppUnit) type EnvFilter = Env -> Env type ResponseFilter = Response -> Response type Param = (String, String) data AppState = AppState   {-    application :: Application-  , env_filters :: [EnvFilter]-  , response_filters :: [ResponseFilter]-  , path :: String+    env :: Env+  , response :: Response   }  instance Default AppState where-  def = AppState def [id] [id] def+  def = AppState def def -type AppUnit = State AppState ()+type AppUnitT a = StateT AppState IO a+type AppUnit = AppUnitT () -run_app :: String -> AppUnit -> Application-run_app path unit = -  let state = execState unit def {path}-      before = state.env_filters.map config-      after = state.response_filters.map (to_io_filter > censor)-  in-  state.application.use (before ++ after)-  where-    to_io_filter f = \x -> return (f x)+run_app :: AppUnit -> Application+run_app unit = \env -> execStateT unit def {env} ^ response  router :: [RoutePath] -> Middleware router h app' = \env'' ->@@ -54,12 +45,44 @@   in   case h.find (match_route env'') of     Nothing -> app' env''-    Just (_, location, app_state) -> -      run_app location app_state (mod_env location)+    Just (_, template, app_state) -> do+      let (location, params) = parse_params template path .fromJust+      run_app app_state (mod_env location .merge_captured params)   where-    match_route env' (method, path, _) = -      env'.request_method.is method && env'.path_info.starts_with path+    match_route env' (method, template, _) = +      env'.request_method.is method +        && env'.path_info.parse_params template .isJust+    merge_captured params env' =+      let loli_captures = params.map_fst (loli_captures_prefix ++)+          new_hack_headers = env'.custom ++ loli_captures+      in+      env' {hackHeaders = new_hack_headers}+       +parse_params :: String -> String -> Maybe (String, [(String, String)])+parse_params t s =+  let template_tokens = t.split "/"+      url_tokens = s.split "/"+  in+  if url_tokens.length < template_tokens.length+    then Nothing+    else +      let rs = zipWith capture template_tokens url_tokens+      in+      if rs.all isJust+        then +          let location = url_tokens.take (template_tokens.length).join "/"+          in+          Just $ (location, rs.map fromJust.filter isJust.map fromJust)+        else Nothing+  +  where+    capture x y +      | x.starts_with ":" = Just $ Just (x.tail, y)+      | x == y = Just Nothing+      | otherwise = Nothing+    +    data Loli = Loli   {@@ -71,7 +94,8 @@ instance Default Loli where   def = Loli def def def -type Unit = State Loli ()+type UnitT a = State Loli a+type Unit = UnitT ()   @@ -90,9 +114,6 @@       in       use [pre, mime_filter, stack, loli_app] -set_application :: Application -> AppState -> AppState-set_application application x = x { application }- update :: (MonadState a m, Functor m) => (a -> a) -> m () update f = get ^ f >>= put @@ -112,21 +133,20 @@ add_mime :: String -> String -> Loli -> Loli add_mime k v s = let xs = s.mimes in s {mimes = xs.insert_last (k, v)} -add_env_filter :: EnvFilter -> AppState -> AppState-add_env_filter x s = -  let xs = s.env_filters in s {env_filters = xs.insert_last x}--add_response_filter :: ResponseFilter -> AppState -> AppState-add_response_filter x s = -  let xs = s.response_filters in s {response_filters = xs.insert_last x}+update_response :: ResponseFilter -> AppUnit+update_response f = update $ \s -> let x = s.response.f in s {response = x} +set_response :: Response -> AppUnit+set_response r = update_response $ const r -request :: EnvFilter-> AppUnit-request x = add_env_filter x .update+get_response :: AppUnitT Response+get_response = get ^ response -response :: ResponseFilter -> AppUnit-response x = add_response_filter x .update+update_env :: EnvFilter -> AppUnit+update_env f = update $ \s -> let x = s.env.f in s {env = x} +get_env :: AppUnitT Env+get_env = get ^ env  -- middleware lookup_mime :: [(String, String)] -> Middleware
src/Test.hs view
@@ -2,10 +2,25 @@ import Hack.Handler.Happstack  main = run . loli $ do++  -- simple+  get "/hello"    (text "hello world")   -  get "/hello" (text "hello world")-  get "/" (html "<html><body><p>loli power!</p></body></html>")+  -- io+  get "/cabal"    $ text =<< io (readFile "loli.cabal") +  -- route captures+  get "/say/:user/:verb" $ do+    text . show =<< captured++  -- html output+  get "/html"     (html "<html><body><p>loli power!</p></body></html>")++  -- default+  get "/"         (text "at root")++  -- public serve, only allows /src   public (Just ".") ["/src"]-    +  +  -- treat .hs extension as text/plain   mime "hs" "text/plain"