summaryrefslogtreecommitdiff
path: root/testsuite/tests/safeHaskell/safeLanguage/SafeLang04.hs
diff options
context:
space:
mode:
Diffstat (limited to 'testsuite/tests/safeHaskell/safeLanguage/SafeLang04.hs')
-rw-r--r--testsuite/tests/safeHaskell/safeLanguage/SafeLang04.hs32
1 files changed, 32 insertions, 0 deletions
diff --git a/testsuite/tests/safeHaskell/safeLanguage/SafeLang04.hs b/testsuite/tests/safeHaskell/safeLanguage/SafeLang04.hs
new file mode 100644
index 0000000000..a9ac3619f3
--- /dev/null
+++ b/testsuite/tests/safeHaskell/safeLanguage/SafeLang04.hs
@@ -0,0 +1,32 @@
+{-# OPTIONS_GHC -fenable-rewrite-rules #-}
+-- | Check rules work as normal without Safe
+module Main where
+
+data T = T1 | T2 | T3 deriving ( Eq, Ord, Show )
+
+lookupx :: Ord key => Show val => [(key,val)] -> key -> Maybe val
+lookupx [] _ = Nothing
+lookupx ((t,a):xs) t' | t == t' = Just a
+ | otherwise = lookupx xs t'
+
+{-# RULES "lookupx/T" lookupx = tLookup #-}
+tLookup :: [(T,a)] -> T -> Maybe a
+tLookup [] _ = Nothing
+tLookup ((t,a):xs) t' | t /= t' = Just a
+ | otherwise = tLookup xs t'
+
+space = [(T1,"a"),(T2,"b"),(T3,"c")]
+key = T3
+
+main = do
+ putStrLn $ "looking for " ++ show key
+ putStrLn $ "in space " ++ show space
+ putStrLn $ "Found: " ++ show (fromMaybe "Not Found!" $ lookupx space key)
+ let b | Just "c" <- lookupx space key = "YES"
+ | otherwise = "NO"
+ putStrLn $ "Rules Disabled: " ++ b
+
+fromMaybe :: a -> Maybe a -> a
+fromMaybe a Nothing = a
+fromMaybe _ (Just a) = a
+