{-# LANGUAGE GeneralizedNewtypeDeriving, StandaloneDeriving, FlexibleInstances,
             FlexibleContexts, UndecidableInstances, MultiParamTypeClasses,
             TypeFamilies #-}
module Types ( GorsvetState(..), Repository(..)
             , GorsvetT(..), Gorsvet, IO', UUID(..), ObjectMap(..), FixedSize(..)
             , repo, pristine, shadow, inventory, order, editRepository, editRepositoryM
             , editInventory, editOrder, editShadow ) where

import Prelude hiding ( readFile, writeFile )
import Control.Applicative( (<$>) )
import Control.Monad.State ( gets, modify )
import Control.Monad.IO.Class( MonadIO(..) )
import Control.Monad.CatchIO ( MonadCatchIO(..) )
import Control.Monad.Trans ( MonadTrans(..) )
import System.FSLib.IO ( IO', FsRO(..), FsRW(..) )
import System.FSLib.Hash ( Hash )
import System.FSLib.StoreMonad ( LoadMonad )
import Data.Patch.ObjectMap ( ObjectMap(..), UUID )
import Data.Patch.ApplyMonad ( ApplyMonad(..), ApplyState, OmSemantics, ApplyDictionary )
import Data.ByteString ( ByteString )
import Data.Map ( Map )
import Data.Path ( Absolute )
import Control.Monad.State( StateT(..), MonadState )

data GorsvetState = GorsvetState { gsRepository :: Repository Gorsvet
                                 , gsRemotes :: [Absolute]
                                 }

data Repository m = Repository { rPristine :: ObjectMap m
                               , rShadow :: ObjectMap m
                               , rInventory :: Map Hash Hash -- from hashPI to patch
                               , rOrder :: [Hash] -- of hashPI
                               }

instance (MonadTrans t, Functor (t m), MonadCatchIO (t m), FsRO m) => FsRO (t m) where
  getCurrentDirectory = lift getCurrentDirectory
  setCurrentDirectory = lift . setCurrentDirectory
  doesDirectoryExist = lift . doesDirectoryExist
  doesFileExist = lift . doesFileExist
  doesExist = lift . doesExist
  readFile = lift . readFile
  readFileBL = lift . readFileBL
  readFileBS = lift . readFileBS
  readFileLazily = lift . readFileLazily
  readDirectory = lift . readDirectory
  getFileStatus = lift . getFileStatus

instance (MonadTrans t,  Functor (t m),MonadCatchIO (t m), FsRW m) => FsRW (t m) where
  createDirectory = lift . createDirectory
  removeRecursively = lift . removeRecursively
  writeFile x y = lift $ writeFile x y
  writeFileBL x y = lift $ writeFileBL x y
  writeFileBS x y = lift $ writeFileBS x y

  rename x y = lift $ rename x y
  renameFile x y = lift $ renameFile x y
  renameDirectory x y = lift $ renameDirectory x y

type instance ApplyState IO' OmSemantics = ObjectMap IO'
type instance ApplyState Gorsvet OmSemantics = ObjectMap Gorsvet

newtype GorsvetT m a = GorsvetT {
  runGorsvetT :: StateT GorsvetState m a
} deriving (Functor, Monad, MonadIO, MonadCatchIO, MonadState GorsvetState, MonadTrans)

type Gorsvet = GorsvetT IO'

repo :: Gorsvet (Repository Gorsvet)
repo = gets gsRepository

pristine :: Gorsvet (ObjectMap Gorsvet)
pristine = rPristine <$> repo

shadow :: Gorsvet (ObjectMap Gorsvet)
shadow = rShadow <$> repo

inventory :: Gorsvet (Map Hash Hash)
inventory = rInventory <$> repo

order :: Gorsvet [Hash]
order = rOrder <$> repo

class FixedSize v where
  fixedSize :: v -> Int
  toBS :: v -> ByteString
  fromBS :: ByteString -> v

editShadow id obj = do put <- omPut <$> shadow
                       shadow' <- put id obj
                       editRepository $ \x -> x { rShadow = shadow' }

editRepository :: (Repository Gorsvet -> Repository Gorsvet) -> Gorsvet ()
editRepository f = modify $ \gs -> gs { gsRepository = f $ gsRepository gs }

editRepositoryM :: (Repository Gorsvet -> Gorsvet (Repository Gorsvet)) -> Gorsvet ()
editRepositoryM f = do repo' <- f =<< repo
                       modify $ \gs -> gs { gsRepository = repo' }

editInventory :: (Map Hash Hash -> Map Hash Hash) -> Gorsvet ()
editInventory f =
  do inv' <- f <$> rInventory <$> repo
     editRepository $ \r -> r { rInventory = inv' }

editOrder :: ([Hash] -> [Hash]) -> Gorsvet ()
editOrder f =
  do ord' <- f <$> rOrder <$> repo
     editRepository $ \r -> r { rOrder = ord' }