Rakka/Page.hs

   1 module Rakka.Page
   2     ( PageName
   3     , Page(..)
   4     , encodePageName
   5     , decodePageName
   6     , mkPageURI
   7     , mkPageFragmentURI
   8     , mkObjectURI
   9     )
  10     where
  11
  12 import           Data.ByteString.Base (LazyByteString)
  13 import qualified Data.ByteString.Char8 as C8
  14 import           Data.Encoding
  15 import           Data.Encoding.UTF8
  16 import           Network.HTTP.Lucu
  17 import           Network.URI
  18 import           Subversion.Types
  19 import           System.FilePath
  20 import           System.Time
  21
  22
  23 type PageName = String
  24
  25
  26 data Page
  27     = Redirection {
  28         redirName     :: !PageName
  29       , redirDest     :: !PageName
  30       , redirRevision :: !(Maybe RevNum)
  31       , redirLastMod  :: !CalendarTime
  32       }
  33     | Entity {
  34         pageName      :: !PageName
  35       , pageType      :: !MIMEType
  36       , pageIsTheme   :: !Bool     -- text/css 以外では無意味
  37       , pageIsFeed    :: !Bool     -- text/x-rakka 以外では無意味
  38       , pageIsLocked  :: !Bool
  39       , pageIsBoring  :: !Bool
  40       , pageIsBinary  :: !Bool
  41       , pageRevision  :: !(Maybe RevNum)
  42       , pageLastMod   :: !CalendarTime
  43       , pageSummary   :: !(Maybe String)
  44       , pageOtherLang :: ![(String, PageName)]
  45       , pageContent   :: !LazyByteString
  46       }
  47
  48
  49 -- UTF-8 に encode してから 0x20 - 0x7E の範圍を除いて URI escape する。
  50 encodePageName :: PageName -> FilePath
  51 encodePageName = escapeURIString isSafe . C8.unpack . encode UTF8
  52     where
  53       isSafe :: Char -> Bool
  54       isSafe c
  55           | c >= ' ' && c <= '~' = True
  56           | otherwise            = False
  57
  58
  59 -- URI unescape して UTF-8 から decode する。
  60 decodePageName :: FilePath -> PageName
  61 decodePageName = decode UTF8 . C8.pack . unEscapeString
  62
  63
  64 mkPageURI :: URI -> PageName -> URI
  65 mkPageURI baseURI name
  66     = baseURI {
  67         uriPath = foldl combine "/" [uriPath baseURI, encodePageName name]
  68       }
  69
  70
  71 mkPageFragmentURI :: URI -> PageName -> String -> URI
  72 mkPageFragmentURI baseURI name fragment
  73     = baseURI {
  74         uriPath     = foldl combine "/" [uriPath baseURI, encodePageName name]
  75       , uriFragment = ('#':fragment)
  76       }
  77
  78
  79 mkObjectURI :: URI -> PageName -> URI
  80 mkObjectURI baseURI name
  81     = baseURI {
  82         uriPath = foldl combine "/" [uriPath baseURI, "object", encodePageName name]
  83       }