packages feed

miku (empty) → 2011.6.11

raw patch · 14 files changed

+553/−0 lines, 14 filesdep +airdep +air-extradep +basesetup-changed

Dependencies added: air, air-extra, base, bytestring, containers, data-default, hack2, hack2-contrib, mtl, utf8-string

Files

+ LICENSE view
@@ -0,0 +1,31 @@+Copyright (c) 2011, Jinjing Wang++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Jinjing Wang nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Nemesis view
@@ -0,0 +1,40 @@+import System.Nemesis (run)+import System.Nemesis.DSL+import Air.Env ((-))+import Prelude hiding ((-))++main = run nemesis+nemesis = do+  +  clean+    [ "**/*.hi"+    , "**/*.o"+    , "manifest"+    ]+    +  desc "prepare cabal dist"+  task "dist" - do+    sh "cabal clean"+    sh "cabal configure"+    sh "cabal sdist"+++  desc "show sloc"+  task "stat" - do+    sh "cloc -match-f=hs- --quiet src --no3"+++  task "i" - do+    sh "ghci -isrc src/Test/Test.hs"+  +  task "run" - do+    sh "runghc -isrc src/Test/Test.hs"+    +  task "myapp" - do+    sh "runghc -isrc src/Test/myapp.hs"+    +  task "moe" - do+    sh "runghc -isrc src/Test/Moe.hs"++  task "moei" - do+    sh "ghci -isrc src/Test/Moe.hs"
+ Setup.lhs view
@@ -0,0 +1,4 @@+#! /usr/bin/env runhaskell++> import Distribution.Simple+> main = defaultMain
+ changelog.md view
+ known-issues.md view
+ miku.cabal view
@@ -0,0 +1,30 @@+Name:                 miku+Version:              2011.6.11+Build-type:           Simple+Synopsis:             A minimum web dev DSL in Haskell+Description:+    +    A simple library for fast web prototyping in Haskell.++License:              BSD3+License-file:         LICENSE+Author:               Jinjing Wang+Maintainer:           Jinjing Wang <nfjinjing@gmail.com>+Build-Depends:        base+Cabal-version:        >= 1.2+category:             Web+homepage:             http://github.com/nfjinjing/miku+data-files:           readme.md, changelog.md, Nemesis, known-issues.md++library+  ghc-options: -Wall+  build-depends: base > 4 && <= 5, data-default, hack2 >= 2009.7.15, hack2-contrib >= 2009.8.18, utf8-string, air >= 2011.6.11, air-extra >= 2011.6.11, mtl, containers, bytestring+  hs-source-dirs: src/+  exposed-modules:  +                      Network.Miku+                      Network.Miku.Config+                      Network.Miku.DSL+                      Network.Miku.Engine+                      Network.Miku.Middleware.MikuRouter+                      Network.Miku.Type+                      Network.Miku.Utils
+ readme.md view
@@ -0,0 +1,121 @@+# miku++A tiny web dev DSL++## Example++    {-# LANGUAGE OverloadedStrings #-}+    +    import Network.Miku+    import Hack2.Handler.HappstackServer+    +    main = run . miku $ get "/" (text "miku power")+++## Installation++    cabal update+    cabal install miku+    cabal install hack2-handler-happstack+    +    -- copy and paste the above example to myapp.hs+    +    runghc myapp.hs++check: <http://localhost:3000>++## Quick reference++<https://github.com/nfjinjing/miku/blob/master/src/Test/Test.hs>+++## Routes++### Verbs++    -- use - instead of $ for clarity+    import Air.Light ((-))+    import Prelude hiding ((-))+    +    import Network.Miku+    import Hack2.Handler.Happstack+    +    main = run . miku - do++      get "/" - do+        -- something for a get request++      post "/" - do+        -- for a post request+    +      put "/" - do+        -- put ..+    +      delete "/" - do+        -- ..++### Captures++    get "/say/:user/:message" - do+      text . show =<< captures++    -- /say/jinjing/hello will output+    -- [("user","jinjing"),("message","hello")]+++## Static++    -- public serve, only allows `./src`+    public (Just ".") ["/src"]++## Mime types++    -- 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++## Hack2 integration++### Use hack2 middleware++    -- note both etag and lambda middleware are removed ... for somce ghc 7.0 compatability ><+    +    import Hack2.Contrib.Middleware.SimpleAccessLogger+    +    middleware - simple_access_logger Nothing++### Convert miku into a hack2 application++    -- in Network.Miku.Engine+    +    miku :: Unit -> Application+++## Hints++* It's recommended to use your own html combinator / template engine. Try DIY with, e.g. [moe](http://github.com/nfjinjing/moe).+* [Example view using custom html combinator (moe in this case)](http://github.com/nfjinjing/miku/blob/master/src/Test/Moe.hs)+* When inspecting the request, use `ask` defined in `ReaderT` monad to get the `Hack2.Environment`, then use helper method defined in `Hack2.Contrib.Request` to query it.+* `Response` is in `StateT`, `html` and `text` are simply helper methods that update the state, i.e. setting the response body, content-type, etc.+* You do need to understand monad transformers to reach the full power of `miku`.+* For mac users, use `GHC 6.12.1` if you have trouble running the server.+    +## Reference++* miku 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/).+++<br/>++<p>+<a href="http://en.wikipedia.org/wiki/Hatsune_Miku"><img src="https://github.com/nfjinjing/miku/raw/master/ita.jpg"/></a>+</p>
+ src/Network/Miku.hs view
@@ -0,0 +1,9 @@+module Network.Miku+(+    module Network.Miku.DSL+  , module Network.Miku.Engine+)+where++import Network.Miku.Engine (miku)+import Network.Miku.DSL
+ src/Network/Miku/Config.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE OverloadedStrings #-}+++module Network.Miku.Config where++import Hack2+import Hack2.Contrib.Middleware.Config+import Hack2.Contrib.Middleware.ContentLength+import Hack2.Contrib.Middleware.ContentType+import Network.Miku.Utils+import Prelude hiding ((.), (>), (^), (-))+import Data.ByteString.Lazy.Char8 (ByteString)+++pre_installed_middlewares :: [Middleware]+pre_installed_middlewares = +  [+    content_length+  , content_type default_content_type+  ]+  where+    default_content_type = "text/plain; charset=UTF-8"+++miku_captures :: ByteString+miku_captures = "miku-captures-"
+ src/Network/Miku/DSL.hs view
@@ -0,0 +1,65 @@+module Network.Miku.DSL where++import Control.Monad.Reader+import Control.Monad.State+import Hack2+import Hack2.Contrib.Middleware.Censor+import Hack2.Contrib.Middleware.Config+import Hack2.Contrib.Middleware.IOConfig+import Hack2.Contrib.Middleware.Static+import Hack2.Contrib.Response+import Hack2.Contrib.Constants+import Air+import Network.Miku.Config+import Network.Miku.Engine+import Network.Miku.Type+import Network.Miku.Utils+import Prelude hiding ((.), (>), (^), (-))+import qualified Control.Monad.State as State+import Data.ByteString.Lazy.Char8 (ByteString)++app :: Application -> AppUnit+app f = ask >>= (f > io) >>= State.put+++router :: Router -> Unit+router = set_router > update++get, put, post, delete :: ByteString -> AppUnit -> Unit+get    = add_route GET+put    = add_route PUT+post   = add_route POST+delete = add_route DELETE+++middleware :: Middleware -> Unit+middleware = add_middleware > update++before :: (Env -> IO Env) -> Unit+before = ioconfig > middleware++after :: (Response -> IO Response) -> Unit+after = censor > middleware++mime :: ByteString -> ByteString -> Unit+mime k v = add_mime k v .update++public :: Maybe ByteString -> [ByteString] -> Unit+public r xs = middleware - static r xs++io :: (MonadIO m) => IO a -> m a+io = liftIO++text :: ByteString -> AppUnit+text x = do+  update - set_content_type _TextPlain+  update - set_body x++html :: ByteString -> AppUnit+html x = do+  update - set_content_type _TextHtml+  update - set_body x+++captures :: AppUnitT [(ByteString, ByteString)]+captures = ask ^ namespace miku_captures
+ src/Network/Miku/Engine.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE NamedFieldPuns #-}++module Network.Miku.Engine where++import Control.Monad.Reader hiding (join)+import Control.Monad.State hiding (join)+import Data.Default+import Hack2+import Hack2.Contrib.Middleware.UserMime+import Hack2.Contrib.Middleware.NotFound+import Hack2.Contrib.Utils hiding (get, put)+import Air.Env+import Network.Miku.Config+import Network.Miku.Middleware.MikuRouter ()+import Network.Miku.Type+import Network.Miku.Utils+import Prelude ()+import Data.ByteString.Lazy.Char8 (ByteString)++run_app :: AppUnit -> Application+run_app unit = \env -> runReaderT unit env .flip execStateT def {status = 200}++miku :: Unit -> Application+miku unit = run unit not_found_app+  where+    not_found_app = not_found dummy_app+    run_route x = (x.router) miku_captures run_app (x.route_path)+    +    run :: Unit -> Middleware+    run unit' = +      let miku_state    = execState unit' def+          route_configs = miku_state.routes+          route         = route_configs.map run_route .use+          mime_filter   = user_mime (miku_state.mimes)+          stack         = miku_state.middlewares.use+          pre           = pre_installed_middlewares.use+      in+      use [pre, mime_filter, stack, route]++add_route_config :: RouteConfig -> Miku -> Miku+add_route_config r s = let xs = s.routes in s {routes = xs.insert_last r}++add_route :: RequestMethod -> ByteString -> 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 -> Miku -> Miku+set_router r x = x { current_router = r }++add_middleware :: Middleware -> Miku -> Miku+add_middleware x s = +  let xs = s.middlewares in s {middlewares = xs.insert_last x}++add_mime :: ByteString -> ByteString -> Miku -> Miku+add_mime k v s = let xs = s.mimes in s {mimes = xs.insert_last (k, v)}++
+ src/Network/Miku/Middleware/MikuRouter.hs view
@@ -0,0 +1,77 @@+{-# LANGUAGE OverloadedStrings #-}++module Network.Miku.Middleware.MikuRouter (miku_router) where++import Data.Maybe+import Hack2+import Hack2.Contrib.Utils+import Hack2.Contrib.Utils hiding (get, put)+import Air.Env+import Air.Extra+import Prelude ()+import Data.ByteString.UTF8 (fromString)+import qualified Prelude as P+import qualified Data.ByteString.Lazy.Char8 as B+import Data.ByteString.Lazy.Char8 (ByteString)++type RoutePathT a = (RequestMethod, ByteString, a)++++miku_router :: ByteString -> (a -> Application) -> RoutePathT a -> Middleware+miku_router prefix runner route_path app = \env ->+  if route_path.match_route env.not+    then app env+    else do+      let (_, template, app_state) = route_path+          (_, params) = parse_params template (env.path_info) .fromJust+          +      runner app_state (env .merge_captured params)+  where+    match_route env' (method, template, _) = +      env'.request_method.is method +        && env'.path_info.parse_params template .isJust+        +    merge_captured params env' = +      env'.put_namespace prefix params +++parse_params :: ByteString -> ByteString -> Maybe (ByteString, [(ByteString, ByteString)])+parse_params "" ""  = Just ("", [])+parse_params "" _   = Nothing+parse_params "/" "" = Nothing+parse_params "/" _  = Just ("/", [])++parse_params t s = +  let template_tokens = t.B.split '/'+      url_tokens      = s.B.split '/'+  in+  if url_tokens.length P.< template_tokens.length+    then Nothing+    else +      let rs = zipWith capture template_tokens url_tokens+      in+      if rs.all isJust+        then +          let token_length = template_tokens.length+              location     = B.pack - "/" / (B.unpack - url_tokens.take token_length .B.intercalate "/")+          in+          Just - (location, rs.catMaybes.catMaybes)+        else Nothing+  +  where+    capture x y +      | x.B.unpack.starts_with ":" = Just - Just (x.B.tail, y)+      | x == y = Just Nothing+      | otherwise = Nothing+      +-- copy from miku utils+put_namespace :: ByteString -> [(ByteString, ByteString)] -> Env -> Env+put_namespace x xs env = +  let adds             = xs.map_fst (x +)+      new_headers      = adds.map fst+      new_hack_headers = +        env.hackHeaders.reject (fst > belongs_to new_headers) ++ adds+  in+  env {hackHeaders = new_hack_headers}+
+ src/Network/Miku/Type.hs view
@@ -0,0 +1,47 @@+module Network.Miku.Type where++import Control.Monad.Reader+import Control.Monad.State+import Data.Default+import Hack2+import Hack2.Contrib.Utils+import Network.Miku.Middleware.MikuRouter+import Data.ByteString.Lazy.Char8 (ByteString)++type RoutePathT a = (RequestMethod, ByteString, a)+type RoutePath    = RoutePathT AppUnit+type AppReader    = Env+type AppState     = Response+type AppUnitT     = ReaderT AppReader (StateT AppState IO)+type AppUnit      = AppUnitT ()++type RouterT a = ByteString -> (a -> Application) -> RoutePathT a -> Middleware+type Router    = RouterT AppUnit++data RouteConfig = RouteConfig+  {+    route_path :: RoutePath+  , router     :: Router+  }++data Miku = Miku+  {+    current_router  :: Router+  , routes          :: [RouteConfig]+  , middlewares     :: [Middleware]+  , mimes           :: [(ByteString, ByteString)]+  }+++instance Default Miku where+  def = Miku +    {+      current_router = miku_router+    , routes = def+    , middlewares = [dummy_middleware]+    , mimes = def+    }+++type UnitT a = State Miku a+type Unit    = UnitT ()
+ src/Network/Miku/Utils.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE OverloadedStrings #-}++module Network.Miku.Utils where++import Control.Monad.State+import Hack2+import Air.Env+import Prelude ()+import Data.ByteString.UTF8 (fromString, toString)++import qualified Data.ByteString.Lazy.Char8 as B+import Data.ByteString.Lazy.Char8 (ByteString)++namespace :: ByteString -> Env -> [(ByteString, ByteString)]+namespace x env =+  env+    .hackHeaders+    .select (fst > (x `B.isPrefixOf`))+    .map_fst (B.drop (x.B.length))++put_namespace :: ByteString -> [(ByteString, ByteString)] -> Env -> Env+put_namespace x xs env = +  let adds             = xs.map_fst (x +)+      new_headers      = adds.map fst+      new_hack_headers = +        env.hackHeaders.reject (fst > belongs_to new_headers) ++ adds+  in+  env {hackHeaders = new_hack_headers}+++set_namespace :: ByteString -> ByteString -> ByteString -> Env -> Env+set_namespace x k v = put_namespace x [(k,v)]++delete_namespace :: ByteString -> ByteString -> Env -> Env+delete_namespace x k env = +  let new_hack_headers = env.hackHeaders.reject (fst > is (x + k))+  in+  env {hackHeaders = new_hack_headers}++insert_last :: a -> [a] -> [a]+insert_last x xs = xs ++ [x]++update :: (MonadState a m, Functor m) => (a -> a) -> m ()+update f = get ^ f >>= put+