module Dixi.Database
( Database , emptyDB
, DixiError (..)
, Amend (..)
, GetDiff (..)
, GetHistory (..)
, GetLatest (..)
, GetVersion (..)
, Revert (..)
) where
import Control.Lens
import Control.Monad.Trans.Except
import Control.Monad
import Data.Acid
import Data.Compositions.Snoc (Compositions)
import Data.Foldable
import Data.Map (Map)
import Data.Monoid
import Data.Patch (Patch)
import Data.SafeCopy hiding (Version)
import Data.Text (Text)
import Data.Time
import Data.Typeable
#ifdef OLDBASE
import Control.Applicative
#endif
import qualified Data.Compositions.Snoc as C
import qualified Data.Patch as P
import qualified Data.Text as T
import qualified Data.Vector as V
import Dixi.Common
import Dixi.Database.Orphans ()
import Dixi.Page
import Dixi.PatchUtils
data Database = DB { _db :: Map Key (Compositions (Page (Patch Char)))}
deriving (Typeable)
emptyDB :: Database
emptyDB = DB mempty
deriveSafeCopy 0 'base ''Database
deriveSafeCopy 0 'base ''DixiError
makeLenses ''Database
getLatest :: Key -> Query Database (Version, Page Text)
getLatest k = do
b <- view (db . ix k)
return (C.length b, patchToText <$> C.composed b)
getVersion :: Key -> Version -> Query Database (Either DixiError (Page Text))
getVersion k v = runExceptT $ do
b <- view (db . ix k)
when (C.length b < v) $ throwE $ VersionNotFound k v
return $ patchToText <$> C.composed (C.take v b)
getHistory :: Key -> Query Database [Page PatchSummary]
getHistory k = view (db . ix k . to (fmap (fmap patchSummary) . toList))
getDiff :: Key -> (Version, Version) -> Query Database (Either DixiError (Page (P.Hunks Char)))
getDiff k (v1 , v2) | v1 > v2 = getDiff k (v2, v1)
| otherwise = runExceptT $ do
b <- view (db . ix k)
let latest = C.length b
when (latest < v1) $ throwE $ VersionNotFound k v1
when (latest < v2) $ throwE $ VersionNotFound k v2
let y = patchToVector (C.composed (C.take v1 b) ^. body)
return $ fmap (`P.hunks` y) (C.dropComposed v1 (C.take v2 b))
amendPatch :: Key -> Version -> Patch Char -> Maybe Text -> UTCTime -> Update Database (Either DixiError Version)
amendPatch k v q com tim = runExceptT $ do
b <- use (db . ix k)
let latest = C.length b
when (latest < v) $ throwE $ VersionNotFound k v
let p = C.dropComposed v b ^. body
r = snd $ P.transformWith P.theirs p q
(db . at k) .= Just (C.snoc b (Page r (Last com) (Last $ Just tim)))
return (latest + 1)
amend :: Key -> Version -> Text -> Maybe Text -> UTCTime -> Update Database (Either DixiError Version)
amend k v new com tim = runExceptT $ do
b <- use (db . ix k)
when (C.length b < v) $ throwE $ VersionNotFound k v
let n = V.fromList (T.unpack new)
o = C.composed (C.take v b) ^. body . to patchToVector
q = P.diff o n
ExceptT $ amendPatch k v q com tim
revert :: Key -> (Version, Version) -> Maybe Text -> UTCTime -> Update Database (Either DixiError Version)
revert k (v1,v2) com tim | v2 < v1 = revert k (v2, v1) com tim
revert k (v1,v2) com tim = runExceptT $ do
b <- use (db . ix k)
let latest = C.length b
when (latest < v1) $ throwE $ VersionNotFound k v1
when (latest < v2) $ throwE $ VersionNotFound k v2
let p = C.dropComposed v1 (C.take v2 b) ^. body
ExceptT $ amendPatch k (max v1 v2) (P.inverse p) com tim
makeAcidic ''Database ['getLatest, 'getVersion, 'getHistory, 'getDiff, 'amend, 'revert]