module Rakka.Storage
    ( Storage

    , mkStorage -- private

    , getPage
    , putPage
    , deletePage

    , getPageA
    , putPageA
    , deletePageA

    , searchPages

    , rebuildIndex
    )
    where

import           Control.Arrow.ArrowIO
import           Control.Concurrent.STM
import           Control.Monad
import           Control.Monad.Trans
import           Data.Maybe
import           Network.HTTP.Lucu
import           Rakka.Page
import           Rakka.Storage.Impl
import           Rakka.Storage.Types
import           Subversion.Types
import           System.IO
import           Subversion.Repository
import           Text.HyperEstraier hiding (WriteLock)


mkStorage :: FilePath -> Repository -> (Page -> IO Document) -> IO Storage
mkStorage lsdir repos mkDraft
    = do chan <- startIndexManager lsdir repos mkDraft
         let sto = Storage {
                     stoRepository = repos
                   , stoIndexChan  = chan
                   }
         syncIndex sto
         return sto


getPage :: MonadIO m => Storage -> PageName -> Maybe RevNum -> m (Maybe Page)
getPage = ((liftIO .) .) . getPage' . stoRepository


putPage :: MonadIO m => Storage -> Page -> m StatusCode
putPage sto page
    = liftIO $ do st <- putPage' (stoRepository sto) page
                  syncIndex sto
                  return st


deletePage :: MonadIO m => Storage -> PageName -> m StatusCode
deletePage sto name
    = liftIO $ do st <- deletePage' (stoRepository sto) name
                  syncIndex sto
                  return st


getPageA :: ArrowIO a => Storage -> a (PageName, Maybe RevNum) (Maybe Page)
getPageA = arrIO2 . getPage 


putPageA :: ArrowIO a => Storage -> a Page StatusCode
putPageA = arrIO . putPage


deletePageA :: ArrowIO a => Storage -> a PageName StatusCode
deletePageA = arrIO . deletePage


searchPages :: MonadIO m => Storage -> Condition -> m [(PageName, RevNum)]
searchPages sto cond
    = liftIO $
      do var <- newEmptyTMVarIO
         atomically $ writeTChan (stoIndexChan sto) (SearchIndex cond var)
         atomically $ takeTMVar var


rebuildIndex :: MonadIO m => Storage -> m ()
rebuildIndex sto
    = liftIO $ atomically $ writeTChan (stoIndexChan sto) RebuildIndex


syncIndex :: Storage -> IO ()
syncIndex sto
    = atomically $ writeTChan (stoIndexChan sto) SyncIndex