<commit_before>{-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving, RecordWildCards,
    DeriveDataTypeable, MultiParamTypeClasses, FunctionalDependencies,
    FlexibleInstances #-}

module Database.Redis.Core (
    Connection(..), connect,
    ConnectInfo(..), defaultConnectInfo,
    Redis(),runRedis,
    RedisCtx(..), MonadRedis(..),
    send, recv, sendRequest,
    HostName, PortID(..),
    ConnectionLostException(..),
    auth
) where

import Prelude hiding (catch)
import Control.Applicative
import Control.Arrow
import Control.Monad.Reader
import Control.Concurrent (ThreadId, forkIO, killThread)
import Control.Concurrent.BoundedChan
import Control.Exception
import qualified Data.Attoparsec as P
import qualified Data.ByteString as B
import Data.IORef
import Data.Pool
import Data.Time
import Data.Typeable
import Network
import System.IO
import System.IO.Unsafe

import Database.Redis.Protocol
import Database.Redis.Types


--------------------------------------------------------------------------------
-- The Redis Monad
--

-- |Context for normal command execution, outside of transactions. Use
--  'runRedis' to run actions of this type.
--
--  In this context, each result is wrapped in an 'Either' to account for the
--  possibility of Redis returning an 'Error' reply.
newtype Redis a = Redis (ReaderT RedisEnv IO a)
    deriving (Monad, MonadIO, Functor, Applicative)

-- |This class captures the following behaviour: In a context @m@, a command
--  will return it's result wrapped in a \"container\" of type @f@.
--
--  Please refer to the Command Type Signatures section of this page for more
--  information.
class (MonadRedis m) => RedisCtx m f | m -> f where
    returnDecode :: RedisResult a => Reply -> m (f a)

instance RedisCtx Redis (Either Reply) where
    returnDecode = return . decode

class (Monad m) => MonadRedis m where
    liftRedis :: Redis a -> m a

instance MonadRedis Redis where
    liftRedis = id

-- |Interact with a Redis datastore specified by the given 'Connection'.
--
--  Each call of 'runRedis' takes a network connection from the 'Connection'
--  pool and runs the given 'Redis' action. Calls to 'runRedis' may thus block
--  while all connections from the pool are in use.
runRedis :: Connection -> Redis a -> IO a
runRedis (Conn pool) redis =
    withResource pool $ \conn -> runRedisInternal conn redis

-- |Internal version of 'runRedis' that does not depend on the 'Connection'
--  abstraction. Used to run the AUTH command when connecting. 
runRedisInternal :: RedisEnv -> Redis a -> IO a
runRedisInternal env (Redis redis) = runReaderT redis env


--------------------------------------------------------------------------------
-- Redis Environment.
--

-- |The per-connection environment the 'Redis' monad can read from.
--
--  Create with 'newEnv'. Modified by 'recv' and 'send'.
data RedisEnv = Env
    { envHandle   :: Handle            -- ^ Connection socket-handle.
    , envReplies  :: IORef [Reply]     -- ^ Reply thunks.
    , envThunks   :: BoundedChan Reply -- ^ Syncs user and eval threads.
    , envEvalTId  :: ThreadId          -- ^ 'ThreadID' of the evaluator thread.
    }

-- |Create a new 'RedisEnv'
newEnv :: Handle -> IO RedisEnv
newEnv envHandle = do
    replies     <- hGetReplies envHandle
    envReplies  <- newIORef replies
    envThunks   <- newBoundedChan 1000
    envEvalTId  <- forkIO $ forceThunks envThunks
    return Env{..}
  where
    forceThunks thunks = do
        t <- readChan thunks<commit_msg>Document reason for synchronization between user- and evaluator threads.<commit_after>{-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving, RecordWildCards,
    DeriveDataTypeable, MultiParamTypeClasses, FunctionalDependencies,
    FlexibleInstances #-}

module Database.Redis.Core (
    Connection(..), connect,
    ConnectInfo(..), defaultConnectInfo,
    Redis(),runRedis,
    RedisCtx(..), MonadRedis(..),
    send, recv, sendRequest,
    HostName, PortID(..),
    ConnectionLostException(..),
    auth
) where

import Prelude hiding (catch)
import Control.Applicative
import Control.Arrow
import Control.Monad.Reader
import Control.Concurrent (ThreadId, forkIO, killThread)
import Control.Concurrent.BoundedChan
import Control.Exception
import qualified Data.Attoparsec as P
import qualified Data.ByteString as B
import Data.IORef
import Data.Pool
import Data.Time
import Data.Typeable
import Network
import System.IO
import System.IO.Unsafe

import Database.Redis.Protocol
import Database.Redis.Types


--------------------------------------------------------------------------------
-- The Redis Monad
--

-- |Context for normal command execution, outside of transactions. Use
--  'runRedis' to run actions of this type.
--
--  In this context, each result is wrapped in an 'Either' to account for the
--  possibility of Redis returning an 'Error' reply.
newtype Redis a = Redis (ReaderT RedisEnv IO a)
    deriving (Monad, MonadIO, Functor, Applicative)

-- |This class captures the following behaviour: In a context @m@, a command
--  will return it's result wrapped in a \"container\" of type @f@.
--
--  Please refer to the Command Type Signatures section of this page for more
--  information.
class (MonadRedis m) => RedisCtx m f | m -> f where
    returnDecode :: RedisResult a => Reply -> m (f a)

instance RedisCtx Redis (Either Reply) where
    returnDecode = return . decode

class (Monad m) => MonadRedis m where
    liftRedis :: Redis a -> m a

instance MonadRedis Redis where
    liftRedis = id

-- |Interact with a Redis datastore specified by the given 'Connection'.
--
--  Each call of 'runRedis' takes a network connection from the 'Connection'
--  pool and runs the given 'Redis' action. Calls to 'runRedis' may thus block
--  while all connections from the pool are in use.
runRedis :: Connection -> Redis a -> IO a
runRedis (Conn pool) redis =
    withResource pool $ \conn -> runRedisInternal conn redis

-- |Internal version of 'runRedis' that does not depend on the 'Connection'
--  abstraction. Used to run the AUTH command when connecting. 
runRedisInternal :: RedisEnv -> Redis a -> IO a
runRedisInternal env (Redis redis) = runReaderT redis env


--------------------------------------------------------------------------------
-- Redis Environment.
--

-- |The per-connection environment the 'Redis' monad can read from.
--
--  Create with 'newEnv'. Modified by 'recv' and 'send'.
data RedisEnv = Env
    { envHandle   :: Handle            -- ^ Connection socket-handle.
    , envReplies  :: IORef [Reply]     -- ^ Reply thunks.
    , envThunks   :: BoundedChan Reply -- ^ Syncs user and eval threads.
    , envEvalTId  :: ThreadId          -- ^ 'ThreadID' of the evaluator thread.
    }

-- |Create a new 'RedisEnv'
newEnv :: Handle -> IO RedisEnv
newEnv envHandle = do
    replies     <- hGetReplies envHandle
    envReplies  <- newIORef replies
    envThunks   <- newBoundedChan 1000
    envEvalTId  <- forkIO $ forceThunks envThunks
    return Env{..}
  where
    forceThunks thunks = do
        -- We must wait for a reply to become available. Otherwise we will
        -- flush the output buffer (in hGetReplies) before a command is written
        -- by the user thread, creating a deadlock.
        t <- readChan thunks
{'fraction_non_alphanumeric': 0.13215071507150716, 'fraction_numerical': 0.0011001100110011, 'mean_word_length': 2.737410071942446, 'pattern_counts': {'":': 0, '<': 13, '<?xml version=': 0, '>': 27, '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': '5294362', 'n_tokens_mistral': 2148, 'n_tokens_neox': 2081, 'n_words': 789}