packages feed

loli 2009.6.26 → 2009.6.27

raw patch · 13 files changed

+278/−83 lines, 13 filesdep +bytestringdep +containersdep +templatePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: bytestring, containers, template

API changes (from Hackage documentation)

- Network.Loli: AppState :: Env -> Response -> AppState
- Network.Loli: Loli :: [RoutePath] -> [Middleware] -> [(String, String)] -> Loli
- Network.Loli: add_middleware :: Middleware -> Loli -> Loli
- Network.Loli: add_mime :: String -> String -> Loli -> Loli
- Network.Loli: add_route :: RoutePath -> Loli -> Loli
- Network.Loli: app :: Application -> AppUnit
- Network.Loli: captured :: AppUnitT [(String, String)]
- Network.Loli: data AppState
- Network.Loli: data Loli
- Network.Loli: delete :: String -> AppUnit -> Unit
- Network.Loli: env :: AppState -> Env
- Network.Loli: get :: String -> AppUnit -> Unit
- Network.Loli: get_env :: AppUnitT Env
- Network.Loli: get_response :: AppUnitT Response
- Network.Loli: html :: String -> AppUnit
- Network.Loli: insert_last :: a -> [a] -> [a]
- Network.Loli: io :: (MonadIO m) => IO a -> m a
- Network.Loli: loli :: Unit -> Application
- Network.Loli: lookup_mime :: [(String, String)] -> Middleware
- Network.Loli: middleware :: Middleware -> Unit
- Network.Loli: middlewares :: Loli -> [Middleware]
- Network.Loli: mime :: String -> String -> Unit
- Network.Loli: mimes :: Loli -> [(String, String)]
- Network.Loli: parse_params :: String -> String -> Maybe (String, [(String, String)])
- Network.Loli: post :: String -> AppUnit -> Unit
- Network.Loli: public :: Maybe String -> [String] -> Unit
- Network.Loli: put :: String -> AppUnit -> Unit
- Network.Loli: response :: AppState -> Response
- Network.Loli: route :: RequestMethod -> String -> AppUnit -> Unit
- Network.Loli: router :: [RoutePath] -> Middleware
- Network.Loli: routes :: Loli -> [RoutePath]
- Network.Loli: run_app :: AppUnit -> Application
- Network.Loli: set_response :: Response -> AppUnit
- Network.Loli: text :: String -> AppUnit
- Network.Loli: type AppUnit = AppUnitT ()
- Network.Loli: type AppUnitT a = StateT AppState IO a
- Network.Loli: type EnvFilter = Env -> Env
- Network.Loli: type Param = (String, String)
- Network.Loli: type ResponseFilter = Response -> Response
- Network.Loli: type RoutePath = (RequestMethod, String, AppUnit)
- Network.Loli: type Unit = UnitT ()
- Network.Loli: type UnitT a = State Loli a
- Network.Loli: update :: (MonadState a m, Functor m) => (a -> a) -> m ()
- Network.Loli: update_env :: EnvFilter -> AppUnit
- Network.Loli: update_response :: ResponseFilter -> AppUnit
+ Network.Loli.Config: loli_bindings :: String
+ Network.Loli.Config: loli_captures :: String
+ Network.Loli.Config: loli_views :: String
+ Network.Loli.Config: pre_installed_middlewares :: [Middleware]
+ Network.Loli.DSL: app :: Application -> AppUnit
+ Network.Loli.DSL: bind :: String -> String -> AppUnit -> AppUnit
+ Network.Loli.DSL: bindings :: AppUnitT [(String, String)]
+ Network.Loli.DSL: captures :: AppUnitT [(String, String)]
+ Network.Loli.DSL: context :: [(String, String)] -> AppUnit -> AppUnit
+ Network.Loli.DSL: delete :: String -> AppUnit -> Unit
+ Network.Loli.DSL: get :: String -> AppUnit -> Unit
+ Network.Loli.DSL: html :: String -> AppUnit
+ Network.Loli.DSL: io :: (MonadIO m) => IO a -> m a
+ Network.Loli.DSL: middleware :: Middleware -> Unit
+ Network.Loli.DSL: mime :: String -> String -> Unit
+ Network.Loli.DSL: post :: String -> AppUnit -> Unit
+ Network.Loli.DSL: public :: Maybe String -> [String] -> Unit
+ Network.Loli.DSL: put :: String -> AppUnit -> Unit
+ Network.Loli.DSL: text :: String -> AppUnit
+ Network.Loli.DSL: views :: String -> Unit
+ Network.Loli.Engine: Loli :: [RoutePath] -> [Middleware] -> [(String, String)] -> Loli
+ Network.Loli.Engine: add_middleware :: Middleware -> Loli -> Loli
+ Network.Loli.Engine: add_mime :: String -> String -> Loli -> Loli
+ Network.Loli.Engine: add_route :: RoutePath -> Loli -> Loli
+ Network.Loli.Engine: data Loli
+ Network.Loli.Engine: instance Default Loli
+ Network.Loli.Engine: loli :: Unit -> Application
+ Network.Loli.Engine: lookup_mime :: [(String, String)] -> Middleware
+ Network.Loli.Engine: middlewares :: Loli -> [Middleware]
+ Network.Loli.Engine: mimes :: Loli -> [(String, String)]
+ Network.Loli.Engine: parse_params :: String -> String -> Maybe (String, [(String, String)])
+ Network.Loli.Engine: route :: RequestMethod -> String -> AppUnit -> Unit
+ Network.Loli.Engine: router :: [RoutePath] -> Middleware
+ Network.Loli.Engine: routes :: Loli -> [RoutePath]
+ Network.Loli.Engine: run_app :: AppUnit -> Application
+ Network.Loli.Engine: type AppReader = Env
+ Network.Loli.Engine: type AppState = Response
+ Network.Loli.Engine: type AppUnit = AppUnitT ()
+ Network.Loli.Engine: type AppUnitT a = ReaderT AppReader (StateT AppState IO) a
+ Network.Loli.Engine: type EnvFilter = Env -> Env
+ Network.Loli.Engine: type Param = (String, String)
+ Network.Loli.Engine: type ResponseFilter = Response -> Response
+ Network.Loli.Engine: type RoutePath = (RequestMethod, String, AppUnit)
+ Network.Loli.Engine: type Unit = UnitT ()
+ Network.Loli.Engine: type UnitT a = State Loli a
+ Network.Loli.Engine: update :: (MonadState a m, Functor m) => (a -> a) -> m ()
+ Network.Loli.Template: template :: Template -> String -> AppUnit
+ Network.Loli.Template: type Context = [(String, String)]
+ Network.Loli.Template: type Template = String -> Context -> IO ByteString
+ Network.Loli.Template.TextTemplate: text_template :: String -> AppUnit
+ Network.Loli.Utils: add_namespace :: String -> String -> String -> Env -> Env
+ Network.Loli.Utils: insert_last :: a -> [a] -> [a]
+ Network.Loli.Utils: namespace :: String -> Env -> [(String, String)]
+ Network.Loli.Utils: set_namespace :: String -> [(String, String)] -> Env -> Env

Files

Nemesis view
@@ -4,6 +4,8 @@     [ "**/*.hi"     , "**/*.o"     , "manifest"+    , "Test"+    , "myloli"     ]        desc "prepare cabal dist"@@ -23,3 +25,16 @@     sh "ghc --make -isrc src/Test.hs -o Test"     sh "echo done.."     sh "./Test"+    +  desc "show sloc"+  task "stat" $ do+    sh "cloc -match-f=hs$ --quiet src --no3"+    ++  task "template" $ sh "ghci -isrc src/Network/Loli/Template.hs"+  +  task "loli" $ do+    sh "ghc --make -isrc src/Test/myloli.hs -o myloli"+    sh "echo done.."+    sh "./myloli"+
changelog.md view
@@ -1,3 +1,12 @@+2009.6.27+---------++### Feature++* add template+* add local binding+* env and response are in reader and state monad respectively+ 2009.6.26 ---------
loli.cabal view
@@ -1,5 +1,5 @@ Name:                 loli-Version:              2009.6.26+Version:              2009.6.27 Build-type:           Simple Synopsis:             A minimum web dev DSL in Haskell Description:@@ -14,15 +14,18 @@ Cabal-version:        >= 1.2 category:             Web homepage:             http://github.com/nfjinjing/loli-data-files:           readme.md, changelog.md, Nemesis, known-issues.md, src/Test.hs+data-files:           readme.md, changelog.md, Nemesis, known-issues.md, src/Test.hs, views/hello.html  library   ghc-options: -Wall-  build-depends: base > 4 && <= 5, data-default, hack >= 2009.5.19, hack-contrib >= 2009.6.25, utf8-string, mps >= 2009.6.25, mtl+  build-depends: base > 4 && <= 5, data-default, hack >= 2009.5.19, hack-contrib >= 2009.6.25, utf8-string, mps >= 2009.6.25, mtl, containers, template, bytestring   hs-source-dirs: src/   exposed-modules:                         Network.Loli-  other-modules:                       Network.Loli.Config                       Network.Loli.DSL                       Network.Loli.Engine+                      Network.Loli.Template+                      Network.Loli.Template.TextTemplate+                      Network.Loli.Utils+
readme.md view
@@ -1,29 +1,96 @@-### Example+# loli +A minimum web dev DSL++## Example++First app++    -- myloli.hs+         import Network.Loli     import Hack.Handler.Happstack     +    main = run . loli $ get "/" (text "loli power")++Install and compile:++    cabal update+    cabal install loli+    cabal install hack-handler-happstack     -    main = run . loli $ do+    ghc --make myloli.hs+    ./myloli -      -- simple-      get "/hello"    (text "hello world")-      -      -- io-      get "/cabal"    $ text =<< io (readFile "loli.cabal")+check: <http://localhost:3000> -      -- route captures-      get "/say/:user/:verb" $ do-        text . show =<< captured -      -- html output-      get "/html"     (html "<html><body><p>loli power!</p></body></html>")+## Routes -      -- default-      get "/"         (text "at root")+### Verb -      -- public serve, only allows /src-      public (Just ".") ["/src"]-      -      -- treat .hs extension as text/plain-      mime "hs" "text/plain"+    get "/" $ do+      -- something for a get request++    post "/" $ do+      -- for a post request+    +    put "/" $ do+      -- put ..+    +    delete "/" $ do+      -- ..+### Captures++    get "/say/:user/:something" $ do+      text . show =<< captures++    -- /say/jinjing/hello will output+    -- [("user","jinjing"),("something","hello")]+++## Static++    -- public serve, only allows /src+    public (Just ".") ["/src"]++## Views++    -- in `./views`, can be changed by+    views "template"++### Text Template++    import Network.Loli.Template.TextTemplate+    +    -- template+    get "/hi/:user" $ text_template "hello.html"+    +    -- in hello.html+    <html>+    <title>hello</title>+    <body>+      <p>hello $user</p>+    </body>+    </html>++### Local bindings++    get "/local-binding" $ do+      bind "user" "alice" (text_template "hello.html")++### Batched local bindings++    get "/batched-local-binding" $ do+      context [("user", "alice"), ("password", "foo")] $ +        text . show =<< bindings+++## Mime types++    -- treat .hs extension as text/plain+    mime "hs" "text/plain"++## Note++If you see this, use the git version!
src/Network/Loli.hs view
@@ -5,5 +5,5 @@ ) where -import Network.Loli.Engine+import Network.Loli.Engine (loli) import Network.Loli.DSL
src/Network/Loli/Config.hs view
@@ -1,18 +1,33 @@ module Network.Loli.Config where  import Hack+import Hack.Contrib.Middleware.Config import Hack.Contrib.Middleware.ContentLength import Hack.Contrib.Middleware.ContentType+import MPS.Light+import Prelude hiding ((.), (>), (^))  pre_installed_middlewares :: [Middleware] pre_installed_middlewares =    [     content_length   , content_type default_content_type+  , config set_view_root   ]   where+    set_view_root env =+      let hack_headers = env.hackHeaders+          view_root = (loli_views ++ "root", "views")+      in+      env {hackHeaders = hack_headers ++ [view_root]}     default_content_type :: String     default_content_type = "text/plain; charset=UTF-8"     -loli_captures_prefix :: String-loli_captures_prefix = "loli_captures_"+loli_captures :: String+loli_captures = "loli_captures_"++loli_bindings :: String+loli_bindings = "loli_bindings_"++loli_views :: String+loli_views = "loli_views_"
src/Network/Loli/DSL.hs view
@@ -1,32 +1,36 @@ module Network.Loli.DSL where +import Control.Monad.Reader import Control.Monad.State import Data.ByteString.Lazy.UTF8 (fromString) import Hack import Hack.Contrib.Constants+import Hack.Contrib.Middleware.Config import Hack.Contrib.Middleware.Static import Hack.Contrib.Response import MPS-import Network.Loli.Engine import Network.Loli.Config+import Network.Loli.Engine+import Network.Loli.Utils import Prelude hiding ((.), (>), (^)) import qualified Control.Monad.State as State - app :: Application -> AppUnit-app f = do-  get_env >>= (f > io) >>= set_response+app f = ask >>= (f > io) >>= State.put  text :: String -> AppUnit text x = do-  update_response $ set_content_type _TextPlain-  update_response $ set_body (x.fromString)+  update $ set_content_type _TextPlain+  update $ set_body (x.fromString)  html :: String -> AppUnit html x = do-  update_response $ set_content_type _TextHtml-  update_response $ set_body (x.fromString)+  update $ set_content_type _TextHtml+  update $ set_body (x.fromString) +views :: String -> Unit+views x = middleware $ config (set_namespace loli_views [("root", x)])+ get, put, delete, post :: String -> AppUnit -> Unit get    = route GET put    = route PUT@@ -45,10 +49,12 @@ 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))-      +context :: [(String, String)] -> AppUnit -> AppUnit+context = set_namespace loli_bindings > local++bind :: String -> String -> AppUnit -> AppUnit+bind k v = context [(k, v)]++captures, bindings :: AppUnitT [(String, String)]+captures = ask ^ namespace loli_captures+bindings = ask ^ namespace loli_bindings
src/Network/Loli/Engine.hs view
@@ -2,6 +2,7 @@  module Network.Loli.Engine where +import Control.Monad.Reader hiding (join) import Control.Monad.State hiding (join) import Data.Default import Data.List (find)@@ -12,27 +13,23 @@ import Hack.Contrib.Utils hiding (get, put) import MPS import Network.Loli.Config-import Network.Loli.Config+import Network.Loli.Utils import Prelude hiding ((.), (/), (>), (^)) -type RoutePath = (RequestMethod, String, AppUnit)-type EnvFilter = Env -> Env++type RoutePath      = (RequestMethod, String, AppUnit)+type EnvFilter      = Env -> Env type ResponseFilter = Response -> Response-type Param = (String, String)-data AppState = AppState-  {-    env :: Env-  , response :: Response-  }+type Param          = (String, String)+type AppState       = Response+type AppReader      = Env -instance Default AppState where-  def = AppState def def+type AppUnitT a     = ReaderT AppReader (StateT AppState IO) a+type AppUnit        = AppUnitT () -type AppUnitT a = StateT AppState IO a-type AppUnit = AppUnitT ()  run_app :: AppUnit -> Application-run_app unit = \env -> execStateT unit def {env} ^ response+run_app unit = \env -> runReaderT unit env .flip execStateT def  router :: [RoutePath] -> Middleware router h app' = \env'' ->@@ -52,14 +49,11 @@     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}-      +    merge_captured params env' = +      env'.set_namespace loli_captures params   parse_params :: String -> String -> Maybe (String, [(String, String)])+parse_params "/" s = Just (s, []) parse_params t s =   let template_tokens = t.split "/"       url_tokens = s.split "/"@@ -92,10 +86,10 @@   }  instance Default Loli where-  def = Loli def def def+  def = Loli def [dummy_middleware] def  type UnitT a = State Loli a-type Unit = UnitT ()+type Unit    = UnitT ()   @@ -117,9 +111,6 @@ update :: (MonadState a m, Functor m) => (a -> a) -> m () update f = get ^ f >>= put -insert_last :: a -> [a] -> [a]-insert_last x xs = xs ++ [x]- add_route :: RoutePath -> Loli -> Loli add_route r s = let xs = s.routes in s {routes = xs.insert_last r} @@ -132,21 +123,6 @@  add_mime :: String -> String -> Loli -> Loli add_mime k v s = let xs = s.mimes in s {mimes = xs.insert_last (k, v)}--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--get_response :: AppUnitT Response-get_response = get ^ response--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/Network/Loli/Template.hs view
@@ -0,0 +1,23 @@+module Network.Loli.Template where++import Control.Monad.Reader+import Data.Maybe+import Hack.Contrib.Response+import MPS+import Network.Loli.Config+import Network.Loli.DSL+import Network.Loli.Engine+import Network.Loli.Utils+import Prelude hiding ((.), (>), (^), (/))+import qualified Data.ByteString.Lazy.Char8 as B+++type Context = [(String, String)]+type Template = String -> Context -> IO B.ByteString++template :: Template -> String -> AppUnit+template f x = do+  c <- captures+  b <- bindings+  root <- ask ^ namespace loli_views ^ lookup "root" ^ fromMaybe "."+  f (root / x) (c ++ b) .io >>= set_body > update
+ src/Network/Loli/Template/TextTemplate.hs view
@@ -0,0 +1,20 @@+module Network.Loli.Template.TextTemplate (text_template) where++import Control.Arrow ((***))+import Data.ByteString.Lazy.UTF8 (fromString)+import MPS+import Network.Loli.Engine+import Network.Loli.Template+import Prelude hiding ((.), (>), (^), (/))+import Text.Template hiding (Context, Template, template)+import qualified Data.ByteString.Lazy.Char8 as B+import qualified Data.Map as Map++create_context :: [(String, String)] -> Map.Map B.ByteString B.ByteString+create_context = map (fromString *** fromString) > to_h++backend :: Template+backend x c = readTemplate (x.u2b) ^ flip render (create_context c)++text_template :: String -> AppUnit+text_template = template backend
+ src/Network/Loli/Utils.hs view
@@ -0,0 +1,29 @@+module Network.Loli.Utils where++import Hack+import Hack.Contrib.Utils+import MPS.Light+import Prelude hiding ((.), (/), (>), (^))++namespace :: String -> Env -> [(String, String)]+namespace x env =+  env+    .custom+    .select (fst > starts_with x)+    .map_fst (drop (x.length))++set_namespace :: String -> [(String, String)] -> Env -> Env+set_namespace x xs env = +  let adds = xs.map_fst (x ++)+      new_headers = adds.map fst+      new_hack_headers = +        env.custom.reject (fst > belongs_to new_headers) ++ adds+  in+  env {hackHeaders = new_hack_headers}+++add_namespace :: String -> String -> String -> Env -> Env+add_namespace x k v = set_namespace x [(k,v)]++insert_last :: a -> [a] -> [a]+insert_last x xs = xs ++ [x]
src/Test.hs view
@@ -1,6 +1,12 @@ import Network.Loli import Hack.Handler.Happstack+import Hack.Contrib.Response+import Hack.Contrib.Utils (dummy_middleware)+import Network.Loli.Template.TextTemplate+import Network.Loli.Engine +-- default on port 3000+ main = run . loli $ do    -- simple@@ -10,12 +16,31 @@   get "/cabal"    $ text =<< io (readFile "loli.cabal")    -- route captures-  get "/say/:user/:verb" $ do-    text . show =<< captured+  get "/say/:user/:something" $ do+    text . show =<< captures    -- html output   get "/html"     (html "<html><body><p>loli power!</p></body></html>") +  -- template+  get "/hi/:user"        $ text_template "hello.html"++  -- manually tweak the reponse body+  get "/hi-html/:user" $ do+    update $ set_content_type "text/html"+    text_template "hello.html"++  -- add local binding+  get "/local-binding" $ do+    bind "user" "alice" (text_template "hello.html")+    +  +  -- batched local bindings+  get "/batched-local-binding" $ do+    context [("user", "alice"), ("password", "foo")] $ +      text .show =<< bindings+  +     -- default   get "/"         (text "at root") @@ -24,3 +49,4 @@      -- treat .hs extension as text/plain   mime "hs" "text/plain"+
+ views/hello.html view
@@ -0,0 +1,6 @@+<html>+<title>hello</title>+<body>+  <p>hello $user</p>+</body>+</html>