From 8d431c958120118e50b4e3142fe3cc262cd6eeff Mon Sep 17 00:00:00 2001
From: crumbtoo <crumb@disroot.org>
Date: Tue, 14 Nov 2023 11:07:13 -0700
Subject: [PATCH] Control.Parser

---
 src/Control/Parser.hs | 50 +++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 50 insertions(+)
 create mode 100644 src/Control/Parser.hs

diff --git a/src/Control/Parser.hs b/src/Control/Parser.hs
new file mode 100644
index 0000000..74d78de
--- /dev/null
+++ b/src/Control/Parser.hs
@@ -0,0 +1,50 @@
+{-|
+Module      : Control.Parser
+Description : The parser *object*
+
+This module implements an interface for parser *types*, used in lexical analysis
+and parsing. For the implementation of the rlp language's parser, see 'Parse'.
+-}
+{-# LANGUAGE GeneralisedNewtypeDeriving #-}
+{-# LANGUAGE BlockArguments, LambdaCase #-}
+module Control.Parser
+    (
+    )
+    where
+----------------------------------------------------------------------------------
+import Control.Applicative
+import Control.Arrow                ((***))
+import Control.Monad
+----------------------------------------------------------------------------------
+
+newtype ParserT i m o = ParserT { runParserT :: i -> m (i, o) }
+    deriving (Functor)
+
+instance (Monad m) => Applicative (ParserT i m) where
+    pure a = ParserT \i -> pure (i, a)
+
+    m <*> k = ParserT \i -> do
+        (i',f) <- runParserT m i
+        fmap (id *** f) $ runParserT k i'
+
+instance (MonadPlus m) => Alternative (ParserT i m) where
+    empty = ParserT $ const empty
+
+    ParserT m <|> ParserT k = ParserT $ \i ->
+        m i <|> k i
+
+instance (MonadPlus m) => MonadPlus (ParserT i m)
+
+instance (Monad m) => Monad (ParserT i m) where
+    m >>= k = ParserT $ \i -> do
+        (i',a) <- runParserT m i
+        runParserT (k a) i'
+
+----------------------------------------------------------------------------------
+
+-- TODO: generalise to non-lists
+satisfy :: (MonadPlus m, Eq a) => a -> ParserT [a] m a
+satisfy c = ParserT $ \case
+    (x:xs) | x == c -> pure (xs,x)
+    _               -> empty
+