extensible-effects 2.1.0.0 → 2.2.1.0

raw patch · 10 files changed

+336/−77 lines, 10 filesdep +criteriondep +mtldep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: criterion, mtl

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• benchmark/Benchmarks.hs +205/−0
• extensible-effects.cabal +14/−1
• src/Control/Eff.hs +76/−47
• src/Control/Eff/Cut.hs +2/−2
• src/Control/Eff/NdetEff.hs +5/−5
• src/Control/Eff/State/Lazy.hs +8/−8
• src/Control/Eff/State/LazyState.hs +4/−4
• src/Control/Eff/State/Strict.hs +7/−7
• src/Control/Eff/Trace.hs +2/−2
• src/Data/FTCQueue.hs +13/−1

@@ -0,0 +1,205 @@+{-# LANGUAGE FlexibleContexts, FlexibleInstances #-}++-- The simplest/silliest of all benchmarks!++import Criterion.Main+import Control.Eff as E+import Control.Eff.Exception as E.Er+import Control.Eff.NdetEff as E.ND+import Control.Eff.State.Strict as E.S+import Control.Monad++-- For comparison+-- We use a strict State monad, because of large space leaks with the+-- lazy monad (one test even overflows the stack)+import Control.Monad.State.Strict as S+import Control.Monad.Error  as Er+-- import Control.Monad.Reader as Rd+import Control.Monad.Cont as Ct+import Control.Applicative++main :: IO ()+main = defaultMain [+  bgroup "state" [ bgroup "10k" [ bench "mtl" $ whnf benchCnt_State 10000+                                , bench "eff" $ whnf benchCnt_Eff 10000+                                ]+                 ]+  , bgroup "error" [ bgroup "50k" [ bench "mtl" $ whnf benchMul_Error 50000+                                  , bench "eff" $ whnf benchMul_Eff 50000+                                  ]+                   ]+  , bgroup "st-error" [ bgroup "err : st" [ bench "mtl" $ whnf mainMax_MTL 10000+                                          , bench "eff" $ whnf mainMax_Eff 10000+                                          ]+                      , bgroup "st : err" [ bench "mtl" $ whnf mainMax1_MTL 10000+                                          , bench "eff" $ whnf mainMax1_Eff 10000+                                          ]+                      ]+  , bgroup "pyth" [ bgroup "ndet" [ bench "mtl" $ whnf mainN_MTL 20+                                  , bench "eff" $ whnf mainN_Eff 20+                                  ]+                  , bgroup "ndet : st" [ bench "mtl" $ nf mainNS_MTL 15+                                       , bench "eff" $ nf mainNS_Eff 15+                                       ]+                  ]+  ]++-- ------------------------------------------------------------------------+-- Single State, with very little non-effectful computation+-- This is a micro-benchmark, and hence not particularly realistic.+-- Because of its simplicity, GHC may do a lot of inlining.+-- See a more realistic max benchmark below, which does a fair amount+-- of computation other than accessing the state.++-- Count-down+benchCnt_State :: Int -> ((),Int)+benchCnt_State n = S.runState m n+ where+ m = do+     x <- S.get+     if x > 0 then S.put (x-1) >> m else return ()++benchCnt_Eff :: Int -> ((),Int)+benchCnt_Eff n = run $ E.S.runState m n+ where+ m = do+     x <- E.S.get+     if x > 0 then E.S.put (x-1::Int) >> m else return ()++-- ------------------------------------------------------------------------+-- Single Error++-- Multiply a list of numbers, throwing an exception when encountering 0+-- This is again a mcro-benchmark++-- make a list of n ones followed by 0+be_make_list :: Int -> [Int]+be_make_list n = replicate n 1 ++ [0]++instance Error Int where++benchMul_Error :: Int -> Int+benchMul_Error n = either id id m+ where+ m = foldM f 1 (be_make_list n)+ f acc 0 = Er.throwError 0+ f acc x = return $! acc * x++benchMul_Eff :: Int -> Int+benchMul_Eff n = either id id . run . runExc $ m+ where+ m = foldM f 1 (be_make_list n)+ f acc 0 = E.Er.throwExc (0::Int)+ f acc x = return $! acc * x++-- ------------------------------------------------------------------------+-- State and Error and non-effectful computation++benchMax_MTL :: (MonadState Int m, MonadError Int m) => Int -> m Int+benchMax_MTL n = foldM f 1 [n, n-1 .. 0]+ where+ f acc 0 = Er.throwError 0+ f acc x | x `mod` 5 == 0 = do+                            s <- S.get+                            S.put $! (s+1)+                            return $! max acc x+ f acc x = return $! max acc x++mainMax_MTL n = S.runState (Er.runErrorT (benchMax_MTL n)) 0++-- Different order of layers+mainMax1_MTL n = (S.runStateT (benchMax_MTL n) 0 :: Either Int (Int,Int))++benchMax_Eff :: (Member (Exc Int) r, Member (E.S.State Int) r) =>+                Int -> Eff r Int+benchMax_Eff n = foldM f 1 [n, n-1 .. 0]+ where+ f acc 0 = E.Er.throwExc (0::Int)+ f acc x | x `mod` 5 == 0 = do+                            s <- E.S.get+                            E.S.put $! (s+1::Int)+                            return $! max acc x+ f acc x = return $! max acc x+++mainMax_Eff n = ((run $ E.S.runState (E.Er.runExc (benchMax_Eff n)) 0) ::+                  (Either Int Int,Int))++mainMax1_Eff n = ((run $ E.Er.runExc (E.S.runState (benchMax_Eff n) 0)) ::+                     Either Int (Int,Int))++-- ------------------------------------------------------------------------+-- Non-determinism benchmark: Pythagorian triples++-- First benchmark, with non-determinism only++-- Stream from k to n+iota k n = if k > n then mzero else return k `mplus` iota (k+1) n++pyth1 :: MonadPlus m => Int -> m (Int, Int, Int)+pyth1 upbound = do+  x <- iota 1 upbound+  y <- iota 1 upbound+  z <- iota 1 upbound+  if x*x + y*y == z*z then return (x,y,z) else mzero++pyth20 =+  [(3,4,5),(4,3,5),(5,12,13),(6,8,10),(8,6,10),(8,15,17),(9,12,15),(12,5,13),+   (12,9,15),(12,16,20),(15,8,17),(16,12,20)]++pythr_MTL = pyth20 == ((runCont (pyth1 20) (\x -> [x])) :: [(Int,Int,Int)])++pythr_EFF = pyth20 == ((run . E.ND.makeChoiceA $ pyth1 20) :: [(Int,Int,Int)])+++-- There is no instance of MonadPlus for ContT+-- we have to make our own++instance Monad m => MonadPlus (ContT [r] m) where+  mzero = ContT $ \k -> return []+  mplus (ContT m1) (ContT m2) = ContT $ \k ->+    liftM2 (++) (m1 k) (m2 k)++instance Monad m => Alternative (ContT [r] m) where+  empty = mzero+  (<|>) = mplus++mainN_MTL n = ((runCont (pyth1 n) (\x -> [x])) :: [(Int,Int,Int)])++mainN_Eff n = ((run . E.ND.makeChoiceA $ pyth1 n) :: [(Int,Int,Int)])++-- Adding state: counting the number of choices++pyth2 :: Int -> ContT [r] (S.State Int) (Int, Int, Int)+pyth2 upbound = do+  x <- iota 1 upbound+  y <- iota 1 upbound+  z <- iota 1 upbound+  cnt <- S.get+  S.put $! (cnt + 1)+  if x*x + y*y == z*z then return (x,y,z) else mzero++pythrNS_MTL :: ([(Int,Int,Int)],Int)+pythrNS_MTL = S.runState (runContT (pyth2 20) (\x -> return [x])) 0++pyth2E :: (Member (E.S.State Int) r, Member NdetEff r) =>+          Int -> Eff r (Int, Int, Int)+pyth2E upbound = do+  x <- iota 1 upbound+  y <- iota 1 upbound+  z <- iota 1 upbound+  cnt <- E.S.get+  E.S.put $! (cnt + 1::Int)+  if x*x + y*y == z*z then return (x,y,z) else mzero+++pyth2Er :: ([(Int,Int,Int)],Int)+pyth2Er = run . (`E.S.runState` 0) . E.ND.makeChoiceA $ pyth2E 20++mainNS_MTL n =+  let (l,cnt) = S.runState (runContT (pyth2 n) (\x -> return [x])) 0+  in ((l::[(Int,Int,Int)]), (cnt::Int))++mainNS_Eff n =+  let (l,cnt) = run . (`E.S.runState` 0) . E.ND.makeChoiceA $ pyth2E n+  in ((l::[(Int,Int,Int)]), (cnt::Int))

@@ -6,7 +6,7 @@ -- PVP summary:      +-+------- breaking API changes --                   | | +----- non-breaking API additions --                   | | | +--- code changes with no API change-version:             2.1.0.0+version:             2.2.1.0  -- A short (one-line) description of the package. synopsis:            An Alternative to Monad Transformers@@ -175,6 +175,19 @@               , test-framework-th >= 0.2               , extensible-effects               , directory >= 1.2 && < 1.4++  default-language:    Haskell2010++benchmark extensible-effects-benchmarks+  type: exitcode-stdio-1.0+  main-is: Benchmarks.hs+  hs-source-dirs: benchmark/+  ghc-options: -Wall -O2 -threaded -fdicts-cheap -funbox-strict-fields+  build-depends:+                base+              , criterion+              , extensible-effects+              , mtl    default-language:    Haskell2010 

@@ -1,6 +1,6 @@ {-# OPTIONS_GHC -Werror #-} {-# LANGUAGE Trustworthy #-}-{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RankNTypes, ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE GADTs #-}@@ -28,6 +28,8 @@ #if __GLASGOW_HASKELL__ < 710 import Control.Applicative #endif+import qualified Control.Arrow as A+import qualified Control.Category as C import safe Data.OpenUnion import safe Data.FTCQueue import GHC.Exts (inline)@@ -36,29 +38,75 @@ -- denoted by r type Arr r a b = a -> Eff r b --- | An effectful function from 'a' to 'b' that is a composition--- of several effectful functions. The paremeter r describes the overall--- effect.--- The composition members are accumulated in a type-aligned queue-type Arrs r a b = FTCQueue (Eff r) a b+-- | An effectful function from 'a' to 'b' that is a composition of one or more+-- effectful functions. The paremeter r describes the overall effect.+--+-- The composition members are accumulated in a type-aligned queue.+-- Using a newtype here enables us to define `Category' and `Arrow' instances.+newtype Arrs r a b = Arrs (FTCQueue (Eff r) a b) -{-# INLINE single #-}-single :: Arr r a b -> Arrs r a b-single = tsingleton+-- | 'Arrs' can be composed and have a natural identity.+instance C.Category (Arrs r) where+  id = ident+  f . g = comp g f --- FIXME: convert to 'Arrs'+-- | As the name suggests, 'Arrs' also has an 'Arrow' instance.+instance A.Arrow (Arrs r) where+  arr = arr+  first = singleK . first . (^$)+ first :: Arr r a b -> Arr r (a, c) (b, c) first x = \(a,c) -> (, c) `fmap` x a +-- | convert single effectful arrow into composable type. i.e., convert 'Arr' to+-- 'Arrs'+{-# INLINE singleK #-}+singleK :: Arr r a b -> Arrs r a b+singleK = Arrs . tsingleton++-- | Application to the `generalized effectful function' Arrs r b w, i.e.,+-- convert 'Arrs' to 'Arr'+{-# INLINABLE qApp #-}+qApp :: forall r b w. Arrs r b w -> Arr r b w+qApp (Arrs q) x = viewlMap (inline tviewl q) ($ x) cons+  where+    cons :: forall x. Arr r b x -> FTCQueue (Eff r) x w -> Eff r w+    cons = \k t -> case k x of+      Val y -> qApp (Arrs t) y+      E u (Arrs q0) -> E u (Arrs (q0 >< t))+{-+-- A bit more understandable version+qApp :: Arrs r b w -> b -> Eff r w+qApp q x = case tviewl q of+   TOne k  -> k x+   k :| t -> bind' (k x) t+ where+   bind' :: Eff r a -> Arrs r a b -> Eff r b+   bind' (Pure y) k     = qApp k y+   bind' (Impure u q) k = Impure u (q >< k)+-}++-- | Syntactic sugar for 'qApp'+{-# INLINABLE (^$) #-}+(^$) :: forall r b w. Arrs r b w -> Arr r b w+q ^$ x = q `qApp` x++-- | Lift a function to an arrow arr :: (a -> b) -> Arrs r a b-arr f = single (Val . f)+arr f = singleK (Val . f) +-- | The identity arrow ident :: Arrs r a a ident = arr id +-- | Arrow composition comp :: Arrs r a b -> Arrs r b c -> Arrs r a c-comp = (><)+comp (Arrs f) (Arrs g) = Arrs (f >< g) +-- | Common pattern: append 'Arr' to 'Arrs'+(^|>) :: Arrs r a b -> Arr r b c -> Arrs r a c+(Arrs f) ^|> g = Arrs (f |> g)+ -- | The Eff monad (not a transformer!). It is a fairly standard coroutine monad -- where the type @r@ is the type of effects that can be handled, and the -- missing type @a@ (from the type application) is the type of value that is@@ -75,69 +123,50 @@ data Eff r a = Val a              | forall b. E  (Union r b) (Arrs r b a) --- | Application to the `generalized effectful function' Arrs r b w-{-# INLINABLE qApp #-}-qApp :: Arrs r b w -> b -> Eff r w-qApp q x =-  case inline tviewl q of-    TOne k  -> k x-    k :| t -> case k x of-      Val y -> qApp t y-      E u q0 -> E u (q0 >< t)--{---- A bit more understandable version-qApp :: Arrs r b w -> b -> Eff r w-qApp q x = case tviewl q of-   TOne k  -> k x-   k :| t -> bind' (k x) t- where-   bind' :: Eff r a -> Arrs r a b -> Eff r b-   bind' (Pure y) k     = qApp k y-   bind' (Impure u q) k = Impure u (q >< k)--}- -- | Compose effectful arrows (and possibly change the effect!) {-# INLINE qComp #-} qComp :: Arrs r a b -> (Eff r b -> Eff r' c) -> Arr r' a c -- qComp g h = (h . (g `qApp`))-qComp g h = \a -> h $ qApp g a+qComp g h = \a -> h $ (g ^$ a) +-- | Compose effectful arrows (and possibly change the effect!)+{-# INLINE qComps #-}+qComps :: Arrs r a b -> (Eff r b -> Eff r' c) -> Arrs r' a c+qComps g h = singleK $ qComp g h+ -- | Eff is still a monad and a functor (and Applicative) -- (despite the lack of the Functor constraint) instance Functor (Eff r) where   {-# INLINE fmap #-}   fmap f (Val x) = Val (f x)-  fmap f (E u q) = E u (q |> (Val . f)) -- does no mapping yet!+  fmap f (E u q) = E u (q ^|> (Val . f)) -- does no mapping yet!  instance Applicative (Eff r) where   {-# INLINE pure #-}   pure = Val-  Val f <*> Val x = Val $ f x-  Val f <*> E u q = E u (q |> (Val . f))-  E u q <*> Val x = E u (q |> (Val . ($ x)))-  E u q <*> m     = E u (q |> (`fmap` m))+  Val f <*> e = f `fmap` e+  E u q <*> e = E u (q ^|> (`fmap` e))  instance Monad (Eff r) where   {-# INLINE return #-}   {-# INLINE [2] (>>=) #-}   return = pure   Val x >>= k = k x-  E u q >>= k = E u (q |> k)          -- just accumulates continuations+  E u q >>= k = E u (q ^|> k)          -- just accumulates continuations {-   Val _ >> m = m-  E u q >> m = E u (q |> const m)+  E u q >> m = E u (q ^|> const m) -}  -- | Send a request and wait for a reply (resulting in an effectful -- computation). {-# INLINE [2] send #-} send :: Member t r => t v -> Eff r v-send t = E (inj t) (tsingleton Val)+send t = E (inj t) (singleK Val) -- This seems to be a very beneficial rule! On micro-benchmarks, cuts -- the needed memory in half and speeds up almost twice. {-# RULES-  "send/bind" [~3] forall t k. send t >>= k = E (inj t) (tsingleton k)+  "send/bind" [~3] forall t k. send t >>= k = E (inj t) (singleK k)  #-}  @@ -164,7 +193,7 @@   loop (Val x)  = ret x   loop (E u q)  = case decomp u of     Right x -> h x k-    Left  u0 -> E u0 (tsingleton k)+    Left  u0 -> E u0 (singleK k)    where k = qComp q loop  -- | Parameterized handle_relay@@ -178,7 +207,7 @@     loop s0 (Val x)  = ret s0 x     loop s0 (E u q)  = case decomp u of       Right x -> h s0 x k-      Left  u0 -> E u0 (tsingleton (k s0))+      Left  u0 -> E u0 (singleK (k s0))      where k s1 x = loop s1 $ qApp q x  -- | Add something like Control.Exception.catches? It could be useful@@ -195,5 +224,5 @@    loop (Val x)  = ret x    loop (E u q)  = case prj u of      Just x -> h x k-     _      -> E u (tsingleton k)+     _      -> E u (singleK k)     where k = qComp q loop

@@ -70,8 +70,8 @@     Left u0 -> check jq u0 q    check jq u _ | Just (Choose []) <- prj u  = next jq  -- (C1)-  check jq u q | Just (Choose [x]) <- prj u = loop jq (qApp q x)  -- (C3), optim-  check jq u q | Just (Choose lst) <- prj u = next $ map (qApp q) lst ++ jq -- (C3)+  check jq u q | Just (Choose [x]) <- prj u = loop jq (q ^$ x)  -- (C3), optim+  check jq u q | Just (Choose lst) <- prj u = next $ map (q ^$) lst ++ jq -- (C3)   check jq u q = loop jq (E (weaken u) q)     -- (C4)    next :: Member Choose r

@@ -54,8 +54,8 @@      Right MZero     -> case jq of        []    -> return empty        (h:t) -> loop t h-     Right MPlus -> loop (qApp q False : jq) (qApp q True)-     Left  u0 -> E u0 (single (\x -> loop jq (qApp q x)))+     Right MPlus -> loop (q ^$ False : jq) (q ^$ True)+     Left  u0 -> E u0 (singleK (\x -> loop jq (q ^$ x)))  -- ------------------------------------------------------------------------ -- Soft-cut: non-deterministic if-then-else, aka Prolog's *->@@ -71,7 +71,7 @@ msplit :: Member NdetEff r => Eff r a -> Eff r (Maybe (a, Eff r a)) msplit = loop []  where- -- single result+ -- singleK result  loop [] (Val x)  = return (Just (x,mzero))  -- definite result and perhaps some others  loop jq (Val x)  = return (Just (x, msum jq))@@ -82,8 +82,8 @@                    []     -> return Nothing                    -- other choices remain, try them                    (j:jqT) -> loop jqT j-  Just MPlus -> loop ((qApp q False):jq) (qApp q True)-  _      -> E u (single k) where k = qComp q (loop jq)+  Just MPlus -> loop ((q ^$ False):jq) (q ^$ True)+  _          -> E u (qComps q (loop jq))  -- Other committed choice primitives can be implemented in terms of msplit -- The following implementations are directly from the LogicT paper

@@ -71,11 +71,11 @@          -> Eff r (w,s)          -- ^ Effect containing final state and a return value runState (Val x) s = return (x,s) runState (E u0 q) s0 = case decomp u0 of-  Right Get     -> runState (qApp q s0) s0-  Right (Put s1) -> runState (qApp q ()) s1+  Right Get     -> runState (q ^$ s0) s0+  Right (Put s1) -> runState (q ^$ ()) s1   Right (Delay m1) -> let ~(x,s1) = run $ runState m1 s0-                      in runState (qApp q x) s1-  Left  u -> E u (single (\x -> runState (qApp q x) s0))+                      in runState (q ^$ x) s1+  Left  u -> E u (singleK (\x -> runState (q ^$ x) s0))  -- | Transform the state with a function. modify :: (Member (State s) r) => (s -> s) -> Eff r ()@@ -101,7 +101,7 @@      Right (Writer w v) -> k w v      Left  u  -> case decomp u of        Right (Reader f) -> k s (f s)-       Left u1 -> E u1 (single (k s))+       Left u1 -> E u1 (singleK (k s))     where k x = qComp q (loop x)  -- | Backwards state@@ -118,9 +118,9 @@    go :: s -> Eff '[State s] a -> (a,s)    go s (Val x) = (x,s)    go s0 (E u q) = case decomp u of-         Right Get      -> go s0 $ qApp q s0-         Right (Put s1)  -> let ~(x,sp) = go sp $ qApp q () in (x,s1)-         Right (Delay m1) -> let ~(x,s1) = go s0 m1 in go s1 $ qApp q x+         Right Get      -> go s0 $ (q ^$ s0)+         Right (Put s1)  -> let ~(x,sp) = go sp $ (q ^$ ()) in (x,s1)+         Right (Delay m1) -> let ~(x,s1) = go s0 m1 in go s1 $ (q ^$ x)          Left _ -> error "Impossible happened: Union []"  -- | Another implementation, exploring Haskell's laziness to make putAttr

@@ -64,10 +64,10 @@    go :: s -> Eff '[LazyState s] a -> (a,s)    go s (Val x) = (x,s)    go s (E u q) = case decomp u of-         Right LGet      -> go s $ qApp q s-         Right (LPut s1)  -> let ~(x,sp) = go sp $ qApp q () in (x,s1)-         Right (Delay m1) -> let ~(x,s1) = go s m1 in go s1 $ qApp q x-         Left _ -> error "LazyState: the impossible happened"+         Right LGet      -> go s $ (q ^$ s)+         Right (LPut s1)  -> let ~(x,sp) = go sp $ (q ^$ ()) in (x,s1)+         Right (Delay m1) -> let ~(x,s1) = go s m1 in go s1 $ (q ^$ x)+         Left _ -> error "LazyState: the impossible happened: Union []"  -- | Another implementation, exploring Haskell's laziness to make putAttr -- also technically inherited, to accumulate the sequence of

@@ -75,9 +75,9 @@          -> Eff r (w,s)           -- ^ Effect containing final state and a return value runState (Val x) !s = return (x,s) runState (E u q) !s = case decomp u of-  Right Get     -> runState (qApp q s) s-  Right (Put s1) -> runState (qApp q ()) s1-  Left  u1 -> E u1 (single (\x -> runState (qApp q x) s))+  Right Get     -> runState (q ^$ s) s+  Right (Put s1) -> runState (q ^$ ()) s1+  Left  u1 -> E u1 (singleK (\x -> runState (q ^$ x) s))  -- | Transform the state with a function. modify :: (Member (State s) r) => (s -> s) -> Eff r ()@@ -102,9 +102,9 @@    loop :: s -> Eff r w -> Eff r w    loop s (Val x) = put s >> return x    loop s (E (u::Union r b) q) = case prj u :: Maybe (State s b) of-     Just Get      -> loop s (qApp q s)-     Just (Put s') -> loop s'(qApp q ())-     _      -> E u (single k) where k = qComp q (loop s)+     Just Get      -> loop s (q ^$ s)+     Just (Put s') -> loop s'(q ^$ ())+     _             -> E u (qComps q (loop s))  -- | A different representation of State: decomposing State into mutation -- (Writer) and Reading. We don't define any new effects: we just handle the@@ -118,5 +118,5 @@      Right (Writer w v) -> k w v      Left  u1  -> case decomp u1 of        Right (Reader f) -> k s0 (f s0)-       Left u2 -> E u2 (single (k s0))+       Left u2 -> E u2 (singleK (k s0))     where k x = qComp q (loop x)

@@ -25,6 +25,6 @@ runTrace :: Eff '[Trace] w -> IO w runTrace (Val x) = return x runTrace (E u q) = case decomp u of-     Right (Trace s) -> putStrLn s >> runTrace (qApp q ())+     Right (Trace s) -> putStrLn s >> runTrace (q ^$ ())      -- Nothing more can occur-     Left _ -> error "runTrace: the impossible happened!"+     Left _ -> error "runTrace: the impossible happened!: Union []"

@@ -1,4 +1,5 @@ {-# LANGUAGE GADTs #-}+{-# LANGUAGE RankNTypes #-} {-# LANGUAGE Safe #-}  -- | Fast type-aligned queue optimized to effectful functions@@ -11,7 +12,8 @@   tsingleton,   (|>), -- snoc   (><), -- append-  ViewL(..),+  ViewL,+  viewlMap,   tviewl   )   where@@ -46,6 +48,16 @@ data ViewL m a b where   TOne  :: (a -> m b) -> ViewL m a b   (:|)  :: (a -> m x) -> (FTCQueue m x b) -> ViewL m a b++-- | Process the Left-edge deconstruction+{-# INLINE viewlMap #-}+viewlMap :: ViewL m a b+         -> ((a -> m b) -> c)+         -> (forall x. (a -> m x) -> (FTCQueue m x b) -> c)+         -> c+viewlMap view tone cons = case view of+  TOne k -> tone k+  k :| t -> cons k t  {-# INLINABLE tviewl #-} tviewl :: FTCQueue m a b -> ViewL m a b