Remove debug print, document Parser.hs

tools/lsp/squirrel/src/AST/Parser.hs

@@ -48,7 +48,6 @@ typedecl = do
 vardecl :: Parser (Binding ASTInfo)
 vardecl = do
   subtree "var_decl" do
-    dump
     ctor Var
       <*> inside "name"  name
       <*> inside "type"  type_
@@ -179,7 +178,6 @@ lambda_expr = do
 
 seq_expr = do
   subtree "block" do
-    dump
     ctor Seq <*> do
       many "statement" do
         inside "statement" do
@@ -229,7 +227,6 @@ skip = do
 case_action :: Parser (Expr ASTInfo)
 case_action = do
   subtree "case_instr" do
-    dump
     ctor Case
       <*> inside "subject" expr
       <*> many "case" do

tools/lsp/squirrel/src/ParseTree.hs

@@ -39,24 +39,22 @@ foreign import ccall unsafe tree_sitter_PascaLigo :: Ptr Language
 getNodeTypesPath :: IO FilePath
 getNodeTypesPath = getDataFileName "../pascaligo/src/node-types.json"
 
+-- | The tree tree-sitter produces.
 data ParseTree = ParseTree
-  { ptID       :: Int
+  { ptID       :: Int          -- ^ Unique number, for fast comparison.
-  , ptName     :: Text.Text
+  , ptName     :: Text.Text    -- ^ Name of the node.
-  , ptRange    :: Range
+  , ptRange    :: Range        -- ^ Range of the node.
-  , ptChildren :: ParseForest
+  , ptChildren :: ParseForest  -- ^ Subtrees.
   }
+  deriving (Show) via PP ParseTree
 
+-- ^ The forest we work with.
 data ParseForest = Forest
-  { pfID    :: Int
+  { pfID    :: Int                       -- ^ Unique number for comparison.
-  , pfGrove :: [(Text.Text, ParseTree)]
+  , pfGrove :: [(Text.Text, ParseTree)]  -- ^ Subtrees.
-  , pfRange :: Range
+  , pfRange :: Range                     -- ^ Full range of the forest.
   }
-
+  deriving (Show) via PP ParseForest
-instance Show ParseTree where
-  show = show . pp
-
-instance Show ParseForest where
-  show = show . pp
 
 instance Pretty ParseTree where
   pp (ParseTree _ n r forest) =
@@ -75,6 +73,7 @@ instance Pretty ParseForest where
         then nest 2 $ pp tree
         else hang (text (Text.unpack field) <> ": ") 2 (pp tree)
 
+-- | Feed file contents into PascaLIGO grammar recogniser.
 toParseTree :: FilePath -> IO ParseForest
 toParseTree fin = do
   parser <- ts_parser_new

tools/lsp/squirrel/src/Parser.hs

@@ -21,24 +21,26 @@ import Pretty
 
 import Debug.Trace
 
+-- | Parse error.
 data Error
   = Expected
-    { eMsg   :: Text
+    { eMsg   :: Text   -- ^ Description of what was expected.
-    , eWhole :: Text
+    , eWhole :: Text   -- ^ Offending text.
-    , eRange :: Range
+    , eRange :: Range  -- ^ Location of the error.
     }
-  deriving stock (Show)
+  deriving (Show) via PP Error
 
 instance Pretty Error where
   pp (Expected msg found r) = "░" <> pp msg <> pp r <> "▒" <> pp found <> "▓"
 
+-- | Parser of tree-sitter-made tree.
 newtype Parser a = Parser
   { unParser
-      :: WriterT [Error]
+      :: WriterT [Error]      -- Early I though to report errors that way. Obs.
-      (  ReaderT ParserEnv
+      (  ReaderT ParserEnv    -- Range/Something.
-      (  StateT  ParseForest
+      (  StateT  ParseForest  -- Current forest to recognise.
-      (  ExceptT Error
+      (  ExceptT Error        -- Backtracking. Change `Error` to `()`?
-      (  IO ))))
+      (  IO ))))              -- I forgot why. `#include`? Debug via `print`?
          a
   }
   deriving newtype
@@ -52,11 +54,13 @@ newtype Parser a = Parser
     , MonadIO
     )
 
+-- | Generate error originating at current location.
 makeError :: Text -> Parser Error
 makeError msg = do
   rng <- getRange
   makeError' msg rng
 
+-- | Generate error originating at given location.
 makeError' :: Text -> Range -> Parser Error
 makeError' msg rng = do
   rng <- getRange
@@ -67,6 +71,7 @@ makeError' msg rng = do
     , eRange = rng
     }
 
+-- | Pick next tree in a forest or die with msg.
 takeNext :: Text -> Parser ParseTree
 takeNext msg = do
   st@Forest {pfGrove, pfRange} <- get
@@ -79,6 +84,10 @@ takeNext msg = do
         }
       return t
 
+-- | Pick a tree with that /field name/ or die with name as msg.
+--
+--   Will erase all subtrees with different names on the path!
+--
 field :: Text -> Parser a -> Parser a
 field name parser = do
   grove <- gets pfGrove
@@ -107,6 +116,7 @@ field name parser = do
         , pfRange = if firstOne then diffRange rng ptRange else rng
         }
 
+-- | Variuos error reports.
 fallback  :: Stubbed a => Text          -> Parser a
 fallback' :: Stubbed a => Text -> Range -> Parser a
 die       ::              Text          -> Parser a
@@ -118,10 +128,13 @@ die       msg     = throwError  =<< makeError  msg
 die'      msg rng = throwError  =<< makeError' msg rng
 complain  msg rng = tell . pure =<< makeError' msg rng
 
+-- | If a parser fails, return stub with error originating here.
 stubbed :: Stubbed a => Text -> Parser a -> Parser a
 stubbed msg parser = do
   parser <|> fallback msg
 
+-- | The forest must start with tree of that name. Its subtrees become new
+--   forest. Otherwise, it dies with name as msg.
 subtree :: Text -> Parser a -> Parser a
 subtree msg parser = do
   ParseTree {ptChildren, ptName} <- takeNext msg
@@ -133,6 +146,7 @@ subtree msg parser = do
   else do
     die msg
 
+-- | Because `ExceptT` requires error to be `Monoid` for `Alternative`.
 (<|>) :: Parser a -> Parser a -> Parser a
 Parser l <|> Parser r = Parser (l `catchError` const r)
 
@@ -142,6 +156,10 @@ select = foldl1 (<|>)
 optional :: Parser a -> Parser (Maybe a)
 optional p = fmap Just p <|> return Nothing
 
+-- | Custom `Alternative.many`.
+--
+--   TODO: remove msg.
+--
 many :: Text -> Parser a -> Parser [a]
 many msg p = many'
   where
@@ -155,6 +173,10 @@ many msg p = many'
       else do
         return [x]
 
+-- | Custom `Alternative.some`.
+--
+--   TODO: remove msg.
+--
 some :: Text -> Parser a -> Parser [a]
 some msg p = some'
   where
@@ -168,12 +190,20 @@ some msg p = some'
       else do
         return [x]
 
+-- | Get UID of current tree. Obsolete.
+--
+--   TODO: remove.
+--
 getTreeID :: Parser (Maybe Int)
 getTreeID = Parser do
   pfGrove <$> get >>= return . \case
     [] -> Nothing
     (_, tree) : _ -> Just (ptID tree)
 
+-- | Assert the parser consumes input. Obsolete.
+--
+--   TODO: remove.
+--
 productive :: Parser a -> Parser (a, Bool)
 productive p = do
   was <- getTreeID
@@ -181,19 +211,33 @@ productive p = do
   now <- getTreeID
   return (res, was /= now)
 
+-- | The `not <$> eos`. Obsolete.
+--
+--   TODO: remove.
+--
 hasPossibleInput :: Parser ()
 hasPossibleInput = do
   yes <- gets (not . null . pfGrove)
   unless yes do
     die "something"
 
+-- | The source of file being parsed. BS, because tree-sitter has offsets
+--   in /bytes/.
 data ParserEnv = ParserEnv
   { peSource :: ByteString
   }
 
+-- | Debug print via IO. Obsolete.
+--
+--   TODO: remove. Also, remove IO from Parser tf stack.
+--
 puts :: MonadIO m => Show a => a -> m ()
 puts = liftIO . print
 
+-- | Run parser on given file.
+--
+--   TODO: invent /proper/ 'ERROR'-node collector.
+--
 runParser :: Parser a -> FilePath -> IO (a, [Error])
 runParser (Parser parser) fin = do
   pforest <- toParseTree fin
@@ -207,6 +251,7 @@ runParser (Parser parser) fin = do
 
   either (error . show) (return . fst) res
 
+-- | Run parser on given file and pretty-print stuff.
 debugParser :: Parser a -> FilePath -> IO a
 debugParser parser fin = do
   (res, errs) <- runParser parser fin
@@ -216,6 +261,7 @@ debugParser parser fin = do
   putStrLn "Result:"
   return res
 
+-- | Consume next tree if it has give name. Or die.
 token :: Text -> Parser Text
 token node = do
   tree@ParseTree {ptName, ptRange} <- takeNext node
@@ -226,28 +272,33 @@ token node = do
   else do
     die' node ptRange
 
+-- | Consume next tree, return its textual representation.
 anything :: Parser Text
 anything = do
   tree <- takeNext "anything"
   cutOut $ ptRange tree
 
+-- | TODO: remove, b/c obsolete.
 consume :: Text -> Parser ()
 consume node = do
   ParseTree {ptName, ptRange} <- takeNext node
   when (ptName /= node) do
     complain node ptRange
 
+-- | TODO: remove, its literally is `void . token`.
 consumeOrDie :: Text -> Parser ()
 consumeOrDie node = do
   ParseTree {ptName, ptRange} <- takeNext node
   when (ptName /= node) do
     die' node ptRange
 
+-- | Extract textual representation of given range.
 cutOut :: Range -> Parser Text
 cutOut (Range (_, _, s) (_, _, f)) = do
   bs <- asks peSource
   return $ decodeUtf8 $ ByteString.take (f - s) (ByteString.drop s bs)
 
+-- | Get range of current tree or forest before the parser was run.
 range :: Parser a -> Parser (a, Range)
 range parser =
   get >>= \case
@@ -259,9 +310,14 @@ range parser =
       a <- parser
       return (a, pfRange)
 
+-- | Get current range.
 getRange :: Parser Range
 getRange = snd <$> range (return ())
 
+-- | Remove all keys until given key is found; remove the latter as well.
+--
+--   Notice: this works differently from `Prelude.remove`!
+--
 delete :: Eq k => k -> [(k, v)] -> [(k, v)]
 delete _ [] = []
 delete k ((k', v) : rest) =
@@ -269,6 +325,7 @@ delete k ((k', v) : rest) =
   then rest
   else delete k rest
 
+-- | Parser negation.
 notFollowedBy :: Parser a -> Parser ()
 notFollowedBy parser = do
   good <- do
@@ -280,24 +337,39 @@ notFollowedBy parser = do
   unless good do
     die "notFollowedBy"
 
+-- | For types that have a default replacer with an `Error`.
 class Stubbed a where
   stub :: Error -> a
 
 instance Stubbed Text where
   stub = pack . show
 
+-- | This is bad, but I had to.
+--
+--   TODO: find a way to remove this instance.
+--
 instance Stubbed [a] where
   stub _ = []
 
+-- | `Nothing` would be bad default replacer.
 instance Stubbed a => Stubbed (Maybe a) where
   stub = Just . stub
 
+-- | Universal accessor.
+--
+--   Usage:
+--
+--   > inside "$field:$treename"
+--   > inside "$field"
+--   > inside ":$treename" -- don't, use "subtree"
+--
 inside :: Stubbed a => Text -> Parser a -> Parser a
 inside sig parser = do
   let (f, st') = Text.breakOn ":" sig
   let st       = Text.drop 1 st'
   if Text.null f
   then do
+    -- The order is important.
     subtree st do
       stubbed f do
         parser
@@ -311,13 +383,16 @@ inside sig parser = do
           subtree st do
             parser
 
+-- Auto-accumulated information to be fed into AST being build.
 data ASTInfo = ASTInfo
   { aiRange    :: Range
   , aiComments :: [Text]
   }
 
+-- | Equip given constructor with info.
 ctor :: (ASTInfo -> a) -> Parser a
 ctor = (<$> (ASTInfo <$> getRange <*> pure []))
 
+-- | /Actual/ debug pring.
 dump :: Parser ()
 dump = gets pfGrove >>= traceShowM