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 RankNTypes #-}
{-# LANGUAGE ExistentialQuantification #-}
module ScanningParser
( ScanningParser(..)
, scanAndParse
, scanAndParse1
) where
import Data.Maybe
import Data.List
import Control.Applicative
import Control.Monad
import Data.Monoid
-- | This type provides the means to parse a stream of 'tok' and extract all
-- the 'obj' parses that occur.
--
-- Use Functor and Monoid interfaces to combine parsers. For example,
--
-- > parserAorB = fmap Left parserA <> fmap Right parserB
--
data ScanningParser tok obj = forall partial. ScanningParser
{ findFirst :: tok -> Maybe partial
-- ^ If the token starts an object, returns a partial parse.
, parseBody :: partial -> [tok] -> (Maybe obj,[tok])
-- ^ Given a partial parse and the stream of tokens that follow, attempt to
-- parse an object and return the unconsumed tokens.
}
instance Functor (ScanningParser a) where
fmap f (ScanningParser ffst pbody)
= ScanningParser ffst (\b -> first (fmap f) . pbody b)
where
first f (x,y) = (f x, y)
instance Semigroup (ScanningParser a b) where
(<>) = mappend
instance Monoid (ScanningParser a b) where
mempty = ScanningParser (const Nothing) (const $ const (Nothing,[]))
mappend (ScanningParser ffstA pbdyA)
(ScanningParser ffstB pbdyB)
= ScanningParser ffst pbody
where
ffst x = mplus (Left <$> ffstA x)
(Right <$> ffstB x)
pbody (Left apart) = pbdyA apart
pbody (Right bpart) = pbdyB bpart
-- | Apply a 'ScanningParser' to a list of tokens, yielding a list of parsed
-- objects.
scanAndParse :: ScanningParser a c -> [a] -> [c]
scanAndParse psr [] = []
scanAndParse psr@(ScanningParser ffst pbdy) ts = do
(b,xs) <- take 1 $ mapMaybe findfst' tss
let (mc,ts') = pbdy b xs
rec = scanAndParse psr ts'
maybe rec (:rec) mc
where
tss = tails ts
findfst' ts = do
x <- listToMaybe ts
b <- ffst x
return (b,drop 1 ts)
scanAndParse1 :: ScanningParser a c -> [a] -> (Maybe c, [a])
scanAndParse1 psr@(ScanningParser ffst pbdy) ts =
maybe (Nothing,[]) (uncurry pbdy) mb
where
mb = listToMaybe $ mapMaybe findfst' tss
tss = tails ts
findfst' ts = do
x <- listToMaybe ts
b <- ffst x
return (b,drop 1 ts)
|
