/
Representable.hs
151 lines (121 loc) · 4.58 KB
/
Representable.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
{-# LANGUAGE TypeFamilies, FlexibleContexts, FlexibleInstances #-}
{-# OPTIONS_GHC -fenable-rewrite-rules #-}
----------------------------------------------------------------------
-- |
-- Module : Data.Functor.Representable
-- Copyright : (c) Edward Kmett 2011
-- License : BSD3
--
-- Maintainer : ekmett@gmail.com
-- Stability : experimental
--
-- Representable endofunctors over the category of Haskell types are
-- isomorphic to the reader monad and so inherit a very large number
-- of properties for free.
----------------------------------------------------------------------
module Data.Functor.Representable
(
-- * Representable Functors
Representable(..)
-- ** Representable Lenses
, repLens
-- * Default definitions
-- ** Functor
, fmapRep
-- ** Distributive
, distributeRep
-- ** Keyed
, mapWithKeyRep
-- ** Apply/Applicative
, apRep
, pureRep
-- ** Bind/Monad
, bindRep
, bindWithKeyRep
-- ** Zip/ZipWithKey
, zipWithRep
, zipWithKeyRep
-- ** MonadReader
, askRep
, localRep
-- ** Extend
, duplicateRep
, extendRep
-- ** Comonad
, extractRep
) where
import Control.Applicative
import Control.Comonad.Trans.Traced
import Control.Comonad.Cofree
import Control.Monad.Trans.Identity
import Control.Monad.Reader
import Data.Distributive
import Data.Key
import Data.Functor.Bind
import Data.Functor.Identity
import Data.Functor.Compose
import Data.Functor.Product
import Data.Lens.Common
import qualified Data.Sequence as Seq
import Data.Semigroup hiding (Product)
import Prelude hiding (lookup)
-- | A 'Functor' @f@ is 'Representable' if 'tabulate' and 'index' witness an isomorphism to @(->) x@.
--
-- > tabulate . index = id
-- > index . tabulate = id
-- > tabulate . return f = return f
class (Indexable f, Distributive f, Keyed f, Apply f, Applicative f, ZipWithKey f) => Representable f where
-- | > fmap f . tabulate = tabulate . fmap f
tabulate :: (Key f -> a) -> f a
{-# RULES
"tabulate/index" forall t. tabulate (index t) = t
#-}
-- * Default definitions
fmapRep :: Representable f => (a -> b) -> f a -> f b
fmapRep f = tabulate . fmap f . index
mapWithKeyRep :: Representable f => (Key f -> a -> b) -> f a -> f b
mapWithKeyRep f = tabulate . (<*>) f . index
pureRep :: Representable f => a -> f a
pureRep = tabulate . const
bindRep :: Representable f => f a -> (a -> f b) -> f b
bindRep m f = tabulate (\a -> index (f (index m a)) a)
bindWithKeyRep :: Representable f => f a -> (Key f -> a -> f b) -> f b
bindWithKeyRep m f = tabulate (\a -> index (f a (index m a)) a)
askRep :: Representable f => f (Key f)
askRep = tabulate id
localRep :: Representable f => (Key f -> Key f) -> f a -> f a
localRep f m = tabulate (index m . f)
apRep :: Representable f => f (a -> b) -> f a -> f b
apRep f g = tabulate (index f <*> index g)
zipWithRep :: Representable f => (a -> b -> c) -> f a -> f b -> f c
zipWithRep f g h = tabulate $ \k -> f (index g k) (index h k)
zipWithKeyRep :: Representable f => (Key f -> a -> b -> c) -> f a -> f b -> f c
zipWithKeyRep f g h = tabulate $ \k -> f k (index g k) (index h k)
distributeRep :: (Representable f, Functor w) => w (f a) -> f (w a)
distributeRep wf = tabulate (\k -> fmap (`index` k) wf)
duplicateRep :: (Representable f, Semigroup (Key f)) => f a -> f (f a)
duplicateRep w = tabulate (\m -> tabulate (index w . (<>) m))
extendRep :: (Representable f, Semigroup (Key f)) => (f a -> b) -> f a -> f b
extendRep f w = tabulate (\m -> f (tabulate (index w . (<>) m)))
extractRep :: (Indexable f, Monoid (Key f)) => f a -> a
extractRep fa = index fa mempty
-- | We extend lens across a representable functor, due to the preservation of limits.
repLens :: Representable f => Lens a b -> Lens (f a) (f b)
repLens l = lens (fmap (l ^$)) (liftA2 (l ^=))
-- * Instances
instance Representable Identity where
tabulate f = Identity (f ())
instance Representable m => Representable (IdentityT m) where
tabulate = IdentityT . tabulate
instance Representable ((->) e) where
tabulate = id
instance Representable m => Representable (ReaderT e m) where
tabulate = ReaderT . fmap tabulate . curry
instance (Representable f, Representable g) => Representable (Compose f g) where
tabulate = Compose . tabulate . fmap tabulate . curry
instance Representable w => Representable (TracedT s w) where
tabulate = TracedT . collect tabulate . curry
instance (Representable f, Representable g) => Representable (Product f g) where
tabulate f = Pair (tabulate (f . Left)) (tabulate (f . Right))
instance Representable f => Representable (Cofree f) where
tabulate f = f Seq.empty :< tabulate (\k -> tabulate (f . (k Seq.<|)))