{-# LANGUAGE
    UnicodeSyntax
  #-}
module Rakka.Environment
    ( Environment(..)
    , InterpTable
    , setupEnv
    )
    where
import Control.Arrow.ArrowList
import Control.Arrow.Unicode
import qualified Data.Map as M
import Network.Socket
import qualified Network.HTTP.Lucu.Config as LC
import           Rakka.Authorization
import           Rakka.Page
import           Rakka.Storage
import           Rakka.SystemConfig
import           Rakka.Wiki.Engine
import           Rakka.Wiki.Interpreter
import qualified Rakka.Wiki.Interpreter.Base      as Base
import qualified Rakka.Wiki.Interpreter.Image     as Image
import qualified Rakka.Wiki.Interpreter.PageList  as PageList
import qualified Rakka.Wiki.Interpreter.Outline   as Outline
import           Subversion.Repository
import           System.Directory
import           System.FilePath
import           System.Log.Logger
import           Text.HyperEstraier
import Text.XML.HXT.Arrow.XmlState

logger :: String
logger = "Rakka.Environment"


data Environment = Environment {
      envLocalStateDir :: !FilePath
    , envLucuConf      :: !LC.Config
    , envRepository    :: !Repository
    , envSysConf       :: !SystemConfig
    , envStorage       :: !Storage
    , envInterpTable   :: !InterpTable
    , envAuthDB        :: !AuthDB
    }

setupEnv ∷ FilePath → ServiceName → IO Environment
setupEnv lsdir port
    = do let lucuConf    = LC.defaultConfig {
                             LC.cnfServerPort = port
                           }
             reposPath   = lsdir </> "repos"
             interpTable = mkInterpTable
         reposExist  <- doesDirectoryExist reposPath
         repos       <- if reposExist then
                            do debugM logger ("Found a subversion repository on " ++ reposPath)
                               openRepository reposPath
                        else
                            do noticeM logger ("Creating a subversion repository on " ++ reposPath)
                               createRepository reposPath [] []
         sysConf     <- mkSystemConfig lucuConf repos
         storage     <- mkStorage lsdir repos (makeDraft' interpTable)
         authDB      <- mkAuthDB lsdir
         return Environment {
                      envLocalStateDir = lsdir
                    , envLucuConf      = lucuConf
                    , envRepository    = repos
                    , envSysConf       = sysConf
                    , envStorage       = storage
                    , envInterpTable   = interpTable
                    , envAuthDB        = authDB
                    }
    where
      makeDraft' ∷ InterpTable → Page → IO Document
      makeDraft' interpTable page
          = do [doc] ← runX ( setErrorMsgHandler False fail
                              ⋙
                              constA page
                              ⋙
                              xmlizePage
                              ⋙
                              makeDraft interpTable
                            )
               return doc

mkInterpTable ∷ InterpTable
mkInterpTable = listToTable $
                concat [ Base.interpreters
                       , Image.interpreters
                       , PageList.interpreters
                       , Outline.interpreters
                       ]
    where
      listToTable ∷ [Interpreter] → InterpTable
      listToTable xs
          = M.fromList [ (commandName x, x) | x ← xs ]