-
Notifications
You must be signed in to change notification settings - Fork 272
/
Equality.hs
76 lines (64 loc) · 2.28 KB
/
Equality.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
{-# LANGUAGE GADTs #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE TypeFamilies #-}
-----------------------------------------------------------------------------
-- |
-- Module : Control.Lens.Equality
-- Copyright : (C) 2012-13 Edward Kmett
-- License : BSD-style (see the file LICENSE)
-- Maintainer : Edward Kmett <ekmett@gmail.com>
-- Stability : provisional
-- Portability : Rank2Types
--
----------------------------------------------------------------------------
module Control.Lens.Equality
(
-- * Type Equality
Equality, Equality'
, AnEquality, AnEquality'
, runEq
, substEq
, mapEq
, fromEq
, simply
-- * Implementation Details
, Identical(..)
) where
import Control.Lens.Internal.Setter
import Control.Lens.Type
{-# ANN module "HLint: ignore Use id" #-}
{-# ANN module "HLint: ignore Eta reduce" #-}
-- $setup
-- >>> import Control.Lens
-----------------------------------------------------------------------------
-- Equality
-----------------------------------------------------------------------------
-- | Provides witness that @(s ~ a, b ~ t)@ holds.
data Identical a b s t where
Identical :: Identical a b a b
-- | When you see this as an argument to a function, it expects an 'Equality'.
type AnEquality s t a b = Identical a (Mutator b) a (Mutator b) -> Identical a (Mutator b) s (Mutator t)
-- | A 'Simple' 'AnEquality'.
type AnEquality' s a = AnEquality s s a a
-- | Extract a witness of type 'Equality'.
runEq :: AnEquality s t a b -> Identical s t a b
runEq l = case l Identical of Identical -> Identical
{-# INLINE runEq #-}
-- | Substituting types with 'Equality'.
substEq :: AnEquality s t a b -> ((s ~ a, t ~ b) => r) -> r
substEq l = case runEq l of
Identical -> \r -> r
{-# INLINE substEq #-}
-- | We can use 'Equality' to do substitution into anything.
mapEq :: AnEquality s t a b -> f s -> f a
mapEq l r = substEq l r
{-# INLINE mapEq #-}
-- | 'Equality' is symmetric.
fromEq :: AnEquality s t a b -> Equality b a t s
fromEq l = substEq l id
{-# INLINE fromEq #-}
-- | This is an adverb that can be used to modify many other 'Lens' combinators to make them require
-- simple lenses, simple traversals, simple prisms or simple isos as input.
simply :: (Overloaded' p f s a -> r) -> Overloaded' p f s a -> r
simply = id
{-# INLINE simply #-}