summaryrefslogtreecommitdiff
path: root/lib/ScanningParser.hs
diff options
context:
space:
mode:
Diffstat (limited to 'lib/ScanningParser.hs')
-rw-r--r--lib/ScanningParser.hs74
1 files changed, 74 insertions, 0 deletions
diff --git a/lib/ScanningParser.hs b/lib/ScanningParser.hs
new file mode 100644
index 0000000..f99e120
--- /dev/null
+++ b/lib/ScanningParser.hs
@@ -0,0 +1,74 @@
1{-# LANGUAGE RankNTypes #-}
2{-# LANGUAGE ExistentialQuantification #-}
3module ScanningParser
4 ( ScanningParser(..)
5 , scanAndParse
6 , scanAndParse1
7 ) where
8
9import Data.Maybe
10import Data.List
11import Control.Applicative
12import Control.Monad
13import Data.Monoid
14
15-- | This type provides the means to parse a stream of 'tok' and extract all
16-- the 'obj' parses that occur.
17--
18-- Use Functor and Monoid interfaces to combine parsers. For example,
19--
20-- > parserAorB = fmap Left parserA <> fmap Right parserB
21--
22data ScanningParser tok obj = forall partial. ScanningParser
23 { findFirst :: tok -> Maybe partial
24 -- ^ If the token starts an object, returns a partial parse.
25 , parseBody :: partial -> [tok] -> (Maybe obj,[tok])
26 -- ^ Given a partial parse and the stream of tokens that follow, attempt to
27 -- parse an object and return the unconsumed tokens.
28 }
29
30instance Functor (ScanningParser a) where
31 fmap f (ScanningParser ffst pbody)
32 = ScanningParser ffst (\b -> first (fmap f) . pbody b)
33 where
34 first f (x,y) = (f x, y)
35
36
37instance Monoid (ScanningParser a b) where
38 mempty = ScanningParser (const Nothing) (const $ const (Nothing,[]))
39 mappend (ScanningParser ffstA pbdyA)
40 (ScanningParser ffstB pbdyB)
41 = ScanningParser ffst pbody
42 where
43 ffst x = mplus (Left <$> ffstA x)
44 (Right <$> ffstB x)
45 pbody (Left apart) = pbdyA apart
46 pbody (Right bpart) = pbdyB bpart
47
48
49-- | Apply a 'ScanningParser' to a list of tokens, yielding a list of parsed
50-- objects.
51scanAndParse :: ScanningParser a c -> [a] -> [c]
52scanAndParse psr [] = []
53scanAndParse psr@(ScanningParser ffst pbdy) ts = do
54 (b,xs) <- take 1 $ mapMaybe findfst' tss
55 let (mc,ts') = pbdy b xs
56 rec = scanAndParse psr ts'
57 maybe rec (:rec) mc
58 where
59 tss = tails ts
60 findfst' ts = do
61 x <- listToMaybe ts
62 b <- ffst x
63 return (b,drop 1 ts)
64
65scanAndParse1 :: ScanningParser a c -> [a] -> (Maybe c, [a])
66scanAndParse1 psr@(ScanningParser ffst pbdy) ts =
67 maybe (Nothing,[]) (uncurry pbdy) mb
68 where
69 mb = listToMaybe $ mapMaybe findfst' tss
70 tss = tails ts
71 findfst' ts = do
72 x <- listToMaybe ts
73 b <- ffst x
74 return (b,drop 1 ts)