<commit_before>{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}

module Reflex.Switching where


import Reflex.Class hiding (constant)
import Reflex.Updated

import Data.Map.Strict (Map)

import Control.Monad
import Control.Monad.Fix
import Data.Semigroup
import Data.Maybe
import Data.Foldable

import Prelude


class (Reflex t) => Switching t r  where
   -- | Generalization of switchable reactive types (e.g. Event, Behavior)
   switching :: MonadHold t m => r -> Event t r -> m r
   
class (Switching t r, Monoid r) => SwitchMerge t r  where   
   switchMerge :: (MonadFix m, MonadHold t m, Ord k) => Map k r -> Event t (Map k (Maybe r)) -> m r


instance (Switching t a, Switching t b) => Switching t (a, b) where
  switching (a, b) e = liftM2 (,) (switching a $ fst <$> e) (switching b $ snd <$> e)
  
  
instance (SwitchMerge t a, SwitchMerge t b) => SwitchMerge t (a, b) where
  switchMerge initial e = do
    a <- switchMerge (fst <$> initial) (fmap (fmap fst) <$> e)
    b <- switchMerge (snd <$> initial) (fmap (fmap snd) <$> e)
    return (a, b)


-- This will hopefully become a primitive (faster!)
switchMergeEvents ::  (MonadFix m, MonadHold t m, Reflex t, Ord k) =>  UpdatedMap t k (Event t a) -> m (Event t (Map k a))
switchMergeEvents mapChanges = switch . fmap mergeMap  <$> holdMap mapChanges 


instance (Semigroup a, Reflex t) => SwitchMerge t (Event t a) where
  switchMerge initial updates = fmap (foldl1 (<>)) <$> switchMergeEvents (UpdatedMap initial updates)
  
instance (Semigroup a, Reflex t) => SwitchMerge t [Event t a] where
  switchMerge initial updates = pure <$> switchMerge' (mergeWith (<>) <$> UpdatedMap initial updates)

  
instance (Monoid a, Reflex t) => SwitchMerge t (Behavior t a) where
  switchMerge initial updates = pull <$> joinMap <$> holdMap (UpdatedMap initial updates)
    where joinMap m = sample =<< fold <$> sample m
  
  
instance (Monoid a, Reflex t) => SwitchMerge t [Behavior t a] where
  switchMerge initial updates = pure <$> switchMerge' (mconcat <$> UpdatedMap initial updates)  
  
instance (Reflex t) => SwitchMerge t () where
  switchMerge _ _ = pure ()  

instance (Monoid a, Reflex t) => Switching t [Behavior t a]  where
  switching bs updates = pure <$> switching (mconcat bs) (mconcat <$> updates)

instance (Semigroup a, Reflex t) => Switching t [Event t a] where
  switching es updates = pure <$> switching (mergeWith (<>) es) (mergeWith (<>) <$> updates)
  
    
instance (Monoid a, Reflex t) => Switching t (Behavior t a)  where
  switching = switcher
    
instance (Semigroup a, Reflex t) => Switching t (Event t a) where
  switching e updates = switch <$> hold e updates
    
instance (Reflex t) => Switching t () where
  switching _ _ = pure ()
  
switchMerge' :: (Reflex t, SwitchMerge t r, MonadFix m, MonadHold t m, Ord k) => UpdatedMap t k r -> m r 
switchMerge' (UpdatedMap initial e) = switchMerge initial e  

switching' :: (Reflex t, Switching t r, MonadFix m, MonadHold t m) => Updated t r -> m r 
switching' (Updated initial e) = switching initial e  


<commit_msg>Generalize Switching instances for [a]<commit_after>{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}

module Reflex.Switching where


import Reflex.Class hiding (constant)
import Reflex.Updated

import Data.Map.Strict (Map)

import Control.Monad
import Control.Monad.Fix
import Data.Semigroup
import Data.Maybe
import Data.Foldable

import Prelude


class (Reflex t) => Switching t r  where
   -- | Generalization of switchable reactive types (e.g. Event, Behavior)
   switching :: MonadHold t m => r -> Event t r -> m r
   
class (Switching t r, Monoid r) => SwitchMerge t r  where   
   switchMerge :: (MonadFix m, MonadHold t m, Ord k) => Map k r -> Event t (Map k (Maybe r)) -> m r


instance (Switching t a, Switching t b) => Switching t (a, b) where
  switching (a, b) e = liftM2 (,) (switching a $ fst <$> e) (switching b $ snd <$> e)
  
  
instance (SwitchMerge t a, SwitchMerge t b) => SwitchMerge t (a, b) where
  switchMerge initial e = do
    a <- switchMerge (fst <$> initial) (fmap (fmap fst) <$> e)
    b <- switchMerge (snd <$> initial) (fmap (fmap snd) <$> e)
    return (a, b)


-- This will hopefully become a primitive (faster!)
switchMergeEvents ::  (MonadFix m, MonadHold t m, Reflex t, Ord k) =>  UpdatedMap t k (Event t a) -> m (Event t (Map k a))
switchMergeEvents mapChanges = switch . fmap mergeMap  <$> holdMap mapChanges 


instance (Semigroup a, Reflex t) => SwitchMerge t (Event t a) where
  switchMerge initial updates = fmap (foldl1 (<>)) <$> switchMergeEvents (UpdatedMap initial updates)
  
  
instance (Monoid a, Reflex t) => SwitchMerge t (Behavior t a) where
  switchMerge initial updates = pull <$> joinMap <$> holdMap (UpdatedMap initial updates)
    where joinMap m = sample =<< fold <$> sample m
  
  
instance (SwitchMerge t a, Monoid a, Reflex t) => SwitchMerge t [a] where
  switchMerge initial updates = pure <$> switchMerge' (mconcat <$> UpdatedMap initial updates) 
  
instance (Switching t a, Monoid a, Reflex t) => Switching t [a]  where
  switching bs updates = pure <$> switching (mconcat bs) (mconcat <$> updates)  
  
  
instance (Reflex t) => SwitchMerge t () where
  switchMerge _ _ = pure ()  


instance (Monoid a, Reflex t) => Switching t (Behavior t a)  where
  switching = switcher
    
instance (Semigroup a, Reflex t) => Switching t (Event t a) where
  switching e updates = switch <$> hold e updates
    
instance (Reflex t) => Switching t () where
  switching _ _ = pure ()
  
switchMerge' :: (Reflex t, SwitchMerge t r, MonadFix m, MonadHold t m, Ord k) => UpdatedMap t k r -> m r 
switchMerge' (UpdatedMap initial e) = switchMerge initial e  

switching' :: (Reflex t, Switching t r, MonadFix m, MonadHold t m) => Updated t r -> m r 
switching' (Updated initial e) = switching initial e  



{'fraction_non_alphanumeric': 0.11526639344262295, 'fraction_numerical': 0.0006830601092896175, 'mean_word_length': 3.604559748427673, 'pattern_counts': {'":': 0, '<': 52, '<?xml version=': 0, '>': 94, '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': '736473', 'n_tokens_mistral': 1968, 'n_tokens_neox': 1921, 'n_words': 770}