From: pho Date: Mon, 22 Oct 2007 05:36:55 +0000 (+0900) Subject: Implemented sidebars X-Git-Url: https://git.cielonegro.org/gitweb.cgi?a=commitdiff_plain;h=dcfffa578c5dd6647a5be7d2074488a520dfcf2d;p=Rakka.git Implemented sidebars darcs-hash:20071022053655-62b54-c9abb0e0a3011fb7f51cd0615734f89c723f81dd.gz --- diff --git a/Rakka.cabal b/Rakka.cabal index 7380ae4..efc767a 100644 --- a/Rakka.cabal +++ b/Rakka.cabal @@ -41,6 +41,9 @@ Data-Files: defaultpages/Help/SampleImage/Small defaultPages/Help/Syntax defaultPages/MainPage + defaultPages/PageTitle + defaultPages/SideBar/Left + defaultPages/SideBar/Right defaultPages/StyleSheet/Default schemas/rakka-page-1.0.rng diff --git a/Rakka/Page.hs b/Rakka/Page.hs index fdc6220..93c7465 100644 --- a/Rakka/Page.hs +++ b/Rakka/Page.hs @@ -64,14 +64,14 @@ decodePageName = decode UTF8 . C8.pack . unEscapeString mkPageURI :: URI -> PageName -> URI mkPageURI baseURI name = baseURI { - uriPath = foldl combine "/" [uriPath baseURI, encodePageName name] + uriPath = foldl combine "/" [uriPath baseURI, encodePageName name ++ ".html"] } mkPageFragmentURI :: URI -> PageName -> String -> URI mkPageFragmentURI baseURI name fragment = baseURI { - uriPath = foldl combine "/" [uriPath baseURI, encodePageName name] + uriPath = foldl combine "/" [uriPath baseURI, encodePageName name ++ ".html"] , uriFragment = ('#':fragment) } diff --git a/Rakka/Resource/Index.hs b/Rakka/Resource/Index.hs index 859b8eb..9db16eb 100644 --- a/Rakka/Resource/Index.hs +++ b/Rakka/Resource/Index.hs @@ -5,6 +5,8 @@ module Rakka.Resource.Index import Network.HTTP.Lucu import Rakka.Environment +import Rakka.Page +import Rakka.SystemConfig resIndex :: Environment -> ResourceDef @@ -12,8 +14,10 @@ resIndex env = ResourceDef { resUsesNativeThread = False , resIsGreedy = False - , resGet = Just $ do setContentType $ read "text/plain" - output "FIXME: not implemented" + , resGet + = Just $ do BaseURI baseURI <- getSysConf (envSysConf env) (BaseURI undefined) + DefaultPage name <- getSysConf (envSysConf env) (DefaultPage undefined) + redirect Found (mkPageURI baseURI name) , resHead = Nothing , resPost = Nothing , resPut = Nothing diff --git a/Rakka/Resource/Render.hs b/Rakka/Resource/Render.hs index 6aee49f..27671da 100644 --- a/Rakka/Resource/Render.hs +++ b/Rakka/Resource/Render.hs @@ -89,9 +89,22 @@ handleRedirect env - + blah blah... - + + + + + blah blah... + + + blah blah... + + + + + blah blah... + -} handleGetEntity :: (ArrowXml a, ArrowChoice a, ArrowIO a) => Environment -> a Page (Resource ()) @@ -103,6 +116,10 @@ handleGetEntity env BaseURI baseURI <- getSysConfA sysConf (BaseURI undefined) -< () StyleSheet cssName <- getSysConfA sysConf (StyleSheet undefined) -< () + Just pageTitle <- getPageA (envStorage env) -< "PageTitle" + Just leftSideBar <- getPageA (envStorage env) -< "SideBar/Left" + Just rightSideBar <- getPageA (envStorage env) -< "SideBar/Right" + tree <- ( eelem "/" += ( eelem "page" += sattr "site" siteName @@ -139,8 +156,28 @@ handleGetEntity env += sattr "page" page | (lang, page) <- xs ] ) - += ( eelem "content" - += (constA page >>> formatPage env ) + += ( eelem "pageTitle" + += ( (constA page &&& constA pageTitle) + >>> + formatSubPage env + ) + ) + += ( eelem "sideBar" + += ( eelem "left" + += ( (constA page &&& constA leftSideBar) + >>> + formatSubPage env + ) + ) + += ( eelem "right" + += ( (constA page &&& constA rightSideBar) + >>> + formatSubPage env + ) + ) + ) + += ( eelem "body" + += (constA page >>> formatPage env) ) >>> uniqueNamespacesFromDeclAndQNames @@ -188,10 +225,11 @@ entityToXHTML += sattr "class" "center" += ( eelem "div" += sattr "class" "title" + += getXPathTreesInDoc "/page/pageTitle/*" ) += ( eelem "div" += sattr "class" "body" - += getXPathTreesInDoc "/page/content/*" + += getXPathTreesInDoc "/page/body/*" ) ) += ( eelem "div" @@ -201,12 +239,14 @@ entityToXHTML += sattr "class" "left sideBar" += ( eelem "div" += sattr "class" "content" + += getXPathTreesInDoc "/page/sideBar/left/*" ) ) += ( eelem "div" += sattr "class" "right sideBar" += ( eelem "div" += sattr "class" "content" + += getXPathTreesInDoc "/page/sideBar/right/*" ) ) ) diff --git a/Rakka/SystemConfig.hs b/Rakka/SystemConfig.hs index ea7e370..423e6c5 100644 --- a/Rakka/SystemConfig.hs +++ b/Rakka/SystemConfig.hs @@ -26,6 +26,7 @@ data SystemConfig = SystemConfig { data SysConfValue = SiteName String | BaseURI URI + | DefaultPage String | StyleSheet String @@ -44,23 +45,26 @@ getSysConfA = (arrIO0 .) . getSysConf {- paths -} sysConfPath :: SysConfValue -> FilePath -sysConfPath (SiteName _) = "/siteName" -sysConfPath (BaseURI _) = "/baseURI" -sysConfPath (StyleSheet _) = "/styleSheet" +sysConfPath (SiteName _) = "/siteName" +sysConfPath (BaseURI _) = "/baseURI" +sysConfPath (DefaultPage _) = "/defaultPage" +sysConfPath (StyleSheet _) = "/styleSheet" {- marshalling -} marshalSysConf :: SysConfValue -> String -marshalSysConf (SiteName name) = name -marshalSysConf (BaseURI uri ) = uriToString id uri "" -marshalSysConf (StyleSheet name) = name +marshalSysConf (SiteName name) = name +marshalSysConf (BaseURI uri ) = uriToString id uri "" +marshalSysConf (DefaultPage name) = name +marshalSysConf (StyleSheet name) = name {- unmarshalling -} unmarshalSysConf :: SysConfValue -> String -> SysConfValue -unmarshalSysConf (SiteName _) name = SiteName name -unmarshalSysConf (BaseURI _) uri = BaseURI $ fromJust $ parseURI uri -unmarshalSysConf (StyleSheet _) name = StyleSheet name +unmarshalSysConf (SiteName _) name = SiteName name +unmarshalSysConf (BaseURI _) uri = BaseURI $ fromJust $ parseURI uri +unmarshalSysConf (DefaultPage _) name = DefaultPage name +unmarshalSysConf (StyleSheet _) name = StyleSheet name {- getting default value -} @@ -83,5 +87,8 @@ sysConfDefault sc (BaseURI _) return $ BaseURI $ fromJust $ parseURI defaultURI +sysConfDefault _ (DefaultPage _) + = return $ DefaultPage "MainPage" + sysConfDefault _ (StyleSheet _) = return $ StyleSheet "StyleSheet/Default" diff --git a/Rakka/Wiki/Engine.hs b/Rakka/Wiki/Engine.hs index 1da0d0e..f0de8fb 100644 --- a/Rakka/Wiki/Engine.hs +++ b/Rakka/Wiki/Engine.hs @@ -1,5 +1,6 @@ module Rakka.Wiki.Engine ( formatPage + , formatSubPage ) where @@ -35,6 +36,18 @@ formatPage env attachXHtmlNs -< tree +formatSubPage :: (ArrowXml a, ArrowChoice a, ArrowIO a) => + Environment + -> a (Page, Page) XmlTree +formatSubPage env + = proc (mainPage, subPage) + -> do tree <- case pageType subPage of + MIMEType "text" "x-rakka" _ + -> do let source = decodeLazy UTF8 (pageContent subPage) + formatWikiPage env -< (Just mainPage, source) + attachXHtmlNs -< tree + + formatWikiPage :: (ArrowXml a, ArrowChoice a, ArrowIO a) => Environment -> a (Maybe Page, String) XmlTree diff --git a/Rakka/Wiki/Interpreter/Base.hs b/Rakka/Wiki/Interpreter/Base.hs index 1475f46..fa225e6 100644 --- a/Rakka/Wiki/Interpreter/Base.hs +++ b/Rakka/Wiki/Interpreter/Base.hs @@ -3,6 +3,7 @@ module Rakka.Wiki.Interpreter.Base ) where +import Rakka.Page import Rakka.Wiki import Rakka.Wiki.Interpreter import Rakka.Wiki.Interpreter.Base.Image @@ -14,6 +15,8 @@ baseInterpreters = [ lineBreakInterp , divInterp , imageInterp , imgFrameInterp + + , pageNameInterp ] @@ -39,3 +42,13 @@ divInterp = BlockCommandInterpreter { , bciInterpret = \ _ (BlockCommand _ attrs contents) -> return $ Div attrs contents } + + +pageNameInterp :: Interpreter +pageNameInterp = InlineCommandInterpreter { + iciName = "pageName" + , iciInterpret + = \ ctx (InlineCommand _ _ _) -> case ctxPage ctx of + Nothing -> return $ Text "(None)" + Just page -> return $ Text $ pageName page + } \ No newline at end of file diff --git a/defaultPages/MainPage b/defaultPages/MainPage index 02abe6b..d042a31 100644 --- a/defaultPages/MainPage +++ b/defaultPages/MainPage @@ -2,7 +2,8 @@ - diff --git a/defaultPages/PageTitle b/defaultPages/PageTitle new file mode 100644 index 0000000..3bd94c3 --- /dev/null +++ b/defaultPages/PageTitle @@ -0,0 +1,8 @@ + + + +]]> + diff --git a/defaultPages/SideBar/Left b/defaultPages/SideBar/Left new file mode 100644 index 0000000..9b3a18d --- /dev/null +++ b/defaultPages/SideBar/Left @@ -0,0 +1,13 @@ + + + + diff --git a/defaultPages/SideBar/Right b/defaultPages/SideBar/Right new file mode 100644 index 0000000..c3b03b1 --- /dev/null +++ b/defaultPages/SideBar/Right @@ -0,0 +1,15 @@ + + + + diff --git a/defaultPages/StyleSheet/Default b/defaultPages/StyleSheet/Default index 49dce5c..584a8b7 100644 --- a/defaultPages/StyleSheet/Default +++ b/defaultPages/StyleSheet/Default @@ -59,6 +59,14 @@ } /* spacing */ +.title { + padding: 5px 20px; +} + +.title p { + margin: 0; +} + .body { padding: 25px 30px; } @@ -92,6 +100,11 @@ margin-top: 0.9em; } +.sideBar h1 { + margin-bottom: 5px; + padding: 0px 5px; +} + .sideBar .content { padding: 20px; } @@ -114,13 +127,64 @@ } /* color and text */ +* { + font-family: sans-serif; +} + body { - background-color: #white; + background-color: white; color: black; line-height: 1.3; } +h1, h2, h3, h4, h5, h6 { + font-weight: normal; +} + +.title { + background-color: #fafafa; + + border-color: #cccccc; + border-width: 0 0 3px 0; + border-style: double; + + font-size: 1.2em; +} + +.body h1 { + font-size: 180%; + + background-color: #fafafa; + + border-color: #dddddd; + border-width: 2px; + border-style: solid; + + padding: 0 10px; +} +.body h2 { + font-size: 150%; +} +.body h3 { + font-size: 130%; +} +.body h4 { + font-size: 110%; +} +.body h5 { + font-size: 90%; +} +.body h2, .body h3, .body h4, .body h5 { + background-color: #fafafa; + + border-color: #dddddd; + border-width: 0 0 1px 0; + border-style: solid; + + padding: 0 10px; +} + .header, .footer, .sideBar { background-color: #eeeeee; } @@ -128,6 +192,11 @@ body { .sideBar h1 { font-size: 120%; font-weight: bold; + background-color: #fafafa; + + border-color: #dddddd white white #dddddd; + border-width: 1px; + border-style: solid; } .sideBar a { @@ -197,6 +266,9 @@ img { border-color: #cccccc; border-width: 1px; border-style: solid; + + margin-top: 5px; + margin-bottom: 5px; } .imageFrame p {