22 import Data.ByteString.Base (LazyByteString)
23 import qualified Data.ByteString.Char8 as C8
26 import Data.Encoding.UTF8
29 import Network.HTTP.Lucu
31 import Subversion.Types
32 import System.FilePath.Posix
36 type PageName = String
38 type LanguageTag = String -- See RFC 3066: http://www.ietf.org/rfc/rfc3066.txt
39 type LanguageName = String -- i.e. "日本語"
44 redirName :: !PageName
45 , redirDest :: !PageName
46 , redirRevision :: !(Maybe RevNum)
47 , redirLastMod :: !CalendarTime
51 , pageType :: !MIMEType
52 , pageLanguage :: !(Maybe LanguageTag)
53 , pageFileName :: !(Maybe String)
54 , pageIsTheme :: !Bool -- text/css 以外では無意味
55 , pageIsFeed :: !Bool -- text/x-rakka 以外では無意味
56 , pageIsLocked :: !Bool
57 , pageIsBoring :: !Bool
58 , pageIsBinary :: !Bool
59 , pageRevision :: !RevNum
60 , pageLastMod :: !CalendarTime
61 , pageSummary :: !(Maybe String)
62 , pageOtherLang :: !(Map LanguageTag PageName)
63 , pageContent :: !LazyByteString
67 -- UTF-8 に encode してから 0x20 - 0x7E の範圍を除いて URI escape する。
68 encodePageName :: PageName -> FilePath
69 encodePageName = escapeURIString isSafeChar . C8.unpack . encode UTF8 . fixPageName
71 fixPageName :: PageName -> PageName
72 fixPageName = (\ (x:xs) -> toUpper x : xs) . map (\ c -> if c == ' ' then '_' else c)
75 isSafeChar :: Char -> Bool
78 | isReserved c = False
79 | c > ' ' && c <= '~' = True
83 -- URI unescape して UTF-8 から decode する。
84 decodePageName :: FilePath -> PageName
85 decodePageName = decode UTF8 . C8.pack . unEscapeString
88 encodeFragment :: String -> String
89 encodeFragment = escapeURIString isSafeChar . C8.unpack . encode UTF8
92 pageFileName' :: Page -> String
94 = fromMaybe (defaultFileName (pageType page) (pageName page)) (pageFileName page)
97 defaultFileName :: MIMEType -> PageName -> String
98 defaultFileName pType pName
99 = let baseName = takeFileName pName
102 MIMEType "text" "x-rakka" _ -> baseName <.> "rakka"
103 MIMEType "text" "css" _ -> baseName <.> "css"
107 mkPageURI :: URI -> PageName -> URI
108 mkPageURI baseURI name
110 uriPath = foldl (</>) "/" [uriPath baseURI, encodePageName name ++ ".html"]
114 mkPageFragmentURI :: URI -> PageName -> String -> URI
115 mkPageFragmentURI baseURI name fragment
117 uriPath = foldl (</>) "/" [uriPath baseURI, encodePageName name ++ ".html"]
118 , uriFragment = ('#' : encodeFragment fragment)
122 mkFragmentURI :: String -> URI
123 mkFragmentURI fragment
125 uriFragment = ('#' : encodeFragment fragment)
129 mkObjectURI :: URI -> PageName -> URI
130 mkObjectURI baseURI name
131 = mkAuxiliaryURI baseURI ["object"] name
134 mkAuxiliaryURI :: URI -> [String] -> PageName -> URI
135 mkAuxiliaryURI baseURI basePath name
137 uriPath = foldl (</>) "/" ([uriPath baseURI] ++ basePath ++ [encodePageName name])
141 mkRakkaURI :: PageName -> URI
142 mkRakkaURI name = URI {
144 , uriAuthority = Nothing
145 , uriPath = encodePageName name