1 module Rakka.Storage.DefaultPage
3 , getDefaultDirContents
8 import Control.Arrow.ArrowIO
9 import Control.Arrow.ArrowList
11 import qualified Data.Set as S
12 import Data.Time.Clock.POSIX
13 import Paths_Rakka -- Cabal が用意する。
15 import System.Directory
16 import System.FilePath
17 import System.FilePath.Find hiding (fileName, modificationTime)
18 import System.Posix.Files
19 import Text.XML.HXT.Arrow.ReadDocument
20 import Text.XML.HXT.DOM.XmlKeywords
23 doesLocalDirExist :: IO Bool
24 doesLocalDirExist = doesDirectoryExist "defaultPages"
27 findAllDefaultPages :: IO (Set PageName)
29 -- ./defaultPages が存在するなら、その中を探す。無ければ Cabal で
31 = do localDirExists <- doesLocalDirExist
32 if localDirExists then
33 findAllIn "defaultPages"
35 -- FIXME: この getDataFileName の使ひ方は undocumented
36 findAllIn =<< getDataFileName "defaultPages"
38 findAllIn :: FilePath -> IO (Set PageName)
40 = find always (fileType ==? RegularFile) dirPath
42 return . S.fromList . map (decodePageName . makeRelative dirPath . dropExtension)
45 getDefaultDirContents :: PageName -> IO (Set PageName)
46 getDefaultDirContents dir
47 -- ./defaultPages が存在するなら、その中を探す。無ければ Cabal で
49 = do localDirExists <- doesLocalDirExist
50 if localDirExists then
51 getDir' "defaultPages"
53 -- FIXME: この getDataFileName の使ひ方は undocumented
54 getDir' =<< getDataFileName "defaultPages"
56 getDir' :: FilePath -> IO (Set PageName)
58 = do let childDirPath = basePath </> encodePageName dir
59 exists <- doesDirectoryExist childDirPath
61 getDirectoryContents childDirPath
63 return . S.fromList . map (m basePath) . filter f
67 m :: FilePath -> FilePath -> PageName
68 m basePath = (dir </>) . decodePageName . makeRelative basePath . dropExtension
76 loadDefaultPage :: PageName -> IO (Maybe Page)
78 -- ./defaultPages が存在するなら、./defaultPages/Foo.xml を探す。無
79 -- ければ Cabal で defaultPages/Foo.xml を探す。
80 = do let pagePath = "defaultPages" </> encodePageName name <.> "xml"
82 localDirExists <- doesLocalDirExist
83 if localDirExists then
86 tryLoad =<< getDataFileName pagePath
88 tryLoad :: FilePath -> IO (Maybe Page)
90 = do exists <- doesFileExist fpath
92 return . Just =<< loadPageFile name fpath
97 loadPageFile :: PageName -> FilePath -> IO Page
98 loadPageFile name path
99 = do [page] <- runX ( setErrorMsgHandler False fail
108 loadPageFileA :: IOStateArrow s (PageName, FilePath) Page
110 = proc (name, fpath) ->
111 do tree <- readFromDocument [ (a_validate , v_0)
112 , (a_check_namespaces , v_1)
113 , (a_remove_whitespace, v_1)
115 lastMod <- arrIO (\ x -> getFileStatus x
117 return . posixSecondsToUTCTime . fromRational . toRational . modificationTime)
119 page <- parseXmlizedPage -< (name, tree)
121 if isEntity page then
124 , entityLastMod = lastMod
129 , redirLastMod = lastMod