わかった気になるgitit-0.8
4 likes1,966 views
This document discusses routing, page display, authentication, and loading plugins in the Haskell wiki framework Gitit. It provides code examples for indexing file paths, rendering an HTML page index, authenticating users, loading plugins from other modules, and accessing resources defined in plugins.
![3/12
ページ表示
indexPage :: Handler
indexPage = do
path' <- getPath
base' <- getWikiBase
let prefix' = if null path' then "" else path' ++ "/"
fs <- getFileStore
listing <- liftIO $ directory fs prefix'
let isDiscussionPage (FSFile f) = isDiscussPageFile f
isDiscussionPage (FSDirectory _) = False
let prunedListing = filter (not . isDiscussionPage) listing
let htmlIndex = fileListToHtml base' prefix' prunedListing
formattedPage defaultPageLayout{
pgPageName = prefix',
pgShowPageTools = False,
pgTabs = [],
pgScripts = [],
pgTitle = "Contents"} htmlIndex](https://image.slidesharecdn.com/20110608haskellrgitit-110608105411-phpapp01/85/gitit-0-8-4-320.jpg)
![5/12
認証
authenticateUserThat predicate level handler = do
cfg <- getConfig
if level <= requireAuthentication cfg
then do
mbUser <- getLoggedInUser
rq <- askRq
let url = rqUri rq ++ rqQuery rq
case mbUser of
Nothing -> tempRedirect ("/_login?" ++
urlEncodeVars [("destination", url)]) $ toResponse ()
Just u -> if predicate u
then handler
else error "Not authorized."
else handler](https://image.slidesharecdn.com/20110608haskellrgitit-110608105411-phpapp01/85/gitit-0-8-6-320.jpg)
![7/12
gititプラグイン#2
loadPlugin :: FilePath -> IO Plugin
loadPlugin pluginName = do
--snip--
pr <- findModule (mkModuleName "Prelude") Nothing
i <- findModule (mkModuleName "Network.Gitit.Interface") Nothing
m <- findModule (mkModuleName modName) Nothing
setContext []
#if MIN_VERSION_ghc(7,0,0)
[(m, Nothing), (i, Nothing), (pr, Nothing)]
#else
[m, i, pr]
#endif
value <- compileExpr (modName ++ ".plugin :: Plugin")
let value' = (unsafeCoerce value) :: Plugin
return value'](https://image.slidesharecdn.com/20110608haskellrgitit-110608105411-phpapp01/85/gitit-0-8-8-320.jpg)
![12/12
plugins使い方#3
Main.hs
import System.Plugins
import API
main = do
m_v <- load_ "../Test.o" ["../api"] "resource"
v <- case m_v of
LoadFailure _ -> error "load failed"
LoadSuccess _ v -> return v
let s = field v
print s -- => "success"と表示](https://image.slidesharecdn.com/20110608haskellrgitit-110608105411-phpapp01/85/gitit-0-8-13-320.jpg)
わかった気になるgitit-0.8
- 1. わかった気になる わかった気になる gitit-0.8 gitit-0.8 初心者Haskell勉強会 Kiwamu Okabe
- 2. 1/12 ルーティング
- 3. 2/12 monadplus handlerをmplusで結合してるだ けに見えます。失敗はmzeroにな るんですが、成功した場合には次 のhandlerを実行してほしくないよ うに見えるのですが、、、そー ゆーもの？？？
- 4. 3/12 ページ表示 indexPage :: Handler indexPage = do path' <- getPath base' <- getWikiBase let prefix' = if null path' then "" else path' ++ "/" fs <- getFileStore listing <- liftIO $ directory fs prefix' let isDiscussionPage (FSFile f) = isDiscussPageFile f isDiscussionPage (FSDirectory _) = False let prunedListing = filter (not . isDiscussionPage) listing let htmlIndex = fileListToHtml base' prefix' prunedListing formattedPage defaultPageLayout{ pgPageName = prefix', pgShowPageTools = False, pgTabs = [], pgScripts = [], pgTitle = "Contents"} htmlIndex
- 5. 4/12 gitアクセス (*1) getFileStoreでFileStoreを呼出 randomPage :: Handler randomPage = do fs <- getFileStore files <- liftIO $ index fs let pages = map dropExtension $ filter (f -> isPageFile f && not (isDiscussPageFile f)) files base' <- getWikiBase if null pages then error "No pages found!" (*1)http://hackage.haskell.org/packages/archive/filestore/ latest/doc/html/Data-FileStore-Types.html
- 6. 5/12 認証 authenticateUserThat predicate level handler = do cfg <- getConfig if level <= requireAuthentication cfg then do mbUser <- getLoggedInUser rq <- askRq let url = rqUri rq ++ rqQuery rq case mbUser of Nothing -> tempRedirect ("/_login?" ++ urlEncodeVars [("destination", url)]) $ toResponse () Just u -> if predicate u then handler else error "Not authorized." else handler
- 7. 6/12 gititプラグイン#1 gitit/Network/Gitit/Plugins.hs (*2) がプラグイン読み込みコード。 (*2)詳細は http://www.bluishcoder.co.nz/2008/11/dynamic- compilation-and-loading-of.html を参照
- 8. 7/12 gititプラグイン#2 loadPlugin :: FilePath -> IO Plugin loadPlugin pluginName = do --snip-- pr <- findModule (mkModuleName "Prelude") Nothing i <- findModule (mkModuleName "Network.Gitit.Interface") Nothing m <- findModule (mkModuleName modName) Nothing setContext [] #if MIN_VERSION_ghc(7,0,0) [(m, Nothing), (i, Nothing), (pr, Nothing)] #else [m, i, pr] #endif value <- compileExpr (modName ++ ".plugin :: Plugin") let value' = (unsafeCoerce value) :: Plugin return value'
- 9. 8/12 ghc7だと動かない $ ghc --version The Glorious Glasgow Haskell Compilation System, version 6.12.1 $ gitit -f default.conf Loading plugin 'plugins/TwitterUrl.hs'... Finished loading plugins. $ ghc --version The Glorious Glasgow Haskell Compilation System, version 7.0.3 $ gitit -f default.conf Loading plugin 'plugins/TwitterUrl.hs'... gitit: This ELF file contains no symtab gitit: gitit: panic! (the 'impossible' happened) (GHC version 7.0.3 for x86_64-unknown-linux): loadArchive "/usr/lib/ghc-7.0.3/ghc-7.0.3/libHSghc-7.0.3.a": failed Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug
- 11. 10/12 plugins使い方#1 API.hs module API where data Test = Test { field :: String } test :: Test test = Test { field = "default value" }
- 12. 11/12 plugins使い方#2 Test.hs module Test where import API resource = test { field = "success" }
- 13. 12/12 plugins使い方#3 Main.hs import System.Plugins import API main = do m_v <- load_ "../Test.o" ["../api"] "resource" v <- case m_v of LoadFailure _ -> error "load failed" LoadSuccess _ v -> return v let s = field v print s -- => "success"と表示