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

import Prelude ()
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.FilePath ( (</>) )
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 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.Hashed
    ( pokePristineHash
    , pristineDirPath
    , patchesDirPath
    , inventoriesDirPath
    , hashedInventoryPath
    )
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.Tree( Tree, emptyTree )
import Darcs.Util.Tree.Hashed( writeDarcsHashed, darcsAddMissingHashes )

createRepositoryFiles :: PatchFormat -> WithWorkingDir -> IO RepoFormat
createRepositoryFiles :: PatchFormat -> WithWorkingDir -> IO RepoFormat
createRepositoryFiles patchfmt :: PatchFormat
patchfmt withWorkingDir :: 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 "WARNING: creating a nested repository."
  FilePath -> IO ()
createDirectory FilePath
darcsdir IO () -> (IOError -> IO ()) -> IO ()
forall a. IO a -> (IOError -> IO a) -> IO a
`catchIOError`
      (\e :: IOError
e-> if IOError -> Bool
isAlreadyExistsError IOError
e
            then FilePath -> IO ()
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail "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
$ "Error creating directory `"FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
darcsdirFilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++"'.")
  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
darcsdir FilePath -> FilePath -> FilePath
</> "format")
  -- 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 patchfmt :: PatchFormat
patchfmt withWorkingDir :: WithWorkingDir
withWorkingDir withPatchIndex :: WithPatchIndex
withPatchIndex useCache :: 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
  repo :: EmptyRepository
repo@(EmptyRepository r :: Repository ('RepoType 'NoRebase) p Origin Origin Origin
r) <- case PatchFormat
patchfmt of
    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
$ RepoFormat
-> Cache
-> Repository
     ('RepoType 'NoRebase) (RepoPatchV1 Prim) Origin Origin Origin
mkRepoV1 RepoFormat
rfmt Cache
cache
    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
$ RepoFormat
-> Cache
-> Repository
     ('RepoType 'NoRebase) (RepoPatchV2 Prim) Origin Origin Origin
mkRepoV2 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
  :: RepoFormat
  -> Cache
  -> Repository ('RepoType 'NoRebase) (RepoPatchV1 V1.Prim) Origin Origin Origin
mkRepoV1 :: RepoFormat
-> Cache
-> Repository
     ('RepoType 'NoRebase) (RepoPatchV1 Prim) Origin Origin Origin
mkRepoV1 repofmt :: RepoFormat
repofmt cache :: 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 "." RepoFormat
repofmt PristineType
HashedPristine Cache
cache

mkRepoV2
  :: RepoFormat
  -> Cache
  -> Repository ('RepoType 'NoRebase) (RepoPatchV2 V2.Prim) Origin Origin Origin
mkRepoV2 :: RepoFormat
-> Cache
-> Repository
     ('RepoType 'NoRebase) (RepoPatchV2 Prim) Origin Origin Origin
mkRepoV2 repofmt :: RepoFormat
repofmt cache :: 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 "." 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
withWorkingDir withPatchIndex :: WithPatchIndex
withPatchIndex useCache :: 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
  let repo :: Repository
  ('RepoType 'NoRebase) (RepoPatchV1 Prim) Origin Origin Origin
repo = RepoFormat
-> Cache
-> Repository
     ('RepoType 'NoRebase) (RepoPatchV1 Prim) Origin Origin Origin
mkRepoV1 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
withWorkingDir withPatchIndex :: WithPatchIndex
withPatchIndex useCache :: 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
  let repo :: Repository
  ('RepoType 'NoRebase) (RepoPatchV2 Prim) Origin Origin Origin
repo = RepoFormat
-> Cache
-> Repository
     ('RepoType 'NoRebase) (RepoPatchV2 Prim) Origin Origin Origin
mkRepoV2 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 NoPatchIndex _ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
maybeCreatePatchIndex YesPatchIndex repo :: 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 :: * -> * -> *) wX. PatchSet rt p wX wX
emptyPatchSet

writePristine :: FilePath -> Tree IO -> IO ()
writePristine :: FilePath -> Tree IO -> IO ()
writePristine dir :: FilePath
dir tree :: 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
$ FilePath -> ByteString -> Doc
pokePristineHash (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 = "."