Lint: Don't remove asserts wrapped in lambdas or other expressions (#1269)
Also reuse the core linting logic in dhall-lsp-server
This commit is contained in:
parent
287752563f
commit
350b54c43e
|
@ -6,8 +6,8 @@ module Dhall.LSP.Backend.Linting
|
||||||
where
|
where
|
||||||
|
|
||||||
import Dhall.Parser (Src)
|
import Dhall.Parser (Src)
|
||||||
import Dhall.Core ( Expr(..), Binding(..), MultiLet(..), Var(..), Import
|
import Dhall.Core ( Expr(..), Binding(..), MultiLet(..), Import
|
||||||
, subExpressions, freeIn, multiLet, wrapInLets)
|
, subExpressions, multiLet, wrapInLets)
|
||||||
import qualified Dhall.Lint as Dhall
|
import qualified Dhall.Lint as Dhall
|
||||||
|
|
||||||
import Dhall.LSP.Backend.Diagnostics
|
import Dhall.LSP.Backend.Diagnostics
|
||||||
|
@ -38,7 +38,7 @@ diagLetInLet _ = Nothing
|
||||||
-- Given a let-block compute all unused variables in the block.
|
-- Given a let-block compute all unused variables in the block.
|
||||||
unusedBindings :: Eq a => MultiLet s a -> [Text]
|
unusedBindings :: Eq a => MultiLet s a -> [Text]
|
||||||
unusedBindings (MultiLet bindings d) =
|
unusedBindings (MultiLet bindings d) =
|
||||||
let go (Binding var _ _ : bs) | not (V var 0 `freeIn` wrapInLets bs d) = [var]
|
let go bs@(Binding var _ _ : _) | Just _ <- Dhall.removeUnusedBindings (wrapInLets bs d) = [var]
|
||||||
go _ = []
|
go _ = []
|
||||||
in foldMap go (NonEmpty.tails bindings)
|
in foldMap go (NonEmpty.tails bindings)
|
||||||
|
|
||||||
|
|
|
@ -3,12 +3,14 @@
|
||||||
module Dhall.Lint
|
module Dhall.Lint
|
||||||
( -- * Lint
|
( -- * Lint
|
||||||
lint
|
lint
|
||||||
|
, removeUnusedBindings
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Dhall.Core (Expr(..), Import, Var(..), subExpressions)
|
import Dhall.Core (Expr(..), Import, Var(..), subExpressions)
|
||||||
|
|
||||||
import qualified Dhall.Core
|
import qualified Dhall.Core
|
||||||
import qualified Dhall.Optics
|
import qualified Dhall.Optics
|
||||||
|
import qualified Lens.Family
|
||||||
|
|
||||||
{-| Automatically improve a Dhall expression
|
{-| Automatically improve a Dhall expression
|
||||||
|
|
||||||
|
@ -20,17 +22,19 @@ import qualified Dhall.Optics
|
||||||
lint :: Expr s Import -> Expr t Import
|
lint :: Expr s Import -> Expr t Import
|
||||||
lint = Dhall.Optics.rewriteOf subExpressions removeUnusedBindings . removeLetInLet
|
lint = Dhall.Optics.rewriteOf subExpressions removeUnusedBindings . removeLetInLet
|
||||||
|
|
||||||
-- Remove unused Let bindings. Only considers Let blocks binding a single
|
-- Remove unused Let bindings.
|
||||||
-- variable -- unfold Let blocks first to make sure we don't miss any rewrite
|
|
||||||
-- opportunities!
|
|
||||||
removeUnusedBindings :: Eq a => Expr s a -> Maybe (Expr s a)
|
removeUnusedBindings :: Eq a => Expr s a -> Maybe (Expr s a)
|
||||||
-- Don't remove assertions!
|
-- Don't remove assertions!
|
||||||
removeUnusedBindings (Let _ _ (Assert _) _) = Nothing
|
removeUnusedBindings (Let _ _ e _) | isOrContainsAssert e = Nothing
|
||||||
removeUnusedBindings (Let a _ _ d)
|
removeUnusedBindings (Let a _ _ d)
|
||||||
| not (V a 0 `Dhall.Core.freeIn` d) =
|
| not (V a 0 `Dhall.Core.freeIn` d) =
|
||||||
Just (Dhall.Core.shift (-1) (V a 0) d)
|
Just (Dhall.Core.shift (-1) (V a 0) d)
|
||||||
removeUnusedBindings _ = Nothing
|
removeUnusedBindings _ = Nothing
|
||||||
|
|
||||||
|
isOrContainsAssert :: Expr s a -> Bool
|
||||||
|
isOrContainsAssert (Assert _) = True
|
||||||
|
isOrContainsAssert e = Lens.Family.anyOf subExpressions isOrContainsAssert e
|
||||||
|
|
||||||
-- The difference between
|
-- The difference between
|
||||||
--
|
--
|
||||||
-- > let x = 1 let y = 2 in x + y
|
-- > let x = 1 let y = 2 in x + y
|
||||||
|
|
|
@ -25,9 +25,9 @@ lintDirectory = "./tests/lint"
|
||||||
|
|
||||||
getTests :: IO TestTree
|
getTests :: IO TestTree
|
||||||
getTests = do
|
getTests = do
|
||||||
formatTests <- Test.Util.discover (Turtle.chars <* "A.dhall") lintTest (Turtle.lstree lintDirectory)
|
lintTests <- Test.Util.discover (Turtle.chars <* "A.dhall") lintTest (Turtle.lstree lintDirectory)
|
||||||
|
|
||||||
let testTree = Tasty.testGroup "format tests" [ formatTests ]
|
let testTree = Tasty.testGroup "lint tests" [ lintTests ]
|
||||||
|
|
||||||
return testTree
|
return testTree
|
||||||
|
|
||||||
|
|
14
dhall/tests/lint/success/assertA.dhall
Normal file
14
dhall/tests/lint/success/assertA.dhall
Normal file
|
@ -0,0 +1,14 @@
|
||||||
|
let simpleAssert = assert : 1 + 1 ≡ 2
|
||||||
|
|
||||||
|
let assertIn1Lam = λ(n : Natural) → assert : Natural/subtract 0 n ≡ n
|
||||||
|
|
||||||
|
let assertIn2Lams =
|
||||||
|
λ(m : Natural)
|
||||||
|
→ λ(n : Natural)
|
||||||
|
→ assert : Natural/subtract m m ≡ Natural/subtract n n
|
||||||
|
|
||||||
|
let assertInLetInLam = λ(m : Natural) → let n = m + 0 in assert : m ≡ n
|
||||||
|
|
||||||
|
let unusedNonAssert = "Foo"
|
||||||
|
|
||||||
|
in {=}
|
12
dhall/tests/lint/success/assertB.dhall
Normal file
12
dhall/tests/lint/success/assertB.dhall
Normal file
|
@ -0,0 +1,12 @@
|
||||||
|
let simpleAssert = assert : 1 + 1 ≡ 2
|
||||||
|
|
||||||
|
let assertIn1Lam = λ(n : Natural) → assert : Natural/subtract 0 n ≡ n
|
||||||
|
|
||||||
|
let assertIn2Lams =
|
||||||
|
λ(m : Natural)
|
||||||
|
→ λ(n : Natural)
|
||||||
|
→ assert : Natural/subtract m m ≡ Natural/subtract n n
|
||||||
|
|
||||||
|
let assertInLetInLam = λ(m : Natural) → let n = m + 0 in assert : m ≡ n
|
||||||
|
|
||||||
|
in {=}
|
Loading…
Reference in New Issue
Block a user