Repository : ssh://darcs.haskell.org//srv/darcs/testsuite On branch : ghc-7.2
http://hackage.haskell.org/trac/ghc/changeset/f27f04176034ae4ba6be9fc3d5df48a47407b40d >--------------------------------------------------------------- commit f27f04176034ae4ba6be9fc3d5df48a47407b40d Author: Simon Peyton Jones <[email protected]> Date: Fri Jul 22 17:40:29 2011 +0100 Test Trac #5303 >--------------------------------------------------------------- tests/simplCore/should_compile/T5303.hs | 44 +++++++++++++++++++++++++++++++ tests/simplCore/should_compile/all.T | 1 + 2 files changed, 45 insertions(+), 0 deletions(-) diff --git a/tests/simplCore/should_compile/T5303.hs b/tests/simplCore/should_compile/T5303.hs new file mode 100644 index 0000000..b19eb22 --- /dev/null +++ b/tests/simplCore/should_compile/T5303.hs @@ -0,0 +1,44 @@ +{-# LANGUAGE KindSignatures, GADTs, TypeFamilies, MultiParamTypeClasses, FlexibleContexts, ScopedTypeVariables, TypeSynonymInstances, FlexibleInstances #-} +module T5303( showContextSeries ) where + +import Control.Monad.State.Strict( StateT ) +import Control.Monad.Trans ( lift ) + +data Tree m = Tree {} + +data FL (a :: * -> * -> *) x z where + (:>:) :: a x y -> FL a y z -> FL a x z + NilFL :: FL a x x + +class (Functor m, Monad m) => ApplyMonad m (state :: (* -> *) -> *) + +class Apply (p :: * -> * -> *) where + type ApplyState p :: (* -> *) -> * + apply :: ApplyMonad m (ApplyState p) => p x y -> m () + +class (Functor m, Monad m, ApplyMonad (ApplyMonadOver m state) state) + => ApplyMonadTrans m (state :: (* -> *) -> *) where + type ApplyMonadOver m state :: * -> * + runApplyMonad :: (ApplyMonadOver m state) x -> state m -> m (x, state m) + +instance (Functor m, Monad m) => ApplyMonadTrans m Tree where + type ApplyMonadOver m Tree = TreeMonad m + runApplyMonad = virtualTreeMonad + +instance (Functor m, Monad m) => ApplyMonad (TreeMonad m) Tree + +-- | Internal state of the 'TreeIO' monad. Keeps track of the current Tree +-- content, unsync'd changes and a current working directory (of the monad). +data TreeState m = TreeState { tree :: !(Tree m) } +type TreeMonad m = StateT (TreeState m) m +type TreeIO = TreeMonad IO + +virtualTreeMonad :: (Functor m, Monad m) => TreeMonad m a -> Tree m -> m (a, Tree m) +virtualTreeMonad action t = undefined + +applyToState :: forall p m x y. (Apply p, ApplyMonadTrans m (ApplyState p)) + => p x y -> (ApplyState p) m -> m ((ApplyState p) m) +applyToState _ _ = snd `fmap` runApplyMonad undefined undefined + +showContextSeries :: (Apply p, ApplyState p ~ Tree) => FL p x y -> TreeIO () +showContextSeries (p:>:_) = (undefined >>= lift . applyToState p) >> return () diff --git a/tests/simplCore/should_compile/all.T b/tests/simplCore/should_compile/all.T index 2705d8f..28be9d4 100644 --- a/tests/simplCore/should_compile/all.T +++ b/tests/simplCore/should_compile/all.T @@ -123,3 +123,4 @@ test('T5168', ['$MAKE -s --no-print-directory T5168']) test('T5329', normal, compile, ['']) +test('T5303', reqlib('mtl'), compile, ['']) # Coercion-optimiation test _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
