Ribosome.hs

{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveAnyClass #-}

module Ribosome.Control.Ribosome where

import Control.Lens (makeClassy)
import Control.Monad.IO.Class (MonadIO)
import Data.Default (Default(def))
import Data.Functor.Syntax ((<$$>))
import Data.Map (Map)
import Data.MessagePack (Object)
import GHC.Generics (Generic)
import UnliftIO.STM (TMVar, TMVar, newTMVarIO)

import Path (Abs, Dir, Path)
import Ribosome.Data.Errors (Errors)
import Ribosome.Data.Scratch (Scratch)

type Locks = Map Text (TMVar ())

data RibosomeInternal =
  RibosomeInternal {
    _locks :: Locks,
    _errors :: Errors,
    _scratch :: Map Text Scratch,
    _watchedVariables :: Map Text Object,
    _projectDir :: Maybe (Path Abs Dir)
  }
  deriving (Generic, Default)

makeClassy ''RibosomeInternal

data RibosomeState s =
  RibosomeState {
    _internal :: RibosomeInternal,
    _public :: s
  }
  deriving (Generic, Default)

makeClassy ''RibosomeState

data Ribosome s =
  Ribosome {
    _name :: Text,
    _state :: TMVar (RibosomeState s)
  }

makeClassy ''Ribosome

newRibosomeTMVar :: MonadIO m => s -> m (TMVar (RibosomeState s))
newRibosomeTMVar s =
  newTMVarIO (RibosomeState def s)

newRibosome :: MonadIO m => Text -> s -> m (Ribosome s)
newRibosome name' =
  Ribosome name' <$$> newRibosomeTMVar