X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Rakka%2FPage.hs;h=ff1c0ac8a0140fab0cc77c599b556a3ccc73ef80;hb=98e508613bb7a50a1f65998ce87f065df957b736;hp=607a0a81b9035b76104b4d87fd677eb190da0266;hpb=484e15845d9c06d0fa62044d3b6b3ff8c78a6e04;p=Rakka.git diff --git a/Rakka/Page.hs b/Rakka/Page.hs index 607a0a8..ff1c0ac 100644 --- a/Rakka/Page.hs +++ b/Rakka/Page.hs @@ -1,7 +1,16 @@ module Rakka.Page ( PageName , Page(..) + , LanguageTag + , LanguageName + , encodePageName + , decodePageName + , mkPageURI + , mkPageFragmentURI + , mkObjectURI + , mkAuxiliaryURI + , mkRakkaURI ) where @@ -9,35 +18,93 @@ import Data.ByteString.Base (LazyByteString) import qualified Data.ByteString.Char8 as C8 import Data.Encoding import Data.Encoding.UTF8 +import Data.Map (Map) import Network.HTTP.Lucu import Network.URI import Subversion.Types +import System.FilePath +import System.Time type PageName = String +type LanguageTag = String -- See RFC 3066: http://www.ietf.org/rfc/rfc3066.txt +type LanguageName = String -- i.e. "日本語" + data Page - = Redirect PageName - | Page { - pageName :: PageName - , pageType :: MIMEType - , pageIsTheme :: Bool -- text/css 以外では無意味 - , pageIsFeed :: Bool -- text/x-rakka 以外では無意味 - , pageIsLocked :: Bool - , pageIsBoring :: Bool - , pageRevision :: Maybe RevNum - , pageSummary :: Maybe String - , pageOtherLang :: [(String, PageName)] - , pageContent :: LazyByteString + = Redirection { + redirName :: !PageName + , redirDest :: !PageName + , redirRevision :: !(Maybe RevNum) + , redirLastMod :: !CalendarTime + } + | Entity { + pageName :: !PageName + , pageType :: !MIMEType + , pageLanguage :: !(Maybe LanguageTag) + , pageIsTheme :: !Bool -- text/css 以外では無意味 + , pageIsFeed :: !Bool -- text/x-rakka 以外では無意味 + , pageIsLocked :: !Bool + , pageIsBoring :: !Bool + , pageIsBinary :: !Bool + , pageRevision :: !RevNum + , pageLastMod :: !CalendarTime + , pageSummary :: !(Maybe String) + , pageOtherLang :: !(Map LanguageTag PageName) + , pageContent :: !LazyByteString } -- UTF-8 に encode してから 0x20 - 0x7E の範圍を除いて URI escape する。 encodePageName :: PageName -> FilePath -encodePageName = escapeURIString shouldEscape . C8.unpack . encode UTF8 +encodePageName = escapeURIString isSafe . C8.unpack . encode UTF8 where - shouldEscape :: Char -> Bool - shouldEscape c - | c >= ' ' && c <= '~' = False - | otherwise = True + isSafe :: Char -> Bool + isSafe c + | c == '/' = True + | isReserved c = False + | c >= ' ' && c <= '~' = True + | otherwise = False + + +-- URI unescape して UTF-8 から decode する。 +decodePageName :: FilePath -> PageName +decodePageName = decode UTF8 . C8.pack . unEscapeString + + +mkPageURI :: URI -> PageName -> URI +mkPageURI baseURI name + = baseURI { + 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 ++ ".html"] + , uriFragment = ('#':fragment) + } + + +mkObjectURI :: URI -> PageName -> URI +mkObjectURI baseURI name + = mkAuxiliaryURI baseURI ["object"] name + + +mkAuxiliaryURI :: URI -> [String] -> PageName -> URI +mkAuxiliaryURI baseURI basePath name + = baseURI { + uriPath = foldl combine "/" ([uriPath baseURI] ++ basePath ++ [encodePageName name]) + } + + +mkRakkaURI :: PageName -> URI +mkRakkaURI name = URI { + uriScheme = "rakka:" + , uriAuthority = Nothing + , uriPath = encodePageName name + , uriQuery = "" + , uriFragment = "" + }