summaryrefslogtreecommitdiff
path: root/testsuite/tests/printer/T18247a.hs
diff options
context:
space:
mode:
Diffstat (limited to 'testsuite/tests/printer/T18247a.hs')
-rw-r--r--testsuite/tests/printer/T18247a.hs134
1 files changed, 134 insertions, 0 deletions
diff --git a/testsuite/tests/printer/T18247a.hs b/testsuite/tests/printer/T18247a.hs
new file mode 100644
index 0000000000..ec3e840525
--- /dev/null
+++ b/testsuite/tests/printer/T18247a.hs
@@ -0,0 +1,134 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE ViewPatterns #-}
+
+module T18247a where
+
+import Control.Monad (guard)
+import qualified Data.Sequence as Seq
+
+import T18247b
+
+-- pattern P = 42
+
+useP P = 43
+
+--
+
+{-
+data Type = App String [Type]
+
+pattern Arrow :: Type -> Type -> Type
+pattern Arrow t1 t2 = App "->" [t1, t2]
+
+pattern Int = App "Int" []
+
+pattern Maybe t = App "Maybe" [t]
+
+-}
+
+collectArgs :: Type -> [Type]
+collectArgs (Arrow t1 t2) = t1 : collectArgs t2
+collectArgs _ = []
+
+isInt :: Type -> Bool
+isInt Int = True
+isInt _ = False
+
+isIntEndo :: Type -> Bool
+isIntEndo (Arrow Int Int) = True
+isIntEndo _ = False
+
+arrows :: [Type] -> Type -> Type
+arrows = flip $ foldr Arrow
+
+--
+{-
+
+pattern Empty <- (Seq.viewl -> Seq.EmptyL)
+pattern x :< xs <- (Seq.viewl -> x Seq.:< xs)
+pattern xs :> x <- (Seq.viewr -> xs Seq.:> x)
+-}
+
+viewPL (x :< Empty) = x
+viewPR (Empty :> y) = y
+
+--
+
+{-
+pattern Succ n <-
+ (\x -> (x -1) <$ guard (x > 0) -> Just n)
+ where
+ Succ n = n + 1
+-}
+
+fac (Succ n) = Succ n * fac n
+fac 0 = 1
+
+--
+
+{-
+data Showable where
+ MkShowable :: (Show a) => a -> Showable
+
+-- Required context is empty, but provided context is not
+pattern Sh :: () => (Show a) => a -> Showable
+pattern Sh x <- MkShowable x
+-}
+
+showable :: (Show a) => a -> Showable
+showable x = MkShowable x
+
+--
+
+{-
+-- Provided context is empty
+pattern One :: (Num a, Eq a) => a
+pattern One <- 1
+-}
+
+one One = 2
+
+--
+
+
+--pattern Pair x y <- [x, y]
+
+
+f (Pair True True) = True
+f _ = False
+
+g [True, True] = True
+g _ = False
+
+
+--
+{-
+data Nat = Z | S Nat deriving (Show)
+
+pattern Ess p = S p
+-}
+
+two = S ( S Z)
+
+--
+
+-- pattern Single x = [x]
+
+-- pattern Head x <- x : xs
+
+single (Single x) = x
+hd :: [a] -> a
+hd (Head x) = x
+
+--
+
+{-
+data T a where
+ MkT :: (Show b) => a -> b -> T a
+
+pattern ExNumPat x = MkT 42 x
+-}
+
+h :: (Num t, Eq t) => T t -> String
+h (ExNumPat x) = show x