@@ -17,7 +17,6 @@ module Control.Distributed.Static
1717 , staticLabel
1818 , staticApply
1919 , staticDuplicate
20−-- , staticTypeOf
2120 -- * Eliminating static values
2221 , RemoteTable
2322 , initRemoteTable
@@ -27,18 +26,6 @@ module Control.Distributed.Static
2726 , Closure(Closure)
2827 , unclosure
2928 , staticClosure
30− -- * Static values
31− , idStatic
32− , composeStatic
33− , constStatic
34− , flipStatic
35− , fstStatic
36− , sndStatic
37− , firstStatic
38− , secondStatic
39− , splitStatic
40− , unitStatic
41− , appStatic
4229 -- * Combinators on static values
4330 , staticCompose
4431 , staticSplit
@@ -49,14 +36,13 @@ module Control.Distributed.Static
4936 , closureCompose
5037 , closureSplit
5138 -- * Re-exports
39+ , Typeable
5240 , Dynamic
5341 , toDynamic
54− , fromDynamic
55− , dynTypeRep
5642 ) where
5743
58−import Prelude hiding (id, (.), const, flip, fst, snd)
59−import qualified Prelude (const, flip, fst, snd)
44+import Prelude hiding (const, fst, snd)
45+import qualified Prelude (const, fst, snd)
6046import Data.Binary
6147 ( Binary(get, put)
6248 , Put
@@ -70,9 +56,8 @@ import Data.ByteString.Lazy (ByteString, empty)
7056import Data.Map (Map)
7157import qualified Data.Map as Map (lookup, empty, insert)
7258import Control.Applicative ((<$>), (<*>))
73−import Control.Category (Category(id, (.)))
74−import qualified Control.Arrow as Arrow (first, second, (***), app)
75−import Data.Rank1Dynamic (Dynamic, toDynamic, fromDynamic, dynApply, dynTypeRep)
59+import qualified Control.Arrow as Arrow ((***), app)
60+import Data.Rank1Dynamic (Dynamic, toDynamic, fromDynamic, dynApply)
7661import Data.Rank1Typeable
7762 ( Typeable
7863 , typeOf
@@ -141,24 +126,6 @@ staticApply (Static f) (Static x) = Static (StaticApply f x)
141126staticDuplicate :: forall a. Static a -> Static (Static a)
142127staticDuplicate (Static x) = Static (StaticDuplicate x)
143128
144−{-
145−-- | @staticTypeOf (x :: a)@ mimicks @static (undefined :: a)@ -- even if
146−-- @x@ is not static, the type of @x@ always is.
147−staticTypeOf :: forall a. Typeable a => a -> Static a
148−staticTypeOf _ = Static (StaticLabel "$undefined" (typeOf (undefined :: a)))
149−
150−typeOfStaticLabel :: StaticLabel -> TypeRep
151−typeOfStaticLabel = undefined
152−{-
153−typeOfStaticLabel (StaticLabel _ typ)
154− = typ
155−typeOfStaticLabel (StaticApply f x)
156− = fromJust $ funResultTy (typeOfStaticLabel f) (typeOfStaticLabel x)
157−typeOfStaticLabel (StaticDuplicate _ typ)
158− = typ
159−-}
160−-}
161−
162129--------------------------------------------------------------------------------
163130-- Eliminating static values --
164131--------------------------------------------------------------------------------
@@ -169,84 +136,54 @@ newtype RemoteTable = RemoteTable (Map String Dynamic)
169136-- | Initial remote table
170137initRemoteTable :: RemoteTable
171138initRemoteTable =
172− registerStatic "$id" (toDynamic identity)
173− . registerStatic "$compose" (toDynamic compose)
139+ registerStatic "$compose" (toDynamic compose)
174140 . registerStatic "$const" (toDynamic const)
175− . registerStatic "$flip" (toDynamic flip)
176− . registerStatic "$fst" (toDynamic fst)
177− . registerStatic "$snd" (toDynamic snd)
178− . registerStatic "$first" (toDynamic first)
179− . registerStatic "$second" (toDynamic second)
180141 . registerStatic "$split" (toDynamic split)
181− . registerStatic "$unit" (toDynamic ())
182142 . registerStatic "$app" (toDynamic app)
183143 . registerStatic "$decodeEnvPair" (toDynamic decodeEnvPair)
184144 $ RemoteTable Map.empty
185145 where
186− identity :: ANY -> ANY
187− identity = id
188−
189146 compose :: (ANY2 -> ANY3) -> (ANY1 -> ANY2) -> ANY1 -> ANY3
190147 compose = (.)
191148
192149 const :: ANY1 -> ANY2 -> ANY1
193150 const = Prelude.const
194151
195− flip :: (ANY1 -> ANY2 -> ANY3) -> ANY2 -> ANY1 -> ANY3
196− flip = Prelude.flip
197−
198− fst :: (ANY1, ANY2) -> ANY1
199− fst = Prelude.fst
200−
201− snd :: (ANY1, ANY2) -> ANY2
202− snd = Prelude.snd
203−
204− first :: (ANY1 -> ANY2) -> (ANY1, ANY3) -> (ANY2, ANY3)
205− first = Arrow.first
206−
207− second :: (ANY1 -> ANY2) -> (ANY3, ANY1) -> (ANY3, ANY2)
208− second = Arrow.second
209−
210152 split :: (ANY1 -> ANY3) -> (ANY2 -> ANY4) -> (ANY1, ANY2) -> (ANY3, ANY4)
211153 split = (Arrow.***)
212154
213− decodeEnvPair :: ByteString -> (ByteString, ByteString)
214− decodeEnvPair = decode
215−
216155 app :: (ANY1 -> ANY2, ANY1) -> ANY2
217156 app = Arrow.app
218157
158+ decodeEnvPair :: ByteString -> (ByteString, ByteString)
159+ decodeEnvPair = decode
160+
219161-- | Register a static label
220162registerStatic :: String -> Dynamic -> RemoteTable -> RemoteTable
221163registerStatic label dyn (RemoteTable rtable)
222164 = RemoteTable (Map.insert label dyn rtable)
223165
224166-- Pseudo-type: RemoteTable -> Static a -> a
225−resolveStaticLabel :: RemoteTable -> StaticLabel -> Maybe Dynamic
167+resolveStaticLabel :: RemoteTable -> StaticLabel -> Either String Dynamic
226168resolveStaticLabel (RemoteTable rtable) (StaticLabel label) =
227− Map.lookup label rtable
169+ case Map.lookup label rtable of
170+ Nothing -> Left $ "Invalid static label '" ++ label ++ "'"
171+ Just d -> Right d
228172resolveStaticLabel rtable (StaticApply label1 label2) = do
229173 f <- resolveStaticLabel rtable label1
230174 x <- resolveStaticLabel rtable label2
231− case f `dynApply` x of
232− Left _err -> Nothing
233− Right y -> Just y
175+ f `dynApply` x
234176resolveStaticLabel rtable (StaticDuplicate label) = do
235177 x <- resolveStaticLabel rtable label -- Resolve only to get type info
236− case toDynamic mkStatic `dynApply` x of
237− Left _err -> Nothing
238− Right y -> Just y
178+ toDynamic mkStatic `dynApply` x
239179 where
240180 mkStatic :: ANY -> Static ANY
241181 mkStatic _ = Static label
242182
243−unstatic :: Typeable a => RemoteTable -> Static a -> Maybe a
244−unstatic rtable (Static static) =
245− case resolveStaticLabel rtable static of
246− Nothing -> Nothing
247− Just dyn -> case fromDynamic dyn of
248− Left _err -> Nothing
249− Right x -> Just x
183+unstatic :: Typeable a => RemoteTable -> Static a -> Either String a
184+unstatic rtable (Static static) = do
185+ dyn <- resolveStaticLabel rtable static
186+ fromDynamic dyn
250187
251188--------------------------------------------------------------------------------
252189-- Closures --
@@ -261,7 +198,7 @@ instance Typeable a => Binary (Closure a) where
261198 get = Closure <$> get <*> get
262199
263200-- | Resolve a closure
264−unclosure :: Typeable a => RemoteTable -> Closure a -> Maybe a
201+unclosure :: Typeable a => RemoteTable -> Closure a -> Either String a
265202unclosure rtable (Closure static env) = do
266203 f <- unstatic rtable static
267204 return (f env)
@@ -274,11 +211,6 @@ staticClosure static = Closure (staticConst static) empty
274211-- Predefined static values --
275212--------------------------------------------------------------------------------
276213
277−-- | Static version of 'id'
278−idStatic :: (Typeable a)
279− => Static (a -> a)
280−idStatic = staticLabel "$id"
281−
282214-- | Static version of ('Prelude..')
283215composeStatic :: (Typeable a, Typeable b, Typeable c)
284216 => Static ((b -> c) -> (a -> b) -> a -> c)
@@ -289,40 +221,11 @@ constStatic :: (Typeable a, Typeable b)
289221 => Static (a -> b -> a)
290222constStatic = staticLabel "$const"
291223
292−-- | Static version of 'flip'
293−flipStatic :: (Typeable a, Typeable b, Typeable c)
294− => Static ((a -> b -> c) -> b -> a -> c)
295−flipStatic = staticLabel "$flip"
296−
297−-- | Static version of 'fst'
298−fstStatic :: (Typeable a, Typeable b)
299− => Static ((a, b) -> a)
300−fstStatic = staticLabel "$fst"
301−
302−-- | Static version of 'snd'
303−sndStatic :: (Typeable a, Typeable b)
304− => Static ((a, b) -> b)
305−sndStatic = staticLabel "$snd"
306−
307−-- | Static version of 'Arrow.first'
308−firstStatic :: (Typeable a, Typeable b, Typeable c)
309− => Static ((a -> b) -> (a, c) -> (b, c))
310−firstStatic = staticLabel "$first"
311−
312−-- | Static version of 'Arrow.second'
313−secondStatic :: (Typeable a, Typeable b, Typeable c)
314− => Static ((a -> b) -> (c, a) -> (c, b))
315−secondStatic = staticLabel "$second"
316−
317224-- | Static version of ('Arrow.***')
318225splitStatic :: (Typeable a, Typeable a', Typeable b, Typeable b')
319226 => Static ((a -> b) -> (a' -> b') -> (a, a') -> (b, b'))
320227splitStatic = staticLabel "$split"
321228
322−-- | Static version of @()@
323−unitStatic :: Static ()
324−unitStatic = staticLabel "$unit"
325−
326229-- | Static version of 'Arrow.app'
327230appStatic :: (Typeable a, Typeable b)
328231 => Static ((a -> b, a) -> b)