Rakka/Page.hs

   1 module Rakka.Page
   2     ( PageName
   3     , Page(..)
   4     , LanguageTag
   5     , LanguageName
   6
   7     , encodePageName
   8     , decodePageName
   9     , mkPageURI
  10     , mkPageFragmentURI
  11     , mkObjectURI
  12     , mkAuxiliaryURI
  13     , mkRakkaURI
  14     )
  15     where
  16
  17 import           Data.ByteString.Base (LazyByteString)
  18 import qualified Data.ByteString.Char8 as C8
  19 import           Data.Encoding
  20 import           Data.Encoding.UTF8
  21 import           Data.Map (Map)
  22 import           Network.HTTP.Lucu
  23 import           Network.URI
  24 import           Subversion.Types
  25 import           System.FilePath
  26 import           System.Time
  27
  28
  29 type PageName = String
  30
  31 type LanguageTag  = String -- See RFC 3066: http://www.ietf.org/rfc/rfc3066.txt
  32 type LanguageName = String -- i.e. "日本語"
  33
  34
  35 data Page
  36     = Redirection {
  37         redirName     :: !PageName
  38       , redirDest     :: !PageName
  39       , redirRevision :: !(Maybe RevNum)
  40       , redirLastMod  :: !CalendarTime
  41       }
  42     | Entity {
  43         pageName      :: !PageName
  44       , pageType      :: !MIMEType
  45       , pageLanguage  :: !(Maybe LanguageTag)
  46       , pageIsTheme   :: !Bool     -- text/css 以外では無意味
  47       , pageIsFeed    :: !Bool     -- text/x-rakka 以外では無意味
  48       , pageIsLocked  :: !Bool
  49       , pageIsBoring  :: !Bool
  50       , pageIsBinary  :: !Bool
  51       , pageRevision  :: !RevNum
  52       , pageLastMod   :: !CalendarTime
  53       , pageSummary   :: !(Maybe String)
  54       , pageOtherLang :: !(Map LanguageTag PageName)
  55       , pageContent   :: !LazyByteString
  56       }
  57
  58
  59 -- UTF-8 に encode してから 0x20 - 0x7E の範圍を除いて URI escape する。
  60 encodePageName :: PageName -> FilePath
  61 encodePageName = escapeURIString isSafe . C8.unpack . encode UTF8
  62     where
  63       isSafe :: Char -> Bool
  64       isSafe c
  65           | c == '/'             = True
  66           | isReserved c         = False
  67           | c >= ' ' && c <= '~' = True
  68           | otherwise            = False
  69
  70
  71 -- URI unescape して UTF-8 から decode する。
  72 decodePageName :: FilePath -> PageName
  73 decodePageName = decode UTF8 . C8.pack . unEscapeString
  74
  75
  76 mkPageURI :: URI -> PageName -> URI
  77 mkPageURI baseURI name
  78     = baseURI {
  79         uriPath = foldl combine "/" [uriPath baseURI, encodePageName name ++ ".html"]
  80       }
  81
  82
  83 mkPageFragmentURI :: URI -> PageName -> String -> URI
  84 mkPageFragmentURI baseURI name fragment
  85     = baseURI {
  86         uriPath     = foldl combine "/" [uriPath baseURI, encodePageName name ++ ".html"]
  87       , uriFragment = ('#':fragment)
  88       }
  89
  90
  91 mkObjectURI :: URI -> PageName -> URI
  92 mkObjectURI baseURI name
  93     = mkAuxiliaryURI baseURI ["object"] name
  94
  95
  96 mkAuxiliaryURI :: URI -> [String] -> PageName -> URI
  97 mkAuxiliaryURI baseURI basePath name
  98     = baseURI {
  99         uriPath = foldl combine "/" ([uriPath baseURI] ++ basePath ++ [encodePageName name])
 100       }
 101
 102
 103 mkRakkaURI :: PageName -> URI
 104 mkRakkaURI name = URI {
 105                     uriScheme    = "rakka:"
 106                   , uriAuthority = Nothing
 107                   , uriPath      = encodePageName name
 108                   , uriQuery     = ""
 109                   , uriFragment  = ""
 110                   }