loli 2009.6.29 → 2009.7.2

raw patch · 15 files changed

+168/−97 lines, 15 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Nemesis +3/−4
• changelog.md +15/−3
• known-issues.md +0/−1
• loli.cabal +2/−1
• readme.md +27/−7
• src/Network/Loli/Config.hs +16/−20
• src/Network/Loli/DSL.hs +18/−6
• src/Network/Loli/Engine.hs +19/−13
• src/Network/Loli/Middleware/IOConfig.hs +6/−0
• src/Network/Loli/Middleware/LoliRouter.hs +24/−21
• src/Network/Loli/Template.hs +2/−2
• src/Network/Loli/Template/TextTemplate.hs +3/−3
• src/Network/Loli/Type.hs +23/−14
• src/Network/Loli/Utils.hs +2/−2
• src/Test/Test.hs +8/−0

@@ -15,9 +15,6 @@     sh "cabal configure"     sh "cabal sdist" -  desc "start console"-  task "i" (sh "ghci -isrc src/Test.hs")-   desc "put all .hs files in manifest"   task "manifest" $ do     sh "find . | grep 'hs$' > manifest"@@ -31,10 +28,12 @@    ghci "template" "Network/Loli/Template"   ghci "ipaste" "Test/LoliPaste"+  ghci "i" "Test/Test"      bin "test" "Test/Test"   bin "paste" "Test/LoliPaste"-  bin "myloli" "Test/myloli"+  bin "myapp" "Test/myapp"+  bin "debug" "Debug/Debug"         -- test

@@ -1,14 +1,26 @@+2009.7.2+--------++### Features++* before / after filter+* On the fly router switcher++### Fix++* safari display weird header+ 2009.6.29 --------- -### Feature+### Features  * Initial hackage release  2009.6.27 --------- -### Feature+### Features  * add template * add local binding@@ -17,7 +29,7 @@ 2009.6.26 --------- -### Feature+### Features  * add route 

@@ -1,2 +1,1 @@-* safari display weird header info * unknown server socket error in LoliPaste.hs, it has something to do with unicode convertion, i.e. changing ls form MPSUTF8 to ls in MPS fix the problem, but encoding stays in utf-8 instead of plain unicode chars

@@ -1,5 +1,5 @@ Name:                 loli-Version:              2009.6.29+Version:              2009.7.2 Build-type:           Simple Synopsis:             A minimum web dev DSL in Haskell Description:@@ -25,6 +25,7 @@                       Network.Loli.Config                       Network.Loli.DSL                       Network.Loli.Engine+                      Network.Loli.Middleware.IOConfig                       Network.Loli.Middleware.LoliRouter                       Network.Loli.Middleware.UserMime                       Network.Loli.Template

@@ -6,7 +6,7 @@  First app -    -- myloli.hs+    -- myapp.hs          import Network.Loli     import Hack.Handler.Happstack@@ -19,15 +19,15 @@     cabal install loli     cabal install hack-handler-happstack     -    ghc --make myloli.hs-    ./myloli+    ghc --make myapp.hs+    ./myapp  check: <http://localhost:3000>   ## Routes -### Verb+### Verbs      get "/" $ do       -- something for a get request@@ -40,6 +40,7 @@          delete "/" $ do       -- ..+ ### Captures      get "/say/:user/:message" $ do@@ -51,7 +52,7 @@  ## Static -    -- public serve, only allows /src+    -- public serve, only allows `./src`     public (Just ".") ["/src"]  ## Views root@@ -65,7 +66,6 @@      import Network.Loli.Template.TextTemplate     -    -- template     get "/hi/:user" $ output (text_template "hello.html")          -- in hello.html@@ -137,6 +137,22 @@     -- treat .hs extension as text/plain     mime "hs" "text/plain" +## Filters++    -- before takes a function of type (Env -> IO Env)+    before $ \e -> do+      putStrLn "before called"+      return e+    +    -- after takes that of type (Response -> IO Response)+    after return++## On the fly router switcher++The router can be switched at any time, it will effect any route path that follows.+    +    router loli_router+ ## Hack integration  ### Use hack middleware@@ -155,4 +171,8 @@  ## Note -If you see this, use the git version!+use the git version ...++## Reference++* loli is inspired by [Rack](http://rack.rubyforge.org), [Rails](http://rubyonrails.org), [Ramaze](http://ramaze.net), [Happstack](http://happstack.com/) and [Sinatra](http://www.sinatrarb.com/).

@@ -18,32 +18,28 @@   where     set_view_root env =       let hack_headers = env.hackHeaders-          pre_config = [(loli_config ++ loli_views, loli_default_views)]+          pre_config   = [(loli_config ++ loli_views, loli_default_views)]       in       env {hackHeaders = hack_headers ++ pre_config}     default_content_type :: String     default_content_type = "text/plain; charset=UTF-8"-    -loli_captures :: String-loli_captures = "loli-captures-" -loli_locals :: String-loli_locals = "loli-locals-" -loli_partials :: String-loli_partials = "loli-partials-" -loli_config :: String-loli_config = "loli-config-"--loli_layout :: String-loli_layout = "layout"--loli_views :: String-loli_views = "views"--loli_default_views :: String-loli_default_views = "views"-+loli_captures       :: String+loli_locals         :: String+loli_partials       :: String+loli_config         :: String+loli_layout         :: String+loli_views          :: String+loli_default_views  :: String loli_layout_content :: String++loli_captures       = "loli-captures-"+loli_locals         = "loli-locals-"+loli_partials       = "loli-partials-"+loli_config         = "loli-config-"+loli_layout         = "layout"+loli_views          = "views"+loli_default_views  = "views" loli_layout_content = "content"

@@ -3,11 +3,13 @@ import Control.Monad.Reader import Control.Monad.State import Hack+import Hack.Contrib.Middleware.Censor import Hack.Contrib.Middleware.Config import Hack.Contrib.Middleware.Static import MPS import Network.Loli.Config import Network.Loli.Engine+import Network.Loli.Middleware.IOConfig import Network.Loli.Type import Network.Loli.Utils import Prelude hiding ((.), (>), (^))@@ -24,14 +26,24 @@ views :: String -> Unit views x = middleware $ config (set_namespace loli_config loli_views x) -get, put, delete, post :: String -> AppUnit -> Unit-get    = route GET-put    = route PUT-delete = route DELETE-post   = route POST+router :: Router -> Unit+router = set_router > update +get, put, post, delete :: String -> AppUnit -> Unit+get    = add_route GET+put    = add_route PUT+post   = add_route POST+delete = add_route DELETE++ middleware :: Middleware -> Unit-middleware x = add_middleware x .update+middleware = add_middleware > update++before :: (Env -> IO Env) -> Unit+before = ioconfig > middleware++after :: (Response -> IO Response) -> Unit+after = censor > middleware  mime :: String -> String -> Unit mime k v = add_mime k v .update

@@ -17,28 +17,34 @@ import Prelude hiding ((.), (/), (>), (^))  run_app :: AppUnit -> Application-run_app unit = \env -> runReaderT unit env .flip execStateT def+run_app unit = \env -> runReaderT unit env .flip execStateT def {status = 200}  loli :: Unit -> Application loli unit = run unit (not_found empty_app)   where+    run_route x = (x.router) loli_captures run_app (x.route_path)+         run :: Unit -> Middleware     run unit' = -      let loli_state  = execState unit' def-          paths       = loli_state.routes-          -          loli_app    = loli_router loli_captures run_app paths -          mime_filter = user_mime (loli_state.mimes)-          stack       = loli_state.middlewares.use-          pre         = pre_installed_middlewares.use+      let loli_state    = execState unit' def+          route_configs = loli_state.routes+          route         = route_configs.map run_route .use+          mime_filter   = user_mime (loli_state.mimes)+          stack         = loli_state.middlewares.use+          pre           = pre_installed_middlewares.use       in-      use [pre, mime_filter, stack, loli_app]+      use [pre, mime_filter, stack, route] -add_route :: RoutePath -> Loli -> Loli-add_route r s = let xs = s.routes in s {routes = xs.insert_last r}+add_route_config :: RouteConfig -> Loli -> Loli+add_route_config r s = let xs = s.routes in s {routes = xs.insert_last r} -route :: RequestMethod -> String -> AppUnit -> Unit-route r s u = update $ add_route (r, s, u)+add_route :: RequestMethod -> String -> AppUnit -> Unit+add_route r s u = do+  c <- get ^ current_router+  update $ add_route_config RouteConfig { route_path = (r, s, u), router = c }++set_router :: Router -> Loli -> Loli+set_router r x = x { current_router = r }  add_middleware :: Middleware -> Loli -> Loli add_middleware x s = 

@@ -0,0 +1,6 @@+module Network.Loli.Middleware.IOConfig (ioconfig) where++import Hack++ioconfig :: (Env -> IO Env) -> Middleware+ioconfig before app = \env -> before env >>= app

@@ -1,6 +1,5 @@ module Network.Loli.Middleware.LoliRouter (loli_router) where -import Data.List (find) import Data.Maybe import Hack import Hack.Contrib.Utils@@ -9,22 +8,24 @@ import Prelude hiding ((.), (>), (/))  -type RoutePathT a   = (RequestMethod, String, a)-type Assoc          = [(String, String)]+type RoutePathT a = (RequestMethod, String, a)+type Assoc        = [(String, String)] -loli_router :: String -> (a -> Application) -> [RoutePathT a] -> Middleware-loli_router prefix runner h app' = \env'' ->-  let path             = env''.path_info-      script           = env''.script_name-      mod_env location = env'' ++loli_router :: String -> (a -> Application) -> RoutePathT a -> Middleware+loli_router prefix runner route_path app' = \env ->+  let path             = env.path_info+      script           = env.script_name+      mod_env location = env          { scriptName  = script ++ location         , pathInfo    = path.drop (location.length)         }   in-  case h.find (match_route env'') of-    Nothing -> app' env''-    Just (_, template, app_state) -> do-      let (location, params) = parse_params template path .fromJust+  if route_path.match_route env.not+    then app' env+    else do+      let (_, template, app_state) = route_path+          (location, params) = parse_params template path .fromJust       runner app_state (mod_env location .merge_captured params)   where     match_route env' (method, template, _) = @@ -35,13 +36,14 @@   parse_params :: String -> String -> Maybe (String, Assoc)-parse_params "" ""   = Just ("", [])-parse_params "" _    = Nothing+parse_params "" ""  = Just ("", [])+parse_params "" _   = Nothing parse_params "/" "" = Nothing-parse_params "/" _ = Just ("/", [])-parse_params t s =+parse_params "/" _  = Just ("/", [])++parse_params t s =    let template_tokens = t.split "/"-      url_tokens = s.split "/"+      url_tokens      = s.split "/"   in   if url_tokens.length < template_tokens.length     then Nothing@@ -50,9 +52,10 @@       in       if rs.all isJust         then -          let location = "/" / url_tokens.take (template_tokens.length).join "/"+          let token_length = template_tokens.length+              location     = "/" / url_tokens.take token_length .join "/"           in-          Just $ (location, rs.map fromJust.filter isJust.map fromJust)+          Just $ (location, rs.catMaybes.catMaybes)         else Nothing      where@@ -64,8 +67,8 @@ -- copy from loli utils put_namespace :: String -> Assoc -> Env -> Env put_namespace x xs env = -  let adds = xs.map_fst (x ++)-      new_headers = adds.map fst+  let adds             = xs.map_fst (x ++)+      new_headers      = adds.map fst       new_hack_headers =          env.custom.reject (fst > belongs_to new_headers) ++ adds   in

@@ -35,9 +35,9 @@ template_locals :: AppUnitT Context template_locals = do   c <- captures-  b <- locals+  l <- locals   p <- partial_locals-  return (c ++ b ++ p)+  return (c ++ l ++ p)  render :: (Template a) => a -> AppUnitT String render x = do

@@ -8,8 +8,8 @@ import Text.Template hiding (Context, Template, template) import qualified Text.Template as T -render_TextTemplate :: String -> Context -> IO String-render_TextTemplate x c = +render_text_template :: String -> Context -> IO String+render_text_template x c =    readTemplate (x.u2b) ^ flip T.render (create_context c) ^ toString   where     create_context = map (fromString *** fromString) > to_h@@ -17,7 +17,7 @@ data TextTemplate = TextTemplate String  instance Template TextTemplate where-  interpolate (TextTemplate x) r = render_TextTemplate (r / x)+  interpolate (TextTemplate x) r = render_text_template (r / x)  text_template :: String -> TextTemplate text_template = TextTemplate

@@ -5,28 +5,37 @@ import Data.Default import Hack import Hack.Contrib.Utils+import Network.Loli.Middleware.LoliRouter -type RoutePathT a   = (RequestMethod, String, a)-type RoutePath      = RoutePathT AppUnit-type EnvFilter      = Env -> Env-type ResponseFilter = Response -> Response-type Assoc          = [(String, String)]-type AppState       = Response-type AppReader      = Env+type RoutePathT a = (RequestMethod, String, a)+type RoutePath    = RoutePathT AppUnit+type AppReader    = Env+type AppState     = Response+type AppUnitT     = ReaderT AppReader (StateT AppState IO)+type AppUnit      = AppUnitT ()+type Assoc        = [(String, String)]+type Context      = Assoc -type AppUnitT       = ReaderT AppReader (StateT AppState IO)-type AppUnit        = AppUnitT ()-type Context        = Assoc+type RouterT a = String -> (a -> Application) -> RoutePathT a -> Middleware+type Router    = RouterT AppUnit +data RouteConfig = RouteConfig+  {+    route_path :: RoutePath+  , router     :: Router+  }+ data Loli = Loli   {-    routes :: [RoutePath]-  , middlewares :: [Middleware]-  , mimes :: Assoc+    current_router  :: Router+  , routes          :: [RouteConfig]+  , middlewares     :: [Middleware]+  , mimes           :: Assoc   } + instance Default Loli where-  def = Loli def [dummy_middleware] def+  def = Loli loli_router def [dummy_middleware] def   type UnitT a = State Loli a

@@ -15,8 +15,8 @@  put_namespace :: String -> [(String, String)] -> Env -> Env put_namespace x xs env = -  let adds = xs.map_fst (x ++)-      new_headers = adds.map fst+  let adds             = xs.map_fst (x ++)+      new_headers      = adds.map fst       new_hack_headers =          env.custom.reject (fst > belongs_to new_headers) ++ adds   in

@@ -8,6 +8,7 @@ import Network.Loli.Template.ConstTemplate (const_template) import Network.Loli.Template.TextTemplate import Network.Loli.Utils+import Network.Loli.Middleware.LoliRouter import Data.Maybe import MPS ((^)) import Prelude hiding ((^))@@ -15,14 +16,21 @@  -- default on port 3000 +main :: IO () main = run . loli $ do        middleware lambda     middleware show_status+    +    before return+    after return      get "/bench"     $ do       name <- ask ^ params ^ lookup "name" ^ fromMaybe "nobody"       html ("<h1>" ++ name ++ "</h1>")++    -- on the fly router switcher+    router loli_router      -- simple     get "/hello"    (text "hello world")