loli 2009.6.27 → 2009.6.29
raw patch · 20 files changed
+488/−221 lines, 20 filesPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
API changes (from Hackage documentation)
- Network.Loli.Config: loli_bindings :: String
- Network.Loli.DSL: bindings :: AppUnitT [(String, String)]
- Network.Loli.DSL: html :: String -> AppUnit
- Network.Loli.DSL: text :: String -> AppUnit
- Network.Loli.Engine: Loli :: [RoutePath] -> [Middleware] -> [(String, String)] -> Loli
- Network.Loli.Engine: data Loli
- Network.Loli.Engine: instance Default Loli
- 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: router :: [RoutePath] -> Middleware
- Network.Loli.Engine: routes :: Loli -> [RoutePath]
- 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.Utils: add_namespace :: String -> String -> String -> Env -> Env
+ Network.Loli.Config: loli_config :: String
+ Network.Loli.Config: loli_default_views :: String
+ Network.Loli.Config: loli_layout :: String
+ Network.Loli.Config: loli_layout_content :: String
+ Network.Loli.Config: loli_locals :: String
+ Network.Loli.Config: loli_partials :: String
+ Network.Loli.DSL: layout :: String -> Unit
+ Network.Loli.DSL: locals :: AppUnitT Assoc
+ Network.Loli.Middleware.LoliRouter: loli_router :: String -> (a -> Application) -> [RoutePathT a] -> Middleware
+ Network.Loli.Middleware.UserMime: user_mime :: [(String, String)] -> Middleware
+ Network.Loli.Template: html :: String -> AppUnit
+ Network.Loli.Template: no_layout :: AppUnit -> AppUnit
+ Network.Loli.Template: output :: (Template a) => a -> AppUnit
+ Network.Loli.Template: partial :: (Template a) => String -> a -> AppUnit -> AppUnit
+ Network.Loli.Template: partial_locals :: AppUnitT Context
+ Network.Loli.Template: partials :: (Template a) => [(String, a)] -> AppUnit -> AppUnit
+ Network.Loli.Template: render :: (Template a) => a -> AppUnitT String
+ Network.Loli.Template: render_layout :: AppUnit
+ Network.Loli.Template: template_locals :: AppUnitT Context
+ Network.Loli.Template: text :: String -> AppUnit
+ Network.Loli.Template: with_layout :: String -> AppUnit -> AppUnit
+ Network.Loli.Template.ConstTemplate: ConstTemplate :: String -> ConstTemplate
+ Network.Loli.Template.ConstTemplate: const_template :: String -> ConstTemplate
+ Network.Loli.Template.ConstTemplate: data ConstTemplate
+ Network.Loli.Template.ConstTemplate: instance Template ConstTemplate
+ Network.Loli.Template.TextTemplate: TextTemplate :: String -> TextTemplate
+ Network.Loli.Template.TextTemplate: data TextTemplate
+ Network.Loli.Template.TextTemplate: instance Template TextTemplate
+ Network.Loli.Template.TextTemplate: render_TextTemplate :: String -> Context -> IO String
+ Network.Loli.Type: Loli :: [RoutePath] -> [Middleware] -> Assoc -> Loli
+ Network.Loli.Type: class Template a
+ Network.Loli.Type: data Loli
+ Network.Loli.Type: instance Default Loli
+ Network.Loli.Type: interpolate :: (Template a) => a -> String -> Context -> IO String
+ Network.Loli.Type: middlewares :: Loli -> [Middleware]
+ Network.Loli.Type: mimes :: Loli -> Assoc
+ Network.Loli.Type: routes :: Loli -> [RoutePath]
+ Network.Loli.Type: type AppReader = Env
+ Network.Loli.Type: type AppState = Response
+ Network.Loli.Type: type AppUnit = AppUnitT ()
+ Network.Loli.Type: type AppUnitT = ReaderT AppReader (StateT AppState IO)
+ Network.Loli.Type: type Assoc = [(String, String)]
+ Network.Loli.Type: type Context = Assoc
+ Network.Loli.Type: type EnvFilter = Env -> Env
+ Network.Loli.Type: type ResponseFilter = Response -> Response
+ Network.Loli.Type: type RoutePath = RoutePathT AppUnit
+ Network.Loli.Type: type RoutePathT a = (RequestMethod, String, a)
+ Network.Loli.Type: type Unit = UnitT ()
+ Network.Loli.Type: type UnitT a = State Loli a
+ Network.Loli.Utils: delete_namespace :: String -> String -> Env -> Env
+ Network.Loli.Utils: put_namespace :: String -> [(String, String)] -> Env -> Env
+ Network.Loli.Utils: update :: (MonadState a m, Functor m) => (a -> a) -> m ()
- Network.Loli.DSL: captures :: AppUnitT [(String, String)]
+ Network.Loli.DSL: captures :: AppUnitT Assoc
- Network.Loli.DSL: context :: [(String, String)] -> AppUnit -> AppUnit
+ Network.Loli.DSL: context :: Assoc -> AppUnit -> AppUnit
- Network.Loli.Template.TextTemplate: text_template :: String -> AppUnit
+ Network.Loli.Template.TextTemplate: text_template :: String -> TextTemplate
- Network.Loli.Utils: set_namespace :: String -> [(String, String)] -> Env -> Env
+ Network.Loli.Utils: set_namespace :: String -> String -> String -> Env -> Env
Files
- Nemesis +27/−10
- changelog.md +7/−0
- known-issues.md +2/−0
- loli.cabal +7/−4
- readme.md +69/−7
- src/Network/Loli.hs +2/−0
- src/Network/Loli/Config.hs +22/−6
- src/Network/Loli/DSL.hs +10/−16
- src/Network/Loli/Engine.hs +9/−93
- src/Network/Loli/Middleware/LoliRouter.hs +72/−0
- src/Network/Loli/Middleware/UserMime.hs +17/−0
- src/Network/Loli/Template.hs +69/−10
- src/Network/Loli/Template/ConstTemplate.hs +11/−0
- src/Network/Loli/Template/TextTemplate.hs +15/−12
- src/Network/Loli/Type.hs +37/−0
- src/Network/Loli/Utils.hs +16/−5
- src/Test.hs +0/−52
- src/Test/Test.hs +90/−0
- views/hello.html +0/−6
- views/layout.html +6/−0
Nemesis view
@@ -6,6 +6,7 @@ , "manifest" , "Test" , "myloli"+ , "pure_hack" ] desc "prepare cabal dist"@@ -21,20 +22,36 @@ task "manifest" $ do sh "find . | grep 'hs$' > manifest" - task "test" $ do- 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"+ ghci "template" "Network/Loli/Template"+ ghci "ipaste" "Test/LoliPaste" - task "loli" $ do- sh "ghc --make -isrc src/Test/myloli.hs -o myloli"- sh "echo done.."- sh "./myloli"+ bin "test" "Test/Test"+ bin "paste" "Test/LoliPaste"+ bin "myloli" "Test/myloli" + + -- test+ + task "tl" $ sh "curl j:3000"+ task "tp" $ sh "curl -d 'src=print' j:3000"++ -- deploy+ task "deploy" $ sh "scp -C .bin/paste easymic.com:~/link/loli/.bin"++ task "start" $ do+ sh "echo starting.."+ sh ".bin/paste"+ + where+ ghci n x = task n $ sh $ "ghci -isrc src/" ++ x ++ ".hs"+ bin n x = task n $ do+ sh $ "ghc --make -Wall -isrc src/" ++ x ++ ".hs -o .bin/" ++ n+ sh $ "echo done.."+ sh $ ".bin/" ++ n
changelog.md view
@@ -1,3 +1,10 @@+2009.6.29+---------++### Feature++* Initial hackage release+ 2009.6.27 ---------
known-issues.md view
@@ -0,0 +1,2 @@+* 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
loli.cabal view
@@ -1,10 +1,10 @@ Name: loli-Version: 2009.6.27+Version: 2009.6.29 Build-type: Simple Synopsis: A minimum web dev DSL in Haskell Description: - A simple and easy to use library for fast web prototyping in Haskell.+ A simple library for fast web prototyping in Haskell. License: BSD3 License-file: LICENSE@@ -14,7 +14,7 @@ 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, views/hello.html+data-files: readme.md, changelog.md, Nemesis, known-issues.md, src/Test/Test.hs, views/layout.html library ghc-options: -Wall@@ -25,7 +25,10 @@ Network.Loli.Config Network.Loli.DSL Network.Loli.Engine+ Network.Loli.Middleware.LoliRouter+ Network.Loli.Middleware.UserMime Network.Loli.Template+ Network.Loli.Template.ConstTemplate Network.Loli.Template.TextTemplate+ Network.Loli.Type Network.Loli.Utils-
readme.md view
@@ -42,11 +42,11 @@ -- .. ### Captures - get "/say/:user/:something" $ do+ get "/say/:user/:message" $ do text . show =<< captures -- /say/jinjing/hello will output- -- [("user","jinjing"),("something","hello")]+ -- [("user","jinjing"),("message","hello")] ## Static@@ -54,17 +54,19 @@ -- public serve, only allows /src public (Just ".") ["/src"] -## Views+## Views root -- in `./views`, can be changed by views "template" +## Template+ ### Text Template import Network.Loli.Template.TextTemplate -- template- get "/hi/:user" $ text_template "hello.html"+ get "/hi/:user" $ output (text_template "hello.html") -- in hello.html <html>@@ -74,22 +76,82 @@ </body> </html> -### Local bindings+### Local binding get "/local-binding" $ do- bind "user" "alice" (text_template "hello.html")+ bind "user" "alice" $ output (text_template "hello.html") ### Batched local bindings get "/batched-local-binding" $ do context [("user", "alice"), ("password", "foo")] $ - text . show =<< bindings+ text . show =<< locals +## Partials +Partials are treated the same as user supplied bindings, i.e. the rendered text is available to the rest of templates, referenced by user supplied keywords.++### with single partial++ get "/single-partial" $ do+ partial "user" (const_template "const-user") $ do+ text . show =<< template_locals++### with batched partials++ get "/group-partial" $ do+ partials + [ ("user", const_template "alex")+ , ("password", const_template "foo")+ ] $ output (text_template "hello.html")++## Layout++### Local++ get "/with-layout" $ do+ with_layout "layout.html" $ do+ text "layout?"+ + -- in layout.html+ <html>+ <body>+ <h1>using a layout</h1>+ $content+ </body>+ </html>++### Global++ layout "layout.html"++### By passed++ get "/no-layout" $ do+ no_layout $ do+ text "no-layout"++ ## Mime types -- treat .hs extension as text/plain mime "hs" "text/plain"++## Hack integration++### Use hack middleware++ import Hack.Contrib.Middleware.ETag+ import Hack.Contrib.Middleware.ShowStatus+ + middleware etag+ middleware show_status++### Convert loli into a hack application++ -- in Network.Loli.Engine+ + loli :: Unit -> Application ## Note
src/Network/Loli.hs view
@@ -1,9 +1,11 @@ module Network.Loli ( module Network.Loli.DSL+ , module Network.Loli.Template , module Network.Loli.Engine ) where import Network.Loli.Engine (loli)+import Network.Loli.Template import Network.Loli.DSL
src/Network/Loli/Config.hs view
@@ -7,6 +7,7 @@ import MPS.Light import Prelude hiding ((.), (>), (^)) + pre_installed_middlewares :: [Middleware] pre_installed_middlewares = [@@ -17,17 +18,32 @@ where set_view_root env = let hack_headers = env.hackHeaders- view_root = (loli_views ++ "root", "views")+ pre_config = [(loli_config ++ loli_views, loli_default_views)] in- env {hackHeaders = hack_headers ++ [view_root]}+ 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_captures = "loli-captures-" -loli_bindings :: String-loli_bindings = "loli_bindings_"+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 = "loli_views_"+loli_views = "views"++loli_default_views :: String+loli_default_views = "views"++loli_layout_content :: String+loli_layout_content = "content"
src/Network/Loli/DSL.hs view
@@ -2,34 +2,27 @@ 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.Config import Network.Loli.Engine+import Network.Loli.Type import Network.Loli.Utils import Prelude hiding ((.), (>), (^)) import qualified Control.Monad.State as State + app :: Application -> AppUnit app f = ask >>= (f > io) >>= State.put -text :: String -> AppUnit-text x = do- update $ set_content_type _TextPlain- update $ set_body (x.fromString) -html :: String -> AppUnit-html x = do- update $ set_content_type _TextHtml- update $ set_body (x.fromString)+layout :: String -> Unit+layout x = middleware $ config (set_namespace loli_config loli_layout x) views :: String -> Unit-views x = middleware $ config (set_namespace loli_views [("root", x)])+views x = middleware $ config (set_namespace loli_config loli_views x) get, put, delete, post :: String -> AppUnit -> Unit get = route GET@@ -49,12 +42,13 @@ io :: (MonadIO m) => IO a -> m a io = liftIO -context :: [(String, String)] -> AppUnit -> AppUnit-context = set_namespace loli_bindings > local+context :: Assoc -> AppUnit -> AppUnit+context = put_namespace loli_locals > local bind :: String -> String -> AppUnit -> AppUnit bind k v = context [(k, v)] -captures, bindings :: AppUnitT [(String, String)]+captures, locals :: AppUnitT Assoc captures = ask ^ namespace loli_captures-bindings = ask ^ namespace loli_bindings+locals = ask ^ namespace loli_locals+
src/Network/Loli/Engine.hs view
@@ -5,112 +5,35 @@ import Control.Monad.Reader hiding (join) import Control.Monad.State hiding (join) import Data.Default-import Data.List (find)-import Data.Maybe import Hack import Hack.Contrib.Middleware.NotFound-import Hack.Contrib.Response import Hack.Contrib.Utils hiding (get, put) import MPS import Network.Loli.Config+import Network.Loli.Middleware.LoliRouter+import Network.Loli.Middleware.UserMime+import Network.Loli.Type import Network.Loli.Utils import Prelude hiding ((.), (/), (>), (^)) --type RoutePath = (RequestMethod, String, AppUnit)-type EnvFilter = Env -> Env-type ResponseFilter = Response -> Response-type Param = (String, String)-type AppState = Response-type AppReader = Env--type AppUnitT a = ReaderT AppReader (StateT AppState IO) a-type AppUnit = AppUnitT ()-- run_app :: AppUnit -> Application run_app unit = \env -> runReaderT unit env .flip execStateT def -router :: [RoutePath] -> Middleware-router h 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- run_app app_state (mod_env location .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'.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 "/"- in- if url_tokens.length < template_tokens.length- then Nothing- else - let rs = zipWith capture template_tokens url_tokens- in- if rs.all isJust- then - let location = url_tokens.take (template_tokens.length).join "/"- in- Just $ (location, rs.map fromJust.filter isJust.map fromJust)- else Nothing- - where- capture x y - | x.starts_with ":" = Just $ Just (x.tail, y)- | x == y = Just Nothing- | otherwise = Nothing- - --data Loli = Loli- {- routes :: [RoutePath]- , middlewares :: [Middleware]- , mimes :: [(String, String)]- }--instance Default Loli where- def = Loli def [dummy_middleware] def--type UnitT a = State Loli a-type Unit = UnitT ()--- loli :: Unit -> Application loli unit = run unit (not_found empty_app) where run :: Unit -> Middleware run unit' = - let s = execState unit' def- paths = s.routes+ let loli_state = execState unit' def+ paths = loli_state.routes - loli_app = router paths- mime_filter = lookup_mime (s.mimes)- stack = s.middlewares.use+ 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 in use [pre, mime_filter, stack, loli_app] -update :: (MonadState a m, Functor m) => (a -> a) -> m ()-update f = get ^ f >>= put- add_route :: RoutePath -> Loli -> Loli add_route r s = let xs = s.routes in s {routes = xs.insert_last r} @@ -124,11 +47,4 @@ add_mime :: String -> String -> Loli -> Loli add_mime k v s = let xs = s.mimes in s {mimes = xs.insert_last (k, v)} --- middleware-lookup_mime :: [(String, String)] -> Middleware-lookup_mime h app env = do- r <- app env- case h.only_fst.find mime >>= flip lookup h of- Nothing -> return r- Just v -> return $ r.set_content_type v- where mime x = env.path_info.ends_with ('.' : x)+
+ src/Network/Loli/Middleware/LoliRouter.hs view
@@ -0,0 +1,72 @@+module Network.Loli.Middleware.LoliRouter (loli_router) where++import Data.List (find)+import Data.Maybe+import Hack+import Hack.Contrib.Utils+import Hack.Contrib.Utils hiding (get, put)+import MPS+import Prelude hiding ((.), (>), (/))+++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'' + { 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+ runner app_state (mod_env location .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 :: String -> String -> Maybe (String, Assoc)+parse_params "" "" = Just ("", [])+parse_params "" _ = Nothing+parse_params "/" "" = Nothing+parse_params "/" _ = Just ("/", [])+parse_params t s =+ let template_tokens = t.split "/"+ url_tokens = s.split "/"+ in+ if url_tokens.length < template_tokens.length+ then Nothing+ else + let rs = zipWith capture template_tokens url_tokens+ in+ if rs.all isJust+ then + let location = "/" / url_tokens.take (template_tokens.length).join "/"+ in+ Just $ (location, rs.map fromJust.filter isJust.map fromJust)+ else Nothing+ + where+ capture x y + | x.starts_with ":" = Just $ Just (x.tail, y)+ | x == y = Just Nothing+ | otherwise = Nothing+ +-- 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+ new_hack_headers = + env.custom.reject (fst > belongs_to new_headers) ++ adds+ in+ env {hackHeaders = new_hack_headers}
+ src/Network/Loli/Middleware/UserMime.hs view
@@ -0,0 +1,17 @@+module Network.Loli.Middleware.UserMime (user_mime) where++import Data.List (find)+import Hack+import Hack.Contrib.Response+import Hack.Contrib.Utils+import MPS.Light+import Prelude hiding ((.))+++user_mime :: [(String, String)] -> Middleware+user_mime h app env = do+ r <- app env+ case h.only_fst.find mime >>= flip lookup h of+ Nothing -> return r+ Just v -> return $ r.set_content_type v+ where mime x = env.path_info.ends_with ('.' : x)
src/Network/Loli/Template.hs view
@@ -1,23 +1,82 @@ module Network.Loli.Template where import Control.Monad.Reader-import Data.Maybe+import Data.ByteString.Lazy.UTF8+import Hack+import Hack.Contrib.Constants import Hack.Contrib.Response import MPS import Network.Loli.Config import Network.Loli.DSL-import Network.Loli.Engine+import Network.Loli.Template.TextTemplate+import Network.Loli.Type import Network.Loli.Utils+import Data.Maybe import Prelude hiding ((.), (>), (^), (/))-import qualified Data.ByteString.Lazy.Char8 as B+import qualified Control.Monad.State as State +-- simple+text :: String -> AppUnit+text x = do+ update $ set_content_type _TextPlain+ update $ set_body (x.fromString)+ render_layout -type Context = [(String, String)]-type Template = String -> Context -> IO B.ByteString+html :: String -> AppUnit+html x = do+ update $ set_content_type _TextHtml+ update $ set_body (x.fromString)+ render_layout -template :: Template -> String -> AppUnit-template f x = do+-- template+partial_locals :: AppUnitT Context+partial_locals = ask ^ namespace loli_partials++template_locals :: AppUnitT Context+template_locals = do c <- captures- b <- bindings- root <- ask ^ namespace loli_views ^ lookup "root" ^ fromMaybe "."- f (root / x) (c ++ b) .io >>= set_body > update+ b <- locals+ p <- partial_locals+ return (c ++ b ++ p)++render :: (Template a) => a -> AppUnitT String+render x = do+ root <- ask ^ namespace loli_config ^ lookup loli_views ^ fromMaybe "."+ context' <- template_locals+ interpolate x root context' .io+ +output :: (Template a) => a -> AppUnit+output x = render x >>= fromString > set_body > update >> render_layout++render_layout :: AppUnit+render_layout = do+ use_layout <- ask ^ namespace loli_config ^ lookup loli_layout+ case use_layout of+ Nothing -> return ()+ Just layout_template -> do+ s <- State.get ^ body ^ toString+ local (set_namespace loli_partials loli_layout_content s) $ do+ render (text_template layout_template) + >>= fromString > set_body > update++++partial :: (Template a) => String -> a -> AppUnit -> AppUnit+partial s x = partials [(s, x)]++partials :: (Template a) => [(String, a)] -> AppUnit -> AppUnit+partials xs unit = do+ let ps = xs.only_snd+ rs <- ps.mapM render+ let ns = zip (xs.only_fst) rs+ + local (put_namespace loli_partials ns) unit+++with_layout :: String -> AppUnit -> AppUnit+with_layout x = + local (set_namespace loli_config loli_layout x)++no_layout :: AppUnit -> AppUnit+no_layout =+ local (delete_namespace loli_config loli_layout)
+ src/Network/Loli/Template/ConstTemplate.hs view
@@ -0,0 +1,11 @@+module Network.Loli.Template.ConstTemplate where+ +import Network.Loli.Type++data ConstTemplate = ConstTemplate String ++instance Template ConstTemplate where+ interpolate (ConstTemplate x) _ _ = return x++const_template :: String -> ConstTemplate+const_template = ConstTemplate
src/Network/Loli/Template/TextTemplate.hs view
@@ -1,20 +1,23 @@-module Network.Loli.Template.TextTemplate (text_template) where+module Network.Loli.Template.TextTemplate where import Control.Arrow ((***))-import Data.ByteString.Lazy.UTF8 (fromString)+import Data.ByteString.Lazy.UTF8 import MPS-import Network.Loli.Engine-import Network.Loli.Template+import Network.Loli.Type import Prelude hiding ((.), (>), (^), (/)) import Text.Template hiding (Context, Template, template)-import qualified Data.ByteString.Lazy.Char8 as B-import qualified Data.Map as Map+import qualified Text.Template as T -create_context :: [(String, String)] -> Map.Map B.ByteString B.ByteString-create_context = map (fromString *** fromString) > to_h+render_TextTemplate :: String -> Context -> IO String+render_TextTemplate x c = + readTemplate (x.u2b) ^ flip T.render (create_context c) ^ toString+ where+ create_context = map (fromString *** fromString) > to_h -backend :: Template-backend x c = readTemplate (x.u2b) ^ flip render (create_context c)+data TextTemplate = TextTemplate String -text_template :: String -> AppUnit-text_template = template backend+instance Template TextTemplate where+ interpolate (TextTemplate x) r = render_TextTemplate (r / x)++text_template :: String -> TextTemplate+text_template = TextTemplate
+ src/Network/Loli/Type.hs view
@@ -0,0 +1,37 @@+module Network.Loli.Type where++import Control.Monad.Reader+import Control.Monad.State+import Data.Default+import Hack+import Hack.Contrib.Utils++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 AppUnitT = ReaderT AppReader (StateT AppState IO)+type AppUnit = AppUnitT ()+type Context = Assoc++data Loli = Loli+ {+ routes :: [RoutePath]+ , middlewares :: [Middleware]+ , mimes :: Assoc+ }++instance Default Loli where+ def = Loli def [dummy_middleware] def+++type UnitT a = State Loli a+type Unit = UnitT ()++class Template a where+ -- the only interface for template+ interpolate :: a -> String -> Context -> IO String
src/Network/Loli/Utils.hs view
@@ -1,7 +1,8 @@ module Network.Loli.Utils where +import Control.Monad.State import Hack-import Hack.Contrib.Utils+import Hack.Contrib.Utils hiding (get, put) import MPS.Light import Prelude hiding ((.), (/), (>), (^)) @@ -12,8 +13,8 @@ .select (fst > starts_with x) .map_fst (drop (x.length)) -set_namespace :: String -> [(String, String)] -> Env -> Env-set_namespace x xs env = +put_namespace :: String -> [(String, String)] -> Env -> Env+put_namespace x xs env = let adds = xs.map_fst (x ++) new_headers = adds.map fst new_hack_headers = @@ -22,8 +23,18 @@ env {hackHeaders = new_hack_headers} -add_namespace :: String -> String -> String -> Env -> Env-add_namespace x k v = set_namespace x [(k,v)]+set_namespace :: String -> String -> String -> Env -> Env+set_namespace x k v = put_namespace x [(k,v)] +delete_namespace :: String -> String -> Env -> Env+delete_namespace x k env = + let new_hack_headers = env.custom.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+
− src/Test.hs
@@ -1,52 +0,0 @@-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- get "/hello" (text "hello world")- - -- io- get "/cabal" $ text =<< io (readFile "loli.cabal")-- -- route captures- 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")-- -- public serve, only allows /src- public (Just ".") ["/src"]- - -- treat .hs extension as text/plain- mime "hs" "text/plain"-
+ src/Test/Test.hs view
@@ -0,0 +1,90 @@+import Control.Monad.Reader+import Hack.Contrib.Response+import Hack.Contrib.Middleware.Lambda+import Hack.Contrib.Middleware.ShowStatus+import Hack.Handler.Happstack+import Network.Loli+import Network.Loli.Engine+import Network.Loli.Template.ConstTemplate (const_template)+import Network.Loli.Template.TextTemplate+import Network.Loli.Utils+import Data.Maybe+import MPS ((^))+import Prelude hiding ((^))+import Hack.Contrib.Request++-- default on port 3000++main = run . loli $ do+ + middleware lambda+ middleware show_status++ get "/bench" $ do+ name <- ask ^ params ^ lookup "name" ^ fromMaybe "nobody"+ html ("<h1>" ++ name ++ "</h1>")++ -- simple+ get "/hello" (text "hello world")+ + get "/debug" (text . show =<< ask)+ + -- io+ get "/cabal" $ text =<< io (readFile "loli.cabal")++ -- route captures+ get "/say/:user/:message" $ do+ text . show =<< captures++ -- html output+ get "/html" (html "<html><body><p>loli power!</p></body></html>")++ -- template+ get "/hi/:user" $ output (text_template "hello.html")++ -- manually tweak the reponse body+ get "/hi-html/:user" $ do+ update $ set_content_type "text/html"+ output $ text_template "hello.html"++ -- add local binding+ get "/local-binding" $ do+ bind "user" "alice" $ output (text_template "hello.html")+ + + -- batched local locals+ get "/batched-local-binding" $ do+ context [("user", "alice"), ("password", "foo")] $ + text .show =<< locals+ + get "/const-template" $ do+ output (const_template "const-string")+ + get "/partial-template" $ do+ partial "user" (const_template "const-user") $ do+ text . show =<< template_locals+ + get "/partial-context" $ do+ partials + [ ("user", const_template "alex")+ , ("password", const_template "foo")+ ] $ do+ output (text_template "hello.html")+ + get "/with-layout" $ do+ with_layout "layout.html" $ do+ text "layout?"+ + get "/without-layout" $ do+ no_layout $ do+ text "no-layout"+ + -- default+ get "/" (text . show =<< ask)++ -- public serve, only allows /src+ public (Just ".") ["/src"]+ + -- treat .hs extension as text/plain+ mime "hs" "text/plain"+
− views/hello.html
@@ -1,6 +0,0 @@-<html>-<title>hello</title>-<body>- <p>hello $user</p>-</body>-</html>
+ views/layout.html view
@@ -0,0 +1,6 @@+<html>+<body>+ <h1>using a layout</h1>+ $content+</body>+</html>