From e701e196fef913925fb0cce00ef092d80271549a Mon Sep 17 00:00:00 2001 From: Kirill Andreev Date: Thu, 4 Jun 2020 17:40:38 +0400 Subject: [PATCH] Improve documentation --- tools/lsp/README.md | 2 +- tools/lsp/squirrel/squirrel.cabal | 3 +-- tools/lsp/squirrel/src/AST.hs | 3 +++ tools/lsp/squirrel/src/AST/Parser.hs | 16 ++++++-------- tools/lsp/squirrel/src/AST/Scope.hs | 26 ++++++++++++++++------- tools/lsp/squirrel/src/Error.hs | 3 +++ tools/lsp/squirrel/src/HasComments.hs | 3 +++ tools/lsp/squirrel/src/Lattice.hs | 3 +++ tools/lsp/squirrel/src/ParseTree.hs | 2 +- tools/lsp/squirrel/src/Parser.hs | 25 +++++++++++----------- tools/lsp/squirrel/src/Pretty.hs | 2 +- tools/lsp/squirrel/src/Range.hs | 3 +++ tools/lsp/squirrel/src/Tree.hs | 30 ++++++++++++++++++++++++--- tools/lsp/squirrel/src/Union.hs | 18 ++++++---------- tools/lsp/squirrel/src/Update.hs | 24 --------------------- 15 files changed, 89 insertions(+), 74 deletions(-) delete mode 100644 tools/lsp/squirrel/src/Update.hs diff --git a/tools/lsp/README.md b/tools/lsp/README.md index 40b50c04e..add4e53d3 100644 --- a/tools/lsp/README.md +++ b/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 diff --git a/tools/lsp/squirrel/squirrel.cabal b/tools/lsp/squirrel/squirrel.cabal index abf9bc6f7..516cb704a 100644 --- a/tools/lsp/squirrel/squirrel.cabal +++ b/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: diff --git a/tools/lsp/squirrel/src/AST.hs b/tools/lsp/squirrel/src/AST.hs index be1fd9fbb..887d1f369 100644 --- a/tools/lsp/squirrel/src/AST.hs +++ b/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 diff --git a/tools/lsp/squirrel/src/AST/Parser.hs b/tools/lsp/squirrel/src/AST/Parser.hs index cd8e78a45..b193e52b7 100644 --- a/tools/lsp/squirrel/src/AST/Parser.hs +++ b/tools/lsp/squirrel/src/AST/Parser.hs @@ -1,20 +1,15 @@ -{- - 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. +{- | Parser for a contract. -} -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" diff --git a/tools/lsp/squirrel/src/AST/Scope.hs b/tools/lsp/squirrel/src/AST/Scope.hs index 2895f13c8..f2baf9a3e 100644 --- a/tools/lsp/squirrel/src/AST/Scope.hs +++ b/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 diff --git a/tools/lsp/squirrel/src/Error.hs b/tools/lsp/squirrel/src/Error.hs index a62c90ac9..72a32c84b 100644 --- a/tools/lsp/squirrel/src/Error.hs +++ b/tools/lsp/squirrel/src/Error.hs @@ -1,4 +1,7 @@ +{- | Parsing errors and utilities. +-} + module Error ( Error(..) , HasErrors (..) diff --git a/tools/lsp/squirrel/src/HasComments.hs b/tools/lsp/squirrel/src/HasComments.hs index 8218c4ba2..25dfa82a3 100644 --- a/tools/lsp/squirrel/src/HasComments.hs +++ b/tools/lsp/squirrel/src/HasComments.hs @@ -1,4 +1,7 @@ +{- | Comments and utilities. +-} + module HasComments ( HasComments(..) , c diff --git a/tools/lsp/squirrel/src/Lattice.hs b/tools/lsp/squirrel/src/Lattice.hs index 7bbbc0b69..ec70745a7 100644 --- a/tools/lsp/squirrel/src/Lattice.hs +++ b/tools/lsp/squirrel/src/Lattice.hs @@ -1,4 +1,7 @@ +{- | The property the @Tree@ @info@ should abide. +-} + module Lattice ( Lattice(..) ) diff --git a/tools/lsp/squirrel/src/ParseTree.hs b/tools/lsp/squirrel/src/ParseTree.hs index 38917d098..5576a2987 100644 --- a/tools/lsp/squirrel/src/ParseTree.hs +++ b/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. diff --git a/tools/lsp/squirrel/src/Parser.hs b/tools/lsp/squirrel/src/Parser.hs index b40200b33..ec578d870 100644 --- a/tools/lsp/squirrel/src/Parser.hs +++ b/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 -> ASTInfo -> Parser a -die :: Text -> Parser a -die' :: Text -> ASTInfo -> Parser a --- complain :: Text -> ASTInfo -> Parser () -fallback msg = pure . stub =<< makeError msg --- fallback' msg rng = pure . stub =<< makeError' msg rng -die msg = throwError =<< makeError msg -die' msg rng = throwError =<< makeError' msg rng --- complain msg rng = tell . pure =<< makeError' msg rng +fallback :: Stubbed a ASTInfo => Text -> Parser a +fallback msg = pure . stub =<< makeError msg + +-- | Produce "expected ${X}" error at this point. +die :: Text -> Parser a +die msg = throwError =<< makeError msg + +die' ::Text -> ASTInfo -> Parser a +die' msg rng = throwError =<< 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] diff --git a/tools/lsp/squirrel/src/Pretty.hs b/tools/lsp/squirrel/src/Pretty.hs index 86e80954c..ce787c28e 100644 --- a/tools/lsp/squirrel/src/Pretty.hs +++ b/tools/lsp/squirrel/src/Pretty.hs @@ -1,4 +1,4 @@ -{- +{- | Pretty printer, a small extension of GHC `pretty` package. -} diff --git a/tools/lsp/squirrel/src/Range.hs b/tools/lsp/squirrel/src/Range.hs index ed5f074f0..28017485b 100644 --- a/tools/lsp/squirrel/src/Range.hs +++ b/tools/lsp/squirrel/src/Range.hs @@ -1,4 +1,7 @@ +{- | Continious location inside the source and utilities. +-} + module Range ( Range(..) , HasRange(..) diff --git a/tools/lsp/squirrel/src/Tree.hs b/tools/lsp/squirrel/src/Tree.hs index 96bdb1f3d..362f0a414 100644 --- a/tools/lsp/squirrel/src/Tree.hs +++ b/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 \ No newline at end of file + 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 diff --git a/tools/lsp/squirrel/src/Union.hs b/tools/lsp/squirrel/src/Union.hs index 04aa35d10..f50379a29 100644 --- a/tools/lsp/squirrel/src/Union.hs +++ b/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` - proj :: Union fs x -> Maybe (f x) -- ^ check if a `Union` is actually @f@ + -- | Embed @f@ into some `Union`. + 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" diff --git a/tools/lsp/squirrel/src/Update.hs b/tools/lsp/squirrel/src/Update.hs deleted file mode 100644 index f133e5716..000000000 --- a/tools/lsp/squirrel/src/Update.hs +++ /dev/null @@ -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 () \ No newline at end of file