summaryrefslogtreecommitdiff
path: root/src/System/IO/Terminal/Input/SeqParser.hs
blob: 8dfdafc07920e94ed60e64c76cc136f6a7938b69 (plain)
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
{-|
Module      : System.IO.Terminal.Input.SeqParser
Copyright   : (c) UU, 2019
License     : MIT
Maintainer  : Tom Smeding
Stability   : experimental
Portability : POSIX, macOS, Windows

This module defines a coroutine-like, finite-state-machine-like type,
'SeqParser'. Sequence parsers consume an infinite stream of values,
producing zero or more output values after each input value read. The
described parser is explicitly lazy to have full and explicit control over
the amount of input necessary to produce an output value.
-}
module System.IO.Terminal.Input.SeqParser where


-- | Consumes an explicitly lazy stream of @a@\'s, producing a staggered
-- infinite stream of @b@\'s.
newtype SeqParser a b = SeqParser (a -> ([b], SeqParser a b))

-- | Consumes an explicitly lazy stream of @a@\'s, and after some nonzero
-- number of such values, produces a @b@.
data SeqParserOnce  a b = SeqParserOnce (a -> SeqParserOnce' a b)
-- | A 'SeqParserOnce' that does not guarantee to consume at least one
-- @a@.
data SeqParserOnce' a b = SeqParserOnce' (a -> SeqParserOnce' a b) | SeqParserVal b

-- | Modify the next result from the 'SeqParser'.
fmap1st :: (b -> b) -> SeqParser a b -> SeqParser a b
fmap1st f (SeqParser g) =
    SeqParser $ \a -> case g a of
                        ([], p)     -> ([], fmap1st f p)
                        (b : bs, p) -> (f b : bs, p)

instance Functor (SeqParserOnce a) where
    fmap f (SeqParserOnce g) = SeqParserOnce (fmap f . g)

instance Functor (SeqParserOnce' a) where
    fmap f (SeqParserVal x)   = SeqParserVal (f x)
    fmap f (SeqParserOnce' g) = SeqParserOnce' (fmap f . g)

-- | After the 'SeqParserOnce' is done, continue processing input with the
-- 'SeqParser'.
followedBy :: SeqParserOnce a b -> SeqParser a b -> SeqParser a b
followedBy (SeqParserOnce g) p =
    SeqParser $ \a -> case g a of
        SeqParserVal b    -> ([b], p)
        SeqParserOnce' g' -> ([], SeqParserOnce g' `followedBy` p)