愿你走出半生，归来仍是Java Parser

1 data   x = Mk  (x -> x)

1 use ::   x -> x
2 use (Mk  x) = let res = x res in res

1 inherit :: (a -> b) -> (b -> a) ->   a ->   b
2 inherit ab ba (Mk  aa) = Mk  (ab . aa . ba)

1 test ::   (Int, Int)
2 test = Mk  $ \\self -> (2, fst self + fst self)

1 inheritTest ::   ((Int, Int), Int)
2 inheritTest = inherit (\\(l, r) -> ((l + 1, r + 2), r + 1)) fst test

 1 class AST repr where
 2   lit :: Int -> repr
 3   plus :: repr -> repr -> repr
 4 
 5 class Var repr where
 6   var :: String -> repr
 7 
 8 type WholeParser repr = Parser repr
 9 type LitParser repr = Parser repr
10 type PlusParser repr = Parser repr
11 
12 intP :: Parser Int
13 intP = read <$> many1 digit
14 
15 stringP :: Parser String
16 stringP = many1 letter
17 
18 type OriginalParser repr = ((LitParser repr, PlusParser repr), WholeParser repr)
19 originalParser :: AST repr =>   (OriginalParser repr)
20 originalParser = Mk  $ \\(~(_, p)) -> let
21   litP = lit <$> intP
22   plusP = between (char \'(\') (char \')\') (do {l <- p; spaces; char \'+\'; spaces; r <- p; return $ plus l r})
23   wholeP = litP <|> plusP in
24   ((litP, plusP), wholeP)
25 
26 type VarParser repr = Parser repr
27 extendedParser :: (AST repr, Var repr) =>   (VarParser repr, OriginalParser repr)
28 extendedParser = inherit extend snd originalParser
29   where
30     extend ~((litP, plusP), wholeP) = let
31       varP = var <$> stringP in
32       (varP, ((litP, plusP), varP <|> wholeP))
33 
34 instance AST String where
35   lit = show
36   plus x y = \"(\" ++ x ++ \" \" ++ \"+\" ++ \" \" ++ y ++ \")\"
37 
38 instance Var String where
39   var x = x