merging sqlite and bs branches

Since the sqlite branch uses blobs extensively, there are some
performance benefits, ByteStrings now get stored and retrieved w/o
conversion in some cases like in Database.Export.

Database/Benchmark.hs

@@ -86,7 +86,7 @@ populateAssociatedFiles h num = do
 	H.flushDbQueue h
 
 keyN :: Integer -> Key
-keyN n = stubKey
+keyN n = mkKey $ \k -> k
 	{ keyName = B8.pack $ "key" ++ show n
 	, keyVariety = OtherKey "BENCH"
 	}

Database/ContentIdentifier.hs

@@ -147,7 +147,7 @@ updateFromLog db (oldtree, currtree) = do
 		recordAnnexBranchTree db currtree
 		flushDbQueue db
   where
-	go ti = case extLogFileKey remoteContentIdentifierExt (getTopFilePath (DiffTree.file ti)) of
+	go ti = case extLogFileKey remoteContentIdentifierExt (toRawFilePath (getTopFilePath (DiffTree.file ti))) of
 		Nothing -> return ()
 		Just k -> do
 			l <- Log.getContentIdentifiers k

Database/Export.hs

@@ -130,26 +130,26 @@ addExportedLocation :: ExportHandle -> Key -> ExportLocation -> IO ()
 addExportedLocation h k el = queueDb h $ do
 	void $ insertUnique $ Exported k ef
 	let edirs = map
-		(\ed -> ExportedDirectory (toSFilePath (fromExportDirectory ed)) ef)
+		(\ed -> ExportedDirectory (toSFilePath (fromRawFilePath (fromExportDirectory ed))) ef)
 		(exportDirectories el)
 	putMany edirs
   where
-	ef = toSFilePath (fromExportLocation el)
+	ef = SFilePath (fromExportLocation el)
 
 removeExportedLocation :: ExportHandle -> Key -> ExportLocation -> IO ()
 removeExportedLocation h k el = queueDb h $ do
 	deleteWhere [ExportedKey ==. k, ExportedFile ==. ef]
-	let subdirs = map (toSFilePath . fromExportDirectory)
+	let subdirs = map (SFilePath . fromExportDirectory)
 		(exportDirectories el)
 	deleteWhere [ExportedDirectoryFile ==. ef, ExportedDirectorySubdir <-. subdirs]
   where
-	ef = toSFilePath (fromExportLocation el)
+	ef = SFilePath (fromExportLocation el)
 
 {- Note that this does not see recently queued changes. -}
 getExportedLocation :: ExportHandle -> Key -> IO [ExportLocation]
 getExportedLocation (ExportHandle h _) k = H.queryDbQueue h $ do
 	l <- selectList [ExportedKey ==. k] []
-	return $ map (mkExportLocation . fromSFilePath . exportedFile . entityVal) l
+	return $ map (mkExportLocation . (\(SFilePath f) -> f) . exportedFile . entityVal) l
 
 {- Note that this does not see recently queued changes. -}
 isExportDirectoryEmpty :: ExportHandle -> ExportDirectory -> IO Bool
@@ -157,13 +157,13 @@ isExportDirectoryEmpty (ExportHandle h _) d = H.queryDbQueue h $ do
 	l <- selectList [ExportedDirectorySubdir ==. ed] []
 	return $ null l
   where
-	ed = toSFilePath $ fromExportDirectory d
+	ed = SFilePath $ fromExportDirectory d
 
 {- Get locations in the export that might contain a key. -}
 getExportTree :: ExportHandle -> Key -> IO [ExportLocation]
 getExportTree (ExportHandle h _) k = H.queryDbQueue h $ do
 	l <- selectList [ExportTreeKey ==. k] []
-	return $ map (mkExportLocation . fromSFilePath . exportTreeFile . entityVal) l
+	return $ map (mkExportLocation . (\(SFilePath f) -> f) . exportTreeFile . entityVal) l
 
 {- Get keys that might be currently exported to a location.
  -
@@ -174,19 +174,19 @@ getExportTreeKey (ExportHandle h _) el = H.queryDbQueue h $ do
 	map (exportTreeKey . entityVal) 
 		<$> selectList [ExportTreeFile ==. ef] []
   where
-	ef = toSFilePath (fromExportLocation el)
+	ef = SFilePath (fromExportLocation el)
 
 addExportTree :: ExportHandle -> Key -> ExportLocation -> IO ()
 addExportTree h k loc = queueDb h $
 	void $ insertUnique $ ExportTree k ef
   where
-	ef = toSFilePath (fromExportLocation loc)
+	ef = SFilePath (fromExportLocation loc)
 
 removeExportTree :: ExportHandle -> Key -> ExportLocation -> IO ()
 removeExportTree h k loc = queueDb h $
 	deleteWhere [ExportTreeKey ==. k, ExportTreeFile ==. ef]
   where
-	ef = toSFilePath (fromExportLocation loc)
+	ef = SFilePath (fromExportLocation loc)
 
 -- An action that is passed the old and new values that were exported,
 -- and updates state.
@@ -211,7 +211,7 @@ mkExportDiffUpdater removeold addnew h srcek dstek i = do
 		Nothing -> return ()
 		Just k -> liftIO $ addnew h (asKey k) loc
   where
-	loc = mkExportLocation $ getTopFilePath $ Git.DiffTree.file i
+	loc = mkExportLocation $ toRawFilePath $ getTopFilePath $ Git.DiffTree.file i
 
 runExportDiffUpdater :: ExportDiffUpdater -> ExportHandle -> Sha -> Sha -> Annex ()
 runExportDiffUpdater updater h old new = do

Database/Keys.hs

@@ -235,7 +235,7 @@ reconcileStaged qh = do
   where
 	go cur indexcache = do
 		(l, cleanup) <- inRepo $ pipeNullSplit diff
-		changed <- procdiff l False
+		changed <- procdiff (map decodeBL' l) False
 		void $ liftIO cleanup
 		-- Flush database changes immediately
 		-- so other processes can see them.
@@ -262,7 +262,8 @@ reconcileStaged qh = do
 		-- perfect. A file could start with this and not be a
 		-- pointer file. And a pointer file that is replaced with
 		-- a non-pointer file will match this.
-		, Param $ "-G^" ++ toInternalGitPath (pathSeparator:objectDir)
+		, Param $ "-G^" ++ fromRawFilePath (toInternalGitPath $
+			toRawFilePath (pathSeparator:objectDir))
 		-- Don't include files that were deleted, because this only
 		-- wants to update information for files that are present
 		-- in the index.
@@ -277,7 +278,7 @@ reconcileStaged qh = do
 	procdiff (info:file:rest) changed = case words info of
 		((':':_srcmode):dstmode:_srcsha:dstsha:_change:[])
 			-- Only want files, not symlinks
-			| dstmode /= fmtTreeItemType TreeSymlink -> do
+			| dstmode /= decodeBS' (fmtTreeItemType TreeSymlink) -> do
 				maybe noop (reconcile (asTopFilePath file)) 
 					=<< catKey (Ref dstsha)
 				procdiff rest True
@@ -292,11 +293,11 @@ reconcileStaged qh = do
 		caches <- liftIO $ SQL.getInodeCaches key (SQL.ReadHandle qh)
 		keyloc <- calcRepo (gitAnnexLocation key)
 		keypopulated <- sameInodeCache keyloc caches
-		p <- fromRepo $ fromTopFilePath file
-		filepopulated <- sameInodeCache p caches
+		p <- fromRepo $ toRawFilePath . fromTopFilePath file
+		filepopulated <- sameInodeCache (fromRawFilePath p) caches
 		case (keypopulated, filepopulated) of
 			(True, False) ->
-				populatePointerFile (Restage True) key keyloc p >>= \case
+				populatePointerFile (Restage True) key (toRawFilePath keyloc) p >>= \case
 					Nothing -> return ()
 					Just ic -> liftIO $
 						SQL.addInodeCaches key [ic] (SQL.WriteHandle qh)

Database/Types.hs

@@ -18,7 +18,6 @@ module Database.Types (
 import Database.Persist.Class hiding (Key)
 import Database.Persist.Sql hiding (Key)
 import qualified Data.ByteString as S
-import qualified Data.ByteString.Lazy as L
 import qualified Data.Text as T
 import qualified Data.Attoparsec.ByteString as A
 import System.PosixCompat.Types
@@ -35,7 +34,7 @@ import Types.UUID
 import Types.Import
 
 instance PersistField Key where
-	toPersistValue = toPersistValue . L.toStrict . serializeKey'
+	toPersistValue = toPersistValue . serializeKey'
 	fromPersistValue b = fromPersistValue b >>= parse
 	  where
 		parse = either (Left . T.pack) Right . A.parseOnly keyParser