1 module Rakka.Storage.DefaultPage
3 , getDefaultDirContents
9 import Control.Arrow.ArrowIO
10 import Control.Arrow.ArrowList
12 import qualified Data.Set as S
13 import Data.Time.Clock.POSIX
14 import Paths_Rakka -- Cabal が用意する。
16 import System.Directory
17 import System.FilePath
18 import System.FilePath.Find hiding (fileName, modificationTime)
19 import System.Posix.Files
20 import Text.XML.HXT.Arrow.ReadDocument
21 import Text.XML.HXT.Arrow.XmlIOStateArrow
22 import Text.XML.HXT.DOM.XmlKeywords
25 doesLocalDirExist :: IO Bool
26 doesLocalDirExist = doesDirectoryExist "defaultPages"
29 findAllDefaultPages :: IO (Set PageName)
31 -- ./defaultPages が存在するなら、その中を探す。無ければ Cabal で
33 = do localDirExists <- doesLocalDirExist
34 if localDirExists then
35 findAllIn "defaultPages"
37 -- FIXME: この getDataFileName の使ひ方は undocumented
38 findAllIn =<< getDataFileName "defaultPages"
40 findAllIn :: FilePath -> IO (Set PageName)
42 = find always (fileType ==? RegularFile) dirPath
44 return . S.fromList . map (decodePageName . makeRelative dirPath . dropExtension)
47 getDefaultDirContents :: PageName -> IO (Set PageName)
48 getDefaultDirContents dir
49 -- ./defaultPages が存在するなら、その中を探す。無ければ Cabal で
51 = do localDirExists <- doesLocalDirExist
52 if localDirExists then
53 getDir' "defaultPages"
55 -- FIXME: この getDataFileName の使ひ方は undocumented
56 getDir' =<< getDataFileName "defaultPages"
58 getDir' :: FilePath -> IO (Set PageName)
60 = do let childDirPath = basePath </> encodePageName dir
61 exists <- doesDirectoryExist childDirPath
63 getDirectoryContents childDirPath
65 return . S.fromList . map (m basePath) . filter f
69 m :: FilePath -> FilePath -> PageName
70 m basePath = (dir </>) . decodePageName . makeRelative basePath . dropExtension
78 loadDefaultPage :: PageName -> IO (Maybe Page)
80 -- ./defaultPages が存在するなら、./defaultPages/Foo.xml を探す。無
81 -- ければ Cabal で defaultPages/Foo.xml を探す。
82 = do let pagePath = "defaultPages" </> encodePageName name <.> "xml"
84 localDirExists <- doesLocalDirExist
85 if localDirExists then
88 tryLoad =<< getDataFileName pagePath
90 tryLoad :: FilePath -> IO (Maybe Page)
92 = do exists <- doesFileExist fpath
94 return . Just =<< loadPageFile name fpath
99 loadPageFile :: PageName -> FilePath -> IO Page
100 loadPageFile name path
101 = do [page] <- runX ( setErrorMsgHandler False fail
110 loadPageFileA :: IOStateArrow s (PageName, FilePath) Page
112 = proc (name, fpath) ->
113 do tree <- readFromDocument [ (a_validate , v_0)
114 , (a_check_namespaces , v_1)
115 , (a_remove_whitespace, v_1)
117 lastMod <- arrIO (\ x -> getFileStatus x
119 return . posixSecondsToUTCTime . fromRational . toRational . modificationTime)
121 page <- parseXmlizedPage -< (name, tree)
123 if isEntity page then
126 , entityLastMod = lastMod
131 , redirLastMod = lastMod