+{-# LANGUAGE
+ Arrows
+ , DoAndIfThenElse
+ , UnicodeSyntax
+ #-}
module Rakka.Storage.DefaultPage
( findAllDefaultPages
, getDefaultDirContents
, loadDefaultPage
)
where
-
-import Control.Arrow
-import Control.Arrow.ArrowIO
-import Control.Arrow.ArrowList
-import Data.Set (Set)
-import qualified Data.Set as S
-import Data.Time.Clock.POSIX
-import Paths_Rakka -- Cabal が用意する。
-import Rakka.Page
-import System.Directory
-import System.FilePath
-import System.FilePath.Find hiding (fileName, modificationTime)
-import System.Posix.Files
-import Text.XML.HXT.Arrow.ReadDocument
-import Text.XML.HXT.Arrow.XmlIOStateArrow
-import Text.XML.HXT.DOM.XmlKeywords
-
-
-doesLocalDirExist :: IO Bool
+import Control.Applicative
+import Control.Arrow
+import Control.Arrow.ArrowIO
+import Control.Arrow.ArrowList
+import Control.Monad.Unicode
+import Data.Set (Set)
+import qualified Data.Set as S
+import qualified Data.Text as T
+import Data.Time.Clock.POSIX
+import Paths_Rakka
+import Prelude.Unicode
+import Rakka.Page
+import System.Directory
+import System.FilePath
+import System.FilePath.Find hiding (fileName, modificationTime)
+import System.Posix.Files
+import Text.XML.HXT.Arrow.ReadDocument
+import Text.XML.HXT.Arrow.XmlState
+
+doesLocalDirExist ∷ IO Bool
doesLocalDirExist = doesDirectoryExist "defaultPages"
-
-findAllDefaultPages :: IO (Set PageName)
+findAllDefaultPages ∷ IO (Set PageName)
findAllDefaultPages
- -- ./defaultPages が存在するなら、その中を探す。無ければ Cabal で
- -- defaultPages を探す。
- = do localDirExists <- doesLocalDirExist
+ -- If ./defaultPages exists, find pages in it. Otherwise find
+ -- defaultPages using Cabal's Paths_Rakka.
+ = do localDirExists ← doesLocalDirExist
if localDirExists then
findAllIn "defaultPages"
- else
- -- FIXME: この getDataFileName の使ひ方は undocumented
- findAllIn =<< getDataFileName "defaultPages"
+ else
+ -- FIXME: This usage of getDataFileName is undocumented.
+ findAllIn =≪ getDataFileName "defaultPages"
where
- findAllIn :: FilePath -> IO (Set PageName)
+ findAllIn ∷ FilePath → IO (Set PageName)
findAllIn dirPath
- = find always (fileType ==? RegularFile) dirPath
- >>=
- return . S.fromList . map (decodePageName . makeRelative dirPath . dropExtension)
-
+ = (S.fromList ∘ (decodePageName ∘ makeRelative dirPath ∘ dropExtension <$>))
+ <$>
+ find always (fileType ==? RegularFile) dirPath
getDefaultDirContents :: PageName -> IO (Set PageName)
getDefaultDirContents dir
else
return S.empty
- m :: FilePath -> FilePath -> PageName
- m basePath = (dir </>) . decodePageName . makeRelative basePath . dropExtension
+ m ∷ FilePath → FilePath → PageName
+ m basePath = T.pack ∘ (T.unpack dir </>) ∘ T.unpack ∘ decodePageName ∘ makeRelative basePath ∘ dropExtension
f :: FilePath -> Bool
f "." = False
)
return page
-
-loadPageFileA :: IOStateArrow s (PageName, FilePath) Page
+loadPageFileA ∷ IOStateArrow s (PageName, FilePath) Page
loadPageFileA
- = proc (name, fpath) ->
- do tree <- readFromDocument [ (a_validate , v_0)
- , (a_check_namespaces , v_1)
- , (a_remove_whitespace, v_1)
- ] -< fpath
- lastMod <- arrIO (\ x -> getFileStatus x
- >>=
- return . posixSecondsToUTCTime . fromRational . toRational . modificationTime)
- -< fpath
- page <- parseXmlizedPage -< (name, tree)
-
+ = proc (name, fpath) →
+ do tree ← readFromDocument [ withValidate no
+ , withCheckNamespaces yes
+ , withRemoveWS yes
+ ] ⤙ fpath
+ lastMod ← arrIO ( \x → getFileStatus x
+ ≫=
+ pure ∘ posixSecondsToUTCTime ∘ fromRational ∘ toRational ∘ modificationTime
+ ) ⤙ fpath
+ page ← parseXmlizedPage ⤙ (name, tree)
if isEntity page then
- returnA -< page {
- entityRevision = 0
- , entityLastMod = lastMod
- }
+ returnA ⤙ page {
+ entityRevision = 0
+ , entityLastMod = lastMod
+ }
else
- returnA -< page {
- redirRevision = 0
- , redirLastMod = lastMod
- }
+ returnA ⤙ page {
+ redirRevision = 0
+ , redirLastMod = lastMod
+ }