Rakka/Page.hs

   1 module Rakka.Page
   2     ( PageName
   3     , Page(..)
   4     , LanguageTag
   5     , LanguageName
   6
   7     , encodePageName
   8     , decodePageName
   9
  10     , pageFileName'
  11
  12     , mkPageURI
  13     , mkPageFragmentURI
  14     , mkObjectURI
  15     , mkAuxiliaryURI
  16     , mkRakkaURI
  17     )
  18     where
  19
  20 import           Data.ByteString.Base (LazyByteString)
  21 import qualified Data.ByteString.Char8 as C8
  22 import           Data.Char
  23 import           Data.Encoding
  24 import           Data.Encoding.UTF8
  25 import           Data.Map (Map)
  26 import           Data.Maybe
  27 import           Network.HTTP.Lucu
  28 import           Network.URI
  29 import           Subversion.Types
  30 import           System.FilePath.Posix
  31 import           System.Time
  32
  33
  34 type PageName = String
  35
  36 type LanguageTag  = String -- See RFC 3066: http://www.ietf.org/rfc/rfc3066.txt
  37 type LanguageName = String -- i.e. "日本語"
  38
  39
  40 data Page
  41     = Redirection {
  42         redirName     :: !PageName
  43       , redirDest     :: !PageName
  44       , redirRevision :: !(Maybe RevNum)
  45       , redirLastMod  :: !CalendarTime
  46       }
  47     | Entity {
  48         pageName      :: !PageName
  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
  62       }
  63
  64
  65 -- UTF-8 に encode してから 0x20 - 0x7E の範圍を除いて URI escape する。
  66 encodePageName :: PageName -> FilePath
  67 encodePageName = escapeURIString isSafe . C8.unpack . encode UTF8 . fixPageName
  68     where
  69       isSafe :: Char -> Bool
  70       isSafe c
  71           | c == '/'             = True
  72           | isReserved c         = False
  73           | c >= ' ' && c <= '~' = True
  74           | otherwise            = False
  75
  76       fixPageName :: PageName -> PageName
  77       fixPageName = (\ (x:xs) -> toUpper x : xs) . map (\ c -> if c == ' ' then '_' else c)
  78
  79
  80 -- URI unescape して UTF-8 から decode する。
  81 decodePageName :: FilePath -> PageName
  82 decodePageName = decode UTF8 . C8.pack . unEscapeString
  83
  84
  85 pageFileName' :: Page -> String
  86 pageFileName' page = fromMaybe (defaultFileName page) (pageFileName page)
  87
  88
  89 defaultFileName :: Page -> String
  90 defaultFileName page
  91     = let baseName = takeFileName (pageName page)
  92       in
  93         case pageType page of
  94           MIMEType "text" "x-rakka" _ -> baseName <.> "rakka"
  95           MIMEType "text" "css"     _ -> baseName <.> "css"
  96           _                           -> baseName
  97
  98
  99 mkPageURI :: URI -> PageName -> URI
 100 mkPageURI baseURI name
 101     = baseURI {
 102         uriPath = foldl (</>) "/" [uriPath baseURI, encodePageName name ++ ".html"]
 103       }
 104
 105
 106 mkPageFragmentURI :: URI -> PageName -> String -> URI
 107 mkPageFragmentURI baseURI name fragment
 108     = baseURI {
 109         uriPath     = foldl (</>) "/" [uriPath baseURI, encodePageName name ++ ".html"]
 110       , uriFragment = ('#':fragment)
 111       }
 112
 113
 114 mkObjectURI :: URI -> PageName -> URI
 115 mkObjectURI baseURI name
 116     = mkAuxiliaryURI baseURI ["object"] name
 117
 118
 119 mkAuxiliaryURI :: URI -> [String] -> PageName -> URI
 120 mkAuxiliaryURI baseURI basePath name
 121     = baseURI {
 122         uriPath = foldl (</>) "/" ([uriPath baseURI] ++ basePath ++ [encodePageName name])
 123       }
 124
 125
 126 mkRakkaURI :: PageName -> URI
 127 mkRakkaURI name = URI {
 128                     uriScheme    = "rakka:"
 129                   , uriAuthority = Nothing
 130                   , uriPath      = encodePageName name
 131                   , uriQuery     = ""
 132                   , uriFragment  = ""
 133                   }