Remove most warnings and renudant line in AST.Parser

tools/lsp/squirrel/app/Main.hs

@@ -222,16 +222,16 @@ loadFromVFS funs uri = do
   (tree, _) <- runParserM . recognise =<< toParseTree (Text fin txt)
   return $ addLocalScopes tree
 
-loadByURI
-  :: J.Uri
-  -> IO (LIGO Info')
-loadByURI uri = do
-  case J.uriToFilePath uri of
-    Just fin -> do
-      (tree, _) <- runParserM . recognise =<< toParseTree (Path fin)
-      return $ addLocalScopes tree
-    Nothing -> do
-      error $ "uriToFilePath " ++ show uri ++ " has failed. We all are doomed."
+-- loadByURI
+--   :: J.Uri
+--   -> IO (LIGO Info')
+-- loadByURI uri = do
+--   case J.uriToFilePath uri of
+--     Just fin -> do
+--       (tree, _) <- runParserM . recognise =<< toParseTree (Path fin)
+--       return $ addLocalScopes tree
+--     Nothing -> do
+--       error $ "uriToFilePath " ++ show uri ++ " has failed. We all are doomed."
 
 collectErrors
   :: Core.LspFuncs ()

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

@@ -12,11 +12,11 @@ import Duplo.Pretty
 
 import AST.Types
 import AST.Scope
-import AST.Parser
+-- import AST.Parser
 import Range
 import Product
 
-import Debug.Trace
+-- import Debug.Trace
 
 
 complete
@@ -33,12 +33,12 @@ complete r tree = do
   let l = spineTo (leq r . getElem) tree
   word <- listToMaybe l
   let scope   = getElem (extract word)
-  let cat   = getElem (extract word)
+  let nameCat = getElem (extract word)
   return
     $ filter (isSubseqOf (ppToText word))
     $ nub
     $ map (ppToText . _sdName)
-    $ filter (fits cat . catFromType)
+    $ filter (fits nameCat . catFromType)
     $ scope
 
 isSubseqOf :: Text -> Text -> Bool

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

@@ -17,7 +17,7 @@ import AST.Scope
 import Product
 import Range
 
-import Debug.Trace
+-- import Debug.Trace
 
 type CanSearch xs =
   ( Contains [ScopedDecl] xs

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

@@ -6,12 +6,7 @@ module AST.Parser
   -- (example, contract, sample)
   where
 
-import Control.Arrow
-
 import Data.Maybe (isJust)
-import Data.Text (Text)
-import qualified Data.Text as Text
-import Data.Sum (Element)
 
 import AST.Types
 
@@ -19,13 +14,13 @@ import Duplo.Error
 import Duplo.Tree
 import Duplo.Pretty
 
-import Range
 import Product
 import Parser
 import ParseTree
 
-import Debug.Trace
+-- import Debug.Trace
 
+example :: FilePath
 -- example = "../../../src/test/contracts/arithmetic.ligo"
 -- example = "../../../src/test/contracts/address.ligo"
 -- example = "../../../src/test/contracts/annotation.ligo"
@@ -115,7 +110,6 @@ recognise = descent (\_ -> error . show . pp) $ map usingScope
         "map_patch"         -> MapPatch  <$> field  "container"  <*> fields "binding"
         "set_patch"         -> SetPatch  <$> field  "container"  <*> fields "key"
         "set_remove"        -> SetRemove <$> field  "key"        <*> field  "container"
-        "map_remove"        -> SetRemove <$> field  "key"        <*> field  "container"
         "update_record"     -> RecordUpd <$> field  "record"     <*> fields "assignment"
         _                   -> fallthrough
 
@@ -272,14 +266,14 @@ recognise = descent (\_ -> error . show . pp) $ map usingScope
 
     -- Err
   , Descent do
-      \(r :> _, ParseTree _ _ text) -> do
+      \(r :> _, ParseTree _ _ text') -> do
         withComments do
-          return (r :> N :> Nil, Err text)
+          return (r :> N :> Nil, Err text')
 
   , Descent do
       \case
-        (r :> _, ParseTree "ERROR" _ text) -> do
-          return ([] :> r :> Y :> Nil, Err text)
+        (r :> _, ParseTree "ERROR" _ text') -> do
+          return ([] :> r :> Y :> Nil, Err text')
 
         _ -> fallthrough
   ]

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

@@ -13,9 +13,8 @@ module AST.Scope
   -- )
   where
 
-import           Control.Arrow (first, second)
+import           Control.Arrow (second)
 import           Control.Monad.State
-import           Control.Monad.Identity
 import           Control.Monad.Catch
 import           Control.Monad.Catch.Pure
 
@@ -23,23 +22,20 @@ import qualified Data.List   as List
 import           Data.Map            (Map)
 import qualified Data.Map    as Map
 import           Data.Maybe          (listToMaybe)
-import           Data.Sum            (Element, Apply, Sum)
 import           Data.Text           (Text)
-import           Data.Either         (fromRight)
 
 import           Duplo.Lattice
 import           Duplo.Pretty
 import           Duplo.Tree
 import           Duplo.Error
 
-import           AST.Parser
+-- import           AST.Parser
 import           AST.Types
--- import           Comment
 import           Parser
 import           Product
 import           Range
 
-import           Debug.Trace
+-- import           Debug.Trace
 
 type CollectM = StateT (Product [FullEnv, [Range]]) Catch
 
@@ -141,6 +137,7 @@ unLetRec = descent leaveBe
     linearize :: Range -> LIGO (Product xs) -> [LIGO (Product xs)] -> LIGO (Product xs)
     linearize r b [x]      = make (modElem @Range (delta r) $ extract x, Let x b)
     linearize r b (x : xs) = make (modElem @Range (delta r) $ extract x, Let x (linearize r b xs))
+    linearize _ _ []       = error "empty Seq"
 
     delta (Range _ f _) (Range s _ t) = Range s f t
 

tools/lsp/squirrel/src/Parser.hs

@@ -4,7 +4,6 @@ module Parser where
 import Control.Arrow
 import Control.Monad.Catch
 import Control.Monad.RWS hiding (Product)
-import Control.Monad.Trans.Maybe
 
 import Data.String.Interpolate (i)
 import Data.Text (Text)
@@ -18,7 +17,7 @@ import ParseTree
 import Range
 import Product
 
-import Debug.Trace
+-- import Dsebug.Trace
 
 {-
   Comment grabber has 2 buffers: 1 and 2.
@@ -40,7 +39,7 @@ data Failure = Failure String
   deriving anyclass (Exception)
 
 instance Scoped (Product [Range, Text]) ParserM RawTree ParseTree where
-  before (r :> _ :> _) (ParseTree ty cs s) = do
+  before (r :> _ :> _) (ParseTree _ cs _) = do
     let (comms, rest) = allComments cs
     let (comms1, _)   = allComments $ reverse rest
     modify $ first  (++ comms)
@@ -50,12 +49,12 @@ instance Scoped (Product [Range, Text]) ParserM RawTree ParseTree where
     tell $ fmap (\t -> (r, Err t)) errs
 
   after _ _ = do
-    modify \(x, y) -> (y, [])
+    modify \(_, y) -> (y, [])
 
 grabComments :: ParserM [Text]
 grabComments = do
   ls <- gets fst
-  modify \(x, y) -> ([], y)
+  modify \(_, y) -> ([], y)
   return ls
 
 allComments :: [RawTree] -> ([Text], [RawTree])
@@ -73,9 +72,10 @@ allErrors = map getBody . filter isUnnamedError
   where
     isUnnamedError :: RawTree -> Bool
     isUnnamedError tree = case only tree of
-      (r :> "" :> _, ParseTree "ERROR" _ _) -> True
+      (_ :> "" :> _, ParseTree "ERROR" _ _) -> True
       _                                     -> False
 
+getBody :: RawTree -> Text
 getBody (gist -> f) = ptSource f
 
 field :: Text -> ParserM RawTree
@@ -90,7 +90,7 @@ fieldOpt name = ask >>= go
       | n == name = return (Just tree)
       | otherwise = go rest
 
-    go [] = return Nothing
+    go _ = return Nothing
 
 fields :: Text -> ParserM [RawTree]
 fields name = ask >>= go
@@ -98,7 +98,7 @@ fields name = ask >>= go
     go (tree@(extract -> _ :> n :> _) : rest) =
       (if n == name then ((tree :) <$>) else id)
         $ go rest
-    go [] = return []
+    go _ = return []
 
 data ShowRange
   = Y | N
@@ -122,11 +122,13 @@ instance
       = ascribeRange (getElem @Range xs) (getElem xs)
       . ascribeComms (getElem xs)
 
+ascribeComms :: [Text] -> Doc -> Doc
 ascribeComms comms
   | null comms = id
   | otherwise  = \d ->
       block $ map (pp . Text.init) comms ++ [d]
 
+ascribeRange :: Pretty p => p -> ShowRange -> Doc -> Doc
 ascribeRange r Y = (pp r $$)
 ascribeRange _ _ = id
 
@@ -142,8 +144,8 @@ boilerplate
   -> ParserM (Info, f RawTree)
 boilerplate f (r :> _, ParseTree ty cs _) = do
   withComments do
-    f <- local (const cs) $ f ty
-    return $ (r :> N :> Nil, f)
+    f' <- local (const cs) $ f ty
+    return $ (r :> N :> Nil, f')
 
 boilerplate'
   :: ((Text, Text) -> ParserM (f RawTree))
@@ -151,8 +153,8 @@ boilerplate'
   -> ParserM (Info, f RawTree)
 boilerplate' f (r :> _, ParseTree ty cs src) = do
   withComments do
-    f <- local (const cs) $ f (ty, src)
-    return $ (r :> N :> Nil, f)
+    f' <- local (const cs) $ f (ty, src)
+    return $ (r :> N :> Nil, f')
 
 fallthrough :: MonadThrow m => m a
 fallthrough = throwM HandlerFailed