@@ -34,7 +34,7 @@ import Control.Monad ((<=<))
3434import Control.Monad.IO.Class
3535import Data.Aeson
3636import Data.Dynamic
37−import Data.IORef (IORef)
37+import Data.IORef (IORef, newIORef)
3838import qualified Data.List.NonEmpty as NEL
3939import Data.List.NonEmpty (NonEmpty)
4040import Data.Map.Strict (Map)
@@ -43,7 +43,7 @@ import Data.Maybe
4343import Data.Type.HasClass
4444import Data.Type.HasClassPreludeInstances
4545import Data.Typeable (TypeRep, Typeable, typeOf, typeRep)
46−import Debug.Trace (traceM)
46+import Debug.Trace (traceM, traceShowM)
4747import GHC.Generics (Generic)
4848import GHC.Generics
4949import GHC.IORef (readIORef)
@@ -142,33 +142,38 @@ callEndpoint staticRoutes =
142142 execute ::
143143 (MonadIO m) =>
144144 Op Concrete ->
145− m (Opaque Dynamic)
145+ m (Opaque (IORef Dynamic))
146146 execute (Op (ApiOffset offset) args) = do
147− traceM (show (offset, args))
147+ -- traceM (show (offset, args))
148148 fmap Opaque . liftIO $ do
149149 realArgs <- mapM (\(tr, v) -> readIORef (opaque v)) args
150150 let (_offset, staticArgs, ret, endpoint) = staticRoutes !! offset
151151 -- now, magic happens: we apply some dynamic arguments to a dynamic
152152 -- function and hopefully somtehing useful pops out the end.
153− func = foldr (\arg curr -> dynApply arg =<< curr) (Just endpoint) realArgs
154− case func >>= fromDynamic of
155− Nothing -> error ("all screwed up: " <> maybe "nothing" (show . dynTypeRep) func)
156− Just (f :: IO Dynamic) -> liftIO f -- >>= either (const $ error "blah") pure
153+ func = foldr (\arg curr -> flip dynApply arg =<< curr) (Just endpoint) realArgs
154+ let showable = map dynTypeRep (endpoint : realArgs)
155+ case func of
156+ Nothing -> error ("all screwed up: " <> maybe ("nothing: " <> show showable) (show . dynTypeRep) func)
157+ Just (f') -> do
158+ case fromDynamic f' of
159+ Nothing -> error "failed on casting final function"
160+ Just f -> liftIO f >>= newIORef -- >>= either (const $ error "blah") pure
157161 in Command
158162 gen
159163 execute
160164 [ Update $ \s@State {..} (Op (ApiOffset offset) args) o' ->
161− let foo :: Var (Opaque Dynamic) v -> Var (Opaque (IORef Dynamic)) v
162− foo = error "oops"
163− in s
164− { stateRefs =
165− let (_, _, tr, _) = staticRoutes !! offset
166− in Map.insertWith
167− (<>)
168− tr
169− (pure $ foo o')
170− stateRefs
171− }
165+ -- let foo :: Var (Opaque Dynamic) v -> Var (Opaque (IORef Dynamic)) v
166+ -- foo = _ . opaque
167+ -- in
168+ s
169+ { stateRefs =
170+ let (_, _, tr, _) = staticRoutes !! offset
171+ in Map.insertWith
172+ (<>)
173+ tr
174+ (pure o')
175+ stateRefs
176+ }
172177 -- , Ensure (no-500 here)
173178 ]
174179
@@ -204,7 +209,7 @@ combine = (\(Foo a) (Foo b) -> pure (Foo (a + b)))
204209eliminate =
205210 ( \(Foo a) ->
206211 if a > 10
207− then error "fuck"
212+ then error "eliminate blew up, oh no!"
208213 else pure ()
209214 )
210215
@@ -235,10 +240,12 @@ tests = do
235240 let clientEnv = mkClientEnv manager burl
236241 -- faking this out for now.
237242 footype = typeOf Foo
243+ handleError :: forall a b m. Applicative m => (Either b a) -> m a
244+ handleError = either (error "oopsie") pure
238245 reifiedApi =
239− [ (ApiOffset 0, [], footype, toDyn $ toDyn <$> runClientM introC clientEnv),
240− (ApiOffset 1, [footype, footype], footype, toDyn $ \f1 f2 -> toDyn <$> runClientM (combineC f1 f2) clientEnv),
241− (ApiOffset 2, [footype], (typeOf ()), toDyn $ \f -> toDyn <$> runClientM (eliminateC f) clientEnv)
246+ [ (ApiOffset 0, [], footype, toDyn $ toDyn <$> (runClientM introC clientEnv >>= handleError)),
247+ (ApiOffset 1, [footype, footype], footype, toDyn $ \f1 f2 -> toDyn <$> (runClientM (combineC f1 f2) clientEnv >>= handleError)),
248+ (ApiOffset 2, [footype], (typeOf ()), toDyn $ \f -> toDyn <$> (runClientM (eliminateC f) clientEnv >>= handleError))
242249 ]
243250 -- type ReifiedApi = [(ApiOffset, [TypeRep], TypeRep, Dynamic)]
244251 checkParallel $ Group "props" [("aprop", prop_sm_sequential reifiedApi)]