summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorjoe <joe@jerkface.net>2014-05-09 03:07:39 -0400
committerjoe <joe@jerkface.net>2014-05-09 03:07:39 -0400
commit77744e9231a06739aafd241418683a9ce384df5d (patch)
tree97433ad6f0d46ec8caf2722d1d51805fca32cff5
parent4c37f71285316bed2de8148bd520ea8c30de6951 (diff)
ScanningParser module
-rw-r--r--ScanningParser.hs96
1 files changed, 96 insertions, 0 deletions
diff --git a/ScanningParser.hs b/ScanningParser.hs
new file mode 100644
index 0000000..9eed080
--- /dev/null
+++ b/ScanningParser.hs
@@ -0,0 +1,96 @@
1{-# LANGUAGE RankNTypes #-}
2{-# LANGUAGE ExistentialQuantification #-}
3module ScanningParser
4 ( ScanningParser(..)
5 ) where
6
7import Data.Maybe
8import Data.List
9import Control.Applicative
10import Control.Monad
11import Data.Monoid
12
13-- | Utility to operate on the first item of a pair.
14first :: (a->b) -> (a,c) -> (b,c)
15first f (x,y) = (f x, y)
16
17-- | This type provides the means to parse a stream of 'tok' and extract all
18-- the 'obj' parses that occur.
19--
20-- Use Functor and Monoid interfaces to combine parsers. For example,
21--
22-- > parserAorB = fmap Left parserA <> fmap Right parserB
23--
24data ScanningParser tok obj = forall partial. ScanningParser
25 { findFirst :: tok -> Maybe partial
26 -- ^ If the token starts an object, returns a partial parse.
27 , parseBody :: partial -> [tok] -> (Maybe obj,[tok])
28 -- ^ Given a partial parse and the stream of tokens that follow, attempt to
29 -- parse an object and return the unconsumed tokens.
30 }
31
32-- | Apply a 'ScanningParser' to a list of tokens, yielding a list of parsed
33-- objects.
34scanAndParse :: ScanningParser a c -> [a] -> [c]
35scanAndParse psr [] = []
36scanAndParse psr@(ScanningParser ffst pbdy) ts = do
37 (b,xs) <- take 1 $ mapMaybe findfst' tss
38 let (mc,ts') = pbdy b xs
39 maybe [] (:scanAndParse psr ts') mc
40 where
41 tss = tails ts
42 findfst' ts = do
43 x <- listToMaybe ts
44 b <- ffst x
45 return (b,drop 1 ts)
46
47instance Functor (ScanningParser a) where
48 fmap f (ScanningParser ffst pbody)
49 = ScanningParser ffst (\b -> first (fmap f) . pbody b)
50
51instance Monoid (ScanningParser a b) where
52 mempty = ScanningParser (const Nothing) (const $ const (Nothing,[]))
53 mappend a b = a <+> b
54
55-- | Combine two parsers into one that tries either.
56(<+>) ::
57 ScanningParser tok obj
58 -> ScanningParser tok obj
59 -> ScanningParser tok obj
60parserA@(ScanningParser ffstA pbdyA) <+> parserB@(ScanningParser ffstB pbdyB) = ScanningParser ffst pbody
61 where
62 ffst x = mplus (Left <$> ffstA x)
63 (Right <$> ffstB x)
64 pbody (Left apart) = pbdyA apart
65 pbody (Right bpart) = pbdyB bpart
66
67{-
68
69-- | Map a parser into a sum type. This is useful for combining multiple
70-- 'ScanningParser's for a single pass scan.
71--
72-- HELP: Can this be done with one function argument instead of three?
73mapParser ::
74 (c -> y)
75 -> (b -> x)
76 -> (x -> b)
77 -> ScanningParser a b c
78 -> ScanningParser a x y
79mapParser g f invf psr =
80 psr { findFirst = fmap f . findFirst psr
81 , parseBody = \b as -> first (fmap g) $ parseBody psr (invf b) as
82 }
83
84-- | map 'Right' over a 'ScanningParser'
85--
86-- > mapRight = mapParser Right Right (\(Right x)->x)
87mapRight :: ScanningParser a b c -> ScanningParser a (Either x b) (Either y c)
88mapRight = mapParser Right Right (\(Right x)->x)
89
90-- | map 'Left' over a 'ScanningParser'
91--
92-- > mapLeft = mapParser Left Left (\(Left x)->x)
93mapLeft :: ScanningParser a b c -> ScanningParser a (Either b x) (Either c y)
94mapLeft = mapParser Left Left (\(Left x)->x)
95
96-}