module Darcs.Repository.Create
    ( createRepository
    , createRepositoryV1
    , createRepositoryV2
    , EmptyRepository(..)
    ) where

import Darcs.Prelude

import Control.Monad ( when )
import qualified Data.ByteString as B
import Data.Maybe( isJust )
import System.Directory
    ( createDirectory
    , getCurrentDirectory
    , setCurrentDirectory
    )
import System.IO.Error
    ( catchIOError
    , isAlreadyExistsError
    )

import Darcs.Patch ( RepoPatch )
import Darcs.Patch.Apply( ApplyState )
import Darcs.Patch.Set ( Origin, emptyPatchSet )
import Darcs.Patch.V1 ( RepoPatchV1 )
import Darcs.Patch.V2 ( RepoPatchV2 )
import Darcs.Patch.V3 ( RepoPatchV3 )
import qualified Darcs.Patch.V1.Prim as V1 ( Prim(..) )
import qualified Darcs.Patch.V2.Prim as V2 ( Prim(..) )

import Darcs.Util.Cache ( Cache )
import Darcs.Repository.Format
    ( RepoFormat
    , createRepoFormat
    , unsafeWriteRepoFormat
    )
import Darcs.Repository.Flags
    ( PatchFormat(..)
    , UseCache(..)
    , WithPatchIndex(..)
    , WithPrefsTemplates(..)
    , WithWorkingDir(..)
    )
import Darcs.Repository.Paths
    ( pristineDirPath
    , patchesDirPath
    , inventoriesDirPath
    , hashedInventoryPath
    , formatPath
    )
import Darcs.Repository.Identify ( seekRepo )
import Darcs.Repository.InternalTypes
    ( AccessType(..)
    , PristineType(..)
    , Repository
    , mkRepo
    )
import Darcs.Repository.PatchIndex ( createOrUpdatePatchIndexDisk )
import Darcs.Repository.Prefs
    ( writeDefaultPrefs
    , getCaches
    , prefsDirPath
    )
import Darcs.Repository.Pristine ( writePristine )

import Darcs.Util.Global ( darcsdir )
import Darcs.Util.Lock ( writeBinFile )
import Darcs.Util.Path ( AbsoluteOrRemotePath, ioAbsoluteOrRemote )
import Darcs.Util.Tree( Tree, emptyTree )

createRepositoryFiles :: PatchFormat -> WithWorkingDir -> WithPrefsTemplates -> IO RepoFormat
createRepositoryFiles :: PatchFormat
-> WithWorkingDir -> WithPrefsTemplates -> IO RepoFormat
createRepositoryFiles PatchFormat
patchfmt WithWorkingDir
withWorkingDir WithPrefsTemplates
withPrefsTemplates = do
  cwd <- IO String
getCurrentDirectory
  x <- seekRepo
  when (isJust x) $ do
      setCurrentDirectory cwd
      putStrLn "WARNING: creating a nested repository."
  createDirectory darcsdir `catchIOError`
      (\IOError
e-> if IOError -> Bool
isAlreadyExistsError IOError
e
            then String -> IO ()
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Tree has already been initialized!"
            else String -> IO ()
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Error creating directory `"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
darcsdirString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"'.")
  createDirectory pristineDirPath
  createDirectory patchesDirPath
  createDirectory inventoriesDirPath
  createDirectory prefsDirPath
  writeDefaultPrefs withPrefsTemplates
  let repo_format = PatchFormat -> WithWorkingDir -> RepoFormat
createRepoFormat PatchFormat
patchfmt WithWorkingDir
withWorkingDir
  unsafeWriteRepoFormat repo_format formatPath
  -- note: all repos we create nowadays are hashed
  writeBinFile hashedInventoryPath B.empty
  return repo_format

data EmptyRepository where
  EmptyRepository :: (RepoPatch p, ApplyState p ~ Tree)
                  => Repository 'RO p Origin Origin
                  -> EmptyRepository

createRepository :: PatchFormat -> WithWorkingDir -> WithPatchIndex -> UseCache -> WithPrefsTemplates
                 -> IO EmptyRepository
createRepository :: PatchFormat
-> WithWorkingDir
-> WithPatchIndex
-> UseCache
-> WithPrefsTemplates
-> IO EmptyRepository
createRepository PatchFormat
patchfmt WithWorkingDir
withWorkingDir WithPatchIndex
withPatchIndex UseCache
useCache WithPrefsTemplates
withPrefsTemplates = do
  rfmt <- PatchFormat
-> WithWorkingDir -> WithPrefsTemplates -> IO RepoFormat
createRepositoryFiles PatchFormat
patchfmt WithWorkingDir
withWorkingDir WithPrefsTemplates
withPrefsTemplates
  rdir <- ioAbsoluteOrRemote here
  cache <- getCaches useCache Nothing
  repo@(EmptyRepository r) <- case patchfmt of
    PatchFormat
PatchFormat1 -> EmptyRepository -> IO EmptyRepository
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (EmptyRepository -> IO EmptyRepository)
-> EmptyRepository -> IO EmptyRepository
forall a b. (a -> b) -> a -> b
$ Repository 'RO (RepoPatchV1 Prim) Origin Origin -> EmptyRepository
forall (p :: * -> * -> *).
(RepoPatch p, ApplyState p ~ Tree) =>
Repository 'RO p Origin Origin -> EmptyRepository
EmptyRepository (Repository 'RO (RepoPatchV1 Prim) Origin Origin
 -> EmptyRepository)
-> Repository 'RO (RepoPatchV1 Prim) Origin Origin
-> EmptyRepository
forall a b. (a -> b) -> a -> b
$ AbsoluteOrRemotePath
-> RepoFormat
-> Cache
-> Repository 'RO (RepoPatchV1 Prim) Origin Origin
mkRepoV1 AbsoluteOrRemotePath
rdir RepoFormat
rfmt Cache
cache
    PatchFormat
PatchFormat2 -> EmptyRepository -> IO EmptyRepository
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (EmptyRepository -> IO EmptyRepository)
-> EmptyRepository -> IO EmptyRepository
forall a b. (a -> b) -> a -> b
$ Repository 'RO (RepoPatchV2 Prim) Origin Origin -> EmptyRepository
forall (p :: * -> * -> *).
(RepoPatch p, ApplyState p ~ Tree) =>
Repository 'RO p Origin Origin -> EmptyRepository
EmptyRepository (Repository 'RO (RepoPatchV2 Prim) Origin Origin
 -> EmptyRepository)
-> Repository 'RO (RepoPatchV2 Prim) Origin Origin
-> EmptyRepository
forall a b. (a -> b) -> a -> b
$ AbsoluteOrRemotePath
-> RepoFormat
-> Cache
-> Repository 'RO (RepoPatchV2 Prim) Origin Origin
mkRepoV2 AbsoluteOrRemotePath
rdir RepoFormat
rfmt Cache
cache
    PatchFormat
PatchFormat3 -> EmptyRepository -> IO EmptyRepository
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (EmptyRepository -> IO EmptyRepository)
-> EmptyRepository -> IO EmptyRepository
forall a b. (a -> b) -> a -> b
$ Repository 'RO (RepoPatchV3 Prim) Origin Origin -> EmptyRepository
forall (p :: * -> * -> *).
(RepoPatch p, ApplyState p ~ Tree) =>
Repository 'RO p Origin Origin -> EmptyRepository
EmptyRepository (Repository 'RO (RepoPatchV3 Prim) Origin Origin
 -> EmptyRepository)
-> Repository 'RO (RepoPatchV3 Prim) Origin Origin
-> EmptyRepository
forall a b. (a -> b) -> a -> b
$ AbsoluteOrRemotePath
-> RepoFormat
-> Cache
-> Repository 'RO (RepoPatchV3 Prim) Origin Origin
mkRepoV3 AbsoluteOrRemotePath
rdir RepoFormat
rfmt Cache
cache
  _ <- writePristine r emptyTree
  maybeCreatePatchIndex withPatchIndex r
  return repo

mkRepoV1
  :: AbsoluteOrRemotePath
  -> RepoFormat
  -> Cache
  -> Repository 'RO (RepoPatchV1 V1.Prim) Origin Origin
mkRepoV1 :: AbsoluteOrRemotePath
-> RepoFormat
-> Cache
-> Repository 'RO (RepoPatchV1 Prim) Origin Origin
mkRepoV1 AbsoluteOrRemotePath
rdir RepoFormat
repofmt Cache
cache = AbsoluteOrRemotePath
-> RepoFormat
-> PristineType
-> Cache
-> Repository 'RO (RepoPatchV1 Prim) Origin Origin
forall (p :: * -> * -> *) wU wR.
AbsoluteOrRemotePath
-> RepoFormat -> PristineType -> Cache -> Repository 'RO p wU wR
mkRepo AbsoluteOrRemotePath
rdir RepoFormat
repofmt PristineType
HashedPristine Cache
cache

mkRepoV2
  :: AbsoluteOrRemotePath
  -> RepoFormat
  -> Cache
  -> Repository 'RO (RepoPatchV2 V2.Prim) Origin Origin
mkRepoV2 :: AbsoluteOrRemotePath
-> RepoFormat
-> Cache
-> Repository 'RO (RepoPatchV2 Prim) Origin Origin
mkRepoV2 AbsoluteOrRemotePath
rdir RepoFormat
repofmt Cache
cache = AbsoluteOrRemotePath
-> RepoFormat
-> PristineType
-> Cache
-> Repository 'RO (RepoPatchV2 Prim) Origin Origin
forall (p :: * -> * -> *) wU wR.
AbsoluteOrRemotePath
-> RepoFormat -> PristineType -> Cache -> Repository 'RO p wU wR
mkRepo AbsoluteOrRemotePath
rdir RepoFormat
repofmt PristineType
HashedPristine Cache
cache

mkRepoV3
  :: AbsoluteOrRemotePath
  -> RepoFormat
  -> Cache
  -> Repository 'RO (RepoPatchV3 V2.Prim) Origin Origin
mkRepoV3 :: AbsoluteOrRemotePath
-> RepoFormat
-> Cache
-> Repository 'RO (RepoPatchV3 Prim) Origin Origin
mkRepoV3 AbsoluteOrRemotePath
rdir RepoFormat
repofmt Cache
cache = AbsoluteOrRemotePath
-> RepoFormat
-> PristineType
-> Cache
-> Repository 'RO (RepoPatchV3 Prim) Origin Origin
forall (p :: * -> * -> *) wU wR.
AbsoluteOrRemotePath
-> RepoFormat -> PristineType -> Cache -> Repository 'RO p wU wR
mkRepo AbsoluteOrRemotePath
rdir RepoFormat
repofmt PristineType
HashedPristine Cache
cache

createRepositoryV1
  :: WithWorkingDir -> WithPatchIndex -> UseCache -> WithPrefsTemplates
  -> IO (Repository 'RO (RepoPatchV1 V1.Prim) Origin Origin)
createRepositoryV1 :: WithWorkingDir
-> WithPatchIndex
-> UseCache
-> WithPrefsTemplates
-> IO (Repository 'RO (RepoPatchV1 Prim) Origin Origin)
createRepositoryV1 WithWorkingDir
withWorkingDir WithPatchIndex
withPatchIndex UseCache
useCache WithPrefsTemplates
withPrefsTemplates = do
  rfmt <- PatchFormat
-> WithWorkingDir -> WithPrefsTemplates -> IO RepoFormat
createRepositoryFiles PatchFormat
PatchFormat1 WithWorkingDir
withWorkingDir WithPrefsTemplates
withPrefsTemplates
  rdir <- ioAbsoluteOrRemote here
  cache <- getCaches useCache Nothing
  let repo = AbsoluteOrRemotePath
-> RepoFormat
-> Cache
-> Repository 'RO (RepoPatchV1 Prim) Origin Origin
mkRepoV1 AbsoluteOrRemotePath
rdir RepoFormat
rfmt Cache
cache
  _ <- writePristine repo emptyTree
  maybeCreatePatchIndex withPatchIndex repo
  return repo

createRepositoryV2
  :: WithWorkingDir -> WithPatchIndex -> UseCache -> WithPrefsTemplates
  -> IO (Repository 'RO (RepoPatchV2 V2.Prim) Origin Origin)
createRepositoryV2 :: WithWorkingDir
-> WithPatchIndex
-> UseCache
-> WithPrefsTemplates
-> IO (Repository 'RO (RepoPatchV2 Prim) Origin Origin)
createRepositoryV2 WithWorkingDir
withWorkingDir WithPatchIndex
withPatchIndex UseCache
useCache WithPrefsTemplates
withPrefsTemplates = do
  rfmt <- PatchFormat
-> WithWorkingDir -> WithPrefsTemplates -> IO RepoFormat
createRepositoryFiles PatchFormat
PatchFormat2 WithWorkingDir
withWorkingDir WithPrefsTemplates
withPrefsTemplates
  rdir <- ioAbsoluteOrRemote here
  cache <- getCaches useCache Nothing
  let repo = AbsoluteOrRemotePath
-> RepoFormat
-> Cache
-> Repository 'RO (RepoPatchV2 Prim) Origin Origin
mkRepoV2 AbsoluteOrRemotePath
rdir RepoFormat
rfmt Cache
cache
  _ <- writePristine repo emptyTree
  maybeCreatePatchIndex withPatchIndex repo
  return repo

maybeCreatePatchIndex :: (RepoPatch p, ApplyState p ~ Tree)
                      => WithPatchIndex -> Repository 'RO p wU Origin -> IO ()
maybeCreatePatchIndex :: forall (p :: * -> * -> *) wU.
(RepoPatch p, ApplyState p ~ Tree) =>
WithPatchIndex -> Repository 'RO p wU Origin -> IO ()
maybeCreatePatchIndex WithPatchIndex
NoPatchIndex Repository 'RO p wU Origin
_ = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
maybeCreatePatchIndex WithPatchIndex
YesPatchIndex Repository 'RO p wU Origin
repo =
  Repository 'RO p wU Origin -> PatchSet p Origin Origin -> IO ()
forall (p :: * -> * -> *) (rt :: AccessType) wU wR.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wU wR -> PatchSet p Origin wR -> IO ()
createOrUpdatePatchIndexDisk Repository 'RO p wU Origin
repo PatchSet p Origin Origin
forall (p :: * -> * -> *). PatchSet p Origin Origin
emptyPatchSet

here :: String
here :: String
here = String
"."