<commit_before>module Program.Mighty.State (
  -- * Types
    Status(..)
  , State(..)
  , Two(..)
  , Stater
  -- * Creating Starter
  , initStater
  -- * Accessing Starter
  , getConnectionCounter
  , getServerStatus
  , isRetiring
  -- * Modifying Starter
  , increment
  , decrement
  , setMyWarpThreadId
  , addAnotherWarpThreadId
  , goRetiring
  -- * Misc
  , ifWarpThreadsAreActive
  ) where

import Control.Applicative
import Control.Concurrent
import Data.IORef
import Program.Mighty.IORef

----------------------------------------------------------------

-- | Server status
data Status = Serving | Retiring deriving (Eq, Show)

-- | FIXME
data Two a = Zero | One a | Two a a

-- | FIXME
data State = State {
    connectionCounter :: !Int
  , serverStatus      :: !Status
  , warpThreadId      :: !(Two ThreadId)
  }

initialState :: State
initialState = State 0 Serving Zero

----------------------------------------------------------------

-- | Reference to a server state.
newtype Stater = Stater (IORef State)

-- | Creating a new 'Stater'.
initStater :: IO Stater
initStater = Stater <$> newIORef initialState

----------------------------------------------------------------

getConnectionCounter :: Stater -> IO Int
getConnectionCounter (Stater sref) = connectionCounter <$> readIORef sref

increment :: Stater -> IO ()
increment (Stater sref) =
    strictAtomicModifyIORef sref $ \st -> st {
        connectionCounter = connectionCounter st + 1
      }

decrement :: Stater -> IO ()
decrement (Stater sref) =
    strictAtomicModifyIORef sref $ \st -> st {
        connectionCounter = connectionCounter st - 1
      }

----------------------------------------------------------------

getServerStatus :: Stater -> IO Status
getServerStatus (Stater sref) = serverStatus <$> readIORef sref

isRetiring :: Stater -> IO Bool
isRetiring stt = (== Retiring) <$> getServerStatus stt

goRetiring :: Stater -> IO ()
goRetiring (Stater sref) =
    strictAtomicModifyIORef sref $ \st -> st {
        serverStatus = Retiring
      , warpThreadId = Zero
      }

----------------------------------------------------------------

getWarpThreadId :: Stater -> IO (Two ThreadId)
getWarpThreadId (Stater sref) = warpThreadId <$> readIORef sref

setWarpThreadId :: Stater -> Two ThreadId -> IO ()
setWarpThreadId (Stater sref) ttids =
    strictAtomicModifyIORef sref $ \st -> st {
        warpThreadId = ttids
      }

setMyWarpThreadId :: Stater -> IO ()
setMyWarpThreadId stt = do
    myid <- myThreadId
    setWarpThreadId stt (One myid)

addAnotherWarpThreadId :: Stater -> ThreadId -> IO ()
addAnotherWarpThreadId stt aid = do
    ttids <- getWarpThreadId stt
    case ttids of
        One tid -> setWarpThreadId stt (Two tid aid)
        _       -> undefined -- FIXME

-- | If Warp threads are active, first terminate them and
--   run new 'IO'.
ifWarpThreadsAreActive :: Stater -> IO () -> IO ()
ifWarpThreadsAreActive stt act = do
    ttids <- getWarpThreadId stt
    case ttids of
        Zero -> return ()
        One tid -> do
            killThread tid
            act
        Two tid1 tid2 -> do
            killThread tid1
            killThread tid2
            act<commit_msg>removing fixme from State.<commit_after>module Program.Mighty.State (
  -- * Types
    Status(..)
  , Stater
  -- * Creating Stater
  , initStater
  -- * Accessing Stater
  , getConnectionCounter
  , getServerStatus
  , isRetiring
  -- * Modifying Stater
  , increment
  , decrement
  , setMyWarpThreadId
  , addAnotherWarpThreadId
  , goRetiring
  -- * Misc
  , ifWarpThreadsAreActive
  ) where

import Control.Applicative
import Control.Concurrent
import Data.IORef
import Program.Mighty.IORef

----------------------------------------------------------------

-- | Server status
data Status = Serving | Retiring deriving (Eq, Show)

data Two a = Zero | One a | Two a a

data State = State {
    connectionCounter :: !Int
  , serverStatus      :: !Status
  , warpThreadId      :: !(Two ThreadId)
  }

initialState :: State
initialState = State 0 Serving Zero

----------------------------------------------------------------

-- | Reference to a server state.
newtype Stater = Stater (IORef State)

-- | Creating a new 'Stater'.
initStater :: IO Stater
initStater = Stater <$> newIORef initialState

----------------------------------------------------------------

getConnectionCounter :: Stater -> IO Int
getConnectionCounter (Stater sref) = connectionCounter <$> readIORef sref

increment :: Stater -> IO ()
increment (Stater sref) =
    strictAtomicModifyIORef sref $ \st -> st {
        connectionCounter = connectionCounter st + 1
      }

decrement :: Stater -> IO ()
decrement (Stater sref) =
    strictAtomicModifyIORef sref $ \st -> st {
        connectionCounter = connectionCounter st - 1
      }

----------------------------------------------------------------

getServerStatus :: Stater -> IO Status
getServerStatus (Stater sref) = serverStatus <$> readIORef sref

isRetiring :: Stater -> IO Bool
isRetiring stt = (== Retiring) <$> getServerStatus stt

-- | Setting status to 'Retiring'.
goRetiring :: Stater -> IO ()
goRetiring (Stater sref) =
    strictAtomicModifyIORef sref $ \st -> st {
        serverStatus = Retiring
      , warpThreadId = Zero
      }

----------------------------------------------------------------

getWarpThreadId :: Stater -> IO (Two ThreadId)
getWarpThreadId (Stater sref) = warpThreadId <$> readIORef sref

setWarpThreadId :: Stater -> Two ThreadId -> IO ()
setWarpThreadId (Stater sref) ttids =
    strictAtomicModifyIORef sref $ \st -> st {
        warpThreadId = ttids
      }

setMyWarpThreadId :: Stater -> IO ()
setMyWarpThreadId stt = do
    myid <- myThreadId
    setWarpThreadId stt (One myid)

addAnotherWarpThreadId :: Stater -> ThreadId -> IO ()
addAnotherWarpThreadId stt aid = do
    ttids <- getWarpThreadId stt
    case ttids of
        One tid -> setWarpThreadId stt (Two tid aid)
        _       -> error "addAnotherWarpThreadId"

-- | If Warp threads are active, first terminate them and
--   run new 'IO'.
ifWarpThreadsAreActive :: Stater -> IO () -> IO ()
ifWarpThreadsAreActive stt act = do
    ttids <- getWarpThreadId stt
    case ttids of
        Zero -> return ()
        One tid -> do
            killThread tid
            act
        Two tid1 tid2 -> do
            killThread tid1
            killThread tid2
            act
{'fraction_non_alphanumeric': 0.1864936689073003, 'fraction_numerical': 0.002188525871502267, 'mean_word_length': 1.9254686785550983, 'pattern_counts': {'":': 0, '<': 19, '<?xml version=': 0, '>': 59, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5594293', 'n_tokens_mistral': 1925, 'n_tokens_neox': 1872, 'n_words': 534}