/
GratePlayGround.purs
133 lines (103 loc) · 4.16 KB
/
GratePlayGround.purs
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
module GratePlayGround where
import Prelude
import Data.Either (Either)
import Data.Foldable (intercalate, sum)
import Data.Generic.Rep (class Generic)
import Data.Lens (Grate, Lens, _Left, over, review, zipFWithOf)
import Data.Lens.Grate (cotraversed, grate)
import Data.Lens.Record (prop)
import Data.Monoid (power)
import Data.Show.Generic (genericShow)
import Type.Proxy (Proxy(..))
-- | Grate Optics を使う
-- | 関数を扱うのが一般的?
data Pair a = Pair a a
derive instance Generic (Pair a) _
instance Show a => Show (Pair a) where
show = genericShow
pFst :: forall a. Pair a -> a
pFst (Pair x _) = x
pSnd :: forall a. Pair a -> a
pSnd (Pair _ y) = y
-- | Grate Optics の定義
pairGrate :: forall a b. Grate (Pair a) (Pair b) a b
pairGrate = grate \f -> Pair (f pFst) (f pSnd)
-- | Review の操作
-- | == Pair 1 1
pairReviewTest :: Pair Int
pairReviewTest = review pairGrate 1
-- | Setter の操作
-- | == Pair 2 3
pairSetterTest :: Pair Int
pairSetterTest = over pairGrate (_ + 1) (Pair 1 2)
-- | Zipper の操作
-- | == Pair 4 5
pairZipperTest :: Pair Int
pairZipperTest = zipFWithOf pairGrate sum [ Pair 1 3, Pair 3 2 ]
-- | 関数でも使える
type NiceFunction a = Int -> a
-- | 関数ばっかでややこしくなる
-- | f :: (NiceFunction a -> a) -> a
-- | f から NiceFunction a を作る
niceFunctionGrate :: forall a b. Grate (NiceFunction a) (NiceFunction b) a b
niceFunctionGrate = grate \f -> \n -> f \nf -> nf n
-- | 次のようにも定義できて便利!
niceFunctionGrate2 :: forall a b. Grate (NiceFunction a) (NiceFunction b) a b
niceFunctionGrate2 = cotraversed
-- | niceFunctionHello 1 == "Hello"
-- | niceFunctionHello 4 == "Helloooo"
niceFunctionHello :: NiceFunction String
niceFunctionHello n = "Hell" <> power "o" n
-- | niceFunctionHello 1 == "World"
-- | niceFunctionHello 4 == "Worrrrld"
niceFunctionWorld :: NiceFunction String
niceFunctionWorld = \n -> "Wo" <> power "r" n <> "ld"
-- | Review の操作
-- | 常に "Const" を返す関数になる
niceFunctionReviewTest :: NiceFunction String
niceFunctionReviewTest = review niceFunctionGrate "Const"
-- | Setter の操作
-- | 結果の値に ! を追加
-- | niceFunctionSetterTest 1 == "Hello!"
-- | niceFunctionSetterTest 4 == "Helloooo!"
niceFunctionSetterTest :: NiceFunction String
niceFunctionSetterTest = over niceFunctionGrate (_ <> "!") niceFunctionHello
-- | Zipper の操作
-- | niceFunctionZipperTest 1 == "Hello World"
-- | niceFunctionZipperTest 4 == "Helloooo Worrrrld"
niceFunctionZipperTest :: NiceFunction String
niceFunctionZipperTest = zipFWithOf niceFunctionGrate (intercalate " ") [ niceFunctionHello, niceFunctionWorld ]
type WithLens a = NiceFunction { hello :: a, world :: String }
helloLens :: forall a b r. Lens { hello :: a | r } { hello :: b | r } a b
helloLens = prop (Proxy :: Proxy "hello")
-- | hello にそのまま n を突っ込む NiceFunction
before :: WithLens Int
before = \n -> { hello: n, world: "world" }
-- | 結果の hello に show を適用
after :: WithLens String
after = over (niceFunctionGrate <<< helloLens) show before
type WithPrism a = NiceFunction (Either a Int)
-- | 常に `Left "I think I'm on the left."` を返す
reviewed :: WithPrism String
reviewed = review (niceFunctionGrate <<< _Left) "I think I'm on the left."
type NiceFunctionPair a = Pair (NiceFunction a)
-- | Review の操作
-- | 常に "Const" を返す関数の Pair ができる
niceFunctionPairReviewTest :: NiceFunctionPair String
niceFunctionPairReviewTest = review (pairGrate <<< niceFunctionGrate) "Const"
niceFunctionPair :: NiceFunctionPair String
niceFunctionPair = Pair niceFunctionHello niceFunctionWorld
-- | Setter の操作
-- | Pair のそれぞれの NiceFunction の結果に ! を追加
niceFunctionPairSetterTest :: NiceFunctionPair String
niceFunctionPairSetterTest = over (pairGrate <<< niceFunctionGrate) (_ <> "!") niceFunctionPair
-- | Zipper の操作
-- | 結果の値 Pair f g に対して
-- | f 5 == "Hellooooo Hellooooo"
-- | g 5 == "Worrrrrld Worrrrrld"
niceFunctionPairZipperTest :: NiceFunctionPair String
niceFunctionPairZipperTest =
zipFWithOf
(pairGrate <<< niceFunctionGrate)
(intercalate " ")
[ niceFunctionPair, niceFunctionPair ]