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
String
cwd <- IO String
getCurrentDirectory
Maybe (Either String ())
x <- IO (Maybe (Either String ()))
seekRepo
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe (Either String ()) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (Either String ())
x) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
String -> IO ()
setCurrentDirectory String
cwd
String -> IO ()
putStrLn String
"WARNING: creating a nested repository."
String -> IO ()
createDirectory String
darcsdir IO () -> (IOError -> IO ()) -> IO ()
forall a. IO a -> (IOError -> IO a) -> IO a
`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
"'.")
String -> IO ()
createDirectory String
pristineDirPath
String -> IO ()
createDirectory String
patchesDirPath
String -> IO ()
createDirectory String
inventoriesDirPath
String -> IO ()
createDirectory String
prefsDirPath
WithPrefsTemplates -> IO ()
writeDefaultPrefs WithPrefsTemplates
withPrefsTemplates
let repo_format :: RepoFormat
repo_format = PatchFormat -> WithWorkingDir -> RepoFormat
createRepoFormat PatchFormat
patchfmt WithWorkingDir
withWorkingDir
RepoFormat -> String -> IO ()
unsafeWriteRepoFormat RepoFormat
repo_format String
formatPath
String -> ByteString -> IO ()
forall p. FilePathLike p => p -> ByteString -> IO ()
writeBinFile String
hashedInventoryPath ByteString
B.empty
RepoFormat -> IO RepoFormat
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return RepoFormat
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
RepoFormat
rfmt <- PatchFormat
-> WithWorkingDir -> WithPrefsTemplates -> IO RepoFormat
createRepositoryFiles PatchFormat
patchfmt WithWorkingDir
withWorkingDir WithPrefsTemplates
withPrefsTemplates
AbsoluteOrRemotePath
rdir <- String -> IO AbsoluteOrRemotePath
ioAbsoluteOrRemote String
here
Cache
cache <- UseCache -> Maybe AbsoluteOrRemotePath -> IO Cache
getCaches UseCache
useCache Maybe AbsoluteOrRemotePath
forall a. Maybe a
Nothing
repo :: EmptyRepository
repo@(EmptyRepository Repository 'RO p Origin Origin
r) <- case PatchFormat
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
PristineHash
_ <- Repository 'RO p Origin Origin -> Tree IO -> IO PristineHash
forall (rt :: AccessType) (p :: * -> * -> *) wU wR.
Repository rt p wU wR -> Tree IO -> IO PristineHash
writePristine Repository 'RO p Origin Origin
r Tree IO
forall (m :: * -> *). Tree m
emptyTree
WithPatchIndex -> Repository 'RO p Origin Origin -> IO ()
forall (p :: * -> * -> *) wU.
(RepoPatch p, ApplyState p ~ Tree) =>
WithPatchIndex -> Repository 'RO p wU Origin -> IO ()
maybeCreatePatchIndex WithPatchIndex
withPatchIndex Repository 'RO p Origin Origin
r
EmptyRepository -> IO EmptyRepository
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return EmptyRepository
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
RepoFormat
rfmt <- PatchFormat
-> WithWorkingDir -> WithPrefsTemplates -> IO RepoFormat
createRepositoryFiles PatchFormat
PatchFormat1 WithWorkingDir
withWorkingDir WithPrefsTemplates
withPrefsTemplates
AbsoluteOrRemotePath
rdir <- String -> IO AbsoluteOrRemotePath
ioAbsoluteOrRemote String
here
Cache
cache <- UseCache -> Maybe AbsoluteOrRemotePath -> IO Cache
getCaches UseCache
useCache Maybe AbsoluteOrRemotePath
forall a. Maybe a
Nothing
let repo :: Repository 'RO (RepoPatchV1 Prim) Origin Origin
repo = AbsoluteOrRemotePath
-> RepoFormat
-> Cache
-> Repository 'RO (RepoPatchV1 Prim) Origin Origin
mkRepoV1 AbsoluteOrRemotePath
rdir RepoFormat
rfmt Cache
cache
PristineHash
_ <- Repository 'RO (RepoPatchV1 Prim) Origin Origin
-> Tree IO -> IO PristineHash
forall (rt :: AccessType) (p :: * -> * -> *) wU wR.
Repository rt p wU wR -> Tree IO -> IO PristineHash
writePristine Repository 'RO (RepoPatchV1 Prim) Origin Origin
repo Tree IO
forall (m :: * -> *). Tree m
emptyTree
WithPatchIndex
-> Repository 'RO (RepoPatchV1 Prim) Origin Origin -> IO ()
forall (p :: * -> * -> *) wU.
(RepoPatch p, ApplyState p ~ Tree) =>
WithPatchIndex -> Repository 'RO p wU Origin -> IO ()
maybeCreatePatchIndex WithPatchIndex
withPatchIndex Repository 'RO (RepoPatchV1 Prim) Origin Origin
repo
Repository 'RO (RepoPatchV1 Prim) Origin Origin
-> IO (Repository 'RO (RepoPatchV1 Prim) Origin Origin)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Repository 'RO (RepoPatchV1 Prim) Origin Origin
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
RepoFormat
rfmt <- PatchFormat
-> WithWorkingDir -> WithPrefsTemplates -> IO RepoFormat
createRepositoryFiles PatchFormat
PatchFormat2 WithWorkingDir
withWorkingDir WithPrefsTemplates
withPrefsTemplates
AbsoluteOrRemotePath
rdir <- String -> IO AbsoluteOrRemotePath
ioAbsoluteOrRemote String
here
Cache
cache <- UseCache -> Maybe AbsoluteOrRemotePath -> IO Cache
getCaches UseCache
useCache Maybe AbsoluteOrRemotePath
forall a. Maybe a
Nothing
let repo :: Repository 'RO (RepoPatchV2 Prim) Origin Origin
repo = AbsoluteOrRemotePath
-> RepoFormat
-> Cache
-> Repository 'RO (RepoPatchV2 Prim) Origin Origin
mkRepoV2 AbsoluteOrRemotePath
rdir RepoFormat
rfmt Cache
cache
PristineHash
_ <- Repository 'RO (RepoPatchV2 Prim) Origin Origin
-> Tree IO -> IO PristineHash
forall (rt :: AccessType) (p :: * -> * -> *) wU wR.
Repository rt p wU wR -> Tree IO -> IO PristineHash
writePristine Repository 'RO (RepoPatchV2 Prim) Origin Origin
repo Tree IO
forall (m :: * -> *). Tree m
emptyTree
WithPatchIndex
-> Repository 'RO (RepoPatchV2 Prim) Origin Origin -> IO ()
forall (p :: * -> * -> *) wU.
(RepoPatch p, ApplyState p ~ Tree) =>
WithPatchIndex -> Repository 'RO p wU Origin -> IO ()
maybeCreatePatchIndex WithPatchIndex
withPatchIndex Repository 'RO (RepoPatchV2 Prim) Origin Origin
repo
Repository 'RO (RepoPatchV2 Prim) Origin Origin
-> IO (Repository 'RO (RepoPatchV2 Prim) Origin Origin)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Repository 'RO (RepoPatchV2 Prim) Origin Origin
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
"."