{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}

{- |
Module      :  Data.Transaction

Copyright   :  Kadzuya Okamoto 2018
License     :  MIT

Stability   :  experimental
Portability :  unknown

Monadic representation of transactions.
-}
module Data.Transaction
  (
  -- * Constructors
    action
  -- * Converters
  , reduce
  , toList
  , tMap
  , tFilter
  , tFilterMap
  -- * Types
  , Transaction
  , TransactionM
  ) where

import Prelude hiding
  ( Foldable(..)
  , all
  , any
  , drop
  , dropWhile
  , filter
  , head
  , init
  , last
  , repeat
  , replicate
  , span
  , tail
  , take
  , takeWhile
  )

import Data.Bifunctor (Bifunctor(..))
import qualified Data.Monoid as Monoid
import Data.MonoTraversable
  ( Element
  , GrowingAppend
  , MonoFoldable(..)
  , MonoFunctor(..)
  , MonoPointed(..)
  , MonoTraversable(..)
  )
import Data.Semigroup as Sem
import Data.Sequences
  ( Index
  , IsSequence(..)
  , SemiSequence(..)
  , defaultSnoc
  , defaultSortBy
  )

{- ==============
 -     Types
 - ============== -}
data TransactionM a x
  = TVal a
         (TransactionM a x)
  | TNull x
  deriving (forall a b. a -> TransactionM a b -> TransactionM a a
forall a b. (a -> b) -> TransactionM a a -> TransactionM a b
forall a a b. a -> TransactionM a b -> TransactionM a a
forall a a b. (a -> b) -> TransactionM a a -> TransactionM a b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> TransactionM a b -> TransactionM a a
$c<$ :: forall a a b. a -> TransactionM a b -> TransactionM a a
fmap :: forall a b. (a -> b) -> TransactionM a a -> TransactionM a b
$cfmap :: forall a a b. (a -> b) -> TransactionM a a -> TransactionM a b
Functor)

type Transaction a = TransactionM a ()

instance Applicative (TransactionM a) where
  pure :: forall a. a -> TransactionM a a
pure = forall a a. a -> TransactionM a a
TNull
  TVal a
a TransactionM a (a -> b)
next <*> :: forall a b.
TransactionM a (a -> b) -> TransactionM a a -> TransactionM a b
<*> TransactionM a a
f = forall a x. a -> TransactionM a x -> TransactionM a x
TVal a
a (TransactionM a (a -> b)
next forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TransactionM a a
f)
  TNull a -> b
g <*> TransactionM a a
f = TransactionM a a
f forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
g)

instance Monad (TransactionM a) where
  return :: forall a. a -> TransactionM a a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
  TVal a
a TransactionM a a
next >>= :: forall a b.
TransactionM a a -> (a -> TransactionM a b) -> TransactionM a b
>>= a -> TransactionM a b
f = forall a x. a -> TransactionM a x -> TransactionM a x
TVal a
a (TransactionM a a
next forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> TransactionM a b
f)
  TNull a
a >>= a -> TransactionM a b
f = a -> TransactionM a b
f a
a

instance Sem.Semigroup (Transaction a) where
  TVal a
a Transaction a
next <> :: Transaction a -> Transaction a -> Transaction a
<> Transaction a
t = forall a x. a -> TransactionM a x -> TransactionM a x
TVal a
a (Transaction a
next forall a. Semigroup a => a -> a -> a
<> Transaction a
t)
  TNull ()
_ <> Transaction a
t = Transaction a
t

instance Monoid (Transaction a) where
  mempty :: Transaction a
mempty = forall a a. a -> TransactionM a a
TNull ()
#if !(MIN_VERSION_base(4,11,0))
  mappend = (<>)
#endif

instance Bifunctor TransactionM where
  first :: forall a b x. (a -> b) -> TransactionM a x -> TransactionM b x
  first :: forall a b c. (a -> b) -> TransactionM a c -> TransactionM b c
first a -> b
_ (TNull x
a) = forall (f :: * -> *) a. Applicative f => a -> f a
pure x
a
  first a -> b
f (TVal a
a TransactionM a x
next) = forall a x. a -> TransactionM a x -> TransactionM a x
TVal (a -> b
f a
a) forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first a -> b
f TransactionM a x
next
  second :: forall a x y. (x -> y) -> TransactionM a x -> TransactionM a y
  second :: forall a a b. (a -> b) -> TransactionM a a -> TransactionM a b
second = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap

type instance Element (Transaction a) = a

instance MonoFunctor (Transaction a) where
  omap :: (a -> a) -> Transaction a -> Transaction a
  omap :: (a -> a) -> Transaction a -> Transaction a
omap = forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first

instance MonoFoldable (Transaction a) where
  otoList :: Transaction a -> [Element (Transaction a)]
otoList = forall a. Transaction a -> [a]
toList
  ocompareLength :: Integral i => Transaction a -> i -> Ordering
  ocompareLength :: forall i. Integral i => Transaction a -> i -> Ordering
ocompareLength (TNull ()) i
i = i
0 forall a. Ord a => a -> a -> Ordering
`compare` i
i
  ocompareLength (TVal a
_ Transaction a
next) i
i
    | i
i forall a. Ord a => a -> a -> Bool
<= i
0 = Ordering
GT
    | Bool
otherwise = forall mono i.
(MonoFoldable mono, Integral i) =>
mono -> i -> Ordering
ocompareLength Transaction a
next (i
i forall a. Num a => a -> a -> a
- i
1)
  ofoldMap :: forall m.
Monoid m =>
(Element (Transaction a) -> m) -> Transaction a -> m
ofoldMap = forall m a. Monoid m => (a -> m) -> Transaction a -> m
foldMap
  ofoldr :: forall b.
(Element (Transaction a) -> b -> b) -> b -> Transaction a -> b
ofoldr = forall a b. (a -> b -> b) -> b -> Transaction a -> b
foldr
  ofoldl' :: forall a.
(a -> Element (Transaction a) -> a) -> a -> Transaction a -> a
ofoldl' = forall b a. (b -> a -> b) -> b -> Transaction a -> b
foldl'
  ofoldr1Ex :: (Element (Transaction a)
 -> Element (Transaction a) -> Element (Transaction a))
-> Transaction a -> Element (Transaction a)
ofoldr1Ex = forall a. (a -> a -> a) -> Transaction a -> a
foldr1
  ofoldl1Ex' :: (Element (Transaction a)
 -> Element (Transaction a) -> Element (Transaction a))
-> Transaction a -> Element (Transaction a)
ofoldl1Ex' = forall a. (a -> a -> a) -> Transaction a -> a
foldl1'

foldMap :: (Monoid m) => (a -> m) -> Transaction a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Transaction a -> m
foldMap a -> m
f = forall a b. (a -> b -> b) -> b -> Transaction a -> b
foldr (\a
x m
m -> a -> m
f a
x forall a. Semigroup a => a -> a -> a
Monoid.<> m
m) forall a. Monoid a => a
mempty

foldr :: (a -> b -> b) -> b -> Transaction a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Transaction a -> b
foldr a -> b -> b
_ b
b (TNull ()) = b
b
foldr a -> b -> b
f b
b (TVal a
a TransactionM a ()
next) = a -> b -> b
f a
a (forall a b. (a -> b -> b) -> b -> Transaction a -> b
foldr a -> b -> b
f b
b TransactionM a ()
next)

foldl :: (b -> a -> b) -> b -> Transaction a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Transaction a -> b
foldl b -> a -> b
f b
b (TVal a
a TransactionM a ()
next) = forall b a. (b -> a -> b) -> b -> Transaction a -> b
foldl b -> a -> b
f (b -> a -> b
f b
b a
a) TransactionM a ()
next
foldl b -> a -> b
_ b
b (TNull ()) = b
b

foldl' :: (b -> a -> b) -> b -> Transaction a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Transaction a -> b
foldl' b -> a -> b
(??) b
z Transaction a
xs = (forall a b. (a -> b -> b) -> b -> Transaction a -> b
foldr a -> (b -> b) -> b -> b
(?!) forall a. a -> a
id Transaction a
xs) b
z
  where
    a
x ?! :: a -> (b -> b) -> b -> b
?! b -> b
g = b -> b
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> a -> b
?? a
x)

foldr1 :: (a -> a -> a) -> Transaction a -> a
foldr1 :: forall a. (a -> a -> a) -> Transaction a -> a
foldr1 a -> a -> a
_ (TNull ()) = forall a. HasCallStack => [Char] -> a
error [Char]
"Transaction.foldr1: empty transaction"
foldr1 a -> a -> a
_ (TVal a
a (TNull ())) = a
a
foldr1 a -> a -> a
f (TVal a
a TransactionM a ()
next) = a -> a -> a
f a
a (forall a. (a -> a -> a) -> Transaction a -> a
foldr1 a -> a -> a
f TransactionM a ()
next)

foldl1' :: (a -> a -> a) -> Transaction a -> a
foldl1' :: forall a. (a -> a -> a) -> Transaction a -> a
foldl1' a -> a -> a
_ (TNull ()) = forall a. HasCallStack => [Char] -> a
error [Char]
"Transaction.foldl1': empty transaction"
foldl1' a -> a -> a
f (TVal a
a TransactionM a ()
next) = forall b a. (b -> a -> b) -> b -> Transaction a -> b
foldl' a -> a -> a
f a
a TransactionM a ()
next

#if MIN_VERSION_base(4,11,0)
{-# NOINLINE [1] length #-}
length :: Transaction a -> Int
length :: forall a. Transaction a -> Int
length Transaction a
t = forall a. Transaction a -> Int -> Int
lenAcc Transaction a
t Int
0

lenAcc :: Transaction a -> Int -> Int
lenAcc :: forall a. Transaction a -> Int -> Int
lenAcc (TNull ()) Int
n = Int
n
lenAcc (TVal a
_ TransactionM a ()
next) Int
n = forall a. Transaction a -> Int -> Int
lenAcc TransactionM a ()
next (Int
n forall a. Num a => a -> a -> a
+ Int
1)
#endif

instance MonoPointed (Transaction a) where
  opoint :: a -> Transaction a
  opoint :: a -> Transaction a
opoint = forall a. a -> Transaction a
action

instance SemiSequence (Transaction a) where
  type Index (Transaction a) = Int
  intersperse :: a -> Transaction a -> Transaction a
  intersperse :: a -> Transaction a -> Transaction a
intersperse a
_ (TNull ()) = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  intersperse a
sep (TVal a
a Transaction a
next) = forall a x. a -> TransactionM a x -> TransactionM a x
TVal a
a forall a b. (a -> b) -> a -> b
$ forall a. a -> Transaction a -> Transaction a
prependToAll a
sep Transaction a
next
  reverse :: Transaction a -> Transaction a
  reverse :: Transaction a -> Transaction a
reverse = forall b a. (b -> a -> b) -> b -> Transaction a -> b
reduce (\Transaction a
t a
a -> forall a x. a -> TransactionM a x -> TransactionM a x
TVal a
a Transaction a
t) (forall a a. a -> TransactionM a a
TNull ())
  find :: (a -> Bool) -> Transaction a -> Maybe a
  find :: (a -> Bool) -> Transaction a -> Maybe a
find a -> Bool
p Transaction a
t =
    case forall a. (a -> Bool) -> Transaction a -> Transaction a
tFilter a -> Bool
p Transaction a
t of
      TNull () -> forall a. Maybe a
Nothing
      TVal a
a Transaction a
_ -> forall a. a -> Maybe a
Just a
a
  sortBy :: (a -> a -> Ordering) -> Transaction a -> Transaction a
  sortBy :: (a -> a -> Ordering) -> Transaction a -> Transaction a
sortBy = forall seq.
IsSequence seq =>
(Element seq -> Element seq -> Ordering) -> seq -> seq
defaultSortBy
  cons :: a -> Transaction a -> Transaction a
  cons :: a -> Transaction a -> Transaction a
cons a
a Transaction a
t = forall a x. a -> TransactionM a x -> TransactionM a x
TVal a
a Transaction a
t
  snoc :: Transaction a -> a -> Transaction a
  snoc :: Transaction a -> a -> Transaction a
snoc = forall seq. IsSequence seq => seq -> Element seq -> seq
defaultSnoc

prependToAll :: a -> Transaction a -> Transaction a
prependToAll :: forall a. a -> Transaction a -> Transaction a
prependToAll a
_ (TNull ()) = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
prependToAll a
sep (TVal a
a TransactionM a ()
next) = forall a x. a -> TransactionM a x -> TransactionM a x
TVal a
sep forall a b. (a -> b) -> a -> b
$ forall a x. a -> TransactionM a x -> TransactionM a x
TVal a
a forall a b. (a -> b) -> a -> b
$ forall a. a -> Transaction a -> Transaction a
prependToAll a
sep TransactionM a ()
next

instance GrowingAppend (Transaction a)

instance MonoTraversable (Transaction a) where
  otraverse :: Applicative f => (a -> f a) -> Transaction a -> f (Transaction a)
  otraverse :: forall (f :: * -> *).
Applicative f =>
(a -> f a) -> Transaction a -> f (Transaction a)
otraverse a -> f a
_ (TNull ()) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  otraverse a -> f a
f (TVal a
a Transaction a
next) = forall a x. a -> TransactionM a x -> TransactionM a x
TVal forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f a
f a
a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall mono (f :: * -> *).
(MonoTraversable mono, Applicative f) =>
(Element mono -> f (Element mono)) -> mono -> f mono
otraverse a -> f a
f Transaction a
next

instance IsSequence (Transaction a) where
  fromList :: [a] -> Transaction a
  fromList :: [a] -> Transaction a
fromList [] = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  fromList (a
x:[a]
xs) = forall a x. a -> TransactionM a x -> TransactionM a x
TVal a
x forall a b. (a -> b) -> a -> b
$ forall seq. IsSequence seq => [Element seq] -> seq
fromList [a]
xs

#if MIN_VERSION_mono_traversable(1,0,2)
  lengthIndex :: Transaction a -> Int
  lengthIndex :: Transaction a -> Int
lengthIndex = forall a. Transaction a -> Int
length
#endif

  {-# NOINLINE [1] filter #-}
  filter :: (a -> Bool) -> Transaction a -> Transaction a
  filter :: (a -> Bool) -> Transaction a -> Transaction a
filter a -> Bool
_ (TNull ()) = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  filter a -> Bool
p (TVal a
a Transaction a
next)
    | a -> Bool
p a
a = forall a x. a -> TransactionM a x -> TransactionM a x
TVal a
a forall a b. (a -> b) -> a -> b
$ forall seq. IsSequence seq => (Element seq -> Bool) -> seq -> seq
filter a -> Bool
p Transaction a
next
    | Bool
otherwise = forall seq. IsSequence seq => (Element seq -> Bool) -> seq -> seq
filter a -> Bool
p Transaction a
next
  filterM :: Monad m => (a -> m Bool) -> Transaction a -> m (Transaction a)
  filterM :: forall (m :: * -> *).
Monad m =>
(a -> m Bool) -> Transaction a -> m (Transaction a)
filterM a -> m Bool
_ (TNull ()) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  filterM a -> m Bool
mp (TVal a
a Transaction a
next) = do
    Bool
b <- a -> m Bool
mp a
a
    Transaction a
next' <- forall seq (m :: * -> *).
(IsSequence seq, Monad m) =>
(Element seq -> m Bool) -> seq -> m seq
filterM a -> m Bool
mp Transaction a
next
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
      if Bool
b
        then forall a x. a -> TransactionM a x -> TransactionM a x
TVal a
a Transaction a
next'
        else Transaction a
next'
  break :: (a -> Bool) -> Transaction a -> (Transaction a, Transaction a)
  break :: (a -> Bool) -> Transaction a -> (Transaction a, Transaction a)
break a -> Bool
p = forall seq.
IsSequence seq =>
(Element seq -> Bool) -> seq -> (seq, seq)
span (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
p)
  span :: (a -> Bool) -> Transaction a -> (Transaction a, Transaction a)
  span :: (a -> Bool) -> Transaction a -> (Transaction a, Transaction a)
span a -> Bool
_ t :: Transaction a
t@(TNull ()) = (Transaction a
t, Transaction a
t)
  span a -> Bool
p t :: Transaction a
t@(TVal a
a Transaction a
next)
    | a -> Bool
p a
a =
      let (Transaction a
y, Transaction a
z) = forall seq.
IsSequence seq =>
(Element seq -> Bool) -> seq -> (seq, seq)
span a -> Bool
p Transaction a
next
       in (forall a x. a -> TransactionM a x -> TransactionM a x
TVal a
a Transaction a
y, Transaction a
z)
    | Bool
otherwise = (forall (f :: * -> *) a. Applicative f => a -> f a
pure (), Transaction a
t)
  dropWhile :: (a -> Bool) -> Transaction a -> Transaction a
  dropWhile :: (a -> Bool) -> Transaction a -> Transaction a
dropWhile a -> Bool
_ (TNull ()) = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  dropWhile a -> Bool
p t :: Transaction a
t@(TVal a
a Transaction a
next)
    | a -> Bool
p a
a = forall seq. IsSequence seq => (Element seq -> Bool) -> seq -> seq
dropWhile a -> Bool
p Transaction a
next
    | Bool
otherwise = Transaction a
t
  takeWhile :: (a -> Bool) -> Transaction a -> Transaction a
  takeWhile :: (a -> Bool) -> Transaction a -> Transaction a
takeWhile a -> Bool
_ (TNull ()) = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  takeWhile a -> Bool
p (TVal a
a Transaction a
next)
    | a -> Bool
p a
a = forall a x. a -> TransactionM a x -> TransactionM a x
TVal a
a forall a b. (a -> b) -> a -> b
$ forall seq. IsSequence seq => (Element seq -> Bool) -> seq -> seq
takeWhile a -> Bool
p Transaction a
next
    | Bool
otherwise = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  splitAt :: Int -> Transaction a -> (Transaction a, Transaction a)
  splitAt :: Int -> Transaction a -> (Transaction a, Transaction a)
splitAt Int
n Transaction a
t = (forall seq. IsSequence seq => Index seq -> seq -> seq
take Int
n Transaction a
t, forall seq. IsSequence seq => Index seq -> seq -> seq
drop Int
n Transaction a
t)
  take :: Int -> Transaction a -> Transaction a
  take :: Int -> Transaction a -> Transaction a
take Int
n Transaction a
_
    | Int
n forall a. Ord a => a -> a -> Bool
<= Int
0 = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  take Int
_ (TNull ()) = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  take Int
n (TVal a
a Transaction a
next) = forall a x. a -> TransactionM a x -> TransactionM a x
TVal a
a forall a b. (a -> b) -> a -> b
$ forall seq. IsSequence seq => Index seq -> seq -> seq
take (Int
n forall a. Num a => a -> a -> a
- Int
1) Transaction a
next
  drop :: Int -> Transaction a -> Transaction a
  drop :: Int -> Transaction a -> Transaction a
drop Int
n Transaction a
t
    | Int
n forall a. Ord a => a -> a -> Bool
<= Int
0 = Transaction a
t
  drop Int
_ (TNull ()) = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  drop Int
n (TVal a
_ Transaction a
next) = forall seq. IsSequence seq => Index seq -> seq -> seq
drop (Int
n forall a. Num a => a -> a -> a
- Int
1) Transaction a
next
  uncons :: Transaction a -> Maybe (a, Transaction a)
  uncons :: Transaction a -> Maybe (a, Transaction a)
uncons (TNull ()) = forall a. Maybe a
Nothing
  uncons (TVal a
a Transaction a
next) = forall a. a -> Maybe a
Just (a
a, Transaction a
next)
  unsnoc :: Transaction a -> Maybe (Transaction a, Element (Transaction a))
unsnoc (TNull ()) = forall a. Maybe a
Nothing
  unsnoc (TVal a
a0 Transaction a
next0) = forall a. a -> Maybe a
Just (forall {t} {c}.
(TransactionM t () -> c) -> t -> TransactionM t () -> (c, t)
loop forall a. a -> a
id a
a0 Transaction a
next0)
    where
      loop :: (TransactionM t () -> c) -> t -> TransactionM t () -> (c, t)
loop TransactionM t () -> c
front t
a (TNull ()) = (TransactionM t () -> c
front forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure (), t
a)
      loop TransactionM t () -> c
front t
a (TVal t
y TransactionM t ()
z) = (TransactionM t () -> c) -> t -> TransactionM t () -> (c, t)
loop (TransactionM t () -> c
front forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a x. a -> TransactionM a x -> TransactionM a x
TVal t
a)) t
y TransactionM t ()
z
  {-# INLINE partition #-}
  partition :: (a -> Bool) -> Transaction a -> (Transaction a, Transaction a)
  partition :: (a -> Bool) -> Transaction a -> (Transaction a, Transaction a)
partition a -> Bool
p Transaction a
t = forall a b. (a -> b -> b) -> b -> Transaction a -> b
foldr (forall a.
(a -> Bool)
-> a
-> (Transaction a, Transaction a)
-> (Transaction a, Transaction a)
select a -> Bool
p) (forall (f :: * -> *) a. Applicative f => a -> f a
pure (), forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) Transaction a
t
  {-# INLINE replicate #-}
  replicate :: Int -> a -> Transaction a
  replicate :: Int -> a -> Transaction a
replicate Int
n a
a = forall seq. IsSequence seq => Index seq -> seq -> seq
take Int
n (forall a. a -> Transaction a
repeat a
a)
  replicateM :: Monad m => Int -> m a -> m (Transaction a)
  replicateM :: forall (m :: * -> *). Monad m => Int -> m a -> m (Transaction a)
replicateM Int
cnt0 m a
f = Int -> m (Transaction a)
loop Int
cnt0
    where
      loop :: Int -> m (Transaction a)
loop Int
cnt
        | Int
cnt forall a. Ord a => a -> a -> Bool
<= Int
0 = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        | Bool
otherwise = forall a x. a -> TransactionM a x -> TransactionM a x
TVal forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
f forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> m (Transaction a)
loop (Int
cnt forall a. Num a => a -> a -> a
- Int
1)

{-# INLINE [0] repeat #-}
repeat :: a -> Transaction a
repeat :: forall a. a -> Transaction a
repeat a
a = TransactionM a ()
t
  where
    t :: TransactionM a ()
t = forall a x. a -> TransactionM a x -> TransactionM a x
TVal a
a TransactionM a ()
t

select ::
     (a -> Bool)
  -> a
  -> (Transaction a, Transaction a)
  -> (Transaction a, Transaction a)
select :: forall a.
(a -> Bool)
-> a
-> (Transaction a, Transaction a)
-> (Transaction a, Transaction a)
select a -> Bool
p a
x ~(Transaction a
ts, Transaction a
fs)
  | a -> Bool
p a
x = (forall a x. a -> TransactionM a x -> TransactionM a x
TVal a
x Transaction a
ts, Transaction a
fs)
  | Bool
otherwise = (Transaction a
ts, forall a x. a -> TransactionM a x -> TransactionM a x
TVal a
x Transaction a
fs)

{- ==============
 -   Operators
 - ============== -}
{- |
>>> :{
toList $ do
  action 4
  action 5
  action 6
:}
[4,5,6]

>>> :{
toList $ filter even $ do
  action 4
  action 5
  action 6
:}
[4,6]
-}
action :: a -> Transaction a
action :: forall a. a -> Transaction a
action a
a = forall a x. a -> TransactionM a x -> TransactionM a x
TVal a
a forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

{- ==============
 -   Converters
 - ============== -}
{- | An alias of 'first' for convenience.

>>> :{
toList $ do
  action 4
  tMap (+1) $ do
    action 5
    action 6
  action 7
:}
[4,6,7,7]
-}
tMap :: (a -> b) -> Transaction a -> Transaction b
tMap :: forall a b. (a -> b) -> Transaction a -> Transaction b
tMap a -> b
f = forall a b. (a -> Maybe b) -> Transaction a -> Transaction b
tFilterMap (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)

{-# DEPRECATED
tFilter "Use `IsSequence.filter` instead."
 #-}

{- | An alias of 'filter'.

>>> :{
toList $ do
  action 4
  tFilter even $ do
    action 5
    action 6
  action 7
:}
[4,6,7]

>>> :{
toList $ do
  action 4
  filter even $ do
    action 5
    action 6
  action 7
:}
[4,6,7]

-}
tFilter :: (a -> Bool) -> Transaction a -> Transaction a
tFilter :: forall a. (a -> Bool) -> Transaction a -> Transaction a
tFilter = forall seq. IsSequence seq => (Element seq -> Bool) -> seq -> seq
filter

{-# DEPRECATED
tFilterMap "This will be removed in a future release."
 #-}

{- |
>>> :{
toList $ do
  action 4
  tFilterMap (\x -> if even x then Just (x + 1) else Nothing) $ do
    action 5
    action 6
  action 7
:}
[4,7,7]
-}
tFilterMap :: (a -> Maybe b) -> Transaction a -> Transaction b
tFilterMap :: forall a b. (a -> Maybe b) -> Transaction a -> Transaction b
tFilterMap a -> Maybe b
f (TVal a
a TransactionM a ()
next) =
  case a -> Maybe b
f a
a of
    Just b
b -> forall a x. a -> TransactionM a x -> TransactionM a x
TVal b
b forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> Transaction a -> Transaction b
tFilterMap a -> Maybe b
f TransactionM a ()
next
    Maybe b
Nothing -> forall a b. (a -> Maybe b) -> Transaction a -> Transaction b
tFilterMap a -> Maybe b
f TransactionM a ()
next
tFilterMap a -> Maybe b
_ (TNull ()) = forall a a. a -> TransactionM a a
TNull ()

{- | An alias of 'foldl' for convenience.
-}
reduce :: (b -> a -> b) -> b -> Transaction a -> b
reduce :: forall b a. (b -> a -> b) -> b -> Transaction a -> b
reduce = forall b a. (b -> a -> b) -> b -> Transaction a -> b
foldl

toList :: Transaction a -> [a]
toList :: forall a. Transaction a -> [a]
toList Transaction a
trans = forall b a. (b -> a -> b) -> b -> Transaction a -> b
reduce (\[a] -> [a]
f a
a -> [a] -> [a]
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
a forall a. a -> [a] -> [a]
:)) forall a. a -> a
id Transaction a
trans []