Ribosome.hs

{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE FlexibleInstances #-}

module Ribosome.Control.Ribosome(
  Ribosome (..),
  RibosomeInternal (..),
  Locks,
  newRibosome,
  _locks,
  _errors,
  newInternalTVar,
  _internal,
) where

import Control.Lens (makeClassy_)
import Control.Monad.IO.Class (MonadIO)
import Data.Default (def)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map (empty)
import UnliftIO.STM (TVar, newTVarIO, TMVar)

import Ribosome.Data.Errors (Errors)

type Locks = Map String (TMVar ())

data RibosomeInternal =
  RibosomeInternal {
    locks :: Locks,
    errors :: Errors
  }
makeClassy_ ''RibosomeInternal

data Ribosome e =
  Ribosome {
    name :: String,
    internal :: TVar RibosomeInternal,
    env :: e
  }
makeClassy_ ''Ribosome

newInternalTVar :: MonadIO m => m (TVar RibosomeInternal)
newInternalTVar = newTVarIO (RibosomeInternal Map.empty def)

newRibosome :: MonadIO m => String -> e -> m (Ribosome (TVar e))
newRibosome name' env' = do
  envTv <- newTVarIO env'
  intTv <- newInternalTVar
  return $ Ribosome name' intTv envTv