1{-# LANGUAGE TypeApplications, ScopedTypeVariables, PolyKinds,
2             TypeFamilies, RankNTypes,
3             FlexibleContexts #-}
4-- tests about visible type application
5
6module Vta1 where
7
8quad :: a -> b -> c -> d -> (a, b, c, d)
9quad = (,,,)
10
11silly = quad @_ @Bool @Char @_ 5 True 'a' "Hello"
12
13pairup_nosig x y = (x, y)
14
15pairup_sig :: a -> b -> (a,b)
16pairup_sig u w = (u, w)
17
18answer_sig = pairup_sig @Bool @Int False 7 --
19-- (False, 7) :: (Bool, Int)
20
21answer_read = show (read @Int "3") -- "3" :: String
22answer_show = show @Integer (read "5") -- "5" :: String
23answer_showread = show @Int (read @Int "7") -- "7" :: String
24
25intcons a = (:) @Int a
26
27intpair x y = pairup_sig @Int x y
28
29answer_pairup = pairup_sig @Int 5 True -- (5, True) :: (Int, Bool)
30answer_intpair = intpair 1 "hello" -- (1, "hello") :: (Int, String)
31answer_intcons = intcons 7 []      -- [7] :: [Int]
32
33type family F a
34type instance F Char = Bool
35
36g :: F a -> a
37g _ = undefined
38
39f :: Char
40f = g True
41
42answer = g @Char False
43
44mapSame :: forall b. (forall a. a -> a) -> [b] -> [b]
45mapSame _ [] = []
46mapSame fun (x:xs) = fun @b x : (mapSame @b fun xs)
47
48pair :: forall a. a-> (forall b. b -> (a, b))
49pair x y = (x, y)
50
51b = pair @Int 3 @Bool True
52c = mapSame id [1,2,3]
53d = pair 3 @Bool True
54
55pairnum :: forall a. Num a => forall b. b -> (a, b)
56pairnum = pair 3
57
58e = (pair 3 :: forall a. Num a => forall b. b -> (a, b)) @Int @Bool True
59h = pairnum @Int @Bool True
60
61data First (a :: * -> *) = F
62data Proxy (a :: k) = P -- This expands to P (kind variable) (type variable)
63data Three (a :: * -> k -> *) = T
64
65foo :: Proxy a -> Int
66foo _ = 0
67
68first :: First a -> Int
69first _ = 0
70
71fTest = first F
72fMaybe = first @Maybe F
73
74test = foo P
75bar = foo @Bool P -- should work
76
77too :: Three a -> Int
78too _ = 3
79
80threeBase = too T
81threeOk = too @Either T
82
83blah = Nothing @Int
84
85newtype N = MkN { unMkN :: forall a. Show a => a -> String }
86
87n = MkN show
88
89boo = unMkN n @Bool
90
91boo2 :: forall (a :: * -> *) . Proxy a -> Bool
92boo2 _ = False
93
94base = boo2 P
95bar'= boo2 @Maybe P -- should work
96