module Rakka.Storage
    ( Storage

    -- re-export from Rakka.Storage.Types
    , SearchResult(..) 
    , SnippetFragment(..)

    , mkStorage -- private

    , getPage
    , putPage
    , deletePage

    , getPageA
    , putPageA
    , deletePageA

    , getAttachment
    , putAttachment

    , getDirContents
    , getDirContentsA

    , 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.Attachment
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 -> Maybe String -> Page -> m StatusCode
putPage sto userID page
    = liftIO $ do st <- putPage' (stoRepository sto) userID page
                  syncIndex sto
                  return st


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


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


putPageA :: ArrowIO a => Storage -> a (Maybe String, Page) StatusCode
putPageA = arrIO2 . putPage


deletePageA :: ArrowIO a => Storage -> a (Maybe String, PageName) StatusCode
deletePageA = arrIO2 . deletePage


getDirContents :: MonadIO m => Storage -> PageName -> Maybe RevNum -> m [PageName]
getDirContents = ((liftIO .) .) . getDirContents' . stoRepository


getDirContentsA :: ArrowIO a => Storage -> a (PageName, Maybe RevNum) [PageName]
getDirContentsA = arrIO2 . getDirContents


searchPages :: MonadIO m => Storage -> Condition -> m [SearchResult]
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


getAttachment :: (Attachment a, MonadIO m) =>
                 Storage
              -> PageName
              -> String
              -> Maybe RevNum
              -> m (Maybe a)
getAttachment = (((liftIO .) .) .) . getAttachment' . stoRepository


putAttachment :: (Attachment a, MonadIO m) =>
                 Storage
              -> Maybe String
              -> Maybe RevNum
              -> PageName
              -> String
              -> a
              -> m StatusCode
putAttachment = (((((liftIO .) .) .) .) .) . putAttachment' . stoRepository