{-# LANGUAGE PackageImports #-}
module ProjectM36.Sessions where
import Control.Concurrent.STM
#if MIN_VERSION_stm_containers(1,0,0)
import qualified StmContainers.Map as StmMap
import qualified StmContainers.Set as StmSet
#else
import qualified STMContainers.Map as StmMap
import qualified STMContainers.Set as StmSet
#endif 
import ProjectM36.Attribute
import ProjectM36.Base
import ProjectM36.Session
import ProjectM36.Relation
import ProjectM36.Error
import qualified Data.UUID as U
#if MIN_VERSION_stm_containers(1,0,0)
import qualified Control.Foldl as Foldl
import qualified DeferredFolds.UnfoldlM as UF
#else
import "list-t" ListT
#endif

type Sessions = StmMap.Map SessionId Session

--from https://github.com/nikita-volkov/stm-containers/blob/master/test/Main/MapTests.hs
stmMapToList :: StmMap.Map k v -> STM [(k, v)]
#if MIN_VERSION_stm_containers(1,0,0)
stmMapToList :: forall k v. Map k v -> STM [(k, v)]
stmMapToList = forall (m :: * -> *) input output.
Monad m =>
FoldM m input output -> UnfoldlM m input -> m output
UF.foldM (forall (m :: * -> *) a b. Monad m => Fold a b -> FoldM m a b
Foldl.generalize forall a. Fold a [a]
Foldl.list) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall key value. Map key value -> UnfoldlM STM (key, value)
StmMap.unfoldlM
#else
stmMapToList = ListT.fold (\l -> return . (:l)) [] . StmMap.stream
#endif

stmSetToList :: StmSet.Set v -> STM [v]
#if MIN_VERSION_stm_containers(1,0,0)
stmSetToList :: forall v. Set v -> STM [v]
stmSetToList = forall (m :: * -> *) input output.
Monad m =>
FoldM m input output -> UnfoldlM m input -> m output
UF.foldM (forall (m :: * -> *) a b. Monad m => Fold a b -> FoldM m a b
Foldl.generalize forall a. Fold a [a]
Foldl.list) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall item. Set item -> UnfoldlM STM item
StmSet.unfoldlM
#else
stmSetToList = ListT.fold (\l -> return . (:l)) [] . StmSet.stream
#endif

uuidAtom :: U.UUID -> Atom
uuidAtom :: UUID -> Atom
uuidAtom = AttributeName -> Atom
TextAtom forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> AttributeName
U.toText

sessionsAsRelation :: Sessions -> STM (Either RelationalError Relation)
sessionsAsRelation :: Sessions -> STM (Either RelationalError Relation)
sessionsAsRelation Sessions
sessions = do
  [(UUID, Session)]
sessionAssocs <- forall k v. Map k v -> STM [(k, v)]
stmMapToList Sessions
sessions
  let atomMatrix :: [[Atom]]
atomMatrix = forall a b. (a -> b) -> [a] -> [b]
map (\(UUID
sessionId, Session
session) -> [UUID -> Atom
uuidAtom UUID
sessionId, UUID -> Atom
uuidAtom (Session -> UUID
parentId Session
session)]) [(UUID, Session)]
sessionAssocs
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Attributes -> [[Atom]] -> Either RelationalError Relation
mkRelationFromList ([Attribute] -> Attributes
attributesFromList [AttributeName -> AtomType -> Attribute
Attribute AttributeName
"sessionid" AtomType
TextAtomType,
                             AttributeName -> AtomType -> Attribute
Attribute AttributeName
"parentCommit" AtomType
TextAtomType]) [[Atom]]
atomMatrix