mirror of
https://code.sup39.dev/repos/Wqawg
synced 2025-03-20 04:46:22 +09:00
Implement an 'initRepo' that actually works
This commit is contained in:
parent
d8d2d160a0
commit
0b06b72b85
3 changed files with 91 additions and 4 deletions
src/Data/Git
81
src/Data/Git/Local.hs
Normal file
81
src/Data/Git/Local.hs
Normal file
|
@ -0,0 +1,81 @@
|
|||
{- This file is part of Vervis.
|
||||
-
|
||||
- Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
|
||||
-
|
||||
- ♡ Copying is an act of love. Please copy, reuse and share.
|
||||
-
|
||||
- The author(s) have dedicated all copyright and related and neighboring
|
||||
- rights to this software to the public domain worldwide. This software is
|
||||
- distributed without any warranty.
|
||||
-
|
||||
- You should have received a copy of the CC0 Public Domain Dedication along
|
||||
- with this software. If not, see
|
||||
- <http://creativecommons.org/publicdomain/zero/1.0/>.
|
||||
-}
|
||||
|
||||
module Data.Git.Local
|
||||
( initRepo
|
||||
)
|
||||
where
|
||||
|
||||
import Prelude
|
||||
|
||||
import Control.Monad (when)
|
||||
import System.Directory.Tree
|
||||
|
||||
import qualified Data.ByteString as B (ByteString, writeFile)
|
||||
|
||||
initialConfig :: B.ByteString
|
||||
initialConfig =
|
||||
"[core]\n\
|
||||
\ repositoryformatversion = 0\n\
|
||||
\ filemode = true\n\
|
||||
\ bare = true"
|
||||
|
||||
initialDescription :: B.ByteString
|
||||
initialDescription =
|
||||
"Unnamed repository; edit this file to name the repository."
|
||||
|
||||
initialHead :: B.ByteString
|
||||
initialHead = "ref: refs/heads/master"
|
||||
|
||||
initialExclude :: B.ByteString
|
||||
initialExclude = ""
|
||||
|
||||
initialRepoTree :: FileName -> DirTree B.ByteString
|
||||
initialRepoTree repo =
|
||||
Dir repo
|
||||
[ Dir "branches" []
|
||||
, File "config" initialConfig
|
||||
, File "description" initialDescription
|
||||
, File "HEAD" initialHead
|
||||
, Dir "hooks" []
|
||||
, Dir "info"
|
||||
[ File "exclude" initialExclude
|
||||
]
|
||||
, Dir "objects"
|
||||
[ Dir "info" []
|
||||
, Dir "pack" []
|
||||
]
|
||||
, Dir "refs"
|
||||
[ Dir "heads" []
|
||||
, Dir "tags" []
|
||||
]
|
||||
]
|
||||
|
||||
-- | initialize a new bare repository at a specific location.
|
||||
--
|
||||
-- Currently in the @hit@ package, i.e. version 0.6.3, the initRepo function
|
||||
-- creates a directory which the git executable doesn't recognize as a git
|
||||
-- repository. The version here creates a properly initialized repo.
|
||||
initRepo
|
||||
:: FilePath
|
||||
-- ^ Parent directory which already exists
|
||||
-> String
|
||||
-- ^ Name of new repo, i.e. new directory to create under the parent
|
||||
-> IO ()
|
||||
initRepo path name = do
|
||||
let tree = path :/ initialRepoTree name
|
||||
result <- writeDirectoryWith B.writeFile tree
|
||||
let errs = failures $ dirTree result
|
||||
when (not . null $ errs) $ error $ show errs
|
Loading…
Add table
Add a link
Reference in a new issue