From ea2fb4dcaa30067c8cb235d7b514986f5257df1b Mon Sep 17 00:00:00 2001
From: crumbtoo <crumb@disroot.org>
Date: Wed, 10 Jan 2024 15:11:26 -0700
Subject: [PATCH] tysigs

---
 src/Rlp/Parse/Decls.hs | 43 +++++++++++++++++++++---------------------
 src/Rlp/Parse/Types.hs |  3 +++
 2 files changed, 25 insertions(+), 21 deletions(-)

diff --git a/src/Rlp/Parse/Decls.hs b/src/Rlp/Parse/Decls.hs
index d8af6ca..d61c0d4 100644
--- a/src/Rlp/Parse/Decls.hs
+++ b/src/Rlp/Parse/Decls.hs
@@ -83,7 +83,7 @@ layout item = scn *> (explicit <|> implicit) where
         let indentGuard = L.indentGuard scn EQ i
         -- override foldGuard in order with new indentation
         let ?foldGuard = void $ L.indentGuard scn GT i
-        fix \ds -> (:) <$> (indentGuard *> item)
+        fix \ds -> (:) <$> (indentGuard *> item <* scn)
                        <*> (ds <|> pure [])
 
 t :: (?foldGuard :: Parser ()) => Parser [Text]
@@ -95,7 +95,7 @@ decl = choice
     -- arbitrary name
     [ infixD
     , dataD
-    , funD
+    , try funD
     , tySigD
     ]
 
@@ -182,17 +182,11 @@ varid = NameVar <$> try (lexeme namevar)
     <|> SymVar <$> lexeme (char '(' *> symvar <* char ')')
     <?> "variable identifier"
 
-decls :: Parser [PartialDecl']
-decls = layout decl <* eof
-
--- decls :: Parser [PartialDecl']
--- decls = do
---     space
---     i <- L.indentLevel
---     let indentGuard = L.indentGuard scn EQ i
---     let ?foldGuard = void $ L.indentGuard scn GT i
---     fix \ds -> (:) <$> (indentGuard *> decl)
---                    <*> (try ds <|> eof *> pure [])
+program :: Parser [Decl' RlpExpr]
+program = do
+    ds <- layout decl <* eof
+    pt <- use psOpTable
+    pure $ complete pt <$> ds
 
 namevar :: Parser Name
 namevar = word
@@ -255,10 +249,10 @@ infixD = do
                 f (Just x) = registerCustomFailure RlpParErrDuplicateInfixD
                            $> Just x
 
-tySigD :: Parser (Decl' e)
-tySigD = undefined -- TySigD <$> (flexeme)
+tySigD :: (OnFold) => Parser (Decl' e)
+tySigD = TySigD <$> (pure <$> varid) <*> (flexeme "::" *> flexeme type_)
 
-dataD :: Parser (Decl' e)
+dataD :: (OnFold) => Parser (Decl' e)
 dataD = DataD <$> (lexeme "data" *> conid) <*> many typaram
       <*> optionalList (symbol "=" *> conalts)
     where
@@ -271,16 +265,16 @@ dataD = DataD <$> (lexeme "data" *> conid) <*> many typaram
         conalt :: Parser ConAlt
         conalt = ConAlt <$> conid <*> many type1
 
-type1 :: Parser Type
+type1 :: (OnFold) => Parser Type
 type1 = choice
     [ lexeme "(" *> type_ <* lexeme ")"
     , TyVar <$> namevar
     , TyCon <$> namecon
     ]
 
-type_ :: Parser Type
+type_ :: (OnFold) => Parser Type
 type_ = choice
-    [ try $ (:->) <$> type1 <*> (lexeme "->" *> type_)
+    [ try $ (:->) <$> type1 <*> (flexeme "->" *> type_)
     , type1
     ]
 
@@ -293,8 +287,15 @@ lit = int
 --------------------------------------------------------------------------------
 -- completing partial expressions
 
-complete :: (?pt :: OpTable) => PartialExpr' -> RlpExpr'
-complete = cata completePartial
+complete :: OpTable -> PartialDecl' -> Decl' RlpExpr
+complete pt (FunD n as b w)    = FunD n as b' w
+    where b' = let ?pt = pt in completeExpr (getConst b)
+complete pt (TySigD ns t)      = TySigD ns t
+complete pt (DataD n as cs)    = DataD n as cs
+complete pt (InfixD a p n)     = InfixD a p n
+
+completeExpr :: (?pt :: OpTable) => PartialExpr' -> RlpExpr'
+completeExpr = cata completePartial
 
 completePartial :: (?pt :: OpTable) => PartialE -> RlpExpr'
 completePartial (E e)        = completeRlpExpr e
diff --git a/src/Rlp/Parse/Types.hs b/src/Rlp/Parse/Types.hs
index e961d2d..41e67f8 100644
--- a/src/Rlp/Parse/Types.hs
+++ b/src/Rlp/Parse/Types.hs
@@ -42,6 +42,9 @@ import Rlp.Syntax
 
 -- parser types
 
+-- TODO: the State is only used for building an operator table from infix[lr]
+-- declarations. we should switch to a normal Parsec monad in the future
+
 type Parser = ParsecT RlpParseError Text (State ParserState)
 
 data ParserState = ParserState