{-# LANGUAGE GADTs, TypeSynonymInstances, FlexibleInstances, ScopedTypeVariables #-}
module Shuffle where

import Control.Monad.State ( gets, modify )
import qualified Data.Map as M
import qualified Data.Set as S

import System.FSLib.Hash ( Hash(..) )
import System.FSLib.StoreMonad ( LoadMonad(..), StoreMonad(..), Load(..), Store(..) )

import Data.Patch.Commute ( commute, CommuteMonad(..), commuteFL )
import Data.Patch.Named ( infopatch, patchcontents, Named )
import Data.Patch.Info ( hashPI, info )
import Data.Patch.Prim.V3.Core ( Prim )
import Data.Patch.Prim.V3 ()
import Witnesses.Ordered ( (:>)(..), FL(..) )
import Witnesses.Unsafe ( unsafeCoerceP )
import Debug.Trace

import Types
import Repository

instance CommuteMonad Gorsvet where
  commuteFail = fail "Error commuting patches."

loadPatch :: (LoadMonad m) => Repository m -> Hash -> m (Named Prim x y)
loadPatch r ih =
  do inf <- load ih
     patch <- load $ case M.lookup ih $ rInventory r of
       Nothing -> error $ "loadPatch " ++ show ih
       Just x -> x
     return $ infopatch inf patch

loadFL :: (LoadMonad m) => Repository m -> [Hash] -> m (FL (Named Prim) x y)
loadFL r [] = return $ unsafeCoerceP NilFL
loadFL r (x:xs) =
  do x' <- loadPatch r x
     xs' <- loadFL r xs
     return $ x' :>: xs'

storePatch :: (StoreMonad m) => Repository m -> Named Prim x y -> m (Repository m)
storePatch r p =
  do phash <- store (patchcontents p)
     return $ r { rInventory = M.insert (hashPI $ info p) phash $ rInventory r }

storeFL :: (StoreMonad m) => Repository m -> (FL (Named Prim) x y) -> m (Repository m)
storeFL r NilFL = return r
storeFL r (p:>:ps) = do r' <- storePatch r p
                        storeFL r' ps

shuffleRepo :: forall m. (CommuteMonad m, StoreMonad m)
            => Repository m -> S.Set Hash -> m (Repository m)
shuffleRepo orig alltodo = shuffle' orig alltodo S.empty
  where shuffle' :: Repository m -> S.Set Hash -> S.Set Hash -> m (Repository m)
        shuffle' repo todoset _ | S.null todoset = return repo
        shuffle' repo todoset doneset = do
          let (done, todo) = span (`S.member` doneset) $ rOrder repo
              (topush, topull:rest) = span (`S.notMember` todoset) $ trace (show todo) todo
          topushFL <- loadFL repo $ reverse topush
          topullP <- loadPatch repo topull
          (pushed :> pulled) <- commuteFL (topullP :> topushFL)
          repo' <- (\r -> storeFL r pushed) =<< storePatch repo pulled
          let repo'' = repo' { rOrder = done ++ (topull:topush) ++ rest }
          shuffle' repo'' (S.delete topull todoset) (S.insert topull doneset)

shuffle :: S.Set Hash -> Gorsvet ()
shuffle phashes = do
  repo <- gets gsRepository
  repo' <- shuffleRepo repo phashes
  modify $ \x -> x { gsRepository = repo' }
  return ()

-- | Take two repositories and shuffle them so that all common patches are
-- moved to a common prefix. The local repository is shuffled in place, while
-- the shuffled remote repository is returned.
coShuffle :: Repository Gorsvet -> Gorsvet (Repository Gorsvet)
coShuffle remote =
 do ours <- inventory
    let theirs = rInventory remote
        extra = M.difference ours theirs -- stuff we have extra
        missing = M.difference theirs ours -- stuff we don't have

    shuffle $ M.keysSet extra -- move extras to top
    remote' <- shuffleRepo remote $ M.keysSet missing
    return remote'