Rakka/Storage/Repos.hs

   1 module Rakka.Storage.Repos
   2     ( loadPageInRepository
   3     )
   4     where
   5
   6 import qualified Data.Map as M
   7 import           Data.Maybe
   8 import           Data.Time
   9 import           Network.HTTP.Lucu hiding (redirect)
  10 import           Rakka.Page
  11 import           Rakka.SystemConfig
  12 import           Rakka.Utils
  13 import           Rakka.W3CDateTime
  14 import           Subversion.Types
  15 import           Subversion.FileSystem
  16 import           Subversion.FileSystem.Revision
  17 import           Subversion.FileSystem.Root
  18 import           Subversion.Repository
  19 import           System.FilePath.Posix
  20
  21
  22 loadPageInRepository :: Repository -> PageName -> Maybe RevNum -> IO (Maybe Page)
  23 loadPageInRepository repos name rev
  24     = do fs   <- getRepositoryFS repos
  25          rev' <- case rev of
  26                    Nothing -> getYoungestRev fs
  27                    Just r  -> return r
  28          withRevision fs rev'
  29              $ do exists <- isFile path
  30                   case exists of
  31                     True
  32                         -> return . Just =<< loadPage'
  33                     False
  34                         -> return Nothing
  35     where
  36       path :: FilePath
  37       path = "pages" </> encodePageName name
  38
  39       loadPage' :: Rev Page
  40       loadPage' = do redirect <- getNodeProp path "rakka:redirect"
  41                      case redirect of
  42                        Nothing
  43                            -> loadPageEntity
  44                        Just _
  45                            -> loadPageRedirect
  46
  47       loadPageEntity :: Rev Page
  48       loadPageEntity
  49           = do props   <- getNodePropList path
  50                hist    <- getNodeHistory True path
  51                content <- getFileContentsLBS path
  52
  53                let pageRev  = fst $ head hist
  54                    mimeType = read
  55                               $ fromMaybe "text/x-rakka"
  56                               $ fmap chomp (lookup "svn:mime-type" props)
  57
  58                lastMod <- getRevisionProp "svn:date"
  59                           >>= return . fromJust . parseW3CDateTime . chomp . fromJust
  60
  61                return Entity {
  62                             pageName      = name
  63                           , pageType      = mimeType
  64                           , pageLanguage  = fmap chomp (lookup "rakka:lang" props)
  65                           , pageFileName  = fmap chomp (lookup "rakka:fileName" props)
  66                           , pageIsTheme   = any ((== "rakka:isTheme") . fst) props
  67                           , pageIsFeed    = any ((== "rakka:isFeed") . fst) props
  68                           , pageIsLocked  = any ((== "rakka:isLocked") . fst) props
  69                           , pageIsBoring  = any ((== "rakka:isBoring") . fst) props
  70                           , pageIsBinary  = case mimeType of
  71                                               MIMEType "text" _ _
  72                                                   -> any ((== "rakka:isBinary") . fst) props
  73                                               _
  74                                                   -> True
  75                           , pageRevision  = pageRev
  76                           , pageLastMod   = zonedTimeToUTC lastMod
  77                           , pageSummary   = lookup "rakka:summary" props
  78                           , pageOtherLang = fromMaybe M.empty
  79                                             $ fmap
  80                                                   (M.fromList . fromJust . deserializeStringPairs)
  81                                                   (lookup "rakka:otherLang" props)
  82                           , pageContent   = content
  83                           }
  84
  85       loadPageRedirect :: Rev Page
  86       loadPageRedirect = fail "FIXME: loadPageRedirect: not implemented"