miku 2016.3.16 → 2016.3.16.1
raw patch · 8 files changed
+142/−135 lines, 8 filesdep +blaze-builderdep +case-insensitivedep +http-typesdep −data-defaultdep −hack2dep −hack2-contrib
Dependencies added: blaze-builder, case-insensitive, http-types, wai, wai-extra
Dependencies removed: data-default, hack2, hack2-contrib
Files
- changelog.md +5/−0
- miku.cabal +16/−14
- readme.md +18/−40
- src/Network/Miku/Config.hs +3/−6
- src/Network/Miku/DSL.hs +44/−34
- src/Network/Miku/Engine.hs +33/−19
- src/Network/Miku/Type.hs +5/−6
- src/Network/Miku/Utils.hs +18/−16
changelog.md view
@@ -1,3 +1,8 @@+2016.3.16.1++* Switch to WAI+* Remove `public` and `mime` helpers, as those functionalities can be achieved through `wai-middleware-static`+ 2016.3.16 * Get rid of the Air dependency
miku.cabal view
@@ -1,5 +1,5 @@ Name: miku-Version: 2016.3.16+Version: 2016.3.16.1 Build-type: Simple Synopsis: A minimum web dev DSL in Haskell Description:@@ -17,19 +17,21 @@ library build-depends: - base > 4 && <= 6- , bytestring- , containers- , data-default- , filepath >= 1.4.0.0- , hack2 >= 2012.1.19- , hack2-contrib >= 2012.1.19- , mtl- , lens- -- for testing- -- , hack2-handler-snap-server- -- , foreign-store- -- , moe+ base > 4 && <= 6+ , blaze-builder >= 0.4.0.1+ , bytestring+ , case-insensitive >= 1.2.0.5+ , containers+ , filepath >= 1.4.0.0+ , http-types >= 0.9+ , lens+ , mtl+ , wai+ , wai-extra+ -- for testing+ -- , foreign-store+ -- , moe+ -- , warp hs-source-dirs: src/
readme.md view
@@ -6,17 +6,18 @@ {-# LANGUAGE OverloadedStrings #-} - import Network.Miku- import Hack2.Handler.SnapServer+ import Network.Miku+ import Network.Wai.Handler.Warp (run) - main = run . miku $ get "/" (text "miku power")+ main :: IO ()+ main = run 3000 . miku $ get "/" (text "miku power") ## Installation cabal update cabal install miku- cabal install hack2-handler-snap-server+ cabal install warp -- copy and paste the above example to myapp.hs @@ -26,8 +27,7 @@ ## Quick reference -<https://github.com/nfjinjing/miku/blob/master/test/route_example.hs>-+<https://github.com/nfjinjing/miku/blob/master/test/RouteExample.hs> ## Routes @@ -35,14 +35,12 @@ {-# LANGUAGE OverloadedStrings #-} - -- use - instead of $ for clarity- import Air.Light ((-))- import Prelude hiding ((-))- import Network.Miku- import Hack2.Handler.SnapServer+ import Network.Miku.Utils ((-))+ import Network.Wai.Handler.Warp (run)+ import Prelude hiding ((-)) - main = run . miku - do+ main = run 3000 . miku - do get "/" - do -- something for a get request@@ -65,35 +63,15 @@ -- [("user","miku"),("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+## WAI integration -### Use hack2 middleware+### Use WAI middleware - import Hack2.Contrib.Middleware.SimpleAccessLogger+ import Network.Wai.Middleware.RequestLogger - middleware - simple_access_logger Nothing+ middleware logStdout -### Convert miku into a hack2 application+### Convert miku into a WAI application -- in Network.Miku.Engine @@ -102,9 +80,9 @@ ## 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/html_using_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.+* It's recommended to use your own html combinator / template engine. Try DIY with, e.g. [moe](https://github.com/nfjinjing/moe).+* [Example view using custom html combinator (moe in this case)](https://github.com/nfjinjing/miku/blob/master/test/HTMLUsingMoe.hs)+* When inspecting the request, use `ask` defined in `ReaderT` monad to get the `Request`, then use helper methods for `wai` 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`.
src/Network/Miku/Config.hs view
@@ -4,18 +4,15 @@ module Network.Miku.Config where import Data.ByteString.Char8 (ByteString)-import Hack2-import Hack2.Contrib.Middleware.Config-import Hack2.Contrib.Middleware.ContentLength-import Hack2.Contrib.Middleware.ContentType import Network.Miku.Utils+import Network.Wai pre_installed_middlewares :: [Middleware] pre_installed_middlewares = [- content_length- , content_type default_content_type+ -- content_length+ -- , content_type default_content_type ] where default_content_type = "text/plain; charset=UTF-8"
src/Network/Miku/DSL.hs view
@@ -2,68 +2,78 @@ module Network.Miku.DSL where +import Blaze.ByteString.Builder (fromByteString) import Control.Lens import Control.Monad.Reader import Control.Monad.State-import qualified Control.Monad.State as State-import Data.ByteString.Char8 (ByteString)-import Hack2-import Hack2.Contrib.Constants-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 qualified Control.Monad.State as State+import Data.ByteString.Char8 (ByteString)+import Data.CaseInsensitive (CI)+import qualified Data.CaseInsensitive as CI+import qualified Network.HTTP.Types as H import Network.Miku.Config import Network.Miku.Engine import Network.Miku.Type import Network.Miku.Utils-import Prelude hiding ((-))+import Network.Wai+import Network.Wai.Middleware.StripHeaders+import Prelude hiding ((-)) -app :: Application -> AppMonad-app f = ask >>= (liftIO . f) >>= State.put+-- import Network.Wai.Middleware.Static +-- app :: Application -> AppMonad+-- app f = ask >>= (liftIO . f) >>= State.put+ middleware :: Middleware -> MikuMonad-middleware x = middlewares %= insert_last x+middleware x = middlewares %= insertLast x get, put, post, delete :: ByteString -> AppMonad -> MikuMonad-get = add_route GET-put = add_route PUT-post = add_route POST-delete = add_route DELETE+get = add_route H.methodGet+put = add_route H.methodPut+post = add_route H.methodPost+delete = add_route H.methodDelete -add_route :: RequestMethod -> ByteString -> AppMonad -> MikuMonad+add_route :: H.Method -> ByteString -> AppMonad -> MikuMonad add_route route_method route_string app_monad = do- modifying router - insert_last - miku_router route_method route_string app_monad+ modifying router - insertLast - miku_router route_method route_string app_monad -before :: (Env -> IO Env) -> MikuMonad-before = middleware . ioconfig+-- before :: (Env -> IO Env) -> MikuMonad+-- before = middleware . ioconfig -after :: (Response -> IO Response) -> MikuMonad-after = middleware . censor+-- after :: (Response -> IO Response) -> MikuMonad+-- after = middleware . censor -mime :: ByteString -> ByteString -> MikuMonad-mime k v = mimes %= insert_last (k,v)+-- mime :: ByteString -> ByteString -> MikuMonad+-- mime k v = mimes %= insertLast (CI.mk k,v) -public :: Maybe ByteString -> [ByteString] -> MikuMonad-public r xs = middleware - static r xs+-- public :: ByteString -> MikuMonad+-- public = staticPolicy . addBase . review (utf8 . _Text) +_ContentType :: ByteString+_ContentType = "Content-Type"++setContentType :: ByteString -> Response -> Response+setContentType x = mapResponseHeaders ((CI.mk _ContentType, x):) . stripHeader _ContentType++setBody :: ByteString -> Response -> Response+setBody x r = responseBuilder (responseStatus r) (responseHeaders r) - fromByteString x+ text :: ByteString -> AppMonad text x = do- update - set_content_type _TextPlain- update - set_body_bytestring - x+ modify - setContentType "text/plain; charset=UTF-8"+ modify - setBody - x html :: ByteString -> AppMonad html x = do- update - set_content_type _TextHtml- update - set_body_bytestring - x+ modify - setContentType "text/html; charset=UTF-8"+ modify - setBody - x json :: ByteString -> AppMonad json x = do- update - set_content_type "text/json"- update - set_body_bytestring - x+ modify - setContentType "text/json"+ modify - setBody - x -captures :: AppMonadT [(ByteString, ByteString)]+captures :: AppMonadT [H.Header] captures = ask <&> namespace miku_captures
src/Network/Miku/Engine.hs view
@@ -4,33 +4,43 @@ module Network.Miku.Engine where -import Control.Lens hiding (use)-import Control.Monad.Reader hiding (join)-import Control.Monad.State hiding (join)-import Data.ByteString.Char8 (ByteString)-import qualified Data.ByteString.Char8 as B-import qualified Data.Default as Default+import Control.Lens hiding (use)+import Control.Monad.Reader hiding (join)+import Control.Monad.State hiding (join)+import Data.Bifunctor (first)+import Data.ByteString.Char8 (ByteString)+import qualified Data.ByteString.Char8 as B+import Data.CaseInsensitive (CI)+import qualified Data.CaseInsensitive as CI import Data.List import Data.Maybe-import Hack2-import Hack2.Contrib.Middleware.NotFound-import Hack2.Contrib.Middleware.UserMime-import Hack2.Contrib.Utils hiding (get, put)+import qualified Network.HTTP.Types as H import Network.Miku.Config import Network.Miku.Type import Network.Miku.Utils-import Prelude hiding ((-))-import System.FilePath ((</>))+import Network.Wai+import Prelude hiding ((-))+import System.FilePath ((</>)) +emptyResponse :: Response+emptyResponse = responseLBS H.status200+ [("Content-Type", "text/plain")]+ "empty app" +emptyApp :: Application+emptyApp _ respond = respond - emptyResponse+ miku :: MikuMonad -> Application-miku miku_monad = miku_middleware miku_monad (not_found dummy_app)+miku = flip miku_middleware emptyApp +use :: [Middleware] -> Middleware+use = foldl (.) id+ miku_middleware :: MikuMonad -> Middleware miku_middleware miku_monad = let miku_state = execState miku_monad mempty- mime_filter = user_mime - miku_state ^. mimes+ mime_filter = id -- user_mime - miku_state ^. mimes miku_middleware_stack = use - miku_state ^. middlewares miku_router_middleware = use - miku_state ^. router pre_installed_middleware_stack = use - pre_installed_middlewares@@ -39,14 +49,15 @@ use [pre_installed_middleware_stack, mime_filter, miku_middleware_stack, miku_router_middleware] -miku_router :: RequestMethod -> ByteString -> AppMonad -> Middleware+miku_router :: H.Method -> ByteString -> AppMonad -> Middleware miku_router route_method route_string app_monad app = \env ->- if request_method env == route_method+ if requestMethod env == route_method then- case env & path_info & parse_params route_string of+ case env & rawPathInfo & parse_params route_string of Nothing -> app env Just (_, params) ->- let miku_app = run_app_monad - local (put_namespace miku_captures params) app_monad+ let mikuHeaders = params & map (first CI.mk)+ miku_app = run_app_monad - local (putNamespace miku_captures mikuHeaders) app_monad in miku_app env @@ -56,8 +67,11 @@ where + run_app_monad :: AppMonad -> Application- run_app_monad app_monad = \env -> runReaderT app_monad env & flip execStateT Default.def+ run_app_monad app_monad env respond = do+ r <- runReaderT app_monad env & flip execStateT emptyResponse+ respond r parse_params :: ByteString -> ByteString -> Maybe (ByteString, [(ByteString, ByteString)])
src/Network/Miku/Type.hs view
@@ -9,10 +9,10 @@ import Control.Monad.State import Data.ByteString.Char8 (ByteString) import Data.Monoid-import Hack2-import Hack2.Contrib.Utils+import Network.Wai+import qualified Network.HTTP.Types as H -type AppReader = Env+type AppReader = Request type AppState = Response type AppMonadT = ReaderT AppReader (StateT AppState IO) type AppMonad = AppMonadT ()@@ -22,12 +22,11 @@ { _middlewares :: [Middleware] , _router :: [Middleware]- , _mimes :: [(ByteString, ByteString)] } instance Monoid MikuState where- mempty = MikuState [] [] []- mappend (MikuState x y z) (MikuState x' y' z') = MikuState (x <> x') (y <> y') (z <> z')+ mempty = MikuState [] []+ mappend (MikuState x y) (MikuState x' y') = MikuState (x <> x') (y <> y') makeLenses ''MikuState
src/Network/Miku/Utils.hs view
@@ -7,37 +7,39 @@ import Data.Bifunctor (first) import Data.ByteString.Char8 (ByteString) import Data.Monoid ((<>))-import Hack2 import Prelude hiding ((-)) import qualified Data.ByteString.Char8 as B+import Network.Wai+import qualified Network.HTTP.Types as H+import Data.String+import Data.CaseInsensitive ( CI )+import qualified Data.CaseInsensitive as CI infixr 0 - {-# INLINE (-) #-} (-) :: (a -> b) -> a -> b f - x = f x -namespace :: ByteString -> Env -> [(ByteString, ByteString)]+namespace :: ByteString -> Request -> [H.Header] namespace x =- map (first (B.drop (B.length x)))- . filter ((x `B.isPrefixOf`) . fst)- . hackHeaders+ map (first . CI.map . B.drop - B.length x)+ . filter ((x `B.isPrefixOf`) . CI.original. fst)+ . requestHeaders -put_namespace :: ByteString -> [(ByteString, ByteString)] -> Env -> Env-put_namespace x xs env =- let adds = map (first (x <>)) xs- new_headers = map fst adds- new_hack_headers =- (hackHeaders env & filter (flip notElem new_headers . fst))+putNamespace :: ByteString -> [H.Header] -> Request -> Request+putNamespace x xs env =+ let adds = map (first (CI.map (x <>))) xs+ newHeaders = map fst adds+ newRequestHeaders =+ (requestHeaders env & filter (flip notElem newHeaders . fst)) <> adds in- env {hackHeaders = new_hack_headers}+ env {requestHeaders = newRequestHeaders} -insert_last :: a -> [a] -> [a]-insert_last x xs = xs ++ [x]+insertLast :: a -> [a] -> [a]+insertLast x xs = xs <> [x] -update :: (MonadState a m, Functor m) => (a -> a) -> m ()-update = modify