pipes-fluid (empty) → 0.3.0.0
raw patch · 8 files changed
+593/−0 lines, 8 filesdep +asyncdep +basedep +constraintssetup-changed
Dependencies added: async, base, constraints, hspec, lens, lifted-async, mmorph, monad-control, mtl, pipes, pipes-concurrency, pipes-fluid, pipes-misc, stm, transformers, transformers-base
Files
- LICENSE +29/−0
- Setup.hs +2/−0
- pipes-fluid.cabal +58/−0
- src/Pipes/Fluid/Alternative.hs +11/−0
- src/Pipes/Fluid/React.hs +105/−0
- src/Pipes/Fluid/ReactIO.hs +139/−0
- src/Pipes/Fluid/Sync.hs +57/−0
- test/Spec.hs +192/−0
+ LICENSE view
@@ -0,0 +1,29 @@+Copyright (c) 2016, Louis Pan++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++1. Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.++3. Neither the name of the copyright holder nor the names of its+ contributors may be used to endorse or promote products derived from+ this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.+IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,+INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,+BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,+OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,+WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)+ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ pipes-fluid.cabal view
@@ -0,0 +1,58 @@+name: pipes-fluid+version: 0.3.0.0+synopsis: Reactively combines Producers so that a value is yielded as soon as possible.+description: Please see README.md+homepage: https://github.com/louispan/pipes-fluid#readme+license: BSD3+license-file: LICENSE+author: Louis Pan+maintainer: louis@pan.me+copyright: 2016 Louis Pan+category: Control, Pipes, FRP+build-type: Simple+cabal-version: >=1.10+tested-with: GHC == 7.10.3, GHC == 8.0.1++library+ hs-source-dirs: src+ exposed-modules: Pipes.Fluid.React+ , Pipes.Fluid.ReactIO+ , Pipes.Fluid.Sync+ , Pipes.Fluid.Alternative+ build-depends: base >= 4.7 && < 5+ , constraints >= 0.4 && < 1+ , lens >= 4 && < 5+ , lifted-async >= 0.9 && < 1+ , monad-control >= 1 && < 2+ , pipes >= 4 && < 5+ , stm >= 2.4 && < 3+ , transformers >= 0.4 && < 6+ , transformers-base >= 0.4 && < 1+ ghc-options: -Wall+ default-language: Haskell2010++test-suite pipes-fluid-test+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Spec.hs+ build-depends: base >= 4.7 && < 5+ , async >= 2 && < 3+ , constraints >= 0.4 && < 1+ , lens >= 4 && < 5+ , hspec >= 2 && < 3+ , lifted-async >= 0.8 && < 1+ , mmorph >= 1 && < 2+ , monad-control >= 1 && < 2+ , mtl >= 2 && < 3+ , pipes >= 4 && < 5+ , pipes-concurrency >= 2 && < 3+ , pipes-fluid+ , pipes-misc >= 0.2.0.0 && < 1+ , stm >= 2.4 && < 3+ , transformers >= 0.4 && < 0.6+ ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N+ default-language: Haskell2010++source-repository head+ type: git+ location: https://github.com/louispan/pipes-fluid
+ src/Pipes/Fluid/Alternative.hs view
@@ -0,0 +1,11 @@+module Pipes.Fluid.Alternative where++import Control.Applicative++bothOrEither :: Alternative f => f a -> f b -> f (Either (a, b) (Either a b))+bothOrEither left right =+ (curry Left <$> left <*> right)+ <|>+ (Right . Left <$> left)+ <|>+ (Right . Right <$> right)
+ src/Pipes/Fluid/React.hs view
@@ -0,0 +1,105 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE ImpredicativeTypes #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}++module Pipes.Fluid.React+ ( React(..)+ , merge+ , merge'+ ) where++import Control.Applicative+import Control.Lens+import Control.Monad.Trans.Class+import qualified Pipes as P+import qualified Pipes.Fluid.Alternative as PFA+import qualified Pipes.Prelude as PP++-- | The applicative instance of this combines multiple Producers reactively+-- ie, yields a value as soon as either or both of the input producers yields a value.+newtype React m a = React+ { reactively :: P.Producer a m ()+ }++makeWrapped ''React++instance Monad m =>+ Functor (React m) where+ fmap f (React as) = React $ as P.>-> PP.map f++-- | Reactively combines two producers, given initial values to use when the producer is blocked/failed.+-- This only works for Alternative m where failure means there was no effects, eg. 'Control.Concurrent.STM', or @MonadTrans t => t STM@.+-- Be careful of monad transformers like ExceptT that hides the STM Alternative instance.+instance (Alternative m, Monad m) =>+ Applicative (React m) where+ pure = React . P.yield+ fs <*> as =+ React $+ P.for (reactively $ merge fs as) $ \r ->+ case r of+ Left (f, a) -> P.yield $ f a+ Right (Left (f, Just a)) -> P.yield $ f a+ Right (Right (Just f, a)) -> P.yield $ f a+ -- never got anything from one of the signals, can't do anything yet.+ -- fail/retry/block until we get something from the other signal+ Right (Left (_, Nothing)) -> lift empty+ Right (Right (Nothing, _)) -> lift empty++-- | Reactively combines two producers, given initial values to use when the produce hasn't produced anything yet+-- Combine two signals, and returns a signal that emits+-- @Either bothfired (Either (leftFired, previousRight) (previousLeft, rightFired))@.+-- This only works for Alternative m where failure means there was no effects, eg. 'Control.Concurrent.STM', or @MonadTrans t => t STM@.+-- Be careful of monad transformers ExceptT that hides the STM Alternative instance.+merge' :: (Alternative m, Monad m) =>+ Maybe x+ -> Maybe y+ -> React m x+ -> React m y+ -> React m (Either (x, y) (Either (x, Maybe y) (Maybe x, y)))+merge' px_ py_ (React xs_) (React ys_) = React $ go px_ py_ xs_ ys_+ where+ go px py xs ys = do+ -- use the Alternative of m, not P.Proxy+ r <- lift $ PFA.bothOrEither (P.next xs) (P.next ys)+ case r+ -- both fs and as have ended+ of+ Left (Left _, Left _) -> pure ()+ -- @xs@ ended, @ys@ failed/retry/blocked+ Right (Left (Left _)) -> ys P.>-> PP.map useRight+ -- @xs@ failed/retry/blocked, @ys@ ended+ Right (Right (Left _)) -> xs P.>-> PP.map useLeft+ -- @xs@ produced something, @ys@ failed/retry/blocked+ Right (Left (Right (x, xs'))) -> do+ P.yield $ Right (Left (x, py))+ go (Just x) py xs' ys+ -- @xs@ failed/retry/blocked, @ys@ produced something+ Right (Right (Right (y, ys'))) -> do+ P.yield $ useRight y+ go px (Just y) xs ys'+ -- @xs@ produced something, @ys@ ended+ Left (Right (x, xs'), Left _) -> do+ P.yield $ useLeft x+ xs' P.>-> PP.map useLeft+ -- @fs@ ended, @as@ produced something+ Left (Left _, Right (y, ys')) -> do+ P.yield $ useRight y+ ys' P.>-> PP.map useRight+ -- both @fs@ and @as@ produced something+ Left (Right (x, xs'), Right (y, ys')) -> do+ P.yield $ Left (x, y)+ go (Just x) (Just y) xs' ys'+ where+ useRight y = Right (Right (px, y))+ useLeft x = Right (Left (x, py))++-- | A simpler version of merge', with the initial values as Nothing+merge :: (Alternative m, Monad m) => React m x -> React m y -> React m (Either (x, y) (Either (x, Maybe y) (Maybe x, y)))+merge = merge' Nothing Nothing
+ src/Pipes/Fluid/ReactIO.hs view
@@ -0,0 +1,139 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE ImpredicativeTypes #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++module Pipes.Fluid.ReactIO+ ( ReactIO(..)+ , mergeIO+ , mergeIO'+ ) where++import qualified Control.Concurrent.Async.Lifted.Safe as A+import qualified Control.Concurrent.STM as S+import Control.Lens+import Control.Monad.Base+import Control.Monad.Trans.Class+import Control.Monad.Trans.Control+import Data.Constraint.Forall (Forall)+import qualified Pipes as P+import qualified Pipes.Fluid.Alternative as PFA+import qualified Pipes.Prelude as PP++-- | The applicative instance of this combines multiple Producers reactively+-- ie, yields a value as soon as either or both of the input producers yields a value.+-- This creates two threads each time this combinator is used.+-- Warning: This means that the monadic effects are run in isolation from each other+-- so if the monad is something like (StateT s IO), then the state will alternate+-- between the two input producers, which is most likely not what you want.+newtype ReactIO m a = ReactIO+ { reactivelyIO :: P.Producer a m ()+ }++makeWrapped ''ReactIO++instance Monad m => Functor (ReactIO m) where+ fmap f (ReactIO as) = ReactIO $ as P.>-> PP.map f++instance (MonadBaseControl IO m, Forall (A.Pure m)) => Applicative (ReactIO m) where+ pure = ReactIO . P.yield+ -- 'ap' doesn't know about initial values+ fs <*> as = ReactIO $ P.for (reactivelyIO $ mergeIO fs as) $ \r ->+ case r of+ Left (f, a) -> P.yield $ f a+ Right (Left (f, Just a)) -> P.yield $ f a+ Right (Right (Just f, a)) -> P.yield $ f a+ -- never got anything from one of the signals, can't do anything yet.+ -- drop the event+ Right (Left (_, Nothing)) -> pure ()+ Right (Right (Nothing, _)) -> pure ()++-- | Reactively combines two producers, given initial values to use when the produce hasn't produced anything yet+-- Combine two signals, and returns a signal that emits+-- @Either bothfired (Either (leftFired, previousRight) (previousLeft, rightFired))@.+-- This creates two threads each time this combinator is used.+-- Warning: This means that the monadic effects are run in isolation from each other+-- so if the monad is something like (StateT s IO), then the state will alternate+-- between the two input producers, which is most likely not what you want.+-- This will be detect as a compile error due to use of Control.Concurrent.Async.Lifted.Safe+mergeIO' :: (MonadBaseControl IO m, Forall (A.Pure m)) =>+ Maybe x+ -> Maybe y+ -> ReactIO m x+ -> ReactIO m y+ -> ReactIO m (Either (x, y) (Either (x, Maybe y) (Maybe x, y)))+mergeIO' px_ py_ (ReactIO xs_) (ReactIO ys_) = ReactIO $ do+ ax <- lift $ A.async $ P.next xs_+ ay <- lift $ A.async $ P.next ys_+ doMergeIO px_ py_ ax ay+ where+ doMergeIO :: (MonadBaseControl IO m, Forall (A.Pure m)) =>+ Maybe x+ -> Maybe y+ -> A.Async (Either () (x, P.Producer x m ()))+ -> A.Async (Either () (y, P.Producer y m ()))+ -> P.Producer (Either (x, y) (Either (x, Maybe y) (Maybe x, y))) m ()+ doMergeIO px py ax ay = do+ r <-+ lift $+ liftBase . S.atomically $ PFA.bothOrEither (A.waitSTM ax) (A.waitSTM ay)+ case r of+ Left (Left _, Left _) -> pure () -- both @ax@ and @ay@ have ended+ -- @ax@ ended, @ay@ still waiting+ Right (Left (Left _)) -> do+ ry <- lift $ A.wait ay -- wait for @ay@ to return and then+ -- only use @ys@+ case ry of+ Left _ -> pure ()+ Right (y', ys') -> do+ P.yield $ useRight y'+ ys' P.>-> PP.map useRight+ -- @ax@ still waiting, @ay@ ended+ Right (Right (Left _)) -> do+ rx <- lift $ A.wait ax -- wait for @ax@ to retrun and then+ -- only use @xs@+ case rx of+ Left _ -> pure ()+ Right (x', xs') -> do+ P.yield $ useLeft x'+ xs' P.>-> PP.map useLeft+ -- @ax@ produced something, @ay@ still waiting+ Right (Left (Right (x, xs'))) -> do+ P.yield $ useLeft x+ ax' <- lift $ A.async $ P.next xs'+ doMergeIO (Just x) py ax' ay+ -- @ax@ still waiting, @ay@ produced something+ Right (Right (Right (y, ys'))) -> do+ P.yield $ useRight y+ ay' <- lift $ A.async $ P.next ys'+ doMergeIO px (Just y) ax ay'+ -- @ax@ produced something, @ay@ ended+ Left (Right (x, xs'), Left _) -> do+ P.yield $ useLeft x+ xs' P.>-> PP.map useLeft+ -- @af@ ended, @aa@ produced something+ Left (Left _, Right (y, ys')) -> do+ P.yield $ useRight y+ ys' P.>-> PP.map useRight+ -- both @fs@ and @as@ produced something+ Left (Right (x, xs'), Right (y, ys')) -> do+ P.yield $ Left (x, y)+ ax' <- lift $ A.async $ P.next xs'+ ay' <- lift $ A.async $ P.next ys'+ doMergeIO (Just x) (Just y) ax' ay'+ where+ useRight y = Right (Right (px, y))+ useLeft x = Right (Left (x, py))++mergeIO :: (MonadBaseControl IO m, Forall (A.Pure m))+ => ReactIO m x+ -> ReactIO m y+ -> ReactIO m (Either (x, y) (Either (x, Maybe y) (Maybe x, y)))+mergeIO = mergeIO' Nothing Nothing
+ src/Pipes/Fluid/Sync.hs view
@@ -0,0 +1,57 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE BangPatterns #-}++module Pipes.Fluid.Sync+ ( Sync(..)+ ) where++import Control.Lens+import Control.Monad+import Control.Monad.Trans.Class+import qualified Pipes as P+import qualified Pipes.Prelude as PP++-- | The applicative instance of this combines multiple Producers synchronously+-- ie, yields a value only when both of the input producers yields a value.+-- Ends as soon as any of the input producer is ended.+newtype Sync m a = Sync+ { synchronously :: P.Producer a m ()+ }++makeWrapped ''Sync++instance Monad m => Functor (Sync m) where+ fmap f (Sync as) = Sync $ as P.>-> PP.map f++instance Monad m => Applicative (Sync m) where+ pure = Sync . forever . P.yield+ Sync xs <*> Sync ys = Sync $ go xs ys++go :: Monad m => P.Producer (t -> a) m r -> P.Producer t m r -> P.Proxy x' x () a m ()+go fs as = do+ rf <- lift $ P.next fs+ ra <- lift $ P.next as+ case (rf, ra) of+ (Left _, _) -> pure ()+ (_, Left _) -> pure ()+ (Right (f, fs'), Right (a, as')) -> do+ P.yield $ f a+ go fs' as'++instance Monad m => Monad (Sync m) where+ Sync as >>= f = Sync $ do+ ra <- lift $ P.next as+ case ra of+ Left _ -> pure ()+ Right (a, as') -> do+ rb <- lift . P.next . synchronously $ f a+ case rb of+ Left _ -> pure ()+ Right (b, _) -> do+ P.yield b+ synchronously $ Sync as' >>= f
+ test/Spec.hs view
@@ -0,0 +1,192 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE MonomorphismRestriction #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}++module Main where++import Control.Applicative+import Control.Concurrent+import Control.Concurrent.STM+import Control.Lens+import Control.Monad+import Control.Monad.Morph as M+import Control.Monad.State.Strict+import Control.Monad.Trans.Identity+import Data.Foldable+import Data.Maybe+import qualified Pipes as P+import qualified Pipes.Concurrent as PC+import qualified Pipes.Fluid.React as PF+import qualified Pipes.Fluid.ReactIO as PF+import qualified Pipes.Fluid.Sync as PF+import qualified Pipes.Misc as PM+import qualified Pipes.Prelude as PP+import Test.Hspec++data Model = Model+ { modelCounter1 :: Int+ , modelCounter2 :: Int+ } deriving (Eq, Show, Ord)++makeFields ''Model++data1 :: [Int]+data1 = [1, 2..9]++data2 :: [Int]+data2 = [10, 20..70]++sig1 :: Monad m => P.Producer Int m ()+sig1 = traverse_ P.yield data1++sig2 :: Monad m => P.Producer Int m ()+sig2 = traverse_ P.yield data2++delay :: Int -> P.Pipe a a IO ()+delay i = P.for P.cat $ \a -> do+ lift $ threadDelay i+ P.yield a++-- | For the Sync tests, not all the input will be consumed+-- so quitEarly will close the mailbox when an of the feeders+-- have finished feeding.+testSig' :: Bool -> (P.Producer Int STM () -> P.Producer Int STM () -> IO a) -> IO a+testSig' quitEarly f = do+ (o1, i1, q1) <- PC.spawn' $ PC.bounded 1+ (o2, i2, q2) <- PC.spawn' $ PC.bounded 1++ feederFinished1 <- newEmptyMVar+ feederFinished2 <- newEmptyMVar++ -- make time delayed signals+ void $ forkIO $ do+ P.runEffect $ sig1 P.>-> delay 30 P.>-> hoist atomically (PM.toOutputSTM o1)+ when quitEarly $ atomically $ do+ -- wait for input to be empty+ r <- PC.recv i1 <|> pure Nothing+ case r of+ Nothing -> q1 *> q2+ Just _ -> retry+ putMVar feederFinished1 ()+ void $ forkIO $ do+ P.runEffect $ sig2 P.>-> delay 50 P.>-> hoist atomically (PM.toOutputSTM o2)+ when quitEarly $ atomically $ do+ -- wait for input to be empty+ r <- PC.recv i2 <|> pure Nothing+ case r of+ Nothing -> q1 *> q2+ Just _ -> retry+ putMVar feederFinished2 ()+ -- thread to destroy PC Input when both feeders have finished+ void $ forkIO $ do+ takeMVar feederFinished1+ takeMVar feederFinished2+ atomically $ q1 *> q2+ -- run the test function+ f (PM.fromInputSTM i1) (PM.fromInputSTM i2)++main :: IO ()+main = do+ hspec $ do+ describe "Sync" $ do+ it "only yield a value when both producers yields a value" $ do+ xs <-+ testSig' True $ \as bs ->+ PP.toListM $+ hoist atomically $+ PF.synchronously $+ (\a b -> (a, b, a + b)) <$> PF.Sync as <*> PF.Sync bs+ xs `shouldBe` (\(a, b) -> (a, b, a + b)) <$> zip data1 data2+ describe "React" $ do+ it "React STM: yield a value whenever any producer yields a value" $ do+ xs <-+ testSig' False $ \as bs ->+ PP.toListM $+ hoist atomically $+ PF.reactively $+ (\a b -> (a, b, a + b)) <$> PF.React as <*> PF.React bs+ xs `shouldSatisfy` isBigger+ it "React IdentityT STM: reactively yields under 't STM'" $ do+ xs <-+ testSig' False $ \as bs ->+ runIdentityT $+ PP.toListM $+ hoist (hoist atomically) $+ PF.reactively $+ (\a b -> (a, b, a + b)) <$> (PF.React $ hoist lift as) <*>+ (PF.React $ hoist lift bs)+ xs `shouldSatisfy` isBigger+ it "React StateT STM: reactively yields under 'StateT STM'" $ do+ xs <-+ testSig' False $ \as bs ->+ (`evalStateT` (Model 0 0)) $+ PP.toListM $+ (hoist (hoist atomically) $+ PF.reactively $+ (\a b -> (a, b, a + b)) <$>+ (PF.React $ hoist lift as P.>-> PM.store id counter1) <*>+ (PF.React $ hoist lift bs P.>-> PM.store id counter2)) P.>->+ PM.retrieve id+ xs `shouldSatisfy` isBigger+ it "React Merge: yield a Left/Right value depending on which producer yields a value" $ do+ xs <-+ testSig' False $ \as bs ->+ PP.toListM $+ hoist atomically $+ PF.reactively $+ PF.React as `PF.merge`PF.React bs+ xs `shouldSatisfy` isDifferent+ describe "ReactIO" $ do+ it "React IO: reactively yield under IO using lifted-async" $ do+ xs <-+ testSig' False $ \as bs ->+ PP.toListM $+ PF.reactivelyIO $+ (\a b -> (a, b, a + b)) <$> (PF.ReactIO $ hoist atomically as) <*>+ (PF.ReactIO $ hoist atomically bs)+ xs `shouldSatisfy` isBigger+ it "React IdentityT IO: reactively yield under 't IO' using lifted-async" $ do+ xs <-+ testSig' False $ \as bs ->+ runIdentityT $+ PP.toListM $+ PF.reactivelyIO $+ (\a b -> (a, b, a + b)) <$> (PF.ReactIO $ hoist (lift . atomically) as) <*>+ (PF.ReactIO $ hoist (lift . atomically) bs)+ xs `shouldSatisfy` isBigger+ it "\nReact StateT IO is unsafe (lift-async detect this as a compile error)" $ do+ pure () `shouldReturn` ()+ it "ReactIO Merge: yield a Left/Right value depending on which producer yields a value" $ do+ xs <-+ testSig' False $ \as bs ->+ PP.toListM $+ PF.reactivelyIO $+ (PF.ReactIO $ hoist atomically as) `PF.mergeIO` (PF.ReactIO $ hoist atomically bs)+ xs `shouldSatisfy` isDifferent++isBigger :: Ord a => [a] -> Bool+isBigger = isJust . foldl' go (Just Nothing)+ where+ go p a =+ case p of+ Nothing -> Nothing+ Just Nothing -> Just (Just a)+ Just (Just p')+ | p' == a -> Nothing+ | p' < a -> Just (Just a)+ | otherwise -> Nothing+++isDifferent :: Eq a => [a] -> Bool+isDifferent = isJust . foldl' go (Just Nothing)+ where+ go p a =+ case p of+ Nothing -> Nothing+ Just Nothing -> Just (Just a)+ Just (Just p')+ | p' == a -> Nothing+ | otherwise -> Just (Just a)