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 = getDirectoryContents (dirPath </> encodePageName dir)
62 return . S.fromList . map (m dirPath) . filter f
64 m :: FilePath -> FilePath -> PageName
65 m dirPath = (dir </>) . decodePageName . makeRelative dirPath . dropExtension
73 loadDefaultPage :: PageName -> IO (Maybe Page)
75 -- ./defaultPages が存在するなら、./defaultPages/Foo.xml を探す。無
76 -- ければ Cabal で defaultPages/Foo.xml を探す。
77 = do let pagePath = "defaultPages" </> encodePageName name <.> "xml"
79 localDirExists <- doesLocalDirExist
80 if localDirExists then
83 tryLoad =<< getDataFileName pagePath
85 tryLoad :: FilePath -> IO (Maybe Page)
87 = do exists <- doesFileExist fpath
89 return . Just =<< loadPageFile name fpath
94 loadPageFile :: PageName -> FilePath -> IO Page
95 loadPageFile name path
96 = do [page] <- runX ( setErrorMsgHandler False fail
105 loadPageFileA :: IOStateArrow s (PageName, FilePath) Page
107 = proc (name, fpath) ->
108 do tree <- readFromDocument [ (a_validate , v_0)
109 , (a_check_namespaces , v_1)
110 , (a_remove_whitespace, v_1)
112 lastMod <- arrIO (\ x -> getFileStatus x
114 return . posixSecondsToUTCTime . fromRational . toRational . modificationTime)
116 page <- parseXmlizedPage -< (name, tree)
118 if isEntity page then
121 , entityLastMod = lastMod
126 , redirLastMod = lastMod