Rakka/Storage/Repos.hs

   1 module Rakka.Storage.Repos
   2     ( findAllPagesInRevision
   3     , loadPageInRepository
   4     )
   5     where
   6
   7 import qualified Data.Map as M
   8 import           Data.Maybe
   9 import           Data.Set (Set)
  10 import qualified Data.Set as S hiding (Set)
  11 import           Data.Time
  12 import           Network.HTTP.Lucu hiding (redirect)
  13 import           Rakka.Page
  14 import           Rakka.SystemConfig
  15 import           Rakka.Utils
  16 import           Rakka.W3CDateTime
  17 import           Subversion.Types
  18 import           Subversion.FileSystem
  19 import           Subversion.FileSystem.DirEntry
  20 import           Subversion.FileSystem.Revision
  21 import           Subversion.FileSystem.Root
  22 import           Subversion.Repository
  23 import           System.FilePath.Posix
  24
  25
  26 findAllPagesInRevision :: Repository -> RevNum -> IO (Set PageName)
  27 findAllPagesInRevision repos rev
  28     = do fs <- getRepositoryFS repos
  29          withRevision fs rev
  30              $ do exists <- isDirectory root
  31                   if exists then
  32                       traverse root
  33                     else
  34                       return S.empty
  35     where
  36       root :: FilePath
  37       root = "/pages"
  38
  39       traverse :: FilePath -> Rev (Set PageName)
  40       traverse dir
  41           = getDirEntries dir >>= mapM (traverse' dir) >>= return . S.unions
  42
  43       traverse' :: FilePath -> DirEntry -> Rev (Set PageName)
  44       traverse' dir entry
  45           = let path = dir </> entName entry
  46             in
  47               do kind <- checkPath path
  48                  case kind of
  49                    NoNode   -> return S.empty
  50                    FileNode -> return $ S.singleton (decodePath path)
  51                    DirNode  -> traverse path
  52
  53       decodePath :: FilePath -> PageName
  54       decodePath = decodePageName . makeRelative root . dropExtension
  55
  56
  57 loadPageInRepository :: Repository -> PageName -> Maybe RevNum -> IO (Maybe Page)
  58 loadPageInRepository repos name rev
  59     = do fs   <- getRepositoryFS repos
  60          rev' <- case rev of
  61                    Nothing -> getYoungestRev fs
  62                    Just r  -> return r
  63          withRevision fs rev'
  64              $ do exists <- isFile path
  65                   case exists of
  66                     True
  67                         -> return . Just =<< loadPage'
  68                     False
  69                         -> return Nothing
  70     where
  71       path :: FilePath
  72       path = "pages" </> (encodePageName name `addExtension` "page")
  73
  74       loadPage' :: Rev Page
  75       loadPage' = do redirect <- getNodeProp path "rakka:redirect"
  76                      case redirect of
  77                        Nothing
  78                            -> loadPageEntity
  79                        Just _
  80                            -> loadPageRedirect
  81
  82       loadPageEntity :: Rev Page
  83       loadPageEntity
  84           = do props   <- getNodePropList path
  85                hist    <- getNodeHistory True path
  86                content <- getFileContentsLBS path
  87
  88                let pageRev  = fst $ head hist
  89                    mimeType = read
  90                               $ fromMaybe "text/x-rakka"
  91                               $ fmap chomp (lookup "svn:mime-type" props)
  92
  93                lastMod <- getRevisionProp "svn:date"
  94                           >>= return . fromJust . parseW3CDateTime . chomp . fromJust
  95
  96                return Entity {
  97                             pageName      = name
  98                           , pageType      = mimeType
  99                           , pageLanguage  = fmap chomp (lookup "rakka:lang" props)
 100                           , pageFileName  = fmap chomp (lookup "rakka:fileName" props)
 101                           , pageIsTheme   = any ((== "rakka:isTheme") . fst) props
 102                           , pageIsFeed    = any ((== "rakka:isFeed") . fst) props
 103                           , pageIsLocked  = any ((== "rakka:isLocked") . fst) props
 104                           , pageIsBoring  = any ((== "rakka:isBoring") . fst) props
 105                           , pageIsBinary  = case mimeType of
 106                                               MIMEType "text" _ _
 107                                                   -> any ((== "rakka:isBinary") . fst) props
 108                                               _
 109                                                   -> True
 110                           , pageRevision  = pageRev
 111                           , pageLastMod   = zonedTimeToUTC lastMod
 112                           , pageSummary   = lookup "rakka:summary" props
 113                           , pageOtherLang = fromMaybe M.empty
 114                                             $ fmap
 115                                                   (M.fromList . fromJust . deserializeStringPairs)
 116                                                   (lookup "rakka:otherLang" props)
 117                           , pageContent   = content
 118                           }
 119
 120       loadPageRedirect :: Rev Page
 121       loadPageRedirect = fail "FIXME: loadPageRedirect: not implemented"