miku 2014.11.17 → 2016.3.16
raw patch · 9 files changed
+157/−188 lines, 9 filesdep +filepathdep +lensdep −airdep −air-thdep ~base
Dependencies added: filepath, lens
Dependencies removed: air, air-th
Dependency ranges changed: base
Files
- Nemesis +0/−42
- changelog.md +4/−0
- miku.cabal +13/−8
- readme.md +17/−19
- src/Network/Miku/Config.hs +7/−8
- src/Network/Miku/DSL.hs +25/−27
- src/Network/Miku/Engine.hs +54/−57
- src/Network/Miku/Type.hs +18/−15
- src/Network/Miku/Utils.hs +19/−12
− Nemesis
@@ -1,42 +0,0 @@-import System.Nemesis (run)-import System.Nemesis.DSL-import Air.Env ((-))-import Prelude hiding ((-))--main = run nemesis-nemesis = do- - clean- [ "**/*.hi"- , "**/*.o"- , "manifest"- , "test/hello_world"- ]- - 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"- - desc "run the test app in 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"
changelog.md view
@@ -0,0 +1,4 @@+2016.3.16++* Get rid of the Air dependency+* Rewrite using common Haskell coding convention
miku.cabal view
@@ -1,5 +1,5 @@ Name: miku-Version: 2014.11.17+Version: 2016.3.16 Build-type: Simple Synopsis: A minimum web dev DSL in Haskell Description:@@ -10,22 +10,27 @@ License-file: LICENSE Author: Jinjing Wang Maintainer: Jinjing Wang <nfjinjing@gmail.com>-Build-Depends: base Cabal-version: >= 1.2 category: Web homepage: https://github.com/nfjinjing/miku-extra-doc-files: readme.md, changelog.md, Nemesis, known-issues.md+extra-doc-files: readme.md, changelog.md, known-issues.md library- build-depends: base > 4 && <= 99+ build-depends: + base > 4 && <= 6+ , bytestring+ , containers , data-default+ , filepath >= 1.4.0.0 , hack2 >= 2012.1.19 , hack2-contrib >= 2012.1.19- , air >= 2014.5.19- , air-th , mtl- , containers- , bytestring+ , lens+ -- for testing+ -- , hack2-handler-snap-server+ -- , foreign-store+ -- , moe+ hs-source-dirs: src/ exposed-modules:
readme.md view
@@ -5,10 +5,10 @@ ## Example {-# LANGUAGE OverloadedStrings #-}- + import Network.Miku import Hack2.Handler.SnapServer- + main = run . miku $ get "/" (text "miku power") @@ -17,31 +17,31 @@ cabal update cabal install miku cabal install hack2-handler-snap-server- + -- 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>+<https://github.com/nfjinjing/miku/blob/master/test/route_example.hs> ## Routes ### Verbs- + {-# LANGUAGE OverloadedStrings #-}- + -- use - instead of $ for clarity import Air.Light ((-)) import Prelude hiding ((-))- + import Network.Miku import Hack2.Handler.SnapServer- + main = run . miku - do get "/" - do@@ -49,10 +49,10 @@ post "/" - do -- for a post request- + put "/" - do -- put ..- + delete "/" - do -- .. @@ -81,7 +81,7 @@ before - \e -> do putStrLn "before called" return e- + -- after takes that of type (Response -> IO Response) after return @@ -90,26 +90,24 @@ ### Use hack2 middleware import Hack2.Contrib.Middleware.SimpleAccessLogger- + middleware - simple_access_logger Nothing ### Convert miku into a hack2 application -- in Network.Miku.Engine- + miku :: MikuMonad -> 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)+* [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. * `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`.- + ## 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/).--
src/Network/Miku/Config.hs view
@@ -3,17 +3,16 @@ 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.Char8 (ByteString)+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 pre_installed_middlewares :: [Middleware]-pre_installed_middlewares = +pre_installed_middlewares = [ content_length , content_type default_content_type
src/Network/Miku/DSL.hs view
@@ -2,31 +2,29 @@ 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.Char8 (ByteString)--import Air.Data.Record.SimpleLabel hiding (get)+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 Network.Miku.Config+import Network.Miku.Engine+import Network.Miku.Type+import Network.Miku.Utils+import Prelude hiding ((-)) app :: Application -> AppMonad-app f = ask >>= (f > io) >>= State.put+app f = ask >>= (liftIO . f) >>= State.put middleware :: Middleware -> MikuMonad-middleware x = modM __middlewares - insert_last x+middleware x = middlewares %= insert_last x get, put, post, delete :: ByteString -> AppMonad -> MikuMonad get = add_route GET@@ -37,16 +35,16 @@ add_route :: RequestMethod -> ByteString -> AppMonad -> MikuMonad add_route route_method route_string app_monad = do- modM __router - insert_last - miku_router route_method route_string app_monad- + modifying router - insert_last - miku_router route_method route_string app_monad+ before :: (Env -> IO Env) -> MikuMonad-before = ioconfig > middleware+before = middleware . ioconfig after :: (Response -> IO Response) -> MikuMonad-after = censor > middleware+after = middleware . censor mime :: ByteString -> ByteString -> MikuMonad-mime k v = modM __mimes - insert_last (k,v)+mime k v = mimes %= insert_last (k,v) public :: Maybe ByteString -> [ByteString] -> MikuMonad public r xs = middleware - static r xs@@ -68,4 +66,4 @@ update - set_body_bytestring - x captures :: AppMonadT [(ByteString, ByteString)]-captures = ask ^ namespace miku_captures+captures = ask <&> namespace miku_captures
src/Network/Miku/Engine.hs view
@@ -1,68 +1,65 @@-{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} module Network.Miku.Engine where -import Control.Monad.Reader hiding (join)-import Control.Monad.State hiding (join)-import Hack2-import Hack2.Contrib.Middleware.UserMime-import Hack2.Contrib.Middleware.NotFound-import Hack2.Contrib.Utils hiding (get, put)-import Air.Env hiding (mod)-import Network.Miku.Config-import Network.Miku.Type-import Network.Miku.Utils-import Prelude ()-import Data.ByteString.Char8 (ByteString)-import qualified Data.ByteString.Char8 as B-import qualified Prelude as P-import Air.Data.Record.SimpleLabel hiding (get)-import Data.Maybe-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.ByteString.Char8 (ByteString)+import qualified Data.ByteString.Char8 as B+import qualified Data.Default as Default+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 Network.Miku.Config+import Network.Miku.Type+import Network.Miku.Utils+import Prelude hiding ((-))+import System.FilePath ((</>)) miku :: MikuMonad -> Application miku miku_monad = miku_middleware miku_monad (not_found dummy_app) - miku_middleware :: MikuMonad -> Middleware-miku_middleware miku_monad = - - let miku_state = execState miku_monad def- mime_filter = user_mime (miku_state.mimes)- miku_middleware_stack = use - miku_state.middlewares- miku_router_middleware = use - miku_state.router+miku_middleware miku_monad =++ let miku_state = execState miku_monad mempty+ mime_filter = 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 in- + use [pre_installed_middleware_stack, mime_filter, miku_middleware_stack, miku_router_middleware]- + miku_router :: RequestMethod -> ByteString -> AppMonad -> Middleware miku_router route_method route_string app_monad app = \env ->- if env.request_method == route_method + if request_method env == route_method then- case env.path_info.parse_params route_string of+ case env & path_info & parse_params route_string of Nothing -> app env- Just (_, params) -> - let miku_app = run_app_monad - local (put_namespace miku_captures params) app_monad + Just (_, params) ->+ let miku_app = run_app_monad - local (put_namespace miku_captures params) app_monad in miku_app env- + else app env- - ++ 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 -> runReaderT app_monad env & flip execStateT Default.def + parse_params :: ByteString -> ByteString -> Maybe (ByteString, [(ByteString, ByteString)]) parse_params "*" x = Just (x, []) parse_params "" "" = Just ("", [])@@ -70,31 +67,31 @@ parse_params "/" "" = Nothing parse_params "/" "/" = Just ("/", []) -parse_params t s = - - let template_tokens = t.B.split '/'- url_tokens = s.B.split '/'- - _template_last_token_matches_everything = template_tokens.length P.> 0 && template_tokens.last.is "*"- _template_tokens_length_equals_url_token_length = template_tokens.length == url_tokens.length+parse_params t s =++ let template_tokens = B.split '/' t+ url_tokens = B.split '/' s++ _template_last_token_matches_everything = (template_tokens & length) > 0 && (["*"] `isSuffixOf` template_tokens)+ _template_tokens_length_equals_url_token_length = (template_tokens & length) == (url_tokens & length) in- + if not - _template_last_token_matches_everything || _template_tokens_length_equals_url_token_length then Nothing- else + 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 "/")+ if all isJust rs+ then+ let token_length = length template_tokens+ location = B.pack - "/" </> (B.unpack - B.intercalate "/" - take token_length url_tokens) in- Just - (location, rs.catMaybes.catMaybes)+ Just - (location, rs & catMaybes & catMaybes) else Nothing- + where- capture x y - | x.B.unpack.starts_with ":" = Just - Just (x.B.tail, y)- | x.is "*" = Just Nothing+ capture x y+ | ":" `isPrefixOf` B.unpack x = Just - Just (B.tail x, y)+ | x == "*" = Just Nothing | x == y = Just Nothing | otherwise = Nothing
src/Network/Miku/Type.hs view
@@ -2,15 +2,15 @@ module Network.Miku.Type where -import Control.Monad.Reader-import Control.Monad.State-import Air.Data.Default-import Hack2-import Hack2.Contrib.Utils-import Data.ByteString.Char8 (ByteString)--import Air.TH-import Air.Data.Record.SimpleLabel+import Control.Lens+import Control.Lens.TH+import Control.Monad.Identity+import Control.Monad.Reader+import Control.Monad.State+import Data.ByteString.Char8 (ByteString)+import Data.Monoid+import Hack2+import Hack2.Contrib.Utils type AppReader = Env type AppState = Response@@ -20,13 +20,16 @@ data MikuState = MikuState {- middlewares :: [Middleware]- , router :: [Middleware]- , mimes :: [(ByteString, ByteString)]+ _middlewares :: [Middleware]+ , _router :: [Middleware]+ , _mimes :: [(ByteString, ByteString)] } -mkDefault ''MikuState-mkLabel ''MikuState+instance Monoid MikuState where+ mempty = MikuState [] [] []+ mappend (MikuState x y z) (MikuState x' y' z') = MikuState (x <> x') (y <> y') (z <> z') +makeLenses ''MikuState+ type MikuMonadT a = State MikuState a-type MikuMonad = MikuMonadT ()+type MikuMonad = MikuMonadT () -- (Identity ())
src/Network/Miku/Utils.hs view
@@ -2,27 +2,34 @@ module Network.Miku.Utils where +import Control.Lens ((#), (&)) import Control.Monad.State+import Data.Bifunctor (first)+import Data.ByteString.Char8 (ByteString)+import Data.Monoid ((<>)) import Hack2-import Air.Env-import Prelude ()-+import Prelude hiding ((-)) import qualified Data.ByteString.Char8 as B-import Data.ByteString.Char8 (ByteString) +infixr 0 -+{-# INLINE (-) #-}+(-) :: (a -> b) -> a -> b+f - x = f x+ namespace :: ByteString -> Env -> [(ByteString, ByteString)]-namespace x env =- env- .hackHeaders- .select (fst > (x `B.isPrefixOf`))- .map_fst (B.drop (x.B.length))+namespace x =+ map (first (B.drop (B.length x)))+ . filter ((x `B.isPrefixOf`) . fst)+ . hackHeaders put_namespace :: ByteString -> [(ByteString, ByteString)] -> Env -> Env put_namespace x xs env =- let adds = xs.map_fst (x +)- new_headers = adds.map fst+ let adds = map (first (x <>)) xs+ new_headers = map fst adds new_hack_headers =- env.hackHeaders.reject (fst > belongs_to new_headers) ++ adds+ (hackHeaders env & filter (flip notElem new_headers . fst))+ <> adds+ in env {hackHeaders = new_hack_headers}