-- |A function to tie together two sorted Haskell Iterators
module Pipes.OrderedZip (orderedZip, orderedZipAll, orderCheckPipe, WrongInputOrderException(..)) where

import           Control.Exception      (Exception)
import           Control.Monad.IO.Class (MonadIO, liftIO)
import           Data.IORef             (newIORef, readIORef, writeIORef)
import           Data.Maybe             (catMaybes)
import           Pipes                  (Pipe, Producer, cat, for, lift, next,
                                         yield, (>->))
import qualified Pipes.Prelude          as P
import           Pipes.Safe             (MonadSafe, throwM)

-- |orderedZip takes a comparison function and two producers and merges them
-- together, creating a new Producer that yields pairs of Maybes of the two
-- datatables provided by the two original producers.
-- The output pairs reflect the Union of the two input producers, with Nothings indicating
-- missing data in one of the producers at that location.
orderedZip :: (Monad m) => (a -> b -> Ordering) -- ^The function to compare types of a with b
           -> Producer a m r1 -- ^The first producer (assumed to be ordered)
           -> Producer b m r2 -- ^The second producer (assumed to be ordered)
           -> Producer (Maybe a, Maybe b) m (r1, r2) -- ^The merged producer
orderedZip :: (a -> b -> Ordering)
-> Producer a m r1
-> Producer b m r2
-> Producer (Maybe a, Maybe b) m (r1, r2)
orderedZip a -> b -> Ordering
ord Producer a m r1
p1 Producer b m r2
p2 = do
    Either r1 (a, Producer a m r1)
p1Front <- m (Either r1 (a, Producer a m r1))
-> Proxy
     X () () (Maybe a, Maybe b) m (Either r1 (a, Producer a m r1))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either r1 (a, Producer a m r1))
 -> Proxy
      X () () (Maybe a, Maybe b) m (Either r1 (a, Producer a m r1)))
-> m (Either r1 (a, Producer a m r1))
-> Proxy
     X () () (Maybe a, Maybe b) m (Either r1 (a, Producer a m r1))
forall a b. (a -> b) -> a -> b
$ Producer a m r1 -> m (Either r1 (a, Producer a m r1))
forall (m :: * -> *) a r.
Monad m =>
Producer a m r -> m (Either r (a, Producer a m r))
next Producer a m r1
p1
    Either r2 (b, Producer b m r2)
p2Front <- m (Either r2 (b, Producer b m r2))
-> Proxy
     X () () (Maybe a, Maybe b) m (Either r2 (b, Producer b m r2))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either r2 (b, Producer b m r2))
 -> Proxy
      X () () (Maybe a, Maybe b) m (Either r2 (b, Producer b m r2)))
-> m (Either r2 (b, Producer b m r2))
-> Proxy
     X () () (Maybe a, Maybe b) m (Either r2 (b, Producer b m r2))
forall a b. (a -> b) -> a -> b
$ Producer b m r2 -> m (Either r2 (b, Producer b m r2))
forall (m :: * -> *) a r.
Monad m =>
Producer a m r -> m (Either r (a, Producer a m r))
next Producer b m r2
p2
    (a -> b -> Ordering)
-> Either r1 (a, Producer a m r1)
-> Producer a m r1
-> Either r2 (b, Producer b m r2)
-> Producer b m r2
-> Producer (Maybe a, Maybe b) m (r1, r2)
forall (m :: * -> *) t r r x' x.
Monad m =>
t
-> Either r (a, Producer a m r)
-> Producer a m r
-> Either r (b, Producer b m r)
-> Producer b m r
-> Proxy x' x () (Maybe a, Maybe b) m (r, r)
go a -> b -> Ordering
ord Either r1 (a, Producer a m r1)
p1Front Producer a m r1
p1 Either r2 (b, Producer b m r2)
p2Front Producer b m r2
p2
    where
        go :: t
-> Either r (a, Producer a m r)
-> Producer a m r
-> Either r (b, Producer b m r)
-> Producer b m r
-> Proxy x' x () (Maybe a, Maybe b) m (r, r)
go t
ord' Either r (a, Producer a m r)
p1Front Producer a m r
p1' Either r (b, Producer b m r)
p2Front Producer b m r
p2' = case (Either r (a, Producer a m r)
p1Front, Either r (b, Producer b m r)
p2Front) of
            (Left r
p1r, Left r
p2r) -> (r, r) -> Proxy x' x () (Maybe a, Maybe b) m (r, r)
forall (m :: * -> *) a. Monad m => a -> m a
return (r
p1r, r
p2r)
            (Left r
_, Right (b
p2a, Producer b m r
p2Rest)) -> do
                (Maybe a, Maybe b) -> Proxy x' x () (Maybe a, Maybe b) m ()
forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
yield (Maybe a
forall a. Maybe a
Nothing, b -> Maybe b
forall a. a -> Maybe a
Just b
p2a)
                Either r (b, Producer b m r)
p2Front' <- m (Either r (b, Producer b m r))
-> Proxy
     x' x () (Maybe a, Maybe b) m (Either r (b, Producer b m r))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either r (b, Producer b m r))
 -> Proxy
      x' x () (Maybe a, Maybe b) m (Either r (b, Producer b m r)))
-> m (Either r (b, Producer b m r))
-> Proxy
     x' x () (Maybe a, Maybe b) m (Either r (b, Producer b m r))
forall a b. (a -> b) -> a -> b
$ Producer b m r -> m (Either r (b, Producer b m r))
forall (m :: * -> *) a r.
Monad m =>
Producer a m r -> m (Either r (a, Producer a m r))
next Producer b m r
p2Rest
                t
-> Either r (a, Producer a m r)
-> Producer a m r
-> Either r (b, Producer b m r)
-> Producer b m r
-> Proxy x' x () (Maybe a, Maybe b) m (r, r)
go t
ord' Either r (a, Producer a m r)
p1Front Producer a m r
p1' Either r (b, Producer b m r)
p2Front' Producer b m r
p2Rest
            (Right (a
p1a, Producer a m r
p1Rest), Left r
_) -> do
                (Maybe a, Maybe b) -> Proxy x' x () (Maybe a, Maybe b) m ()
forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
yield (a -> Maybe a
forall a. a -> Maybe a
Just a
p1a, Maybe b
forall a. Maybe a
Nothing)
                Either r (a, Producer a m r)
p1Front' <- m (Either r (a, Producer a m r))
-> Proxy
     x' x () (Maybe a, Maybe b) m (Either r (a, Producer a m r))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either r (a, Producer a m r))
 -> Proxy
      x' x () (Maybe a, Maybe b) m (Either r (a, Producer a m r)))
-> m (Either r (a, Producer a m r))
-> Proxy
     x' x () (Maybe a, Maybe b) m (Either r (a, Producer a m r))
forall a b. (a -> b) -> a -> b
$ Producer a m r -> m (Either r (a, Producer a m r))
forall (m :: * -> *) a r.
Monad m =>
Producer a m r -> m (Either r (a, Producer a m r))
next Producer a m r
p1Rest
                t
-> Either r (a, Producer a m r)
-> Producer a m r
-> Either r (b, Producer b m r)
-> Producer b m r
-> Proxy x' x () (Maybe a, Maybe b) m (r, r)
go t
ord' Either r (a, Producer a m r)
p1Front' Producer a m r
p1Rest Either r (b, Producer b m r)
p2Front Producer b m r
p2'
            (Right (a
p1a, Producer a m r
p1Rest), Right (b
p2a, Producer b m r
p2Rest)) -> case a -> b -> Ordering
ord a
p1a b
p2a of
                Ordering
LT -> do
                    (Maybe a, Maybe b) -> Proxy x' x () (Maybe a, Maybe b) m ()
forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
yield (a -> Maybe a
forall a. a -> Maybe a
Just a
p1a, Maybe b
forall a. Maybe a
Nothing)
                    Either r (a, Producer a m r)
p1Front' <- m (Either r (a, Producer a m r))
-> Proxy
     x' x () (Maybe a, Maybe b) m (Either r (a, Producer a m r))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either r (a, Producer a m r))
 -> Proxy
      x' x () (Maybe a, Maybe b) m (Either r (a, Producer a m r)))
-> m (Either r (a, Producer a m r))
-> Proxy
     x' x () (Maybe a, Maybe b) m (Either r (a, Producer a m r))
forall a b. (a -> b) -> a -> b
$ Producer a m r -> m (Either r (a, Producer a m r))
forall (m :: * -> *) a r.
Monad m =>
Producer a m r -> m (Either r (a, Producer a m r))
next Producer a m r
p1Rest
                    t
-> Either r (a, Producer a m r)
-> Producer a m r
-> Either r (b, Producer b m r)
-> Producer b m r
-> Proxy x' x () (Maybe a, Maybe b) m (r, r)
go t
ord' Either r (a, Producer a m r)
p1Front' Producer a m r
p1Rest Either r (b, Producer b m r)
p2Front Producer b m r
p2'
                Ordering
EQ -> do
                    (Maybe a, Maybe b) -> Proxy x' x () (Maybe a, Maybe b) m ()
forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
yield (a -> Maybe a
forall a. a -> Maybe a
Just a
p1a, b -> Maybe b
forall a. a -> Maybe a
Just b
p2a)
                    Either r (a, Producer a m r)
p1Front' <- m (Either r (a, Producer a m r))
-> Proxy
     x' x () (Maybe a, Maybe b) m (Either r (a, Producer a m r))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either r (a, Producer a m r))
 -> Proxy
      x' x () (Maybe a, Maybe b) m (Either r (a, Producer a m r)))
-> m (Either r (a, Producer a m r))
-> Proxy
     x' x () (Maybe a, Maybe b) m (Either r (a, Producer a m r))
forall a b. (a -> b) -> a -> b
$ Producer a m r -> m (Either r (a, Producer a m r))
forall (m :: * -> *) a r.
Monad m =>
Producer a m r -> m (Either r (a, Producer a m r))
next Producer a m r
p1Rest
                    Either r (b, Producer b m r)
p2Front' <- m (Either r (b, Producer b m r))
-> Proxy
     x' x () (Maybe a, Maybe b) m (Either r (b, Producer b m r))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either r (b, Producer b m r))
 -> Proxy
      x' x () (Maybe a, Maybe b) m (Either r (b, Producer b m r)))
-> m (Either r (b, Producer b m r))
-> Proxy
     x' x () (Maybe a, Maybe b) m (Either r (b, Producer b m r))
forall a b. (a -> b) -> a -> b
$ Producer b m r -> m (Either r (b, Producer b m r))
forall (m :: * -> *) a r.
Monad m =>
Producer a m r -> m (Either r (a, Producer a m r))
next Producer b m r
p2Rest
                    t
-> Either r (a, Producer a m r)
-> Producer a m r
-> Either r (b, Producer b m r)
-> Producer b m r
-> Proxy x' x () (Maybe a, Maybe b) m (r, r)
go t
ord' Either r (a, Producer a m r)
p1Front' Producer a m r
p1Rest Either r (b, Producer b m r)
p2Front' Producer b m r
p2Rest
                Ordering
GT -> do
                    (Maybe a, Maybe b) -> Proxy x' x () (Maybe a, Maybe b) m ()
forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
yield (Maybe a
forall a. Maybe a
Nothing, b -> Maybe b
forall a. a -> Maybe a
Just b
p2a)
                    Either r (b, Producer b m r)
p2Front' <- m (Either r (b, Producer b m r))
-> Proxy
     x' x () (Maybe a, Maybe b) m (Either r (b, Producer b m r))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either r (b, Producer b m r))
 -> Proxy
      x' x () (Maybe a, Maybe b) m (Either r (b, Producer b m r)))
-> m (Either r (b, Producer b m r))
-> Proxy
     x' x () (Maybe a, Maybe b) m (Either r (b, Producer b m r))
forall a b. (a -> b) -> a -> b
$ Producer b m r -> m (Either r (b, Producer b m r))
forall (m :: * -> *) a r.
Monad m =>
Producer a m r -> m (Either r (a, Producer a m r))
next Producer b m r
p2Rest
                    t
-> Either r (a, Producer a m r)
-> Producer a m r
-> Either r (b, Producer b m r)
-> Producer b m r
-> Proxy x' x () (Maybe a, Maybe b) m (r, r)
go t
ord' Either r (a, Producer a m r)
p1Front Producer a m r
p1' Either r (b, Producer b m r)
p2Front' Producer b m r
p2Rest

-- |orderedZipAll takes a comparison function and a list of producers and merges them
-- together, creating a new Producer that yields lists of Maybes of the
-- input data type provided by the original producers.
-- The output list reflects the Union of all input producers, with Nothings indicating
-- missing data in any of the producers at that instance.
orderedZipAll :: (Monad m) => (a -> a -> Ordering) -- ^The function to compare types of a with itself
              -> [Producer a m r] -- ^A list of producers (have to be ordered)
              -> Producer [Maybe a] m [r] -- ^The merged producer
orderedZipAll :: (a -> a -> Ordering)
-> [Producer a m r] -> Producer [Maybe a] m [r]
orderedZipAll a -> a -> Ordering
compFunc [Producer a m r]
prodList = (a -> a -> Ordering)
-> Int -> [Producer a m r] -> Producer [Maybe a] m [r]
forall (m :: * -> *) a r.
Monad m =>
(a -> a -> Ordering)
-> Int -> [Producer a m r] -> Producer [Maybe a] m [r]
go a -> a -> Ordering
compFunc ([Producer a m r] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Producer a m r]
prodList) [Producer a m r]
prodList
  where
    go :: (Monad m) => (a -> a -> Ordering) -> Int -> [Producer a m r] -> Producer [Maybe a] m [r]
    go :: (a -> a -> Ordering)
-> Int -> [Producer a m r] -> Producer [Maybe a] m [r]
go a -> a -> Ordering
compFunc Int
_ [] = [Char] -> Producer [Maybe a] m [r]
forall a. HasCallStack => [Char] -> a
error [Char]
"orderedZipAll error: empty list" -- just to make the function complete
    go a -> a -> Ordering
compFunc Int
_ [Producer a m r
prod] = (r -> [r])
-> Proxy X () () [Maybe a] m r -> Producer [Maybe a] m [r]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap r -> [r]
forall (m :: * -> *) a. Monad m => a -> m a
return (Producer a m r
prod Producer a m r
-> Proxy () a () [Maybe a] m r -> Proxy X () () [Maybe a] m r
forall (m :: * -> *) a' a b r c' c.
Functor m =>
Proxy a' a () b m r -> Proxy () b c' c m r -> Proxy a' a c' c m r
>-> (a -> [Maybe a]) -> Proxy () a () [Maybe a] m r
forall (m :: * -> *) a b r. Functor m => (a -> b) -> Pipe a b m r
P.map (Maybe a -> [Maybe a]
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> [Maybe a]) -> (a -> Maybe a) -> a -> [Maybe a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just))
    go a -> a -> Ordering
compFunc Int
n (Producer a m r
prod1:[Producer a m r]
prods) =
        (((r, [r]) -> [r])
-> Proxy X () () (Maybe a, Maybe [Maybe a]) m (r, [r])
-> Proxy X () () (Maybe a, Maybe [Maybe a]) m [r]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(r
r, [r]
rs) -> (r
rr -> [r] -> [r]
forall a. a -> [a] -> [a]
:[r]
rs)) ((a -> [Maybe a] -> Ordering)
-> Producer a m r
-> Producer [Maybe a] m [r]
-> Proxy X () () (Maybe a, Maybe [Maybe a]) m (r, [r])
forall (m :: * -> *) a b r1 r2.
Monad m =>
(a -> b -> Ordering)
-> Producer a m r1
-> Producer b m r2
-> Producer (Maybe a, Maybe b) m (r1, r2)
orderedZip ((a -> a -> Ordering) -> a -> [Maybe a] -> Ordering
forall a. (a -> a -> Ordering) -> a -> [Maybe a] -> Ordering
compFunc2 a -> a -> Ordering
compFunc) Producer a m r
prod1 ((a -> a -> Ordering)
-> Int -> [Producer a m r] -> Producer [Maybe a] m [r]
forall (m :: * -> *) a r.
Monad m =>
(a -> a -> Ordering)
-> Int -> [Producer a m r] -> Producer [Maybe a] m [r]
go a -> a -> Ordering
compFunc (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [Producer a m r]
prods))) Proxy X () () (Maybe a, Maybe [Maybe a]) m [r]
-> Proxy () (Maybe a, Maybe [Maybe a]) () [Maybe a] m [r]
-> Producer [Maybe a] m [r]
forall (m :: * -> *) a' a b r c' c.
Functor m =>
Proxy a' a () b m r -> Proxy () b c' c m r -> Proxy a' a c' c m r
>-> ((Maybe a, Maybe [Maybe a]) -> [Maybe a])
-> Proxy () (Maybe a, Maybe [Maybe a]) () [Maybe a] m [r]
forall (m :: * -> *) a b r. Functor m => (a -> b) -> Pipe a b m r
P.map (Maybe a, Maybe [Maybe a]) -> [Maybe a]
forall a. (Maybe a, Maybe [Maybe a]) -> [Maybe a]
mergeMaybeTuples
      where
        mergeMaybeTuples :: (Maybe a, Maybe [Maybe a]) -> [Maybe a]
        mergeMaybeTuples :: (Maybe a, Maybe [Maybe a]) -> [Maybe a]
mergeMaybeTuples (Maybe a
Nothing, Maybe [Maybe a]
Nothing) = [Char] -> [Maybe a]
forall a. HasCallStack => [Char] -> a
error [Char]
"orderedZipAll - should never happen" -- just to make this function complete
        mergeMaybeTuples (Maybe a
Nothing, Just [Maybe a]
mla) = (Maybe a
forall a. Maybe a
NothingMaybe a -> [Maybe a] -> [Maybe a]
forall a. a -> [a] -> [a]
: [Maybe a]
mla)
        mergeMaybeTuples (Just a
a, Maybe [Maybe a]
Nothing) = (a -> Maybe a
forall a. a -> Maybe a
Just a
a Maybe a -> [Maybe a] -> [Maybe a]
forall a. a -> [a] -> [a]
: Int -> Maybe a -> [Maybe a]
forall a. Int -> a -> [a]
replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Maybe a
forall a. Maybe a
Nothing)
        mergeMaybeTuples (Just a
a, Just [Maybe a]
mla) = (a -> Maybe a
forall a. a -> Maybe a
Just a
a Maybe a -> [Maybe a] -> [Maybe a]
forall a. a -> [a] -> [a]
: [Maybe a]
mla)
        compFunc2 :: (a -> a -> Ordering) -> a -> [Maybe a] -> Ordering
        compFunc2 :: (a -> a -> Ordering) -> a -> [Maybe a] -> Ordering
compFunc2 a -> a -> Ordering
compFunc a
x [Maybe a]
xs =
            let allJusts :: [a]
allJusts = [Maybe a] -> [a]
forall a. [Maybe a] -> [a]
catMaybes [Maybe a]
xs
            in  case [a]
allJusts of
                    []      -> [Char] -> Ordering
forall a. HasCallStack => [Char] -> a
error [Char]
"orderedZipAll compFunc2 - should never happen" -- just to make this complete
                    (a
xs1:[a]
_) -> a -> a -> Ordering
compFunc a
x a
xs1

-- an exception type to represent invalid input order
data WrongInputOrderException = WrongInputOrderException String
    deriving (Int -> WrongInputOrderException -> ShowS
[WrongInputOrderException] -> ShowS
WrongInputOrderException -> [Char]
(Int -> WrongInputOrderException -> ShowS)
-> (WrongInputOrderException -> [Char])
-> ([WrongInputOrderException] -> ShowS)
-> Show WrongInputOrderException
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [WrongInputOrderException] -> ShowS
$cshowList :: [WrongInputOrderException] -> ShowS
show :: WrongInputOrderException -> [Char]
$cshow :: WrongInputOrderException -> [Char]
showsPrec :: Int -> WrongInputOrderException -> ShowS
$cshowsPrec :: Int -> WrongInputOrderException -> ShowS
Show, WrongInputOrderException -> WrongInputOrderException -> Bool
(WrongInputOrderException -> WrongInputOrderException -> Bool)
-> (WrongInputOrderException -> WrongInputOrderException -> Bool)
-> Eq WrongInputOrderException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WrongInputOrderException -> WrongInputOrderException -> Bool
$c/= :: WrongInputOrderException -> WrongInputOrderException -> Bool
== :: WrongInputOrderException -> WrongInputOrderException -> Bool
$c== :: WrongInputOrderException -> WrongInputOrderException -> Bool
Eq)
instance Exception WrongInputOrderException

-- a pipe to check wether the stream is ordered according to a custom ordering function
orderCheckPipe :: (MonadIO m, MonadSafe m, Show a) => (a -> a -> Ordering) -- ^the custom ordering function
               -> Pipe a a m r -- ^the resulting pipe
orderCheckPipe :: (a -> a -> Ordering) -> Pipe a a m r
orderCheckPipe a -> a -> Ordering
cmpFunc = do
    IORef (Maybe a)
lastValRef <- IO (IORef (Maybe a)) -> Proxy () a () a m (IORef (Maybe a))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (Maybe a)) -> Proxy () a () a m (IORef (Maybe a)))
-> IO (IORef (Maybe a)) -> Proxy () a () a m (IORef (Maybe a))
forall a b. (a -> b) -> a -> b
$ Maybe a -> IO (IORef (Maybe a))
forall a. a -> IO (IORef a)
newIORef (Maybe a
forall a. Maybe a
Nothing)
    Pipe a a m r -> (a -> Proxy () a () a m ()) -> Pipe a a m r
forall (m :: * -> *) x' x b' b a' c' c.
Functor m =>
Proxy x' x b' b m a'
-> (b -> Proxy x' x c' c m b') -> Proxy x' x c' c m a'
for Pipe a a m r
forall (m :: * -> *) a r. Functor m => Pipe a a m r
cat ((a -> Proxy () a () a m ()) -> Pipe a a m r)
-> (a -> Proxy () a () a m ()) -> Pipe a a m r
forall a b. (a -> b) -> a -> b
$ \a
entry -> do
        Maybe a
lastVal <- IO (Maybe a) -> Proxy () a () a m (Maybe a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe a) -> Proxy () a () a m (Maybe a))
-> IO (Maybe a) -> Proxy () a () a m (Maybe a)
forall a b. (a -> b) -> a -> b
$ IORef (Maybe a) -> IO (Maybe a)
forall a. IORef a -> IO a
readIORef IORef (Maybe a)
lastValRef
        case Maybe a
lastVal of
            Maybe a
Nothing -> () -> Proxy () a () a m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Just a
p -> case a -> a -> Ordering
cmpFunc a
entry a
p of
                Ordering
LT -> WrongInputOrderException -> Proxy () a () a m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (WrongInputOrderException -> Proxy () a () a m ())
-> WrongInputOrderException -> Proxy () a () a m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> WrongInputOrderException
WrongInputOrderException ([Char]
"ordering violated: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
p [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" should come after " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
entry)
                Ordering
_ -> () -> Proxy () a () a m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        IO () -> Proxy () a () a m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Proxy () a () a m ()) -> IO () -> Proxy () a () a m ()
forall a b. (a -> b) -> a -> b
$ IORef (Maybe a) -> Maybe a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe a)
lastValRef (a -> Maybe a
forall a. a -> Maybe a
Just a
entry)
        a -> Proxy () a () a m ()
forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
yield a
entry