@@ -0,0 +1,29 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+module ProjectM36.Sessions where
3+import Control.Concurrent.STM
4+import qualified STMContainers.Map as STMMap
5+import ListT
6+import ProjectM36.Attribute
7+import ProjectM36.Base
8+import ProjectM36.Atom
9+import ProjectM36.Session
10+import ProjectM36.Relation
11+import ProjectM36.Error
12+import qualified Data.UUID as U
13+
14+type Sessions = STMMap.Map SessionId Session
15+
16+stmMapToList :: STMMap.Map k v -> STM [(k, v)]
17+stmMapToList = ListT.fold (\l -> return . (:l)) [] . STMMap.stream
18+
19+uuidAtom :: U.UUID -> Atom
20+uuidAtom = stringAtom . U.toText
21+
22+sessionsAsRelation :: Sessions -> STM (Either RelationalError Relation)
23+sessionsAsRelation sessions = do
24+ sessionAssocs <- stmMapToList sessions
25+ let atomMatrix = map (\(sessionId, (Session (DisconnectedTransaction parentUUID _))) -> [uuidAtom sessionId, uuidAtom parentUUID]) sessionAssocs
26+ pure $ mkRelationFromList (attributesFromList [Attribute "sessionid" stringAtomType,
27+ Attribute "parentCommit" stringAtomType]) atomMatrix
28+
29+