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