hsubconvert (empty) → 0.0.1
raw patch · 5 files changed
+255/−0 lines, 5 filesdep +basedep +bytestringdep +cmdargssetup-changed
Dependencies added: base, bytestring, cmdargs, general-prelude, gitlib, hslogger, lzma-conduit, parallel-io, regex-posix, shelly, svndump, system-fileio, text, time, transformers, unix
Files
- LICENSE +28/−0
- Main.hs +179/−0
- README.md +6/−0
- Setup.hs +0/−0
- hsubconvert.cabal +42/−0
+ LICENSE view
@@ -0,0 +1,28 @@+Copyright (c) 2003-2009, John Wiegley. All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++- Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++- Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.++- Neither the name of New Artisans LLC nor the names of its+ contributors may be used to endorse or promote products derived from+ this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Main.hs view
@@ -0,0 +1,179 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ExtendedDefaultRules #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# OPTIONS_GHC -fno-warn-type-defaults #-}++module Main where++import qualified Data.ByteString as B+import qualified Data.ByteString.Internal as BI+import qualified Data.ByteString.Lazy as BL+import qualified Data.ByteString.Lazy.Internal as BLI+import Data.Git+import Data.Text.Lazy (Text)+import qualified Data.Text.Lazy as T+import Filesystem (isDirectory, removeTree)+import Foreign.ForeignPtr+import Foreign.Ptr+import GHC.Conc+import Prelude.General+import Shelly+import Subversion.Dump+import System.Console.CmdArgs+import System.Environment+import System.Log.Logger++default (Text)++version :: String+version = "0.0.1"++copyright :: String+copyright = "2012"++hSubconvertSummary :: String+hSubconvertSummary =+ "hsubconvert v" ++ version ++ ", (C) John Wiegley " ++ copyright++data HSubconvert = HSubconvert { jobs :: Int+ , verbose :: Bool+ , debug :: Bool+ , files :: [String] }+ deriving (Data, Typeable, Show, Eq)++hSubconvert :: HSubconvert+hSubconvert = HSubconvert+ { jobs = def &= name "j" &= typ "INT"+ &= help "Run INT concurrent jobs (default: 4)"+ , verbose = def &= name "v"+ &= help "Report progress verbosely"+ , debug = def &= name "D"+ &= help "Report debug information"+ , files = def &= args } &=+ summary hSubconvertSummary &=+ program "hsubconvert" &=+ help "One-time, faithful conversion of Subversion repositories to Git"++withRepository :: Text -> (Repository -> IO ()) -> IO ()+withRepository n f = do let p = fromText n+ exists <- isDirectory p+ when exists $ removeTree p+ f =<< createRepository p True++main :: IO ()+main = do+ -- process command-line options+ mainArgs <- getArgs+ opts <- withArgs (if null mainArgs then ["--help"] else mainArgs)+ (cmdArgs hSubconvert)++ _ <- GHC.Conc.setNumCapabilities $ case jobs opts of 0 -> 4; x -> x++ when (verbose opts) $ updateGlobalLogger "hsubconvert" (setLevel INFO)+ when (debug opts) $ updateGlobalLogger "hsubconvert" (setLevel DEBUG)++ hSetBuffering stdout NoBuffering++ withRepository "test.git" $ \repo -> do+ file <- BL.readFile (head (files opts))++ let revs = readSvnDump file+ (c, lastRev) <-+ foldM (\(co, _) rev -> do+ when (isJust co) $+ reportProgress False (revNumber rev) (fromJust co)+ co' <- applyRevision repo co rev+ return (co', rev))+ (Nothing, head revs) revs++ case c of+ Nothing -> putStrLn "No revisions were converted!"+ Just c' -> do+ reportProgress True (revNumber lastRev) c'++ cid <- objectId c'+ writeRef_ $ createRef "refs/heads/master" (RefTargetId cid) repo+ writeRef_ $+ createRef "HEAD" (RefTargetSymbolic "refs/heads/master") repo++ putStr "\nConversion completed\n"++ where+ reportProgress :: Updatable a => Bool -> Int -> a -> IO ()+ reportProgress force num obj+ | force || num < 10 = showProgress num obj+ | num < 100 = when (num `mod` 10 == 0) $ showProgress num obj+ | num < 1000 = when (num `mod` 100 == 0) $ showProgress num obj+ | otherwise = when (num `mod` 1000 == 0) $ showProgress num obj++ showProgress :: Updatable a => Int -> a -> IO ()+ showProgress num _ = do+ putStr $ "Converting " ++ show num ++ "...\r"+ -- void (forkOS (update_ obj))++applyRevision :: Repository -> Maybe Commit -> Revision+ -> IO (Maybe Commit)+applyRevision repo c rev = do+ case foldl' (\co op -> co `seq` foldOp co op)+ (Left (makeCommit c)) (revOperations rev) of+ Left _ -> return c+ Right x -> Just <$> x++ where+ makeCommit co =+ let nco = case co of+ Nothing -> createCommit repo+ Just p -> commitTree .~ p^.commitTree+ $ commitParents .~ [ObjRef p]+ $ createCommit repo+ sig = Signature {+ _signatureName = fromMaybe "Unknown" (revAuthor rev)+ , _signatureEmail = "unknown@unknown.org"+ , _signatureWhen = revDate rev }++ in commitAuthor .~ sig+ $ commitCommitter .~ sig+ $ commitLog .~ fromMaybe "" (revComment rev) $ nco++ foldOp :: Either Commit (IO Commit) -> Operation+ -> Either Commit (IO Commit)+ foldOp c' op =+ case opAction op of+ Add ->+ case opKind op of+ Directory -> c'+ File -> addFile op c'++ Change -> c'+ Replace -> c'+ Delete -> c'++ addFile op c'+ | BL.null (opContents op) = c'+ | otherwise =+ Right (case c' of Left f -> return f; Right x -> x+ >>= updateCommit (opFilePath op) (wrapBlob op repo)+ >>= update)++opFilePath :: Operation -> FilePath+opFilePath = fromText . T.pack . opPathname++opBlob :: Operation -> Repository -> Blob+opBlob op = createBlob (lazyToStrict (opContents op))++wrapBlob :: Operation -> Repository -> TreeEntry+wrapBlob op repo = BlobEntry (ObjRef (opBlob op repo)) False++lazyToStrict :: BL.ByteString -> B.ByteString+lazyToStrict lb = BI.unsafeCreate len $ go lb+ where+ len = BLI.foldlChunks (\l sb -> l + B.length sb) 0 lb++ go BLI.Empty _ = return ()+ go (BLI.Chunk (BI.PS fp s l) r) ptr =+ withForeignPtr fp $ \p -> do+ BI.memcpy ptr (p `plusPtr` s) (fromIntegral l)+ go r (ptr `plusPtr` l)++-- Main.hs (hsubconvert) ends here
+ README.md view
@@ -0,0 +1,6 @@+hsubconvert: One-time, faithful conversion of Subversion repositories to Git.++by John Wiegley <johnw@newartisans.com>++To install, type "cabal install", and make sure that ~/.cabal/bin is on your+PATH.
+ Setup.hs view
+ hsubconvert.cabal view
@@ -0,0 +1,42 @@+Name: hsubconvert++Version: 0.0.1+Synopsis: One-time, faithful conversion of Subversion repositories to Git++Description: One-time, faithful conversion of Subversion repositories to Git.++Homepage: https://github.com/jwiegley/hsubconvert+License: BSD3+License-file: LICENSE+Author: John Wiegley+Maintainer: John Wiegley <johnw@newartisans.com>+Category: Development+Build-type: Simple+Cabal-version: >= 1.8++Extra-Source-Files: README.md++Executable hsubconvert+ Main-is: Main.hs+ Ghc-options: -threaded++ Build-depends: base >= 4 && < 5+ , svndump+ , gitlib+ , general-prelude >= 0.1+ , bytestring >= 0.9.2.1+ , cmdargs >= 0.10+ , hslogger >= 1.2.0+ , parallel-io >= 0.3.2+ , regex-posix >= 0.95.2+ , shelly >= 0.14.1+ , system-fileio >= 0.3.10+ , text >= 0.11.2.0+ , time >= 1.4+ , transformers >= 0.3.0+ , lzma-conduit >= 0.5.2.1+ , unix >= 2.5.1.1++Source-repository head+ type: git+ location: https://github.com/jwiegley/hsubconvert