1{-# LANGUAGE CPP #-} 2{-# LANGUAGE DeriveGeneric #-} 3{-# LANGUAGE DeriveDataTypeable #-} 4{-# LANGUAGE StandaloneDeriving #-} 5module Foundation.Monad 6 ( MonadIO(..) 7 , MonadFailure(..) 8 , MonadThrow(..) 9 , MonadCatch(..) 10 , MonadBracket(..) 11 , MonadTrans(..) 12 , Identity(..) 13 , replicateM 14 ) where 15 16import Basement.Imports 17import Basement.Types.OffsetSize 18import Basement.Monad (MonadFailure(..)) 19import Foundation.Monad.MonadIO 20import Foundation.Monad.Exception 21import Foundation.Monad.Transformer 22import Foundation.Numerical 23import Control.Applicative (liftA2) 24 25#if MIN_VERSION_base(4,8,0) 26import Data.Functor.Identity 27 28#else 29 30import Control.Monad.Fix 31import Control.Monad.Zip 32import Basement.Compat.Base 33 34import GHC.Generics (Generic1) 35 36-- | Identity functor and monad. (a non-strict monad) 37-- 38-- @since 4.8.0.0 39newtype Identity a = Identity { runIdentity :: a } 40 deriving (Eq, Ord, Data, Generic, Generic1, Typeable) 41 42instance Functor Identity where 43 fmap f (Identity x) = Identity (f x) 44 45instance Applicative Identity where 46 pure = Identity 47 Identity f <*> Identity x = Identity (f x) 48 49instance Monad Identity where 50 return = Identity 51 m >>= k = k (runIdentity m) 52 53instance MonadFix Identity where 54 mfix f = Identity (fix (runIdentity . f)) 55 56instance MonadZip Identity where 57 mzipWith f (Identity x) (Identity y) = Identity (f x y) 58 munzip (Identity (x, y)) = (Identity x, Identity y) 59 60#endif 61 62-- | @'replicateM' n act@ performs the action @n@ times, 63-- gathering the results. 64replicateM :: Applicative m => CountOf a -> m a -> m [a] 65replicateM (CountOf count) f = loop count 66 where 67 loop cnt 68 | cnt <= 0 = pure [] 69 | otherwise = liftA2 (:) f (loop (cnt - 1)) 70{-# INLINEABLE replicateM #-} 71