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

import Darcs.Prelude

import Control.Monad ( when )
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BC
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.RepoType ( RepoType(..), RebaseType(..) )
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.Repository.Cache ( Cache )
import Darcs.Repository.Format
    ( RepoFormat
    , createRepoFormat
    , writeRepoFormat
    )
import Darcs.Repository.Flags
    ( UseCache(..)
    , WithWorkingDir (..)
    , WithPatchIndex (..)
    , PatchFormat (..)
    )
import Darcs.Repository.Inventory
    ( pokePristineHash
    , mkValidHash
    )
import Darcs.Repository.Paths
    ( pristineDirPath
    , patchesDirPath
    , inventoriesDirPath
    , hashedInventoryPath
    , formatPath
    )
import Darcs.Repository.Identify ( seekRepo )
import Darcs.Repository.InternalTypes
    ( Repository
    , PristineType(..)
    , mkRepo
    )
import Darcs.Repository.PatchIndex ( createOrUpdatePatchIndexDisk )
import Darcs.Repository.Prefs
    ( writeDefaultPrefs
    , getCaches
    , prefsDirPath
    )

import Darcs.Util.ByteString( gzReadFilePS )
import Darcs.Util.File ( withCurrentDirectory )
import Darcs.Util.Global ( darcsdir )
import Darcs.Util.Hash( encodeBase16 )
import Darcs.Util.Lock
    ( writeBinFile
    , writeDocBinFile
    )
import Darcs.Util.Path ( ioAbsoluteOrRemote, toPath )
import Darcs.Util.Tree( Tree, emptyTree )
import Darcs.Util.Tree.Hashed( writeDarcsHashed, darcsAddMissingHashes )

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

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

createRepository :: PatchFormat -> WithWorkingDir -> WithPatchIndex -> UseCache
                 -> IO EmptyRepository
createRepository :: PatchFormat
-> WithWorkingDir
-> WithPatchIndex
-> UseCache
-> IO EmptyRepository
createRepository PatchFormat
patchfmt WithWorkingDir
withWorkingDir WithPatchIndex
withPatchIndex UseCache
useCache = do
  RepoFormat
rfmt <- PatchFormat -> WithWorkingDir -> IO RepoFormat
createRepositoryFiles PatchFormat
patchfmt WithWorkingDir
withWorkingDir
  Cache
cache <- UseCache -> FilePath -> IO Cache
getCaches UseCache
useCache FilePath
here
  FilePath
rdir <- AbsoluteOrRemotePath -> FilePath
forall a. FilePathOrURL a => a -> FilePath
toPath (AbsoluteOrRemotePath -> FilePath)
-> IO AbsoluteOrRemotePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO AbsoluteOrRemotePath
ioAbsoluteOrRemote FilePath
here
  repo :: EmptyRepository
repo@(EmptyRepository Repository ('RepoType 'NoRebase) p Origin Origin Origin
r) <- case PatchFormat
patchfmt of
    PatchFormat
PatchFormat1 -> EmptyRepository -> IO EmptyRepository
forall (m :: * -> *) a. Monad m => a -> m a
return (EmptyRepository -> IO EmptyRepository)
-> EmptyRepository -> IO EmptyRepository
forall a b. (a -> b) -> a -> b
$ Repository
  ('RepoType 'NoRebase) (RepoPatchV1 Prim) Origin Origin Origin
-> EmptyRepository
forall (p :: * -> * -> *).
(RepoPatch p, ApplyState p ~ Tree) =>
Repository ('RepoType 'NoRebase) p Origin Origin Origin
-> EmptyRepository
EmptyRepository (Repository
   ('RepoType 'NoRebase) (RepoPatchV1 Prim) Origin Origin Origin
 -> EmptyRepository)
-> Repository
     ('RepoType 'NoRebase) (RepoPatchV1 Prim) Origin Origin Origin
-> EmptyRepository
forall a b. (a -> b) -> a -> b
$ FilePath
-> RepoFormat
-> Cache
-> Repository
     ('RepoType 'NoRebase) (RepoPatchV1 Prim) Origin Origin Origin
mkRepoV1 FilePath
rdir RepoFormat
rfmt Cache
cache
    PatchFormat
PatchFormat2 -> EmptyRepository -> IO EmptyRepository
forall (m :: * -> *) a. Monad m => a -> m a
return (EmptyRepository -> IO EmptyRepository)
-> EmptyRepository -> IO EmptyRepository
forall a b. (a -> b) -> a -> b
$ Repository
  ('RepoType 'NoRebase) (RepoPatchV2 Prim) Origin Origin Origin
-> EmptyRepository
forall (p :: * -> * -> *).
(RepoPatch p, ApplyState p ~ Tree) =>
Repository ('RepoType 'NoRebase) p Origin Origin Origin
-> EmptyRepository
EmptyRepository (Repository
   ('RepoType 'NoRebase) (RepoPatchV2 Prim) Origin Origin Origin
 -> EmptyRepository)
-> Repository
     ('RepoType 'NoRebase) (RepoPatchV2 Prim) Origin Origin Origin
-> EmptyRepository
forall a b. (a -> b) -> a -> b
$ FilePath
-> RepoFormat
-> Cache
-> Repository
     ('RepoType 'NoRebase) (RepoPatchV2 Prim) Origin Origin Origin
mkRepoV2 FilePath
rdir RepoFormat
rfmt Cache
cache
    PatchFormat
PatchFormat3 -> EmptyRepository -> IO EmptyRepository
forall (m :: * -> *) a. Monad m => a -> m a
return (EmptyRepository -> IO EmptyRepository)
-> EmptyRepository -> IO EmptyRepository
forall a b. (a -> b) -> a -> b
$ Repository
  ('RepoType 'NoRebase) (RepoPatchV3 Prim) Origin Origin Origin
-> EmptyRepository
forall (p :: * -> * -> *).
(RepoPatch p, ApplyState p ~ Tree) =>
Repository ('RepoType 'NoRebase) p Origin Origin Origin
-> EmptyRepository
EmptyRepository (Repository
   ('RepoType 'NoRebase) (RepoPatchV3 Prim) Origin Origin Origin
 -> EmptyRepository)
-> Repository
     ('RepoType 'NoRebase) (RepoPatchV3 Prim) Origin Origin Origin
-> EmptyRepository
forall a b. (a -> b) -> a -> b
$ FilePath
-> RepoFormat
-> Cache
-> Repository
     ('RepoType 'NoRebase) (RepoPatchV3 Prim) Origin Origin Origin
mkRepoV3 FilePath
rdir RepoFormat
rfmt Cache
cache
  WithPatchIndex
-> Repository ('RepoType 'NoRebase) p Origin Origin Origin -> IO ()
forall (p :: * -> * -> *) (rt :: RepoType) wU.
(RepoPatch p, ApplyState p ~ Tree) =>
WithPatchIndex -> Repository rt p Origin wU Origin -> IO ()
maybeCreatePatchIndex WithPatchIndex
withPatchIndex Repository ('RepoType 'NoRebase) p Origin Origin Origin
r
  EmptyRepository -> IO EmptyRepository
forall (m :: * -> *) a. Monad m => a -> m a
return EmptyRepository
repo

mkRepoV1
  :: FilePath
  -> RepoFormat
  -> Cache
  -> Repository ('RepoType 'NoRebase) (RepoPatchV1 V1.Prim) Origin Origin Origin
mkRepoV1 :: FilePath
-> RepoFormat
-> Cache
-> Repository
     ('RepoType 'NoRebase) (RepoPatchV1 Prim) Origin Origin Origin
mkRepoV1 FilePath
rdir RepoFormat
repofmt Cache
cache = FilePath
-> RepoFormat
-> PristineType
-> Cache
-> Repository
     ('RepoType 'NoRebase) (RepoPatchV1 Prim) Origin Origin Origin
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
FilePath
-> RepoFormat -> PristineType -> Cache -> Repository rt p wR wU wT
mkRepo FilePath
rdir RepoFormat
repofmt PristineType
HashedPristine Cache
cache

mkRepoV2
  :: FilePath
  -> RepoFormat
  -> Cache
  -> Repository ('RepoType 'NoRebase) (RepoPatchV2 V2.Prim) Origin Origin Origin
mkRepoV2 :: FilePath
-> RepoFormat
-> Cache
-> Repository
     ('RepoType 'NoRebase) (RepoPatchV2 Prim) Origin Origin Origin
mkRepoV2 FilePath
rdir RepoFormat
repofmt Cache
cache = FilePath
-> RepoFormat
-> PristineType
-> Cache
-> Repository
     ('RepoType 'NoRebase) (RepoPatchV2 Prim) Origin Origin Origin
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
FilePath
-> RepoFormat -> PristineType -> Cache -> Repository rt p wR wU wT
mkRepo FilePath
rdir RepoFormat
repofmt PristineType
HashedPristine Cache
cache

mkRepoV3
  :: FilePath
  -> RepoFormat
  -> Cache
  -> Repository ('RepoType 'NoRebase) (RepoPatchV3 V2.Prim) Origin Origin Origin
mkRepoV3 :: FilePath
-> RepoFormat
-> Cache
-> Repository
     ('RepoType 'NoRebase) (RepoPatchV3 Prim) Origin Origin Origin
mkRepoV3 FilePath
rdir RepoFormat
repofmt Cache
cache = FilePath
-> RepoFormat
-> PristineType
-> Cache
-> Repository
     ('RepoType 'NoRebase) (RepoPatchV3 Prim) Origin Origin Origin
forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
FilePath
-> RepoFormat -> PristineType -> Cache -> Repository rt p wR wU wT
mkRepo FilePath
rdir RepoFormat
repofmt PristineType
HashedPristine Cache
cache

createRepositoryV1
  :: WithWorkingDir -> WithPatchIndex -> UseCache
  -> IO (Repository ('RepoType 'NoRebase) (RepoPatchV1 V1.Prim) Origin Origin Origin)
createRepositoryV1 :: WithWorkingDir
-> WithPatchIndex
-> UseCache
-> IO
     (Repository
        ('RepoType 'NoRebase) (RepoPatchV1 Prim) Origin Origin Origin)
createRepositoryV1 WithWorkingDir
withWorkingDir WithPatchIndex
withPatchIndex UseCache
useCache = do
  RepoFormat
rfmt <- PatchFormat -> WithWorkingDir -> IO RepoFormat
createRepositoryFiles PatchFormat
PatchFormat1 WithWorkingDir
withWorkingDir
  Cache
cache <- UseCache -> FilePath -> IO Cache
getCaches UseCache
useCache FilePath
here
  FilePath
rdir <- AbsoluteOrRemotePath -> FilePath
forall a. FilePathOrURL a => a -> FilePath
toPath (AbsoluteOrRemotePath -> FilePath)
-> IO AbsoluteOrRemotePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO AbsoluteOrRemotePath
ioAbsoluteOrRemote FilePath
here
  let repo :: Repository
  ('RepoType 'NoRebase) (RepoPatchV1 Prim) Origin Origin Origin
repo = FilePath
-> RepoFormat
-> Cache
-> Repository
     ('RepoType 'NoRebase) (RepoPatchV1 Prim) Origin Origin Origin
mkRepoV1 FilePath
rdir RepoFormat
rfmt Cache
cache
  WithPatchIndex
-> Repository
     ('RepoType 'NoRebase) (RepoPatchV1 Prim) Origin Origin Origin
-> IO ()
forall (p :: * -> * -> *) (rt :: RepoType) wU.
(RepoPatch p, ApplyState p ~ Tree) =>
WithPatchIndex -> Repository rt p Origin wU Origin -> IO ()
maybeCreatePatchIndex WithPatchIndex
withPatchIndex Repository
  ('RepoType 'NoRebase) (RepoPatchV1 Prim) Origin Origin Origin
repo
  Repository
  ('RepoType 'NoRebase) (RepoPatchV1 Prim) Origin Origin Origin
-> IO
     (Repository
        ('RepoType 'NoRebase) (RepoPatchV1 Prim) Origin Origin Origin)
forall (m :: * -> *) a. Monad m => a -> m a
return Repository
  ('RepoType 'NoRebase) (RepoPatchV1 Prim) Origin Origin Origin
repo

createRepositoryV2
  :: WithWorkingDir -> WithPatchIndex -> UseCache
  -> IO (Repository ('RepoType 'NoRebase) (RepoPatchV2 V2.Prim) Origin Origin Origin)
createRepositoryV2 :: WithWorkingDir
-> WithPatchIndex
-> UseCache
-> IO
     (Repository
        ('RepoType 'NoRebase) (RepoPatchV2 Prim) Origin Origin Origin)
createRepositoryV2 WithWorkingDir
withWorkingDir WithPatchIndex
withPatchIndex UseCache
useCache = do
  RepoFormat
rfmt <- PatchFormat -> WithWorkingDir -> IO RepoFormat
createRepositoryFiles PatchFormat
PatchFormat2 WithWorkingDir
withWorkingDir
  Cache
cache <- UseCache -> FilePath -> IO Cache
getCaches UseCache
useCache FilePath
here
  FilePath
rdir <- AbsoluteOrRemotePath -> FilePath
forall a. FilePathOrURL a => a -> FilePath
toPath (AbsoluteOrRemotePath -> FilePath)
-> IO AbsoluteOrRemotePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO AbsoluteOrRemotePath
ioAbsoluteOrRemote FilePath
here
  let repo :: Repository
  ('RepoType 'NoRebase) (RepoPatchV2 Prim) Origin Origin Origin
repo = FilePath
-> RepoFormat
-> Cache
-> Repository
     ('RepoType 'NoRebase) (RepoPatchV2 Prim) Origin Origin Origin
mkRepoV2 FilePath
rdir RepoFormat
rfmt Cache
cache
  WithPatchIndex
-> Repository
     ('RepoType 'NoRebase) (RepoPatchV2 Prim) Origin Origin Origin
-> IO ()
forall (p :: * -> * -> *) (rt :: RepoType) wU.
(RepoPatch p, ApplyState p ~ Tree) =>
WithPatchIndex -> Repository rt p Origin wU Origin -> IO ()
maybeCreatePatchIndex WithPatchIndex
withPatchIndex Repository
  ('RepoType 'NoRebase) (RepoPatchV2 Prim) Origin Origin Origin
repo
  Repository
  ('RepoType 'NoRebase) (RepoPatchV2 Prim) Origin Origin Origin
-> IO
     (Repository
        ('RepoType 'NoRebase) (RepoPatchV2 Prim) Origin Origin Origin)
forall (m :: * -> *) a. Monad m => a -> m a
return Repository
  ('RepoType 'NoRebase) (RepoPatchV2 Prim) Origin Origin Origin
repo

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

writePristine :: FilePath -> Tree IO -> IO ()
writePristine :: FilePath -> Tree IO -> IO ()
writePristine FilePath
dir Tree IO
tree =
  FilePath -> IO () -> IO ()
forall p a. FilePathLike p => p -> IO a -> IO a
withCurrentDirectory FilePath
dir (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    ByteString
inv <- FilePath -> IO ByteString
gzReadFilePS FilePath
hashedInventoryPath
    Tree IO
tree' <- Tree IO -> IO (Tree IO)
forall (m :: * -> *). Monad m => Tree m -> m (Tree m)
darcsAddMissingHashes Tree IO
tree
    Hash
root <- Tree IO -> FilePath -> IO Hash
writeDarcsHashed Tree IO
tree' FilePath
pristineDirPath
    FilePath -> Doc -> IO ()
forall p. FilePathLike p => p -> Doc -> IO ()
writeDocBinFile FilePath
hashedInventoryPath (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$
      PristineHash -> ByteString -> Doc
pokePristineHash (FilePath -> PristineHash
forall a. ValidHash a => FilePath -> a
mkValidHash (FilePath -> PristineHash) -> FilePath -> PristineHash
forall a b. (a -> b) -> a -> b
$ ByteString -> FilePath
BC.unpack (ByteString -> FilePath) -> ByteString -> FilePath
forall a b. (a -> b) -> a -> b
$ Hash -> ByteString
encodeBase16 Hash
root) ByteString
inv

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