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