Rakka/Page.hs

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