module Actions ( Action (..)
, execute
, every
, Batch
, BatchAct
, BatchAction
, inBatches
, pack
, PrintF
, batchViz
, batchPrint
) where
import Control.Monad
type Act x m a = x -> a -> m a
data Action x m a b = Action (Act x m a) (a -> m b) a
execute :: Monad m => Action x m a b -> x -> m (Action x m a b)
execute (Action act fin a) x = liftM (Action act fin) (act x a)
every :: Monad m => Int -> Action x m a b -> Action x m (a,Int) b
every n (Action act fin a) =
let skip_act x (b,i) = if i == (n1)
then do b' <- act x b
return (b',0)
else return (b,i+1)
skip_fin = fin . fst
in Action skip_act skip_fin (a,0)
type Batch x = ([x], Int)
type BatchAct x m = Act x m (Batch x)
type BatchAction x m b = Action x m (Batch x) b
inBatches :: Monad m => (Batch x -> m b) -> Int -> BatchAct x m
inBatches f n x a@(l, i)
| i == n = f a >> return ([x], 1)
| otherwise = return (x:l, i+1)
pack :: (Batch x -> m b) -> BatchAct x m -> BatchAction x m b
pack f act = Action act f ([], 0)
type PrintF x s = [x] -> [s]
vizJSON :: Show s => [s] -> String
vizJSON samplelist = "{\"rvars\": {\"x\": " ++ show samplelist ++ "}}"
closeJSON :: Show s => [s] -> String
closeJSON samplelist = "{\"close\": true, \"rvars\": {\"x\": " ++ show samplelist ++ "}}"
visualize :: Show s => PrintF x s -> Batch x -> IO ()
visualize f (ls,_) = unless (null ls) $ putStrLn.vizJSON $ f ls
vizClose :: Show s => PrintF x s -> Batch x -> IO ()
vizClose f (ls,_) = unless (null ls) $ putStrLn.closeJSON $ f ls
batchViz :: Show s => PrintF x s -> Int -> BatchAction x IO ()
batchViz f n =
let viz = visualize f
close = vizClose f
in pack close $ inBatches viz n
batchPrint :: Show s => PrintF x s -> Int -> BatchAction x IO ()
batchPrint f n =
let p fn (ls,_) = unless (null ls) $ print $ fn ls
in pack (p f) $ inBatches (p f) n