{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE Trustworthy #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Functor.Identity
-- Copyright   :  (c) Andy Gill 2001,
--                (c) Oregon Graduate Institute of Science and Technology 2001
-- License     :  BSD-style (see the file LICENSE)
--
-- Maintainer  :  ross@soi.city.ac.uk
-- Stability   :  experimental
-- Portability :  portable
--
-- The identity functor and monad.
--
-- This trivial type constructor serves two purposes:
--
-- * It can be used with functions parameterized by functor or monad classes.
--
-- * It can be used as a base monad to which a series of monad
--   transformers may be applied to construct a composite monad.
--   Most monad transformer modules include the special case of
--   applying the transformer to 'Identity'.  For example, @State s@
--   is an abbreviation for @StateT s 'Identity'@.
--
-- @since 4.8.0.0
-----------------------------------------------------------------------------

module Data.Functor.Identity (
    Identity(..),
  ) where

import Control.Monad.Fix
import Data.Bits (Bits, FiniteBits)
import Data.Coerce
import Data.Foldable
import Data.Functor.Utils ((#.))
import Foreign.Storable (Storable)
import GHC.Ix (Ix)
import GHC.Base ( Applicative(..), Eq(..), Functor(..), Monad(..)
                , Semigroup, Monoid, Ord(..), ($), (.) )
import GHC.Enum (Bounded, Enum)
import GHC.Float (Floating, RealFloat)
import GHC.Generics (Generic, Generic1)
import GHC.Num (Num)
import GHC.Read (Read(..), lex, readParen)
import GHC.Real (Fractional, Integral, Real, RealFrac)
import GHC.Show (Show(..), showParen, showString)
import GHC.Types (Bool(..))

-- | Identity functor and monad. (a non-strict monad)
--
-- @since 4.8.0.0
newtype Identity a = Identity { Identity a -> a
runIdentity :: a }
    deriving ( Bits       -- ^ @since 4.9.0.0
             , Bounded    -- ^ @since 4.9.0.0
             , Enum       -- ^ @since 4.9.0.0
             , Eq         -- ^ @since 4.8.0.0
             , FiniteBits -- ^ @since 4.9.0.0
             , Floating   -- ^ @since 4.9.0.0
             , Fractional -- ^ @since 4.9.0.0
             , Generic    -- ^ @since 4.8.0.0
             , Generic1   -- ^ @since 4.8.0.0
             , Integral   -- ^ @since 4.9.0.0
             , Ix         -- ^ @since 4.9.0.0
             , Semigroup  -- ^ @since 4.9.0.0
             , Monoid     -- ^ @since 4.9.0.0
             , Num        -- ^ @since 4.9.0.0
             , Ord        -- ^ @since 4.8.0.0
             , Real       -- ^ @since 4.9.0.0
             , RealFrac   -- ^ @since 4.9.0.0
             , RealFloat  -- ^ @since 4.9.0.0
             , Storable   -- ^ @since 4.9.0.0
             )

-- | This instance would be equivalent to the derived instances of the
-- 'Identity' newtype if the 'runIdentity' field were removed
--
-- @since 4.8.0.0
instance (Read a) => Read (Identity a) where
    readsPrec :: Int -> ReadS (Identity a)
readsPrec Int
d = Bool -> ReadS (Identity a) -> ReadS (Identity a)
forall a. Bool -> ReadS a -> ReadS a
readParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ReadS (Identity a) -> ReadS (Identity a))
-> ReadS (Identity a) -> ReadS (Identity a)
forall a b. (a -> b) -> a -> b
$ \ String
r ->
        [(a -> Identity a
forall a. a -> Identity a
Identity a
x,String
t) | (String
"Identity",String
s) <- ReadS String
lex String
r, (a
x,String
t) <- Int -> ReadS a
forall a. Read a => Int -> ReadS a
readsPrec Int
11 String
s]

-- | This instance would be equivalent to the derived instances of the
-- 'Identity' newtype if the 'runIdentity' field were removed
--
-- @since 4.8.0.0
instance (Show a) => Show (Identity a) where
    showsPrec :: Int -> Identity a -> ShowS
showsPrec Int
d (Identity a
x) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
        String -> ShowS
showString String
"Identity " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 a
x

-- ---------------------------------------------------------------------------
-- Identity instances for Functor and Monad

-- | @since 4.8.0.0
instance Foldable Identity where
    foldMap :: (a -> m) -> Identity a -> m
foldMap                = (a -> m) -> Identity a -> m
coerce

    elem :: a -> Identity a -> Bool
elem                   = ((a -> Bool) -> (Identity a -> a) -> Identity a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity a -> a
forall a. Identity a -> a
runIdentity) ((a -> Bool) -> Identity a -> Bool)
-> (a -> a -> Bool) -> a -> Identity a -> Bool
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==)
    foldl :: (b -> a -> b) -> b -> Identity a -> b
foldl                  = (b -> a -> b) -> b -> Identity a -> b
coerce
    foldl' :: (b -> a -> b) -> b -> Identity a -> b
foldl'                 = (b -> a -> b) -> b -> Identity a -> b
coerce
    foldl1 :: (a -> a -> a) -> Identity a -> a
foldl1 a -> a -> a
_               = Identity a -> a
forall a. Identity a -> a
runIdentity
    foldr :: (a -> b -> b) -> b -> Identity a -> b
foldr a -> b -> b
f b
z (Identity a
x) = a -> b -> b
f a
x b
z
    foldr' :: (a -> b -> b) -> b -> Identity a -> b
foldr'                 = (a -> b -> b) -> b -> Identity a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
    foldr1 :: (a -> a -> a) -> Identity a -> a
foldr1 a -> a -> a
_               = Identity a -> a
forall a. Identity a -> a
runIdentity
    length :: Identity a -> Int
length Identity a
_               = Int
1
    maximum :: Identity a -> a
maximum                = Identity a -> a
forall a. Identity a -> a
runIdentity
    minimum :: Identity a -> a
minimum                = Identity a -> a
forall a. Identity a -> a
runIdentity
    null :: Identity a -> Bool
null Identity a
_                 = Bool
False
    product :: Identity a -> a
product                = Identity a -> a
forall a. Identity a -> a
runIdentity
    sum :: Identity a -> a
sum                    = Identity a -> a
forall a. Identity a -> a
runIdentity
    toList :: Identity a -> [a]
toList (Identity a
x)    = [a
x]

-- | @since 4.8.0.0
instance Functor Identity where
    fmap :: (a -> b) -> Identity a -> Identity b
fmap     = (a -> b) -> Identity a -> Identity b
coerce

-- | @since 4.8.0.0
instance Applicative Identity where
    pure :: a -> Identity a
pure     = a -> Identity a
forall a. a -> Identity a
Identity
    <*> :: Identity (a -> b) -> Identity a -> Identity b
(<*>)    = Identity (a -> b) -> Identity a -> Identity b
coerce
    liftA2 :: (a -> b -> c) -> Identity a -> Identity b -> Identity c
liftA2   = (a -> b -> c) -> Identity a -> Identity b -> Identity c
coerce

-- | @since 4.8.0.0
instance Monad Identity where
    Identity a
m >>= :: Identity a -> (a -> Identity b) -> Identity b
>>= a -> Identity b
k  = a -> Identity b
k (Identity a -> a
forall a. Identity a -> a
runIdentity Identity a
m)

-- | @since 4.8.0.0
instance MonadFix Identity where
    mfix :: (a -> Identity a) -> Identity a
mfix a -> Identity a
f   = a -> Identity a
forall a. a -> Identity a
Identity ((a -> a) -> a
forall a. (a -> a) -> a
fix (Identity a -> a
forall a. Identity a -> a
runIdentity (Identity a -> a) -> (a -> Identity a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Identity a
f))