{-# LANGUAGE ScopedTypeVariables #-} module Control.Shortcut where import Control.Applicative import Control.Monad import Data.Either import Data.Maybe -- | class of things that can be run in parallel and can be shortcuted. -- The funtion in parameter is called everytime an intermediate result is known, as soon as it -- returns True the intermediate results are returned (discarding those not yet available). -- the order of the lists must be preserved class Shortcutable s where shortcut :: [s a] -> ([Maybe a] -> Bool) -> s [Maybe a] -- | version without the maybes shortcut_ :: (Functor s, Shortcutable s) => [s a] -> ([a] -> Bool) -> s [a] shortcut_ as f = catMaybes <$> shortcut as (f . catMaybes) -- | version with two different types of result shortcut2 :: (Functor s, Monad s, Shortcutable s) => [s a] -> [s b] -> ([Maybe a] -> [Maybe b] -> Bool) -> s ([Maybe a], [Maybe b]) shortcut2 as bs f = do let stripEitherFst aes = map (fromLeft <$>) $ take (length as) aes let stripEitherLst bes = map (fromRight <$>) $ drop (length as) bes let f' abs = f (stripEitherFst abs) (stripEitherLst abs) mabs <- shortcut ((map (Left <$>) as) ++ (map (Right <$>) bs)) f' return (stripEitherFst mabs, stripEitherLst mabs) -- | version with a supplementary event which result is discarded shortcut2b :: (Functor s, Monad s, Shortcutable s) => [s a] -> s b -> ([Maybe a] -> Bool -> Bool) -> s ([Maybe a], Bool) shortcut2b as b f = do let f' as bs = f as (isJust $ head bs) (as, bs) <- shortcut2 as [b] f' return (as, isJust $ head bs) fromLeft :: Either a b -> a fromLeft (Right _) = error "Argument takes form 'Right _'" fromLeft (Left x) = x fromRight :: Either a b -> b fromRight (Left _) = error "Argument takes form 'Left _'" fromRight (Right x) = x