@@ -1,18 +1,22 @@
11{-# LANGUAGE OverloadedStrings #-}
22module ProjectM36.TransactionGraph.Persist where
3+import ProjectM36.Error
4+import ProjectM36.TransactionGraph
5+import ProjectM36.Transaction
6+import ProjectM36.Transaction.Persist
37import ProjectM36.Base
4−import qualified Data.Binary as B
58import System.Directory
9+import System.Posix.Files
610import System.FilePath
11+import System.IO.Temp
712import Data.List
813import qualified Data.UUID as U
914import qualified Data.Set as S
1015import 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
1516import qualified Data.Text as T
17+import Control.Monad (foldM)
18+import Data.Either (isRight)
19+import Data.Maybe (catMaybes)
1620
1721{-
1822The "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
2024
2125-}
2226
23−--as a first pass, just write to the directory as if it's empty
24−--next pass, make the writing incremental by only writing new transactions at the heads
27+transactionLogPath :: FilePath -> FilePath
28+transactionLogPath = (</>) "m36v1"
29+
30+headsDir :: FilePath -> FilePath
31+headsDir = (</>) "heads"
32+
33+{-
34+verify that the database directory is valid or bootstrap it
35+-note: checking for the existence of every transaction may be prohibitively expensive
36+-}
37+
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
43+ return Nothing
44+ else if not m36exists then do
45+ bootstrapDatabaseDir dbdir bootstrapGraph
46+ return Nothing
47+ else
48+ return $ Just (InvalidDirectoryError dbdir)
49+
50+{-
51+initialize a database directory with the graph from which to bootstrap
52+-}
53+bootstrapDatabaseDir :: FilePath -> TransactionGraph -> IO ()
54+bootstrapDatabaseDir dbdir bootstrapGraph = do
55+ createDirectory dbdir
56+ transactionGraphPersist dbdir bootstrapGraph
57+
58+{-
59+incrementally updates an existing database directory
60+--algorithm:
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"
64+-}
2565transactionGraphPersist :: FilePath -> TransactionGraph -> IO ()
2666transactionGraphPersist destDirectory graph = do
27− mapM_ (writeTransaction destDirectory) $ S.toList (transactionsForGraph graph)
67+ mapM_ (writeTransaction destDirectory) $ M.elems (transactionHeadsForGraph graph)
2868 writeGraphUUIDFile destDirectory graph
69+ transactionGraphHeadsPersist destDirectory graph
2970 return ()
3071
72+{-
73+write a head datum to the file system
74+1. create a symlink in a temporary directory
75+2. atomically rename it
76+-}
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
90+
91+
92+{-
93+load any transactions which are not already part of the incoming transaction graph
94+-}
95+
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
102+ case uuidInfo of
103+ Left err -> return $ Left err
104+ Right info -> do
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)
109+
110+{-
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
112+-}
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
118+ else do
119+ trans <- readTransaction dbdir transUUID
120+ case trans of
121+ Left err -> return $ Left err
122+ Right trans' -> return $ Right $ TransactionGraph (transactionHeadsForGraph graphIn) (S.insert trans' (transactionsForGraph graphIn))
123+
31124writeGraphUUIDFile :: FilePath -> TransactionGraph -> IO ()
32125writeGraphUUIDFile destDirectory (TransactionGraph _ transSet) = writeFile graphFile uuidInfo
33126 where
@@ -36,40 +129,12 @@ writeGraphUUIDFile destDirectory (TransactionGraph _ transSet) = writeFile graph
36129 graphLines = S.toList $ S.map graphLine transSet
37130 graphLine trans = U.toString (transactionUUID trans) ++ " " ++ intercalate " " (S.toList (S.map U.toString $ transactionParentUUIDs trans))
38131
39−readGraphUUIDFile :: FilePath -> IO ()
40−readGraphUUIDFile destDirectory = undefined
41−
42−readTransaction :: FilePath -> U.UUID -> IO ()
43−readTransaction destDirectory transUUID = undefined
132+readGraphUUIDFile :: FilePath -> IO (Either PersistenceError [(U.UUID, [U.UUID])])
133+readGraphUUIDFile dbdir = do
134+ --read in all transactions' uuids
135+ let grapher line = let uuids = catMaybes (map U.fromString (words line)) in
136+ (head uuids, tail uuids)
137+ --warning: uses lazy IO
138+ graphUUIDData <- readFile (transactionLogPath dbdir)
139+ return $ Right (map grapher $ lines graphUUIDData)
44140
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]
54− --write relvars
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
62−
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)
67−
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"))
72−
73−writeIncDep :: FilePath -> (IncDepName, InclusionDependency) -> IO ()
74−writeIncDep incDepDir (incDepName, incDep) = do
75− BS.writeFile (incDepDir </> T.unpack incDepName) $ B.encode incDep