From aff1c6b4c698682a883c3b76816f9a030670861e Mon Sep 17 00:00:00 2001
From: crumbtoo <crumb@disroot.org>
Date: Thu, 11 Jan 2024 11:49:46 -0700
Subject: [PATCH] decent starting point

---
 .ghci         |  2 ++
 src/Rlp/Lex.x | 58 +++++++++++++++++++++++++++++++++++++++++----------
 2 files changed, 49 insertions(+), 11 deletions(-)
 create mode 100644 .ghci

diff --git a/.ghci b/.ghci
new file mode 100644
index 0000000..83c65a0
--- /dev/null
+++ b/.ghci
@@ -0,0 +1,2 @@
+:set -XOverloadedStrings
+
diff --git a/src/Rlp/Lex.x b/src/Rlp/Lex.x
index 893a487..34dd85f 100644
--- a/src/Rlp/Lex.x
+++ b/src/Rlp/Lex.x
@@ -9,6 +9,7 @@ module Rlp.Lex
     , lexer
     )
     where
+import Control.Monad
 import Data.Functor.Identity
 import Core.Syntax              (Name)
 import Data.Text                (Text)
@@ -18,17 +19,32 @@ import Lens.Micro
 
 %wrapper "monad-strict-text"
 
+$whitechar = [ \t\n\r\f\v]
+
 rlp :-
+    
+    -- skip whitespace
+    $white+             ;
+    -- TODO: don't treat operators like (-->) as comments
+    "--".*              ;
+    ";"                 { constToken TokenSemicolon }
+    "{"                 { constToken TokenLBrace }
+    "}"                 { constToken TokenRBrace }
+
 <0>
 {
     "a" { const $ const $ pure $ Located (AlexPn 0 0 0) (TokenVarName "a") }
-    "" { undefined }
 }
 
 {
 
-alexEOF :: Alex a
-alexEOF = undefined
+constToken :: RlpToken -> AlexAction (Located RlpToken)
+constToken t inp _ = pure $ Located (inp ^. _1) t
+
+alexEOF :: Alex (Located RlpToken)
+alexEOF = do
+    inp <- alexGetInput
+    pure (Located (inp ^. _1) TokenEOF)
 
 data RlpToken = TokenEquals
               | TokenLitInt Int
@@ -38,27 +54,47 @@ data RlpToken = TokenEquals
               | TokenConSym Name
               | TokenData
               | TokenPipe
+              -- syntax control
+              | TokenSemicolon
+              | TokenLBrace
+              | TokenRBrace
               | TokenEOF
               deriving (Show)
 
-newtype P a = P { runP :: Text -> Either String a }
+newtype P a = P { runP :: PState -> Text -> Either String a }
     deriving (Functor)
 
-instance Applicative P where
-    pure = P . const . Right
+data PState = PState
+    { psLayoutStack     :: [Layout]
+    }
 
-    liftA2 f p q = P $ \s -> undefined
+data Layout = ExplicitLayout
+            | ImplicitLayout Int
+            deriving (Show)
+
+instance Applicative P where
+    pure = P . const . const . Right
+
+    liftA2 = liftM2
 
 instance Monad P where
-    m >>= k = P $ \s -> case runP m s of
-        Right a -> runP (k a) s
+    m >>= k = P $ \st s -> case runP m st s of
+        Right a -> runP (k a) st s
         Left e -> Left e
 
 data Located a = Located AlexPosn a
     deriving (Show)
 
 lexer :: (Located RlpToken -> P a) -> P a
-lexer f = P $ \s -> case runAlex s ((,) <$> alexMonadScan <*> alexGetInput) of
-    Right (a,s') -> runP (f a) (s' ^. _4)
+lexer f = P $ \st s -> case m s of
+        Right (a,s') -> runP (f a) st (s' ^. _4)
+        Left  e      -> error (show e)
+    where
+        m s = runAlex s ((,) <$> alexMonadScan <*> alexGetInput)
+
+lexStream :: P [RlpToken]
+lexStream = lexer go where
+    go (Located _ TokenEOF) = pure [TokenEOF]
+    go (Located _ t)        = (t:) <$> lexStream
 
 }