{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE TypeFamilies       #-}
{-# LANGUAGE TemplateHaskell    #-}
{-# LANGUAGE RankNTypes         #-}
{-# LANGUAGE CPP                #-}
{-# OPTIONS -fno-warn-orphans   #-}
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))

{-# ANN module "HLint: ignore Reduce duplication" #-}
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]