[Haskell-cafe] Help me refactor this type!
Ryan Ingram
ryani.spam at gmail.com
Thu Apr 24 19:10:21 EDT 2008
More FRP stuff: a new type for Future that came to me in an
inspiration this morning. But it's ugly and I need someone with
better theoretical underpinnings than me to tell me what I've really
built :)
data Future t a =
Known t a
| Unknown (t -> IO (STM (Maybe (Future t a))))
Given Eq t, Ord t, Bounded t, this type is at least member of Monad,
Applicative, Functor, and MonadPlus/Monoid. But the derivation gives
me that "needs refactoring" feeling; here's an example:
force :: (Ord t, Bounded t) => Future t a -> IO (t, a)
force (Known t a) = return (t, a)
force (Unknown f) = do
stmF <- f maxBound
mF <- atomically stmF
case mF of
Nothing -> return (maxBound, error "never")
Just fut' -> force fut'
delayF :: Ord t => t -> Future t a -> Future t a
delayF t0 (Known t a) = Known (max t0 t) a
delayF t0 (Unknown f) = Unknown $ \t -> fmap (fmap (fmap (delayF t0))) (f t)
instance (Ord t, Bounded t) => Monad (Future t) where
return = Known minBound
Known t a >>= g = delayF t (g a)
Unknown f >>= g = Unknown $ \t -> do -- IO
stmF <- f t
return $ do -- STM
mF <- stmF
return $ do -- Maybe
fut' <- mF
return (fut' >>= g)
This code makes me sad; so many nested blocks. There's got to be a
refactoring of this that I am missing!
It's clearly got something to do with Fix, Either, ReaderT, and
MaybeT, and type composition, but none of those seem to answer the
whole question.
Any thoughts?
-- ryan
More information about the Haskell-Cafe
mailing list