1 files changed, 49 insertions, 0 deletions
diff --git a/src/System/IO/Terminal/Input/SeqParser.hs b/src/System/IO/Terminal/Input/SeqParser.hs
new file mode 100644
index 0000000..8dfdafc
--- /dev/null
+++ b/src/System/IO/Terminal/Input/SeqParser.hs
@@ -0,0 +1,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)