prototype 0.3 → 0.4.1

raw patch · 2 files changed

+42/−20 lines, 2 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• prototype.cabal +14/−12
• src/Control/Prototype.hs +28/−8

@@ -2,7 +2,7 @@ cabal-version:	>= 1.2  name:		prototype-version:	0.3+version:	0.4.1 stability:	experimental author:		Yoshikuni Jujo <PAF01143@nifty.ne.jp> maintainer:	Yoshikuni Jujo <PAF01143@nifty.ne.jp>@@ -26,17 +26,19 @@ 		> 		> main :: IO () 		> main = fmap fst $ flip runPT initPTEnv $ do-		>	dog <- clone object-		>	name	<- makeMember "name"-		>	setName	<- makeMember "setName"-		>	sit	<- makeMember "sit"-		>	setMethod dog setName $ \this [ n ] -> do-		>		setMember this name n-		>		return [ ]-		>	setMethod dog sit $ \this _ -> do-		>		n <- member this name-		>		liftPT $ putStrLn $ fromPrimStr n ++ " sitting."-		>		return [ ]+		>	( dog, setName, sit ) <- package "dog" $ do+		>		dog <- clone object+		>		name	<- makeMember "name"+		>		setName	<- makeMember "setName"+		>		sit	<- makeMember "sit"+		>		setMethod dog setName $ \this [ n ] -> do+		>			setMember this name n+		>			return [ ]+		>		setMethod dog sit $ \this _ -> do+		>			n <- member this name+		>			liftPT $ putStrLn $ fromPrimStr n ++ " sitting."+		>			return [ ]+		>		return ( dog, setName, sit ) 		>	myDog <- clone dog 		>	method myDog setName [ primStr "John" ] 		>	method myDog sit [ ]

@@ -16,6 +16,8 @@ 	setMember, 	setMethod, +	package,+ 	liftPT, 	primInt, 	primStr,@@ -27,7 +29,7 @@  import Prelude hiding ( head ) import "monads-tf" Control.Monad.State (-	StateT, runStateT, lift, MonadIO, liftIO, modify, gets )+	StateT, runStateT, lift, MonadIO, liftIO, put, get, gets ) import Data.List ( (\\) ) import Data.Maybe ( fromMaybe, listToMaybe ) @@ -47,10 +49,16 @@ liftPT :: Monad m => m a -> PTMonad m a liftPT = lift -type PTEnv m = [ ObjectBody m ]+data PTEnv m = PTEnv {+	packageName	:: String,+	objectBodys	:: [ ObjectBody m ]+ } deriving Show  initPTEnv :: PTEnv m-initPTEnv = [ ObjectBody object [ ] ]+initPTEnv = PTEnv {+	packageName	= "main",+	objectBodys	= [ ObjectBody object [ ] ]+ }  data Object = 	ObjectId { fromObjId :: Int } |@@ -85,18 +93,20 @@ --------------------------------------------------------------------------------  getNewId :: Monad m => PTMonad m Object-getNewId = gets $-	ObjectId . head err . ( [ 1 .. ] \\ ) .	map ( fromObjId . objectId )+getNewId = gets $ ObjectId . head err . ( [ 1 .. ] \\ ) .+	map ( fromObjId . objectId ) . objectBodys 	where 	err = error "too many objects"  getObject :: Monad m => Object -> PTMonad m ( ObjectBody m )-getObject obj =	gets $ head err . filter ( ( == obj ) . objectId )+getObject obj =	gets $ head err . filter ( ( == obj ) . objectId ) . objectBodys 	where 	err = error $ "no such object: " ++ show obj  putObject :: Monad m => ObjectBody m -> PTMonad m ()-putObject = modify . ( : )+putObject objBody = do+	env@PTEnv { objectBodys = obs } <- get+	put env { objectBodys = objBody : obs }  clone :: Monad m => Object -> PTMonad m Object clone obj = do@@ -106,7 +116,8 @@ 	return newId  makeMember :: Monad m => String -> PTMonad m Member-makeMember = return . Member+makeMember name =+	mmap ( Member . ( ++ name ) . ( ++ "::" ) ) $ gets packageName  member :: Monad m => Object -> Member -> PTMonad m Object member obj mem =@@ -128,6 +139,15 @@ 	newId <- getNewId 	putObject $ Method newId met 	setMember obj mem newId++package :: Monad m => String -> PTMonad m a -> PTMonad m a+package pkg act = do+	env0@PTEnv { packageName = oldPkg } <- get+	put env0 { packageName = pkg }+	ret <- act+	env1 <- get+	put env1 { packageName = oldPkg }+	return ret  printMemberName :: MonadIO m => Member -> m () printMemberName ( Member name ) = liftIO $ putStrLn name