{-# 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 :: Map k v -> STM [(k, v)]
stmMapToList = FoldM STM (k, v) [(k, v)] -> UnfoldlM STM (k, v) -> STM [(k, v)]
forall (m :: * -> *) input output.
Monad m =>
FoldM m input output -> UnfoldlM m input -> m output
UF.foldM (Fold (k, v) [(k, v)] -> FoldM STM (k, v) [(k, v)]
forall (m :: * -> *) a b. Monad m => Fold a b -> FoldM m a b
Foldl.generalize Fold (k, v) [(k, v)]
forall a. Fold a [a]
Foldl.list) (UnfoldlM STM (k, v) -> STM [(k, v)])
-> (Map k v -> UnfoldlM STM (k, v)) -> Map k v -> STM [(k, v)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k v -> UnfoldlM STM (k, v)
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 :: Set v -> STM [v]
stmSetToList = FoldM STM v [v] -> UnfoldlM STM v -> STM [v]
forall (m :: * -> *) input output.
Monad m =>
FoldM m input output -> UnfoldlM m input -> m output
UF.foldM (Fold v [v] -> FoldM STM v [v]
forall (m :: * -> *) a b. Monad m => Fold a b -> FoldM m a b
Foldl.generalize Fold v [v]
forall a. Fold a [a]
Foldl.list) (UnfoldlM STM v -> STM [v])
-> (Set v -> UnfoldlM STM v) -> Set v -> STM [v]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set v -> UnfoldlM STM v
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 = Text -> Atom
TextAtom (Text -> Atom) -> (UUID -> Text) -> UUID -> Atom
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> Text
U.toText

sessionsAsRelation :: Sessions -> STM (Either RelationalError Relation)
sessionsAsRelation :: Sessions -> STM (Either RelationalError Relation)
sessionsAsRelation Sessions
sessions = do
  [(UUID, Session)]
sessionAssocs <- Sessions -> STM [(UUID, Session)]
forall k v. Map k v -> STM [(k, v)]
stmMapToList Sessions
sessions
  let atomMatrix :: [[Atom]]
atomMatrix = ((UUID, Session) -> [Atom]) -> [(UUID, Session)] -> [[Atom]]
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
  Either RelationalError Relation
-> STM (Either RelationalError Relation)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RelationalError Relation
 -> STM (Either RelationalError Relation))
-> Either RelationalError Relation
-> STM (Either RelationalError Relation)
forall a b. (a -> b) -> a -> b
$ Attributes -> [[Atom]] -> Either RelationalError Relation
mkRelationFromList ([Attribute] -> Attributes
attributesFromList [Text -> AtomType -> Attribute
Attribute Text
"sessionid" AtomType
TextAtomType,
                             Text -> AtomType -> Attribute
Attribute Text
"parentCommit" AtomType
TextAtomType]) [[Atom]]
atomMatrix