1 module Rakka.Storage.DefaultPage
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.Arrow.XmlIOStateArrow
21 import Text.XML.HXT.DOM.XmlKeywords
24 doesLocalDirExist :: IO Bool
25 doesLocalDirExist = doesDirectoryExist "defaultPages"
28 findAllDefaultPages :: IO (Set PageName)
30 -- ./defaultPages が存在するなら、その中を探す。無ければ Cabal で
32 = do localDirExists <- doesLocalDirExist
33 if localDirExists then
34 findAllIn "defaultPages"
36 -- FIXME: この getDataFileName の使ひ方は undocumented
37 findAllIn =<< getDataFileName "defaultPages"
39 findAllIn :: FilePath -> IO (Set PageName)
41 = find always (fileType ==? RegularFile) dirPath
43 return . S.fromList . map (decodePageName . makeRelative dirPath . dropExtension)
46 loadDefaultPage :: PageName -> IO (Maybe Page)
48 -- ./defaultPages が存在するなら、./defaultPages/Foo.xml を探す。無
49 -- ければ Cabal で defaultPages/Foo.xml を探す。
50 = do let pagePath = "defaultPages" </> encodePageName name <.> "xml"
52 localDirExists <- doesLocalDirExist
53 if localDirExists then
56 tryLoad =<< getDataFileName pagePath
58 tryLoad :: FilePath -> IO (Maybe Page)
60 = do exists <- doesFileExist fpath
62 return . Just =<< loadPageFile name fpath
67 loadPageFile :: PageName -> FilePath -> IO Page
68 loadPageFile name path
69 = do [page] <- runX ( setErrorMsgHandler False fail
78 loadPageFileA :: IOStateArrow s (PageName, FilePath) Page
80 = proc (name, fpath) ->
81 do tree <- readFromDocument [ (a_validate , v_0)
82 , (a_check_namespaces , v_1)
83 , (a_remove_whitespace, v_1)
85 lastMod <- arrIO (\ x -> getFileStatus x
87 return . posixSecondsToUTCTime . fromRational . toRational . modificationTime)
89 page <- parseXmlizedPage -< (name, tree)
94 , entityLastMod = lastMod
99 , redirLastMod = lastMod