{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE StandaloneDeriving #-}
module Foundation.Monad
( MonadIO(..)
, MonadFailure(..)
, MonadThrow(..)
, MonadCatch(..)
, MonadBracket(..)
, MonadTrans(..)
, Identity(..)
, replicateM
) where
import Basement.Imports
import Basement.Types.OffsetSize
import Basement.Monad (MonadFailure(..))
import Foundation.Monad.MonadIO
import Foundation.Monad.Exception
import Foundation.Monad.Transformer
import Foundation.Numerical
#if MIN_VERSION_base(4,8,0)
import Data.Functor.Identity
#else
import Control.Monad.Fix
import Control.Monad.Zip
import Basement.Compat.Base
import GHC.Generics (Generic1)
newtype Identity a = Identity { runIdentity :: a }
deriving (Eq, Ord, Data, Generic, Generic1, Typeable)
instance Functor Identity where
fmap f (Identity x) = Identity (f x)
instance Applicative Identity where
pure = Identity
Identity f <*> Identity x = Identity (f x)
instance Monad Identity where
return = Identity
m >>= k = k (runIdentity m)
instance MonadFix Identity where
mfix f = Identity (fix (runIdentity . f))
instance MonadZip Identity where
mzipWith f (Identity x) (Identity y) = Identity (f x y)
munzip (Identity (x, y)) = (Identity x, Identity y)
#endif
replicateM :: Applicative m => CountOf a -> m a -> m [a]
replicateM :: forall (m :: * -> *) a. Applicative m => CountOf a -> m a -> m [a]
replicateM (CountOf Int
count) m a
f = Int -> m [a]
loop Int
count
where
loop :: Int -> m [a]
loop Int
cnt
| Int
cnt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = [a] -> m [a]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
| Bool
otherwise = (:) (a -> [a] -> [a]) -> m a -> m ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
f m ([a] -> [a]) -> m [a] -> m [a]
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int -> m [a]
loop (Int
cnt Int -> Int -> Difference Int
forall a. Subtractive a => a -> a -> Difference a
- Int
1))
{-# INLINEABLE replicateM #-}