diff --git a/Nemesis b/Nemesis --- a/Nemesis +++ b/Nemesis @@ -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 diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,10 @@ +2009.6.29 +--------- + +### Feature + +* Initial hackage release + 2009.6.27 --------- diff --git a/known-issues.md b/known-issues.md --- a/known-issues.md +++ b/known-issues.md @@ -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 diff --git a/loli.cabal b/loli.cabal --- a/loli.cabal +++ b/loli.cabal @@ -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 - diff --git a/readme.md b/readme.md --- a/readme.md +++ b/readme.md @@ -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 @@ -74,22 +76,82 @@ -### 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 + + +

using a layout

+ $content + + + +### 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 diff --git a/src/Network/Loli.hs b/src/Network/Loli.hs --- a/src/Network/Loli.hs +++ b/src/Network/Loli.hs @@ -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 diff --git a/src/Network/Loli/Config.hs b/src/Network/Loli/Config.hs --- a/src/Network/Loli/Config.hs +++ b/src/Network/Loli/Config.hs @@ -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" diff --git a/src/Network/Loli/DSL.hs b/src/Network/Loli/DSL.hs --- a/src/Network/Loli/DSL.hs +++ b/src/Network/Loli/DSL.hs @@ -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 + diff --git a/src/Network/Loli/Engine.hs b/src/Network/Loli/Engine.hs --- a/src/Network/Loli/Engine.hs +++ b/src/Network/Loli/Engine.hs @@ -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) + diff --git a/src/Network/Loli/Middleware/LoliRouter.hs b/src/Network/Loli/Middleware/LoliRouter.hs new file mode 100644 --- /dev/null +++ b/src/Network/Loli/Middleware/LoliRouter.hs @@ -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} diff --git a/src/Network/Loli/Middleware/UserMime.hs b/src/Network/Loli/Middleware/UserMime.hs new file mode 100644 --- /dev/null +++ b/src/Network/Loli/Middleware/UserMime.hs @@ -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) diff --git a/src/Network/Loli/Template.hs b/src/Network/Loli/Template.hs --- a/src/Network/Loli/Template.hs +++ b/src/Network/Loli/Template.hs @@ -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) diff --git a/src/Network/Loli/Template/ConstTemplate.hs b/src/Network/Loli/Template/ConstTemplate.hs new file mode 100644 --- /dev/null +++ b/src/Network/Loli/Template/ConstTemplate.hs @@ -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 diff --git a/src/Network/Loli/Template/TextTemplate.hs b/src/Network/Loli/Template/TextTemplate.hs --- a/src/Network/Loli/Template/TextTemplate.hs +++ b/src/Network/Loli/Template/TextTemplate.hs @@ -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 diff --git a/src/Network/Loli/Type.hs b/src/Network/Loli/Type.hs new file mode 100644 --- /dev/null +++ b/src/Network/Loli/Type.hs @@ -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 diff --git a/src/Network/Loli/Utils.hs b/src/Network/Loli/Utils.hs --- a/src/Network/Loli/Utils.hs +++ b/src/Network/Loli/Utils.hs @@ -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 + diff --git a/src/Test.hs b/src/Test.hs deleted file mode 100644 --- a/src/Test.hs +++ /dev/null @@ -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 "

loli power!

") - - -- 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" - diff --git a/src/Test/Test.hs b/src/Test/Test.hs new file mode 100644 --- /dev/null +++ b/src/Test/Test.hs @@ -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 ("

" ++ name ++ "

") + + -- 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 "

loli power!

") + + -- 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" + diff --git a/views/hello.html b/views/hello.html deleted file mode 100644 --- a/views/hello.html +++ /dev/null @@ -1,6 +0,0 @@ - -hello - -

hello $user

- - diff --git a/views/layout.html b/views/layout.html new file mode 100644 --- /dev/null +++ b/views/layout.html @@ -0,0 +1,6 @@ + + +

using a layout

+ $content + +