Advertisement
Guest User

Untitled

a guest
Mar 19th, 2019
76
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 1.02 KB | None | 0 0
  1. {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, GeneralizedNewtypeDeriving, FlexibleContexts #-}
  2.  
  3. module Lib where
  4.  
  5. import Control.Monad.State
  6. import Control.Monad.Writer
  7. import Control.Monad.IO.Class
  8. import Control.Monad.Reader
  9.  
  10. someFunc :: IO ()
  11. someFunc = print =<< runBatchT 50 writin
  12.  
  13. writin :: MonadWriter [Int] m => m ()
  14. writin = do
  15. forM_ [0..1000] $ \i -> do
  16. tell [i]
  17.  
  18. newtype BatchT w m a = BatchT { unBatchT :: StateT (Int, [[w]]) m a }
  19. deriving (Functor, Applicative, Monad, MonadIO)
  20.  
  21. runBatchT :: Monad m => Int -> BatchT w m a -> m ([[w]], a)
  22. runBatchT limit (BatchT s) = do
  23. (a, (_, r)) <- runStateT s (limit, mempty)
  24. pure (r, a)
  25.  
  26. instance (Monoid w, Monad m) => MonadWriter w (BatchT w m) where
  27. tell x = BatchT $ do
  28. (limit, logs) <- get
  29. case logs of
  30. [] ->
  31. put (limit, [[x]])
  32. (l:ls)
  33. | length l > limit ->
  34. put (limit, [x] : (l : ls))
  35. | otherwise ->
  36. put (limit, (x : l) : ls)
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement