{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE RecordWildCards #-}
module Dhall.Lint
(
lint
, removeUnusedBindings
, fixAssert
, fixParentPath
) where
import Control.Applicative ((<|>))
import Dhall.Syntax
( Binding(..)
, Directory(..)
, Expr(..)
, File(..)
, FilePrefix(..)
, Import(..)
, ImportHashed(..)
, ImportType(..)
, Var(..)
, subExpressions
)
import qualified Data.List.NonEmpty as NonEmpty
import qualified Dhall.Core
import qualified Dhall.Optics
import qualified Lens.Family
lint :: Expr s Import -> Expr t Import
lint =
Dhall.Optics.rewriteOf
subExpressions
(\e -> fixAssert e <|> removeUnusedBindings e <|> fixParentPath e)
. removeLetInLet
removeUnusedBindings :: Eq a => Expr s a -> Maybe (Expr s a)
removeUnusedBindings (Let (Binding _ _ _ _ _ e) _)
| isOrContainsAssert e = Nothing
removeUnusedBindings (Let (Binding _ a _ _ _ _) d)
| not (V a 0 `Dhall.Core.freeIn` d) =
Just (Dhall.Core.shift (-1) (V a 0) d)
removeUnusedBindings _ = Nothing
fixAssert :: Expr s a -> Maybe (Expr s a)
fixAssert (Let (Binding { value = Equivalent x y, ..}) body) =
Just (Let (Binding { value = Assert (Equivalent x y), .. }) body)
fixAssert (Let binding (Equivalent x y)) =
Just (Let binding (Assert (Equivalent x y)))
fixAssert _ =
Nothing
fixParentPath :: Expr s Import -> Maybe (Expr s Import)
fixParentPath (Embed oldImport) = do
let Import{..} = oldImport
let ImportHashed{..} = importHashed
case importType of
Local Here File{ directory = Directory { components }, .. }
| Just nonEmpty <- NonEmpty.nonEmpty components
, NonEmpty.last nonEmpty == ".." -> do
let newDirectory =
Directory { components = NonEmpty.init nonEmpty }
let newImportType =
Local Parent File{ directory = newDirectory, .. }
let newImportHashed =
ImportHashed { importType = newImportType, .. }
let newImport = Import { importHashed = newImportHashed, .. }
Just (Embed newImport)
_ ->
Nothing
fixParentPath _ = Nothing
isOrContainsAssert :: Expr s a -> Bool
isOrContainsAssert (Assert _) = True
isOrContainsAssert e = Lens.Family.anyOf subExpressions isOrContainsAssert e
removeLetInLet :: Expr s a -> Expr t a
removeLetInLet = Dhall.Core.denote