[Haskell-cafe] Controlling scope using monadic classes
oleg at pobox.com
oleg at pobox.com
Wed May 17 03:55:46 EDT 2006
Daniel McAllansmith wrote:
> I'm trying to control the scope within which functions can be used by
> putting them in a type class. Unfortunately I can't seem to figure
> out how to get it done. Any advice would be much appreciated.
Hopefully the following is close to what you wanted. The idea is to
describe each appropriate function (like getInfo) with a label and to
identify each monadic scope with a label, and then define the
relationship which tells which labeled functions can be used within
which scopes. If we attempt to obtain InfoC within the scope B, we get
an error ``no instance (LabelOK ScopeC ScopeB)'' -- which seems clear.
The more elaborate version of similar example can be found here:
http://pobox.com/~oleg/ftp/Haskell/types.html#monadic-regions
Using labels to enforce well-formedness term constraints (content
model constraints for HTML/XML terms) can be found here:
http://www.haskell.org/pipermail/haskell/2006-March/017656.html
http://www.haskell.org/pipermail/haskell/2006-March/017684.html
{-# OPTIONS -fglasgow-exts #-}
module Scopes where
import Control.Monad.Trans
-- Our scopes
newtype ScopeA m a = ScopeA{runScopeA :: m a} deriving (Monad, MonadIO)
newtype ScopeB m a = ScopeB{runScopeB :: m a} deriving (Monad, MonadIO)
newtype ScopeC m a = ScopeC{runScopeC :: m a} deriving (Monad, MonadIO)
runScopeBA (ScopeB x) = ScopeA x
runScopeCB (ScopeC x) = ScopeB x
-- The deriving Show part is just to make the example better
instance Show (ScopeA m a) where
show _ = "ScopeA"
instance Show (ScopeB m a) where
show _ = "ScopeB"
instance Show (ScopeC m a) where
show _ = "ScopeC"
-- Here we define the relationship that tells which labeled functions
-- (identified by label') can appear within which scope (identified by label)
class LabelOK (label' :: ( * -> * ) -> * -> * )
(label :: ( * -> * ) -> * -> * )
-- If we use overlapping isntances extension, the number of instances
-- below can be significantly reduced.
instance LabelOK ScopeA ScopeA
instance LabelOK ScopeA ScopeB
instance LabelOK ScopeA ScopeC
instance LabelOK ScopeB ScopeB
instance LabelOK ScopeB ScopeC
instance LabelOK ScopeC ScopeC
-- The function getInfo is labeled. The constraint LabelOK tells
-- the the function can be used within any (monadic) scope where
-- it is OK...
getInfo :: (Monad m, Monad (label m), Show (label' [] ()),
LabelOK label' label) => label' [] () -> label m String
getInfo l = return (show l)
-- The latter functions are to be defined analogously
-- putInfo :: LabelOK label' label => label' -> String -> m ()
-- updateInfo :: UpdateOK label' label => label' -> Int -> m ()
main = runScopeA aScoped >>= print
aScoped = do
bResult <- runScopeBA bScoped
-- updateAInfo bResult
return "done"
-- Inferred type: bScoped :: ScopeB IO Int
bScoped = do
i1 <- b1
i2 <- b2
return (i1 + i2)
b1 :: (Monad m, MonadIO m) => ScopeB m Int
b1 = do
-- Within B scope, we can request AInfo and BInfo
getInfo (ScopeA [()]) >>= liftIO . print
getInfo (ScopeB [()]) >>= liftIO . print
-- But we can't request CInfo
-- If we uncomment the following, we get
-- no instance (LabelOK ScopeC ScopeB)
-- I think the error message is quite clear
-- getInfo (ScopeC [()]) >>= liftIO . print
return 2
b2 :: (Monad m, MonadIO m) => ScopeB m Int
b2 = runScopeCB cScoped >>= return . fromEnum
cScoped :: (Monad m, MonadIO m) => ScopeC m Char
cScoped = do
-- Within C scope, we can request AInfo and BInfo and CInfo
getInfo (ScopeA [()]) >>= liftIO . print
getInfo (ScopeB [()]) >>= liftIO . print
getInfo (ScopeC [()]) >>= liftIO . print
return '('
More information about the Haskell-Cafe
mailing list