<commit_before>-- Example of Multiple Type Binding

{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}

import Control.Monad.State (MonadState)
import Control.Monad.State (gets)
import Control.Monad.State (modify)
import Control.Monad.State (State)
import Control.Monad.State (runState)
import Control.Monad.State (evalState)
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import Data.Set (Set)
import qualified Data.Set as Set


class MonadState s m => Binding m s v where
  type family Var m s v :: *
  newVar    :: v         -> m (Var m s v)
  lookupVar :: Var m s v -> m v
  updateVar :: Var m s v -> v -> m ()


data IMEnv =
  IMEnv
  { fdINextId :: IMVarId
  , fdIMap :: IntMap Int
  , fdBNextId :: IMVarId
  , fdBMap :: IntMap Bool }
  deriving (Show)

data IMVar v = IMVar { imVarId :: IMVarId } deriving (Show, Eq)

initState :: IMEnv
initState =
  IMEnv
  { fdINextId = 0
  , fdIMap    = IntMap.empty
  , fdBNextId = 0
  , fdBMap    = IntMap.empty }

type IMVarId = IntMap.Key

instance MonadState IMEnv m => Binding m IMEnv Int where
  type Var m IMEnv Int = IMVar Int
  newVar v = do
    vid <- gets fdINextId
    modify $ \s -> s { fdINextId = vid + 1 }
    let var = IMVar vid
    updateVar var v
    return var
  lookupVar (IMVar vid) = do
    si <- gets fdIMap
    return $ si IntMap.! vid
  updateVar (IMVar vid) v = do
    si <- gets fdIMap
    modify $ \s -> s { fdIMap = IntMap.insert vid v si }

instance MonadState IMEnv m => Binding m IMEnv Bool where
  type Var m IMEnv Bool = IMVar Bool
  newVar v = do
    vid <- gets fdBNextId
    modify $ \s -> s { fdBNextId = vid + 1 }
    let var = IMVar vid
    updateVar var v
    return var
  lookupVar (IMVar vid) = do
    si <- gets fdBMap
    return $ si IntMap.! vid
  updateVar (IMVar vid) v = do
    sb <- gets fdBMap
    modify $ \s -> s { fdBMap = IntMap.insert vid v sb }

prog :: State IMEnv ((Int, Bool), (Int, Bool))
prog = do
  vi <- newVar (123::Int)
  vb <- newVar True
  i1 <- lookupVar vi
  b1 <- lookupVar vb
  updateVar vi (456::Int)
  updateVar vb False
  i2 <- lookupVar vi
  b2 <- lookupVar vb
  return ((i1, b1), (i2, b2))

{-|
>>> test
(((123,True),(456,False)),IMEnv {fdINextId = 1, fdIMap = fromList [(0,456)], fdBNextId = 1, fdBMap = fromList [(0,False)]})
-}
test :: (((Int, Bool), (Int, Bool)), IMEnv)
test = runState prog initState<commit_msg>Example of Multiple Type Binding<commit_after>-- Example of Multiple Type Binding

{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

import Control.Monad.State (MonadState)
import Control.Monad.State (gets)
import Control.Monad.State (modify)
import Control.Monad.State (State)
import Control.Monad.State (runState)
import Control.Monad.State (evalState)
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import Data.Set (Set)
import qualified Data.Set as Set

-- Interface for variable binding

class MonadState s m => Binding m s v where
  type family Var m s v :: *
  newVar    :: v         -> m (Var m s v)
  lookupVar :: Var m s v -> m v
  updateVar :: Var m s v -> v -> m ()

-- An implementation of binding with IntMap

data IMEnv =
  IMEnv
  { fdNextId :: IMVarId
  , fdIMap :: IntMap Int
  , fdBMap :: IntMap Bool }
  deriving (Show)

data IMVar v = IMVar { imVarId :: IMVarId } deriving (Show, Eq)

initIMEnv :: IMEnv
initIMEnv =
  IMEnv
  { fdNextId = 0
  , fdIMap    = IntMap.empty
  , fdBMap    = IntMap.empty }

type IMVarId = IntMap.Key

class MonadState IMEnv m => IMBinding m v where
  getMap :: m (IntMap v)
  setMap :: IntMap v -> m ()

instance IMBinding m v => Binding m IMEnv v where
  type Var m IMEnv v = IMVar v
  newVar v = do
    vid <- gets fdNextId
    modify $ \s -> s { fdNextId = vid + 1 }
    let var = IMVar vid
    updateVar var v
    return var
  lookupVar (IMVar vid) = do
    si <- getMap
    return $ si IntMap.! vid
  updateVar (IMVar vid) v = do
    si <- getMap
    setMap $ IntMap.insert vid v si

-- Declaration per type

instance MonadState IMEnv m => IMBinding m Int where
  getMap = gets fdIMap
  setMap m = modify $ \s -> s { fdIMap = m }

instance MonadState IMEnv m => IMBinding m Bool where
  getMap = gets fdBMap
  setMap m = modify $ \s -> s { fdBMap = m }

-- Example for use

prog :: State IMEnv ((Int, Bool), (Int, Bool))
prog = do
  vi <- newVar 123
  vb <- newVar True
  i1 <- lookupVar vi
  b1 <- lookupVar vb
  updateVar vi 456
  updateVar vb False
  i2 <- lookupVar vi
  b2 <- lookupVar vb
  return ((i1, b1), (i2, b2))

{-|
>>> test
(((123,True),(456,False)),IMEnv {fdNextId = 2, fdIMap = fromList [(0,456)], fdBMap = fromList [(1,False)]})
-}
test :: (((Int, Bool), (Int, Bool)), IMEnv)
test = runState prog initIMEnv
{'fraction_non_alphanumeric': 0.11763498254978444, 'fraction_numerical': 0.012112502566208171, 'mean_word_length': 2.9069767441860463, 'pattern_counts': {'":': 0, '<': 24, '<?xml version=': 0, '>': 33, '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': '1956959', 'n_tokens_mistral': 1879, 'n_tokens_neox': 1754, 'n_words': 620}