@@ -1,18 +1,22 @@
1{-# LANGUAGE OverloadedStrings #-}
1{-# LANGUAGE OverloadedStrings #-}
2module ProjectM36.TransactionGraph.Persist where
2module ProjectM36.TransactionGraph.Persist where
3+import ProjectM36.Error
4+import ProjectM36.TransactionGraph
5+import ProjectM36.Transaction
6+import ProjectM36.Transaction.Persist
3import ProjectM36.Base
7import ProjectM36.Base
4−import qualified Data.Binary as B
5import System.Directory
8import System.Directory
9+import System.Posix.Files
6import System.FilePath
10import System.FilePath
7import Data.List
12import Data.List
8import qualified Data.UUID as U
13import qualified Data.UUID as U
9import qualified Data.Set as S
14import qualified Data.Set as S
10import qualified Data.Map as M
15import qualified Data.Map as M
11−import qualified Data.HashSet as HS
12−import ProjectM36.Transaction
13−import qualified Data.ByteString.Lazy as BS
14−import qualified Data.Text.Encoding as TE
15import qualified Data.Text as T
16import qualified Data.Text as T
17+import Control.Monad (foldM)
18+import Data.Either (isRight)
19+import Data.Maybe (catMaybes)
18The "m36v1" file at the top-level of the destination directory contains the the transaction graph as a set of UUIDs referencing their parents (1 or more)
22The "m36v1" file at the top-level of the destination directory contains the the transaction graph as a set of UUIDs referencing their parents (1 or more)
@@ -20,14 +24,103 @@ Each Transaction is written to it own directory named by its UUID. Partially wri
23−--as a first pass, just write to the directory as if it's empty
27+transactionLogPath :: FilePath -> FilePath
24−--next pass, make the writing incremental by only writing new transactions at the heads
28+transactionLogPath = (</>) "m36v1"
30+headsDir :: FilePath -> FilePath
31+headsDir = (</>) "heads"
34+verify that the database directory is valid or bootstrap it
35+-note: checking for the existence of every transaction may be prohibitively expensive
38+setupDatabaseDir :: FilePath -> TransactionGraph -> IO (Maybe PersistenceError)
39+setupDatabaseDir dbdir bootstrapGraph = do
40+ dbdirExists <- doesDirectoryExist dbdir
41+ m36exists <- doesFileExist (transactionLogPath dbdir)
42+ if dbdirExists && m36exists then
44+ else if not m36exists then do
45+ bootstrapDatabaseDir dbdir bootstrapGraph
48+ return $ Just (InvalidDirectoryError dbdir)
51+initialize a database directory with the graph from which to bootstrap
53+bootstrapDatabaseDir :: FilePath -> TransactionGraph -> IO ()
54+bootstrapDatabaseDir dbdir bootstrapGraph = do
55+ createDirectory dbdir
56+ transactionGraphPersist dbdir bootstrapGraph
59+incrementally updates an existing database directory
61+-check that all heads have been written
62+-assume that all non-head transactions have already been written because this is an incremental (and concurrent!) write method
63+--store the head names with a symlink to the transaction under "heads"
25transactionGraphPersist :: FilePath -> TransactionGraph -> IO ()
65transactionGraphPersist :: FilePath -> TransactionGraph -> IO ()
26transactionGraphPersist destDirectory graph = do
66transactionGraphPersist destDirectory graph = do
27− mapM_ (writeTransaction destDirectory) $ S.toList (transactionsForGraph graph)
67+ mapM_ (writeTransaction destDirectory) $ M.elems (transactionHeadsForGraph graph)
28 writeGraphUUIDFile destDirectory graph
68 writeGraphUUIDFile destDirectory graph
69+ transactionGraphHeadsPersist destDirectory graph
73+write a head datum to the file system
74+1. create a symlink in a temporary directory
75+2. atomically rename it
77+--should updating all the heads be atomic (create temp directory and new symlinks for every persistence?
78+transactionGraphHeadsPersist :: FilePath -> TransactionGraph -> IO ()
79+transactionGraphHeadsPersist dbdir graph = do
80+ let writeHead headsPath (headName, trans) = do
81+ let symlinkPath = ".." </> U.toString (transactionUUID trans)
82+ createSymbolicLink symlinkPath (headsPath </> T.unpack headName)
83+ finalHeadsDir = headsDir dbdir
84+ withTempDirectory dbdir ".headsdir.XXXXX" $ \newHeadsDir -> do
85+ let tempHeadsDir = (newHeadsDir </> "heads")
86+ createDirectory tempHeadsDir
87+ mapM_ (writeHead tempHeadsDir) $ M.toList (transactionHeadsForGraph graph)
88+ --move the new heads dir into place atomically
89+ renameDirectory tempHeadsDir finalHeadsDir
93+load any transactions which are not already part of the incoming transaction graph
96+--ALERT I need to figure out how to manage the transaction heads (branch names)
97+transactionGraphLoad :: FilePath -> TransactionGraph -> IO (Either PersistenceError TransactionGraph)
98+transactionGraphLoad dbdir graphIn = do
99+ --optimization: perform tail-bisection search to find last-recorded transaction in the existing stream- replay the rest
100+ --read in all missing transactions from transaction directories and add to graph
101+ uuidInfo <- readGraphUUIDFile dbdir
103+ Left err -> return $ Left err
105+ let folder = \eitherGraph transUUID -> case eitherGraph of
106+ Left err -> return $ Left err
107+ Right graph -> readTransactionIfNecessary dbdir transUUID graph
108+ foldM folder (Right graphIn) (map fst info)
111+if the transaction with the UUID argument is not yet part of the graph, then read the transaction and add it - this does not update the heads
113+readTransactionIfNecessary :: FilePath -> U.UUID -> TransactionGraph -> IO (Either PersistenceError TransactionGraph)
114+readTransactionIfNecessary dbdir transUUID graphIn = do
115+ if isRight $ transactionForUUID transUUID graphIn then
116+ --the transaction is already known and loaded- done
117+ return $ Right graphIn
119+ trans <- readTransaction dbdir transUUID
121+ Left err -> return $ Left err
122+ Right trans' -> return $ Right $ TransactionGraph (transactionHeadsForGraph graphIn) (S.insert trans' (transactionsForGraph graphIn))
31writeGraphUUIDFile :: FilePath -> TransactionGraph -> IO ()
124writeGraphUUIDFile :: FilePath -> TransactionGraph -> IO ()
32writeGraphUUIDFile destDirectory (TransactionGraph _ transSet) = writeFile graphFile uuidInfo
125writeGraphUUIDFile destDirectory (TransactionGraph _ transSet) = writeFile graphFile uuidInfo
@@ -36,40 +129,12 @@ writeGraphUUIDFile destDirectory (TransactionGraph _ transSet) = writeFile graph
36 graphLines = S.toList $ S.map graphLine transSet
129 graphLines = S.toList $ S.map graphLine transSet
37 graphLine trans = U.toString (transactionUUID trans) ++ " " ++ intercalate " " (S.toList (S.map U.toString $ transactionParentUUIDs trans))
130 graphLine trans = U.toString (transactionUUID trans) ++ " " ++ intercalate " " (S.toList (S.map U.toString $ transactionParentUUIDs trans))
39−readGraphUUIDFile :: FilePath -> IO ()
132+readGraphUUIDFile :: FilePath -> IO (Either PersistenceError [(U.UUID, [U.UUID])])
40−readGraphUUIDFile destDirectory = undefined
133+readGraphUUIDFile dbdir = do
41−
134+ --read in all transactions' uuids
42−readTransaction :: FilePath -> U.UUID -> IO ()
135+ let grapher line = let uuids = catMaybes (map U.fromString (words line)) in
43−readTransaction destDirectory transUUID = undefined
136+ (head uuids, tail uuids)
137+ --warning: uses lazy IO
138+ graphUUIDData <- readFile (transactionLogPath dbdir)
139+ return $ Right (map grapher $ lines graphUUIDData)
45−writeTransaction :: FilePath -> Transaction -> IO ()
46−writeTransaction destDirectory trans = do
47− let tempDestDir = takeDirectory destDirectory </> "." ++ takeFileName destDirectory
48− relvarsDir = tempDestDir </> "relvars"
49− incDepsDir = tempDestDir </> "incdeps"
50− atomFuncsDir = tempDestDir </> "atomfuncs"
51− context = transactionContext trans
52− --create sub directories
53− mapM_ createDirectory [tempDestDir, relvarsDir, incDepsDir, atomFuncsDir]
55− mapM_ (writeRelVar relvarsDir) $ M.toList (relationVariables context)
56− --write inclusion dependencies
57− mapM_ (writeIncDep incDepsDir) $ M.toList (inclusionDependencies context)
58− --write atom functions
59− mapM_ (writeAtomFunc atomFuncsDir) $ HS.toList (atomFunctions context)
60− --move the temp directory to final location
61− renameDirectory tempDestDir destDirectory
63−writeRelVar :: FilePath -> (RelVarName, Relation) -> IO ()
64−writeRelVar relvarDestDir (relvarName, rel) = do
65− let relvarPath = relvarDestDir </> T.unpack relvarName
66− BS.writeFile relvarPath (B.encode rel)
68−--to write the atom functions, we really some bytecode to write (GHCi bytecode?)
69−writeAtomFunc :: FilePath -> AtomFunction -> IO ()
70−writeAtomFunc atomFuncDestDir func = do
71− BS.appendFile (atomFuncDestDir </> "atomFuncs") $ BS.fromStrict (TE.encodeUtf8 (atomFuncName func `T.append` "\n"))
73−writeIncDep :: FilePath -> (IncDepName, InclusionDependency) -> IO ()
74−writeIncDep incDepDir (incDepName, incDep) = do
75− BS.writeFile (incDepDir </> T.unpack incDepName) $ B.encode incDep