summaryrefslogtreecommitdiff
path: root/testsuite/tests/linear/should_fail/TypeClass.hs
blob: 9752810dc4574930e9b71b3b592b48f5d0badcd3 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UnicodeSyntax #-}
{-# LANGUAGE LinearTypes #-}
module Foo where

data Either a b = Left a | Right b

either :: (a -> c) -> (b -> c) -> Either a b -> c
either f g (Left a) = f a
either f g (Right b) = g b

class Iden p where
  iden :: p a a

instance Iden (->) where
  iden x = x

class Cat p where
  comp :: p b c -> p a b -> p a c

instance Cat (->) where
  comp f g = \x -> f (g x)

class ArrowChoice a where
    (+++) :: a b c -> a b' c' -> a (Either b b') (Either c c')
    (|||) :: a b d -> a c d -> a (Either b c) d

instance ArrowChoice (->) where
--    This doesn't work as |p| is inferred to be |-o| because of |Left|.
--    Then GHC complains that |f| is not the same type before it realises
--    that the overall type must be (->)
--    f +++ g = (Left `comp` f) ||| (Right `comp` g)
    f +++ g = (comp @(->) Left f) ||| (comp @(->) Right g)
    (|||) = either


-- This shouldn't work
foo :: a ⊸ a
foo = iden