module Rakka.Storage.DefaultPage
    ( findAllDefaultPages
    , 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
doesLocalDirExist = doesDirectoryExist "defaultPages"


findAllDefaultPages :: IO (Set PageName)
findAllDefaultPages
    -- ./defaultPages が存在するなら、その中を探す。無ければ Cabal で
    -- defaultPages を探す。
    = do localDirExists <- doesLocalDirExist
         if localDirExists then
             findAllIn "defaultPages"
           else
             -- FIXME: この getDataFileName の使ひ方は undocumented
             findAllIn =<< getDataFileName "defaultPages"
    where
      findAllIn :: FilePath -> IO (Set PageName)
      findAllIn dirPath
          = find always (fileType ==? RegularFile) dirPath
            >>=
            return . S.fromList . map (decodePageName . makeRelative dirPath . dropExtension)


loadDefaultPage :: PageName -> IO (Maybe Page)
loadDefaultPage name
    -- ./defaultPages が存在するなら、./defaultPages/Foo.xml を探す。無
    -- ければ Cabal で defaultPages/Foo.xml を探す。
    = do let pagePath = "defaultPages" </> encodePageName name <.> "xml"

         localDirExists <- doesLocalDirExist
         if localDirExists then
             tryLoad pagePath
           else
             tryLoad =<< getDataFileName pagePath
    where
      tryLoad :: FilePath -> IO (Maybe Page)
      tryLoad fpath
          = do exists <- doesFileExist fpath
               if exists then
                   return . Just =<< loadPageFile name fpath
                 else
                   return Nothing


loadPageFile :: PageName -> FilePath -> IO Page
loadPageFile name path
    = do [page] <- runX ( setErrorMsgHandler False fail
                          >>>
                          constA (name, path)
                          >>>
                          loadPageFileA
                        )
         return 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)

         case page of
           Redirection _ _ _ _ _
               -> returnA -< page {
                     redirRevision = 0
                   , redirLastMod  = lastMod
                   }

           Entity _ _ _ _ _ _ _ _ _ _ _ _ _ _ _
               -> returnA -< page {
                     entityRevision = 0
                   , entityLastMod  = lastMod
                   }