c6c2758c9d71ddfeca05d9d10e35f7484cac779a
[ghc.git] / libraries / base / Data / Functor / Utils.hs
1 {-# LANGUAGE Trustworthy #-}
2 {-# LANGUAGE NoImplicitPrelude #-}
3
4 -----------------------------------------------------------------------------
5 -- This is a non-exposed internal module.
6 --
7 -- This code contains utility function and data structures that are used
8 -- to improve the efficiency of several instances in the Data.* namespace.
9 -----------------------------------------------------------------------------
10 module Data.Functor.Utils where
11
12 import Data.Coerce (Coercible, coerce)
13 import GHC.Base ( Applicative(..), Functor(..), Maybe(..), Monoid(..), Ord(..)
14 , Semigroup(..), ($), otherwise )
15
16 -- We don't expose Max and Min because, as Edward Kmett pointed out to me,
17 -- there are two reasonable ways to define them. One way is to use Maybe, as we
18 -- do here; the other way is to impose a Bounded constraint on the Monoid
19 -- instance. We may eventually want to add both versions, but we don't want to
20 -- trample on anyone's toes by imposing Max = MaxMaybe.
21
22 newtype Max a = Max {getMax :: Maybe a}
23 newtype Min a = Min {getMin :: Maybe a}
24
25 -- | @since 4.11.0.0
26 instance Ord a => Semigroup (Max a) where
27 {-# INLINE (<>) #-}
28 m <> Max Nothing = m
29 Max Nothing <> n = n
30 (Max m@(Just x)) <> (Max n@(Just y))
31 | x >= y = Max m
32 | otherwise = Max n
33
34 -- | @since 4.8.0.0
35 instance Ord a => Monoid (Max a) where
36 mempty = Max Nothing
37
38 -- | @since 4.11.0.0
39 instance Ord a => Semigroup (Min a) where
40 {-# INLINE (<>) #-}
41 m <> Min Nothing = m
42 Min Nothing <> n = n
43 (Min m@(Just x)) <> (Min n@(Just y))
44 | x <= y = Min m
45 | otherwise = Min n
46
47 -- | @since 4.8.0.0
48 instance Ord a => Monoid (Min a) where
49 mempty = Min Nothing
50
51 -- left-to-right state transformer
52 newtype StateL s a = StateL { runStateL :: s -> (s, a) }
53
54 -- | @since 4.0
55 instance Functor (StateL s) where
56 fmap f (StateL k) = StateL $ \ s -> let (s', v) = k s in (s', f v)
57
58 -- | @since 4.0
59 instance Applicative (StateL s) where
60 pure x = StateL (\ s -> (s, x))
61 StateL kf <*> StateL kv = StateL $ \ s ->
62 let (s', f) = kf s
63 (s'', v) = kv s'
64 in (s'', f v)
65 liftA2 f (StateL kx) (StateL ky) = StateL $ \s ->
66 let (s', x) = kx s
67 (s'', y) = ky s'
68 in (s'', f x y)
69
70 -- right-to-left state transformer
71 newtype StateR s a = StateR { runStateR :: s -> (s, a) }
72
73 -- | @since 4.0
74 instance Functor (StateR s) where
75 fmap f (StateR k) = StateR $ \ s -> let (s', v) = k s in (s', f v)
76
77 -- | @since 4.0
78 instance Applicative (StateR s) where
79 pure x = StateR (\ s -> (s, x))
80 StateR kf <*> StateR kv = StateR $ \ s ->
81 let (s', v) = kv s
82 (s'', f) = kf s'
83 in (s'', f v)
84 liftA2 f (StateR kx) (StateR ky) = StateR $ \ s ->
85 let (s', y) = ky s
86 (s'', x) = kx s'
87 in (s'', f x y)
88
89 -- See Note [Function coercion]
90 (#.) :: Coercible b c => (b -> c) -> (a -> b) -> (a -> c)
91 (#.) _f = coerce
92 {-# INLINE (#.) #-}
93
94 {-
95 Note [Function coercion]
96 ~~~~~~~~~~~~~~~~~~~~~~~
97
98 Several functions here use (#.) instead of (.) to avoid potential efficiency
99 problems relating to #7542. The problem, in a nutshell:
100
101 If N is a newtype constructor, then N x will always have the same
102 representation as x (something similar applies for a newtype deconstructor).
103 However, if f is a function,
104
105 N . f = \x -> N (f x)
106
107 This looks almost the same as f, but the eta expansion lifts it--the lhs could
108 be _|_, but the rhs never is. This can lead to very inefficient code. Thus we
109 steal a technique from Shachaf and Edward Kmett and adapt it to the current
110 (rather clean) setting. Instead of using N . f, we use N #. f, which is
111 just
112
113 coerce f `asTypeOf` (N . f)
114
115 That is, we just *pretend* that f has the right type, and thanks to the safety
116 of coerce, the type checker guarantees that nothing really goes wrong. We still
117 have to be a bit careful, though: remember that #. completely ignores the
118 *value* of its left operand.
119 -}