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
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
|
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ScopedTypeVariables #-}
module GRead2 () where
{-
For the discussion in the 2nd boilerplate paper,
we favour some simplified generic read, which is checked to compile.
For the full/real story see Data.Generics.Text.
-}
import Control.Applicative (Applicative(..))
import Control.Monad (ap, liftM)
import Data.Generics
gread :: Data a => String -> Maybe a
gread input = runDec input readM
-- The decoder monad
newtype DecM a = D (String -> Maybe (String, a))
instance Functor DecM where
fmap = liftM
instance Applicative DecM where
pure a = D (\s -> Just (s,a))
(<*>) = ap
instance Monad DecM where
return = pure
(D m) >>= k = D (\s ->
case m s of
Nothing -> Nothing
Just (s1,a) -> let D n = k a
in n s1)
runDec :: String -> DecM a -> Maybe a
runDec input (D m) = do (_,x) <- m input
return x
parseConstr :: DataType -> DecM Constr
parseConstr ty = D (\s ->
match s (dataTypeConstrs ty))
where
match :: String -> [Constr]
-> Maybe (String, Constr)
match _ [] = Nothing
match input (con:cons)
| take n input == showConstr con
= Just (drop n input, con)
| otherwise
= match input cons
where
n = length (showConstr con)
readM :: forall a. Data a => DecM a
readM = read
where
read :: DecM a
read = do { let val = argOf read
; let ty = dataTypeOf val
; constr <- parseConstr ty
; let con::a = fromConstr constr
; gmapM (\_ -> readM) con }
argOf :: c a -> a
argOf = undefined
yareadM :: forall a. Data a => DecM a
yareadM = do { let ty = dataTypeOf (undefined::a)
; constr <- parseConstr ty
; let con::a = fromConstr constr
; gmapM (\_ -> yareadM) con }
|
