[commit: ghc] master: Test #13585 in typecheck/should_compile/T13585 (6df8bef)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/6df8bef054db0b95bb8f9e55bb82580e27d251d6/ghc

>---------------------------------------------------------------

commit 6df8bef054db0b95bb8f9e55bb82580e27d251d6
Author: Richard Eisenberg <rae at cs.brynmawr.edu>
Date:   Mon May 1 23:16:20 2017 -0400

    Test #13585 in typecheck/should_compile/T13585


>---------------------------------------------------------------

6df8bef054db0b95bb8f9e55bb82580e27d251d6
 testsuite/tests/typecheck/should_compile/Makefile  |  6 ++
 testsuite/tests/typecheck/should_compile/T13585.hs |  5 ++
 .../tests/typecheck/should_compile/T13585a.hs      | 81 ++++++++++++++++++++++
 .../tests/typecheck/should_compile/T13585b.hs      |  7 ++
 testsuite/tests/typecheck/should_compile/all.T     |  1 +
 5 files changed, 100 insertions(+)

diff --git a/testsuite/tests/typecheck/should_compile/Makefile b/testsuite/tests/typecheck/should_compile/Makefile
index cb8269a..fc90899 100644
--- a/testsuite/tests/typecheck/should_compile/Makefile
+++ b/testsuite/tests/typecheck/should_compile/Makefile
@@ -56,3 +56,9 @@ Tc271:
 	'$(TEST_HC)' $(TEST_HC_OPTS) -c Tc271.hs-boot
 	'$(TEST_HC)' $(TEST_HC_OPTS) -c Tc271a.hs
 	'$(TEST_HC)' $(TEST_HC_OPTS) -c Tc271.hs
+
+T13585:
+	$(RM) -f T13585a.o T13585a.hi T13585b.o T13585b.hi T13585.o T13585.hi
+	'$(TEST_HC)' $(TEST_HC_OPTS) -c T13585a.hs -O
+	'$(TEST_HC)' $(TEST_HC_OPTS) -c T13585b.hs -O
+	'$(TEST_HC)' $(TEST_HC_OPTS) -c T13585.hs  -O
diff --git a/testsuite/tests/typecheck/should_compile/T13585.hs b/testsuite/tests/typecheck/should_compile/T13585.hs
new file mode 100644
index 0000000..74c9412
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/T13585.hs
@@ -0,0 +1,5 @@
+module T13585 where
+import T13585b (extractZonedTime)
+
+main :: IO ()
+main = print extractZonedTime
diff --git a/testsuite/tests/typecheck/should_compile/T13585a.hs b/testsuite/tests/typecheck/should_compile/T13585a.hs
new file mode 100644
index 0000000..fda3d70
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/T13585a.hs
@@ -0,0 +1,81 @@
+{-# LANGUAGE KindSignatures, RankNTypes, TypeFamilies, MultiParamTypeClasses, FlexibleInstances,UndecidableInstances #-}
+
+module T13585a where
+
+import Data.Monoid (First(..))
+import Data.Functor.Identity
+
+class Profunctor p where
+  dimap :: (a -> b) -> (c -> d) -> p b c -> p a d
+  dimap f g = lmap f . rmap g
+  {-# INLINE dimap #-}
+
+  lmap :: (a -> b) -> p b c -> p a c
+  lmap f = dimap f id
+  {-# INLINE lmap #-}
+
+  rmap :: (b -> c) -> p a b -> p a c
+  rmap = dimap id
+  {-# INLINE rmap #-}
+
+
+data Exchange a b s t = Exchange (s -> a) (b -> t)
+
+instance Functor (Exchange a b s) where
+  fmap f (Exchange sa bt) = Exchange sa (f . bt)
+  {-# INLINE fmap #-}
+
+instance Profunctor (Exchange a b) where
+  dimap f g (Exchange sa bt) = Exchange (sa . f) (g . bt)
+  {-# INLINE dimap #-}
+  lmap f (Exchange sa bt) = Exchange (sa . f) bt
+  {-# INLINE lmap #-}
+  rmap f (Exchange sa bt) = Exchange sa (f . bt)
+  {-# INLINE rmap #-}
+
+
+
+withIso :: AnIso s t a b -> ((s -> a) -> (b -> t) -> r) -> r
+withIso ai k = case ai (Exchange id Identity) of
+  Exchange sa bt -> k sa (runIdentity undefined bt)
+{-# INLINE withIso #-}
+
+type Iso s t a b = forall p f. (Profunctor p, Functor f) => p a (f b) -> p s (f t)
+type Iso' s a = Iso s s a a
+type AnIso s t a b = Exchange a b a (Identity b) -> Exchange a b s (Identity t)
+
+class    (Rewrapped s t, Rewrapped t s) => Rewrapping s t
+instance (Rewrapped s t, Rewrapped t s) => Rewrapping s t
+
+
+instance (t ~ First b) => Rewrapped (First a) t
+instance Wrapped (First a) where
+    type Unwrapped (First a) = Maybe a
+    _Wrapped' = iso getFirst First
+    {-# INLINE _Wrapped' #-}
+
+class Wrapped s => Rewrapped (s :: *) (t :: *)
+
+class Wrapped s where
+    type Unwrapped s :: *
+    _Wrapped' :: Iso' s (Unwrapped s)
+
+_Wrapping :: Rewrapping s t => (Unwrapped s -> s) -> Iso s t (Unwrapped s) (Unwrapped t)
+_Wrapping _ = _Wrapped
+{-# INLINE _Wrapping #-}
+
+iso :: (s -> a) -> (b -> t) -> Iso s t a b
+iso sa bt = dimap sa (fmap bt)
+{-# INLINE iso #-}
+
+_Wrapped :: Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
+_Wrapped = withIso _Wrapped' $ \ sa _ -> withIso _Wrapped' $ \ _ bt -> iso sa bt
+{-# INLINE _Wrapped #-}
+
+au :: Functor f => AnIso s t a b -> ((b -> t) -> f s) -> f a
+au k = withIso k $ \ sa bt f -> fmap sa (f bt)
+{-# INLINE au #-}
+
+ala :: (Functor f, Rewrapping s t) => (Unwrapped s -> s) -> ((Unwrapped t -> t) -> f s) -> f (Unwrapped s)
+ala = au . _Wrapping
+{-# INLINE ala #-}
diff --git a/testsuite/tests/typecheck/should_compile/T13585b.hs b/testsuite/tests/typecheck/should_compile/T13585b.hs
new file mode 100644
index 0000000..db09cf1
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/T13585b.hs
@@ -0,0 +1,7 @@
+module T13585b where
+
+import T13585a
+import Data.Monoid
+
+extractZonedTime :: Maybe ()
+extractZonedTime = ala First foldMap [Nothing]
diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T
index 8742353..34b8184 100644
--- a/testsuite/tests/typecheck/should_compile/all.T
+++ b/testsuite/tests/typecheck/should_compile/all.T
@@ -557,3 +557,4 @@ test('T13509', normal, compile, [''])
 test('T13526', normal, compile, [''])
 test('T13603', normal, compile, [''])
 test('T13333', normal, compile, [''])
+test('T13585', [extra_files(['T13585.hs', 'T13585a.hs', 'T13585b.hs'])], run_command, ['$MAKE -s --no-print-directory T13585'])