20 import Data.ByteString.Base (LazyByteString)
21 import qualified Data.ByteString.Char8 as C8
24 import Data.Encoding.UTF8
27 import Network.HTTP.Lucu
29 import Subversion.Types
30 import System.FilePath.Posix
34 type PageName = String
36 type LanguageTag = String -- See RFC 3066: http://www.ietf.org/rfc/rfc3066.txt
37 type LanguageName = String -- i.e. "日本語"
42 redirName :: !PageName
43 , redirDest :: !PageName
44 , redirRevision :: !(Maybe RevNum)
45 , redirLastMod :: !CalendarTime
49 , pageType :: !MIMEType
50 , pageLanguage :: !(Maybe LanguageTag)
51 , pageFileName :: !(Maybe String)
52 , pageIsTheme :: !Bool -- text/css 以外では無意味
53 , pageIsFeed :: !Bool -- text/x-rakka 以外では無意味
54 , pageIsLocked :: !Bool
55 , pageIsBoring :: !Bool
56 , pageIsBinary :: !Bool
57 , pageRevision :: !RevNum
58 , pageLastMod :: !CalendarTime
59 , pageSummary :: !(Maybe String)
60 , pageOtherLang :: !(Map LanguageTag PageName)
61 , pageContent :: !LazyByteString
65 -- UTF-8 に encode してから 0x20 - 0x7E の範圍を除いて URI escape する。
66 encodePageName :: PageName -> FilePath
67 encodePageName = escapeURIString isSafe . C8.unpack . encode UTF8 . fixPageName
69 isSafe :: Char -> Bool
72 | isReserved c = False
73 | c >= ' ' && c <= '~' = True
76 fixPageName :: PageName -> PageName
77 fixPageName = (\ (x:xs) -> toUpper x : xs) . map (\ c -> if c == ' ' then '_' else c)
80 -- URI unescape して UTF-8 から decode する。
81 decodePageName :: FilePath -> PageName
82 decodePageName = decode UTF8 . C8.pack . unEscapeString
85 pageFileName' :: Page -> String
86 pageFileName' page = fromMaybe (defaultFileName page) (pageFileName page)
89 defaultFileName :: Page -> String
91 = let baseName = takeFileName (pageName page)
94 MIMEType "text" "x-rakka" _ -> baseName <.> "rakka"
95 MIMEType "text" "css" _ -> baseName <.> "css"
99 mkPageURI :: URI -> PageName -> URI
100 mkPageURI baseURI name
102 uriPath = foldl (</>) "/" [uriPath baseURI, encodePageName name ++ ".html"]
106 mkPageFragmentURI :: URI -> PageName -> String -> URI
107 mkPageFragmentURI baseURI name fragment
109 uriPath = foldl (</>) "/" [uriPath baseURI, encodePageName name ++ ".html"]
110 , uriFragment = ('#':fragment)
114 mkObjectURI :: URI -> PageName -> URI
115 mkObjectURI baseURI name
116 = mkAuxiliaryURI baseURI ["object"] name
119 mkAuxiliaryURI :: URI -> [String] -> PageName -> URI
120 mkAuxiliaryURI baseURI basePath name
122 uriPath = foldl (</>) "/" ([uriPath baseURI] ++ basePath ++ [encodePageName name])
126 mkRakkaURI :: PageName -> URI
127 mkRakkaURI name = URI {
129 , uriAuthority = Nothing
130 , uriPath = encodePageName name