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
  -- note: all repos we create nowadays are hashed
  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
"."