Improve documentation

tools/lsp/README.md

@@ -13,7 +13,7 @@ Grammars are in separate folders, in form of tree-sitter grammars.
 They are compiled via `tree-sitter generate` command in their respective folder.
 
 Then they are linked as `parser.c` file with GHC toolchain.
-Because GHC is unable to link from outside of project folder, the `parser.c` is
+Because GHCi REPL is unable to link from outside of project folder, the `parser.c` is
 symlinked into `vendor/` directory.
 
 Right now only one parser is linked there; the name of symlink should be changed

tools/lsp/squirrel/squirrel.cabal

@@ -4,7 +4,7 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: b811c8b08ccf5e457be7e405973ea06f046839b90e70ebd729a1df9bb668dc69
+-- hash: 0561ca5eedeec178effcd82246fe314b488637ceea34ea241eb4943714bdb7aa
 
 name:           squirrel
 version:        0.0.0
@@ -25,7 +25,6 @@ library
       Range
       Tree
       Union
-      Update
   other-modules:
       Paths_squirrel
   hs-source-dirs:

tools/lsp/squirrel/src/AST.hs

@@ -1,4 +1,7 @@
 
+{- | The "all things AST"-module.
+-}
+
 module AST (module M) where
 
 import AST.Types as M

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

@@ -1,20 +1,15 @@
 
-{-
+{- | Parser for a contract.
-  Parser for a contract. The `example` is exported to run on current debug target.
-
-  TODO: prune some "path" and alike stuff from grammar, refactor common things.
-
-  TODO: break <*>/do ladders onto separate named parsers.
 -}
 
-module AST.Parser (example, contract) where
+module AST.Parser ({-example,-} contract) where
 
 import Data.Text (Text)
 
 import AST.Types
 
 import Parser
-import Tree
+import Tree hiding (skip)
 import Union
 
 -- import Debug.Trace
@@ -30,6 +25,7 @@ ranged p = do
   a <- p
   return $ mk r a
 
+-- | The entrypoint.
 contract :: Parser (Pascal ASTInfo)
 contract =
   ranged do
@@ -844,6 +840,7 @@ typeTuple = do
   subtree "type_tuple" do
     many do inside "element" type_
 
+-- example :: Text
 -- example = "../../../src/test/contracts/application.ligo"
 -- example = "../../../src/test/contracts/address.ligo"
 -- example = "../../../src/test/contracts/amount.ligo"
@@ -861,8 +858,7 @@ typeTuple = do
 -- example = "../../../src/test/contracts/bytes_arithmetic.ligo"
 -- example = "../../../src/test/contracts/bytes_unpack.ligo"
 -- example = "../../../src/test/contracts/chain_id.ligo"
-example :: Text
+-- example = "../../../src/test/contracts/coase.ligo"
-example = "../../../src/test/contracts/coase.ligo"
 -- example = "../../../src/test/contracts/failwith.ligo"
 -- example = "../../../src/test/contracts/loop.ligo"
 -- example = "../../../src/test/contracts/application.ligo"

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

@@ -27,19 +27,25 @@ import Data.Text (Text)
 
 import Parser
 import Range
-import Update
 import AST.Types
 import Tree
 import HasComments
 import Pretty
 
+-- | Scope-holding monad.
 type ScopeM = State [Env]
 
+-- | Run the computation with scope starting from empty scope.
+evalScopeM :: ScopeM a -> a
+evalScopeM action = evalState action [Env []]
+
+-- | The environment.
 newtype Env = Env
   { _eDecls :: [ScopedDecl]
   }
   deriving newtype (Semigroup, Monoid)
 
+-- | The type/value declaration.
 data ScopedDecl = ScopedDecl
   { _sdName   :: (Pascal ())
   , _sdOrigin :: Range
@@ -47,14 +53,22 @@ data ScopedDecl = ScopedDecl
   , _sdType   :: Maybe (Either (Pascal ()) Kind)
   }
 
+-- | The kind.
 data Kind = Star
 
-enter, leave :: ScopeM ()
+-- | Make a new scope out of enclosing parent one.
+enter  :: ScopeM ()
+enter = modify \(a : b) -> a : a : b
+
+-- | Leave current scope, return to parent one.
+leave  :: ScopeM ()
+leave = modify tail
+
+-- | Add a declaration to the current scope.
 define :: ScopedDecl -> ScopeM ()
-enter    = modify \(a : b) -> a : a : b
-leave    = modify tail
 define d = modify \(Env a : b) -> Env (d : a) : b
 
+-- | Add a type declaration to the current scope.
 defType :: HasRange a => Pascal a -> Kind -> Pascal a -> ScopeM ()
 defType name kind body = do
   define $ ScopedDecl
@@ -63,6 +77,7 @@ defType name kind body = do
     (Just $ getRange $ infoOf body)
     (Just (Right kind))
 
+-- | Add a value declaration to the current scope.
 def
   :: HasRange a
   => Pascal a
@@ -316,9 +331,6 @@ data Scope = Scope { unScope :: Text }
 instance HasComments Scope where
   getComments = pure . ("(* " <>) . (<> " *)") . unScope
 
-evalScopeM :: ScopeM a -> a
-evalScopeM action = evalState action [Env []]
-
 _testUpdate :: Pascal ASTInfo -> ScopeM (Pascal Scope)
 _testUpdate = updateTree \_ -> do
   Env topmost <- gets head

tools/lsp/squirrel/src/Error.hs

@@ -1,4 +1,7 @@
 
+{- | Parsing errors and utilities.
+-}
+
 module Error
   ( Error(..)
   , HasErrors (..)

tools/lsp/squirrel/src/HasComments.hs

@@ -1,4 +1,7 @@
 
+{- | Comments and utilities.
+-}
+
 module HasComments
   ( HasComments(..)
   , c

tools/lsp/squirrel/src/Lattice.hs

@@ -1,4 +1,7 @@
 
+{- | The property the @Tree@ @info@ should abide.
+-}
+
 module Lattice
   ( Lattice(..)
   )

tools/lsp/squirrel/src/ParseTree.hs

@@ -57,7 +57,7 @@ data ParseTree = ParseTree
   }
   deriving (Show) via PP ParseTree
 
--- ^ The forest we work with.
+-- | The forest we work with.
 data ParseForest = Forest
   { pfID    :: Int                  -- ^ Unique number for comparison.
   , pfGrove :: [(Text, ParseTree)]  -- ^ Subtrees.

tools/lsp/squirrel/src/Parser.hs

@@ -63,11 +63,12 @@ module Parser
   , ASTInfo(..)
   ) where
 
-import Control.Lens hiding (inside)
 import Control.Monad.State
 import Control.Monad.Writer
 import Control.Monad.Except
+import Control.Monad.Identity
 
+import Data.Functor ((<&>))
 import Data.Foldable
 import Data.Text (Text, unpack)
 import qualified Data.Text as Text
@@ -204,17 +205,15 @@ field name parser = do
 
       return res
 
--- | Variuos error reports.
+fallback :: Stubbed a ASTInfo => Text -> Parser a
-fallback  :: Stubbed a ASTInfo => Text            -> Parser a
+fallback msg = pure . stub =<< makeError msg
--- fallback' :: Stubbed a ASTInfo => Text -> ASTInfo -> Parser a
+
-die       ::                      Text            -> Parser a
+-- | Produce "expected ${X}" error at this point.
-die'      ::                      Text -> ASTInfo -> Parser a
+die :: Text -> Parser a
--- complain  ::                      Text -> ASTInfo -> Parser ()
+die msg = throwError =<< makeError msg
-fallback  msg     = pure . stub =<< makeError  msg
+
--- fallback' msg rng = pure . stub =<< makeError' msg rng
+die' ::Text -> ASTInfo -> Parser a
-die       msg     = throwError  =<< makeError  msg
+die' msg rng = throwError =<< makeError' msg rng
-die'      msg rng = throwError  =<< makeError' msg rng
--- complain  msg rng = tell . pure =<< makeError' msg rng
 
 -- | When tree-sitter found something it was unable to process.
 unexpected :: ParseTree -> Error ASTInfo
@@ -398,7 +397,7 @@ inside sig parser = do
           subtree st do
             parser
 
--- Auto-accumulated information to be fed into AST being build.
+-- | Auto-accumulated information to be put into AST being build.
 data ASTInfo = ASTInfo
   { aiRange    :: Range
   , aiComments :: [Text]

tools/lsp/squirrel/src/Pretty.hs

@@ -1,4 +1,4 @@
-{-
+{- |
   Pretty printer, a small extension of GHC `pretty` package.
 -}
 

tools/lsp/squirrel/src/Range.hs

@@ -1,4 +1,7 @@
 
+{- | Continious location inside the source and utilities.
+-}
+
 module Range
   ( Range(..)
   , HasRange(..)

tools/lsp/squirrel/src/Tree.hs

@@ -10,11 +10,16 @@
 -}
 
 module Tree
-  ( Tree
+  ( -- * Tree type
+    Tree
   , spineTo
   , updateTree
   , mk
   , infoOf
+
+    -- * Callbacks on update
+  , UpdateOver (..)
+  , skip
   )
   where
 
@@ -23,7 +28,6 @@ import Data.Functor.Compose
 import Data.Foldable
 
 import Union
-import Update
 import Lattice
 import HasComments
 import Pretty
@@ -131,4 +135,24 @@ instance Foldable (Union fs) => HasErrors (Tree fs info) info where
   errors = go . unTree
     where
       go (Fix (Compose (Left err))) = pure err
-      go (Fix rest)                 = foldMap go rest
+      go (Fix rest)                 = foldMap go rest
+
+-- | Update callbacks for a @f a@ while working inside monad @m@.
+class Monad m => UpdateOver m f a where
+  before :: f a -> m ()
+  after  :: f a -> m ()
+
+  before _ = skip
+  after  _ = skip
+
+-- | Do nothing.
+skip :: Monad m => m ()
+skip = return ()
+
+instance Monad m => UpdateOver m (Union '[]) a where
+  before = error "Union.empty"
+  after  = error "Union.empty"
+
+instance (UpdateOver m f a, UpdateOver m (Union fs) a) => UpdateOver m (Union (f : fs)) a where
+  before = eliminate before before
+  after  = eliminate after  after

tools/lsp/squirrel/src/Union.hs

@@ -15,7 +15,6 @@ module Union
   )
   where
 
-import Update
 import Pretty
 
 -- | The "one of" datatype.
@@ -53,10 +52,13 @@ eliminate here there = \case
   Here  fx   -> here fx
   There rest -> there rest
 
--- | The `f` functior is in the `fs` list.
+-- | The @f@ functior is in the @fs@ list.
 class Member f fs where
-  inj  :: f x -> Union fs x          -- ^ embed @f@ into some `Union`
+  -- | Embed @f@ into some `Union`.
-  proj :: Union fs x -> Maybe (f x)  -- ^ check if a `Union` is actually @f@
+  inj  :: f x -> Union fs x
+
+  -- | Check if a `Union` is actually @f@.
+  proj :: Union fs x -> Maybe (f x)
 
 instance {-# OVERLAPS #-} Member f (f : fs) where
   inj  = Here
@@ -66,14 +68,6 @@ instance Member f fs => Member f (g : fs) where
   inj  = There . inj
   proj = eliminate (const Nothing) proj
 
-instance Monad m => UpdateOver m (Union '[]) a where
-  before = error "Union.empty"
-  after  = error "Union.empty"
-
-instance (UpdateOver m f a, UpdateOver m (Union fs) a) => UpdateOver m (Union (f : fs)) a where
-  before = eliminate before before
-  after  = eliminate after  after
-
 instance Pretty1 (Union '[]) where
   pp1 = error "Union.empty"
 

tools/lsp/squirrel/src/Update.hs

@@ -1,24 +0,0 @@
-
-{- | Utils for updating the @Tree@ type.
--}
-
-module Update
-  ( -- * Interfaces
-    UpdateOver(..)
-
-    -- * Default implementation
-  , skip
-  )
-  where
-
--- | Update callbacks for a @f a@ while working inside monad @m@.
-class Monad m => UpdateOver m f a where
-  before :: f a -> m ()
-  after  :: f a -> m ()
-
-  before _ = skip
-  after  _ = skip
-
--- | Do nothing.
-skip :: Monad m => m ()
-skip = return ()