]> gitweb @ CieloNegro.org - Rakka.git/blobdiff - Rakka/Page.hs
preparation for javascripts
[Rakka.git] / Rakka / Page.hs
index 1fd54c92f326ad1e84e348b0452c3d0541c780b4..ec6ce8008209b498afb4064d9560f26e2df4d85c 100644 (file)
@@ -12,6 +12,7 @@ module Rakka.Page
     , mkPageURI
     , mkPageFragmentURI
     , mkObjectURI
+    , mkFragmentURI
     , mkAuxiliaryURI
     , mkRakkaURI
     )
@@ -64,24 +65,29 @@ data Page
 
 -- UTF-8 に encode してから 0x20 - 0x7E の範圍を除いて URI escape する。
 encodePageName :: PageName -> FilePath
-encodePageName = escapeURIString isSafe . C8.unpack . encode UTF8 . fixPageName
+encodePageName = escapeURIString isSafeChar . C8.unpack . encode UTF8 . fixPageName
     where
-      isSafe :: Char -> Bool
-      isSafe c
-          | c == '/'             = True
-          | isReserved c         = False
-          | c >= ' ' && c <= '~' = True
-          | otherwise            = False
-
       fixPageName :: PageName -> PageName
       fixPageName = (\ (x:xs) -> toUpper x : xs) . map (\ c -> if c == ' ' then '_' else c)
 
 
+isSafeChar :: Char -> Bool
+isSafeChar 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
 
 
+encodeFragment :: String -> String
+encodeFragment = escapeURIString isSafeChar . C8.unpack . encode UTF8
+
+
 pageFileName' :: Page -> String
 pageFileName' page = fromMaybe (defaultFileName page) (pageFileName page)
 
@@ -107,7 +113,14 @@ mkPageFragmentURI :: URI -> PageName -> String -> URI
 mkPageFragmentURI baseURI name fragment
     = baseURI {
         uriPath     = foldl (</>) "/" [uriPath baseURI, encodePageName name ++ ".html"]
-      , uriFragment = ('#':fragment)
+      , uriFragment = ('#' : encodeFragment fragment)
+      }
+
+
+mkFragmentURI :: String -> URI
+mkFragmentURI fragment
+    = nullURI {
+        uriFragment = ('#' : encodeFragment fragment)
       }