blob: 6ccf6b90deec720f385854dd0477d1eb34cf46f9 (
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
46
|
{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies,
FlexibleInstances, FlexibleContexts, UndecidableInstances #-}
-- Example of improvement, due to George Russel
module Folders where
data Folder = Folder
newtype SB x = SB x
newtype SS x = SS x
data NodeArcsHidden = NodeArcsHidden
class HasSS hasS x | hasS -> x where
toSS :: hasS -> SS x
instance HasSS (SB x) x where
toSS (SB x) = (SS x)
class HMV option graph node where
modd :: option -> graph -> node value -> IO ()
instance HMV NodeArcsHidden graph node
=> HMV (Maybe NodeArcsHidden) graph node
where
modd = error "burk"
gn :: HMV NodeArcsHidden graph node
=> graph
-> SS (graph -> node Int -> IO ())
gn graph = fmapSS (\ arcsHidden -> (\ graph node -> modd arcsHidden graph node))
(toSS (error "C" :: SB (Maybe NodeArcsHidden)))
-- The call to modd gives rise to
-- HMV option graph node
-- The call to toSS gives rise to
-- HasSS (SB (Maybe NodeArcsHidden)) x
-- where (toSS (error ...)) :: SS x
-- and hence arcsHidden :: x
--
-- Then improvement should give x = Maybe NodeArcsHidden
-- and hence option=Maybe NodeArcsHidden
fmapSS :: (a->b) -> SS a -> SS b
fmapSS = error "urk"
|
