1 -----------------------------------------------------------------------------
3 -- Module : Text.ParserCombinators.Parsec.Perm
4 -- Copyright : (c) Daan Leijen 1999-2001
5 -- License : BSD-style (see the file libraries/base/LICENSE)
7 -- Maintainer : daan@cs.uu.nl
8 -- Stability : provisional
9 -- Portability : non-portable (uses existentially quantified data constructors)
11 -- This module implements permutation parsers. The algorithm used
12 -- is fairly complex since we push the type system to its limits :-)
13 -- The algorithm is described in:
15 -- /Parsing Permutation Phrases,/
16 -- by Arthur Baars, Andres Loh and Doaitse Swierstra.
17 -- Published as a functional pearl at the Haskell Workshop 2001.
19 -----------------------------------------------------------------------------
21 module Text.ParserCombinators.Parsec.Perm
22 ( PermParser -- abstract
29 import Text.ParserCombinators.Parsec
31 {---------------------------------------------------------------
33 ---------------------------------------------------------------}
38 {---------------------------------------------------------------
39 test -- parse a permutation of
40 * an optional string of 'a's
43 ---------------------------------------------------------------}
45 = parse (do{ x <- ptest; eof; return x }) "" input
47 ptest :: Parser (String,Char,Char)
50 (,,) <$?> ("",many1 (char 'a'))
55 {---------------------------------------------------------------
56 Building a permutation parser
57 ---------------------------------------------------------------}
58 (<||>) :: PermParser tok st (a -> b) -> GenParser tok st a -> PermParser tok st b
59 (<||>) perm p = add perm p
60 (<$$>) f p = newperm f <||> p
62 (<|?>) perm (x,p) = addopt perm x p
63 (<$?>) f (x,p) = newperm f <|?> (x,p)
67 {---------------------------------------------------------------
69 ---------------------------------------------------------------}
70 data PermParser tok st a = Perm (Maybe a) [Branch tok st a]
71 data Branch tok st a = forall b. Branch (PermParser tok st (b -> a)) (GenParser tok st b)
74 -- transform a permutation tree into a normal parser
75 permute :: PermParser tok st a -> GenParser tok st a
77 = choice (map branch xs ++ empty)
84 branch (Branch perm p)
90 -- build permutation trees
91 newperm :: (a -> b) -> PermParser tok st (a -> b)
95 add :: PermParser tok st (a -> b) -> GenParser tok st a -> PermParser tok st b
96 add perm@(Perm mf fs) p
97 = Perm Nothing (first:map insert fs)
100 insert (Branch perm' p')
101 = Branch (add (mapPerms flip perm') p) p'
103 addopt :: PermParser tok st (a -> b) -> a -> GenParser tok st a -> PermParser tok st b
104 addopt perm@(Perm mf fs) x p
105 = Perm (fmap ($ x) mf) (first:map insert fs)
107 first = Branch perm p
108 insert (Branch perm' p')
109 = Branch (addopt (mapPerms flip perm') x p) p'
112 mapPerms :: (a -> b) -> PermParser tok st a -> PermParser tok st b
113 mapPerms f (Perm x xs)
114 = Perm (fmap f x) (map (mapBranch f) xs)
116 mapBranch f (Branch perm p)
117 = Branch (mapPerms (f.) perm) p