module Test.MuCheck.MuOp (MuOp
, Mutable(..)
, (==>*)
, (*==>*)
, (~~>)
, mkMp'
, same
) where
import Language.Haskell.Exts (Name, QName, QOp, Exp, Literal, GuardedRhs, Decl)
import qualified Data.Generics as G
import Control.Monad (MonadPlus, mzero)
data MuOp = N (Name, Name)
| QN (QName, QName)
| QO (QOp, QOp)
| E (Exp, Exp)
| D (Decl, Decl)
| L (Literal, Literal)
| G (GuardedRhs, GuardedRhs)
deriving Eq
same :: MuOp -> Bool
same (N (a,b)) = a == b
same (QN (a,b)) = a == b
same (QO (a,b)) = a == b
same (E (a,b)) = a == b
same (D (a,b)) = a == b
same (L (a,b)) = a == b
same (G (a,b)) = a == b
mkMp' :: (MonadPlus m, G.Typeable a) => MuOp -> a -> m a
mkMp' (N (s,t)) = G.mkMp (s ~~> t)
mkMp' (QN (s,t)) = G.mkMp (s ~~> t)
mkMp' (QO (s,t)) = G.mkMp (s ~~> t)
mkMp' (E (s,t)) = G.mkMp (s ~~> t)
mkMp' (D (s,t)) = G.mkMp (s ~~> t)
mkMp' (L (s,t)) = G.mkMp (s ~~> t)
mkMp' (G (s,t)) = G.mkMp (s ~~> t)
showM :: (Show a1, Show a) => (a, a1) -> String
showM (s, t) = "\n" ++ show s ++ " ==> " ++ show t
instance Show MuOp where
show (N a) = showM a
show (QN a) = showM a
show (QO a) = showM a
show (E a) = showM a
show (D a) = showM a
show (L a) = showM a
show (G a) = showM a
class Mutable a where
(==>) :: a -> a -> MuOp
(==>*) :: Mutable a => a -> [a] -> [MuOp]
(==>*) x lst = map (\i -> x ==> i) lst
(*==>*) :: Mutable a => [a] -> [a] -> [MuOp]
xs *==>* ys = concatMap (==>* ys) xs
(~~>) :: (MonadPlus m, Eq a) => a -> a -> a -> m a
x ~~> y = \z -> if z == x then return y else mzero
instance Mutable Name where
(==>) = (N .) . (,)
instance Mutable QName where
(==>) = (QN .) . (,)
instance Mutable QOp where
(==>) = (QO .) . (,)
instance Mutable Exp where
(==>) = (E .) . (,)
instance Mutable Decl where
(==>) = (D .) . (,)
instance Mutable Literal where
(==>) = (L .) . (,)
instance Mutable GuardedRhs where
(==>) = (G .) . (,)