diff options
author | joe <joe@jerkface.net> | 2014-04-21 20:36:12 -0400 |
---|---|---|
committer | joe <joe@jerkface.net> | 2014-04-21 20:36:12 -0400 |
commit | b0e298c9203bb0b901dddc398ce00c96ff12071d (patch) | |
tree | 0b442d3b5ddfddee825999bd79c12bb58fcda363 /ExperimentalCruft.hs | |
parent | e8df0c028a87f1271d5a2ee258ac31d1913e5f3c (diff) |
removed experimental code
Diffstat (limited to 'ExperimentalCruft.hs')
-rw-r--r-- | ExperimentalCruft.hs | 199 |
1 files changed, 199 insertions, 0 deletions
diff --git a/ExperimentalCruft.hs b/ExperimentalCruft.hs new file mode 100644 index 0000000..0c60731 --- /dev/null +++ b/ExperimentalCruft.hs | |||
@@ -0,0 +1,199 @@ | |||
1 | {-# LANGUAGE ExistentialQuantification #-} | ||
2 | module ExperimentalCruft where | ||
3 | |||
4 | import KeyRing | ||
5 | |||
6 | data KeyRingAction a = KeyRingAction a | RunTimeAction (KeyRingRuntime -> a) | ||
7 | |||
8 | data Kiki a = | ||
9 | SinglePass { passInfo :: KeyRingOperation | ||
10 | , rtAction :: KeyRingAction a } | ||
11 | | forall b. | ||
12 | MultiPass { passInfo :: KeyRingOperation | ||
13 | , passAction :: KeyRingAction b | ||
14 | , nextPass :: Kiki (b -> a) | ||
15 | } | ||
16 | |||
17 | |||
18 | |||
19 | evalAction :: KeyRingRuntime -> KeyRingAction a -> a | ||
20 | evalAction rt (KeyRingAction v) = v | ||
21 | evalAction rt (RunTimeAction g) = g rt | ||
22 | |||
23 | instance Monad KeyRingAction where | ||
24 | return x = KeyRingAction x | ||
25 | m >>= g = case m of | ||
26 | KeyRingAction v -> g v | ||
27 | RunTimeAction f -> RunTimeAction $ \rt -> evalAction rt (g $ f rt) | ||
28 | |||
29 | instance Functor KeyRingAction where | ||
30 | fmap g (KeyRingAction v) = KeyRingAction $ g v | ||
31 | fmap g (RunTimeAction f) = RunTimeAction $ \rt -> g (f rt) | ||
32 | |||
33 | {- | ||
34 | argOut :: (KeyRingAction (a -> b)) -> a -> KeyRingAction b | ||
35 | argOut = todo | ||
36 | argIn :: (a -> KeyRingAction b) -> KeyRingAction (a->b) | ||
37 | -} | ||
38 | |||
39 | {- | ||
40 | fmapWithRT :: (a -> KeyRingAction b) -> Kiki a -> Kiki b | ||
41 | fmapWithRT g k@(SinglePass {}) = k { rtAction = action } | ||
42 | where | ||
43 | action = rtAction k >>= g | ||
44 | fmapWithRT g (MultiPass p atn next) = MultiPass p atn next' | ||
45 | where | ||
46 | next' = fmapWithRT g' next {- next :: Kiki (x -> a) -} | ||
47 | -- g' :: ( (x->a) -> KeyRingAction b) | ||
48 | g' h = RunTimeAction $ | ||
49 | \rt x -> case g (h x) of | ||
50 | KeyRingAction v -> v | ||
51 | RunTimeAction f -> f rt | ||
52 | -} | ||
53 | |||
54 | fmapWithRT :: KeyRingAction (a -> b) -> Kiki a -> Kiki b | ||
55 | fmapWithRT g (SinglePass pass atn) = SinglePass pass atn' | ||
56 | where | ||
57 | atn' = g >>= flip fmap atn | ||
58 | fmapWithRT g (MultiPass p atn next) = MultiPass p atn next' | ||
59 | where | ||
60 | next' = fmapWithRT g' next | ||
61 | g' = fmap (\gf h -> gf . h) g | ||
62 | |||
63 | instance Functor Kiki where | ||
64 | fmap f k = fmapWithRT (return f) k | ||
65 | |||
66 | {- | ||
67 | instance Monad Kiki where | ||
68 | return x = SinglePass todo (return x) | ||
69 | k >>= f = kjoin $ fmap f k | ||
70 | |||
71 | kikiAction :: Kiki a -> KeyRingAction a | ||
72 | kikiAction (SinglePass _ atn) = atn | ||
73 | kikiAction (MultiPass _ atn next) = do | ||
74 | x <- atn | ||
75 | g <- kikiAction next | ||
76 | return $ g x | ||
77 | |||
78 | kjoin :: Kiki (Kiki a) -> Kiki a | ||
79 | kjoin k = fmapWithRT eval' k | ||
80 | where | ||
81 | eval' :: KeyRingAction (Kiki a -> a) | ||
82 | eval' = RunTimeAction (\rt -> evalAction rt . kikiAction ) | ||
83 | |||
84 | {- | ||
85 | kjoin :: Kiki (Kiki a) -> Kiki a | ||
86 | kjoin k = kjoin' (fmap kikiAction k) | ||
87 | where | ||
88 | ev rt (KeyRingAction v) = v | ||
89 | ev rt (RunTimeAction g) = g rt | ||
90 | |||
91 | kjoin' :: Kiki (KeyRingAction a) -> Kiki a | ||
92 | kjoin' (SinglePass pass atn) = SinglePass pass $ join atn | ||
93 | kjoin' (MultiPass pass atn next) = MultiPass pass atn next' | ||
94 | where | ||
95 | next' = todo | ||
96 | -} | ||
97 | |||
98 | |||
99 | {- | ||
100 | instance Functor Kiki where | ||
101 | fmap f (SinglePass pass atn) | ||
102 | = SinglePass pass (fmap f atn) | ||
103 | fmap f (MultiPass pass atn next) | ||
104 | = MultiPass pass atn (next >>= g) | ||
105 | where | ||
106 | g = todo | ||
107 | -} | ||
108 | |||
109 | {- | ||
110 | data Kiki a = SinglePass (KeyRingOperation a) | ||
111 | | forall b. MultiPass (KeyRingOperation b) (Kiki (b -> a)) | ||
112 | |||
113 | instance Functor Kiki where | ||
114 | fmap f (SinglePass d) = SinglePass $ case kAction d of | ||
115 | KeyRingAction v -> d { kAction = KeyRingAction (f v) } | ||
116 | RunTimeAction g -> d { kAction = RunTimeAction (f . g) } | ||
117 | fmap f (MultiPass p k)= MultiPass p (fmap (f .) k) | ||
118 | |||
119 | eval :: KeyRingRuntime -> Kiki a -> a | ||
120 | eval rt (SinglePass (KeyRingOperation { kAction = KeyRingAction v})) = v | ||
121 | eval rt (SinglePass (KeyRingOperation { kAction = RunTimeAction f})) = f rt | ||
122 | eval rt (MultiPass p kk) = eval rt kk $ eval rt (SinglePass p) | ||
123 | |||
124 | fmapWithRT :: (KeyRingRuntime -> a -> b) -> Kiki a -> Kiki b | ||
125 | fmapWithRT g (SinglePass d@(KeyRingOperation { kAction = KeyRingAction v})) | ||
126 | = SinglePass $ d { kAction = RunTimeAction (\rt -> g rt v) } | ||
127 | fmapWithRT g (SinglePass d@(KeyRingOperation { kAction = RunTimeAction f})) | ||
128 | = SinglePass $ d { kAction = RunTimeAction f' } | ||
129 | where f' rt = g rt (f rt) | ||
130 | fmapWithRT g (MultiPass p kk) = MultiPass p (fmapWithRT g' kk) | ||
131 | where g' rt h = g rt . h | ||
132 | |||
133 | kjoin :: Kiki (Kiki a) -> Kiki a | ||
134 | kjoin k = fmapWithRT eval k | ||
135 | |||
136 | passCount :: Kiki a -> Int | ||
137 | passCount (MultiPass _ k) = 1 + passCount k | ||
138 | passCount (SinglePass {}) = 1 | ||
139 | |||
140 | instance Monad Kiki where | ||
141 | return x = SinglePass (kret x) | ||
142 | k >>= f = kjoin (fmap f k) | ||
143 | -} | ||
144 | |||
145 | |||
146 | -- Kiki a -> a -> Kiki b | ||
147 | |||
148 | atRuntime :: (KeyRingRuntime -> IO (a,KeyRingRuntime)) -> Kiki a | ||
149 | atRuntime = todo | ||
150 | |||
151 | goHome :: Maybe FilePath -> Kiki () | ||
152 | goHome p = todo -- SinglePass $ (kret ()) { homeSpec = p } | ||
153 | |||
154 | syncRing :: InputFile -> Kiki () | ||
155 | syncRing = todo | ||
156 | |||
157 | syncSubKey :: String -> FilePath -> String -> Kiki () | ||
158 | syncSubKey usage path cmd = todo | ||
159 | |||
160 | syncWallet :: FilePath -> Kiki () | ||
161 | syncWallet = todo | ||
162 | |||
163 | usePassphraseFD :: Int -> Kiki () | ||
164 | usePassphraseFD = todo | ||
165 | |||
166 | {- | ||
167 | importAll :: Kiki () | ||
168 | importAll = todo | ||
169 | -} | ||
170 | |||
171 | importAllAuthentic :: Kiki () | ||
172 | importAllAuthentic = todo | ||
173 | |||
174 | signSelfAuthorized :: Kiki () | ||
175 | signSelfAuthorized = todo | ||
176 | |||
177 | showIdentity :: Message -> String | ||
178 | showIdentity = todo | ||
179 | |||
180 | identities :: Kiki [Message] | ||
181 | identities = todo | ||
182 | |||
183 | currentIdentity :: Kiki Message | ||
184 | currentIdentity = todo | ||
185 | |||
186 | identityBySpec :: String -> Kiki Message | ||
187 | identityBySpec = todo | ||
188 | |||
189 | identityBySSHKey :: String -> Kiki Message | ||
190 | identityBySSHKey = todo | ||
191 | |||
192 | keyBySpec :: String -> Kiki Packet | ||
193 | keyBySpec = todo | ||
194 | |||
195 | walletInputFormat :: Packet -> String | ||
196 | walletInputFormat = todo | ||
197 | |||
198 | -} | ||
199 | |||