module Rakka.SystemConfig
    ( SystemConfig
    , SysConfValue(..)

    , mkSystemConfig -- private

    , getSysConf
    , getSysConfA
    )
    where

import           Control.Arrow.ArrowIO
import           Control.Concurrent.STM
import           Control.Monad.Trans
import qualified Data.ByteString.Char8 as C8
import           Data.Encoding
import           Data.Encoding.UTF8
import           Data.Map (Map)
import qualified Data.Map as M
import           Data.Maybe
import           GHC.Conc (unsafeIOToSTM)
import           Network
import qualified Network.HTTP.Lucu.Config as LC
import           Network.URI
import           Rakka.Utils
import           Subversion.FileSystem
import           Subversion.FileSystem.Revision
import           Subversion.FileSystem.Root
import           Subversion.Repository
import           System.FilePath.Posix


data SystemConfig = SystemConfig {
      scLucuConf   :: !LC.Config
    , scRepository :: !Repository
    , scCache      :: !(TVar (Map FilePath SysConfValue))
    }


data SysConfValue
    = SiteName String
    | BaseURI URI
    | DefaultPage String
    | StyleSheet String
    deriving (Eq, Show)


mkSystemConfig :: LC.Config -> Repository -> IO SystemConfig
mkSystemConfig lc repos
    = do cache <- newTVarIO M.empty
         return $ SystemConfig {
                      scLucuConf   = lc
                    , scRepository = repos
                    , scCache      = cache
                    }


getSysConf :: MonadIO m => SystemConfig -> SysConfValue -> m SysConfValue
getSysConf sc key
    = liftIO $
      atomically $
      do let path = sysConfPath key

         cache <- readTVar (scCache sc)

         case M.lookup path cache of
           Just val -> return val
           Nothing  -> do val <- unsafeIOToSTM (getSysConf' sc key)
                          writeTVar (scCache sc) (M.insert path val cache)
                          return val


getSysConf' :: SystemConfig -> SysConfValue -> IO SysConfValue
getSysConf' sc key
    = do fs    <- getRepositoryFS (scRepository sc)
         rev   <- getYoungestRev fs
         value <- withRevision fs rev
                  $ do let path = fromConfPath (sysConfPath key)
                       exists <- isFile path
                       case exists of
                         True
                             -> do str <- getFileContentsLBS path
                                   return $ Just $ chomp $ decodeLazy UTF8 str
                         False
                             -> return Nothing
         case value of
           Just str -> return $ unmarshalSysConf key str
           Nothing  -> sysConfDefault sc key


getSysConfA :: ArrowIO a => SystemConfig -> SysConfValue -> a b SysConfValue
getSysConfA = (arrIO0 .) . getSysConf


fromConfPath :: FilePath -> FilePath
fromConfPath = combine "/config"


{- paths -}
sysConfPath :: SysConfValue -> FilePath
sysConfPath (SiteName    _) = "siteName"
sysConfPath (BaseURI     _) = "baseURI"
sysConfPath (DefaultPage _) = "defaultPage"
sysConfPath (StyleSheet  _) = "styleSheet"


{- marshalling -}
marshalSysConf :: SysConfValue -> String
marshalSysConf (SiteName    name) = name
marshalSysConf (BaseURI     uri ) = uriToString id uri ""
marshalSysConf (DefaultPage name) = name
marshalSysConf (StyleSheet  name) = name


{- unmarshalling -}
unmarshalSysConf :: SysConfValue -> String -> SysConfValue
unmarshalSysConf (SiteName    _) name = SiteName name
unmarshalSysConf (BaseURI     _) uri  = BaseURI $ fromJust $ parseURI uri
unmarshalSysConf (DefaultPage _) name = DefaultPage name
unmarshalSysConf (StyleSheet  _) name = StyleSheet name


{- getting default value -}
sysConfDefault :: SystemConfig -> SysConfValue -> IO SysConfValue

sysConfDefault _ (SiteName _)
    = return $ SiteName "Rakka"

sysConfDefault sc (BaseURI _)
    = do let conf = scLucuConf sc
             host = C8.unpack $ LC.cnfServerHost conf
             port = case LC.cnfServerPort conf of
                      PortNumber num -> fromIntegral num
             
             defaultURI
                  = "http://" ++ host ++
                    (if port == 80
                     then ""
                     else ':' : show port) ++ "/"

         return $ BaseURI $ fromJust $ parseURI defaultURI

sysConfDefault _ (DefaultPage _)
    = return $ DefaultPage "MainPage"

sysConfDefault _ (StyleSheet _)
    = return $ StyleSheet "StyleSheet/Default"