[Haskell-cafe] Illegal .... - solved - style question
Marc Weber
marco-oweber at gmx.de
Sun Feb 25 09:17:21 EST 2007
On Sun, Feb 25, 2007 at 12:18:25AM +0300, Bulat Ziganshin wrote:
> Hello Marc,
>
> Friday, February 23, 2007, 5:22:12 PM, you wrote:
>
> > type ActionMonad a l = forall l. (HOccurs D1 l)
> > => ( ReaderT l IO a )
>
> 'l' should be either parameter of type constructor or forall'ed
> variable. it seems that you try to set limitations on type constructor
> parameter - thing that has another syntax and anyway not much support
> in haskell'98. i suggest you to use smth like the following instead:
>
> type ActionMonad a l = ( ReaderT l IO a )
>
> instance (HOccurs D1 l) => Get CR (ActionMonad Bool ()) where
> get (CR a) = a
>
> --
> Best regards,
> Bulat mailto:Bulat.Ziganshin at gmail.com
Hi Bulat (and others)
Thanks for your answer. I've tried doing this:
a)
The idea of using get instead of record accessing functions a1, a2 is
overloading:
( let a = a1 record
vs
let (A a) <- get record
let (A a) <- get record2 (record2 can be different type than record)
)
benefit of the snd version: You can also see its type immideately.
Because I've taught DrIft to derive Get a b .. its not much additional
work.
b)
The snd idea is using an invironment which is typesafe and easy to
extend by using a HList and hOccurs to get the environment.
I think this is great because you don't have to write getStateX,
getEnvY = accessor . ask/get
Im curious about reading you comments on a) b) ;)
Happily
Marc Weber
============= testfile - needs HList and GHC =========================
{-# OPTIONS -fglasgow-exts #-}
{-# OPTIONS -fallow-undecidable-instances #-}
{-# OPTIONS -fallow-incoherent-instances #-}
{-# OPTIONS -fallow-overlapping-instances #-}
{-# OPTIONS -fno-monomorphism-restriction #-}
module Main where
import HList hiding ( liftIO )
import Control.Monad.Reader
import Control.Monad.Trans
import HOccurs
class Get a b where
get :: a -> b
data D1 = D1 Int deriving (Show) -- dummy type
data D2 = D2 Int deriving (Show) -- dummy type
type ActionMonad l a = ReaderT l IO a
newtype A l a = A (ActionMonad l a)
newtype B l a = B (ActionMonad l a)
data ActionRecord l a = ActionRecord { a1 :: A l a
, a2 :: B l a
}
instance Get (ActionRecord l a) (A l a)
where get ar = a1 ar
instance Get (ActionRecord l a) (B l a)
where get ar = a2 ar
type RD1 = (HCons D1 HNil)
type RD2D1 = (HCons D2 RD1)
myActionRecord = ActionRecord (A act1) (B act2)
where
act1 :: ReaderT RD1 IO ()
act1 = do
liftIO $ print "act 1"
(d1@(D1 _)) <- asks hOccurs
liftIO $ print (show d1)
act2 :: ReaderT RD1 IO ()
act2 = do
liftIO $ print "act 2"
(d1@(D1 _)) <- asks hOccurs
liftIO $ print (show d1)
mytrans act3 $ (\l -> HCons (D2 7) l) -- adding new environment (D2 7) here
-- addD2 act3 (D2 2)
mytrans f tr = do a <- ask
lift $ runReaderT f (tr a)
-- here order doesn't matter:
act3 :: ( HOccurs D1 (HCons a b)
, HOccurs D2 (HCons a b)) =>
ReaderT (HCons a b) IO ()
act3 = do
liftIO $ print "act 3 within act2"
(d2@(D2 _)) <- asks hOccurs
liftIO $ print (show d2)
-- asks' :: (HOccurs l D2) => (l -> D2) -> ReaderT l IO D2
-- asks' = asks
-- addD2 :: (HOccurs l' D2, HOccurs l D1) => ReaderT l' IO a -> D2 -> ReaderT l IO a
-- addD2 m d2 = mytrans m (\l -> HCons d2 l)
hcons2 :: a -> b -> HCons a (HCons b HNil)
hcons2 a b = HCons a (HCons b HNil)
main = let
(A act1 :: A RD1 ()) = get myActionRecord
(B act2 :: B RD1 ()) = get myActionRecord
in do runReaderT (sequence [act1, act2]) (HCons (D1 1) HNil)
runReaderT act3 (hcons2 (D2 7) (D1 1))
-- order doen't matter:
runReaderT act3 (hcons2 (D1 3) (D2 7))
============= testfile ===============================================
More information about the Haskell-Cafe
mailing list