Rakka/Page.hs

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