@@ -0,0 +1,38 @@
1+#!/usr/bin/env stack
2+-- stack runghc
3+
4+{-# LANGUAGE FlexibleContexts #-}
5+
6+import Data.Word
7+import System.Random
8+import Data.List (sort)
9+import qualified Asyncly as A
10+
11+getSorted = do
12+ g <- A.liftIO getStdGen
13+ let ls = take 100000 (randoms g) :: [Word16]
14+ A.foldMapWith (A.<>) return (sort ls)
15+
16+mergeAsync :: (Ord a, A.MonadAsync m)
17+ => A.AsyncT m a -> A.AsyncT m a -> A.AsyncT m a
18+mergeAsync a b = do
19+ x <- A.lift $ A.async a
20+ y <- A.lift $ A.async b
21+ merge x y
22+
23+merge a b = do
24+ x <- A.lift $ A.next a
25+ case x of
26+ Nothing -> b
27+ Just (va, ma) -> do
28+ y <- A.lift $ A.next b
29+ case y of
30+ Nothing -> return va A.<> ma
31+ Just (vb, mb) ->
32+ if (vb < va)
33+ then (return vb) A.<> merge (return va A.<> ma) mb
34+ else (return va) A.<> merge ma (return vb A.<> mb)
35+
36+main = do
37+ xs <- A.toList $ mergeAsync getSorted getSorted
38+ putStrLn $ show $ length xs