{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ViewPatterns #-}
module Dhall.Lint
(
lint
, removeUnusedBindings
, fixAssert
, fixParentPath
, removeLetInLet
, replaceOptionalBuildFold
, replaceSaturatedOptionalFold
) where
import Control.Applicative ((<|>))
import Dhall.Syntax
( Binding(..)
, Const(..)
, Directory(..)
, Expr(..)
, File(..)
, FilePrefix(..)
, Import(..)
, ImportHashed(..)
, ImportType(..)
, Var(..)
, subExpressions
)
import qualified Data.List.NonEmpty as NonEmpty
import qualified Dhall.Core as Core
import qualified Dhall.Optics
import qualified Lens.Family
lint :: Expr s Import -> Expr s Import
lint :: Expr s Import -> Expr s Import
lint = ASetter
(Expr s Import) (Expr s Import) (Expr s Import) (Expr s Import)
-> (Expr s Import -> Maybe (Expr s Import))
-> Expr s Import
-> Expr s Import
forall a b. ASetter a b a b -> (b -> Maybe a) -> a -> b
Dhall.Optics.rewriteOf ASetter
(Expr s Import) (Expr s Import) (Expr s Import) (Expr s Import)
forall (f :: * -> *) s a.
Applicative f =>
(Expr s a -> f (Expr s a)) -> Expr s a -> f (Expr s a)
subExpressions Expr s Import -> Maybe (Expr s Import)
forall s. Expr s Import -> Maybe (Expr s Import)
lowerPriorityRewrite
(Expr s Import -> Expr s Import)
-> (Expr s Import -> Expr s Import)
-> Expr s Import
-> Expr s Import
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter
(Expr s Import) (Expr s Import) (Expr s Import) (Expr s Import)
-> (Expr s Import -> Maybe (Expr s Import))
-> Expr s Import
-> Expr s Import
forall a b. ASetter a b a b -> (b -> Maybe a) -> a -> b
Dhall.Optics.rewriteOf ASetter
(Expr s Import) (Expr s Import) (Expr s Import) (Expr s Import)
forall (f :: * -> *) s a.
Applicative f =>
(Expr s a -> f (Expr s a)) -> Expr s a -> f (Expr s a)
subExpressions Expr s Import -> Maybe (Expr s Import)
forall s a. Expr s a -> Maybe (Expr s a)
higherPriorityRewrite
where
lowerPriorityRewrite :: Expr s Import -> Maybe (Expr s Import)
lowerPriorityRewrite e :: Expr s Import
e =
Expr s Import -> Maybe (Expr s Import)
forall s a. Expr s a -> Maybe (Expr s a)
fixAssert Expr s Import
e
Maybe (Expr s Import)
-> Maybe (Expr s Import) -> Maybe (Expr s Import)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Expr s Import -> Maybe (Expr s Import)
forall a s. Eq a => Expr s a -> Maybe (Expr s a)
removeUnusedBindings Expr s Import
e
Maybe (Expr s Import)
-> Maybe (Expr s Import) -> Maybe (Expr s Import)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Expr s Import -> Maybe (Expr s Import)
forall s. Expr s Import -> Maybe (Expr s Import)
fixParentPath Expr s Import
e
Maybe (Expr s Import)
-> Maybe (Expr s Import) -> Maybe (Expr s Import)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Expr s Import -> Maybe (Expr s Import)
forall s a. Expr s a -> Maybe (Expr s a)
removeLetInLet Expr s Import
e
Maybe (Expr s Import)
-> Maybe (Expr s Import) -> Maybe (Expr s Import)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Expr s Import -> Maybe (Expr s Import)
forall s a. Expr s a -> Maybe (Expr s a)
replaceOptionalBuildFold Expr s Import
e
higherPriorityRewrite :: Expr s a -> Maybe (Expr s a)
higherPriorityRewrite = Expr s a -> Maybe (Expr s a)
forall s a. Expr s a -> Maybe (Expr s a)
replaceSaturatedOptionalFold
removeUnusedBindings :: Eq a => Expr s a -> Maybe (Expr s a)
removeUnusedBindings :: Expr s a -> Maybe (Expr s a)
removeUnusedBindings (Let (Binding _ _ _ _ _ e :: Expr s a
e) _)
| Expr s a -> Bool
forall s a. Expr s a -> Bool
isOrContainsAssert Expr s a
e = Maybe (Expr s a)
forall a. Maybe a
Nothing
removeUnusedBindings (Let (Binding _ a :: Text
a _ _ _ _) d :: Expr s a
d)
| Bool -> Bool
not (Text -> Int -> Var
V Text
a 0 Var -> Expr s a -> Bool
forall a s. Eq a => Var -> Expr s a -> Bool
`Core.freeIn` Expr s a
d) =
Expr s a -> Maybe (Expr s a)
forall a. a -> Maybe a
Just (Int -> Var -> Expr s a -> Expr s a
forall s a. Int -> Var -> Expr s a -> Expr s a
Core.shift (-1) (Text -> Int -> Var
V Text
a 0) Expr s a
d)
removeUnusedBindings _ = Maybe (Expr s a)
forall a. Maybe a
Nothing
fixAssert :: Expr s a -> Maybe (Expr s a)
fixAssert :: Expr s a -> Maybe (Expr s a)
fixAssert (Let (Binding { value :: forall s a. Binding s a -> Expr s a
value = v :: Expr s a
v@(Expr s a -> Expr s a
forall s a. Expr s a -> Expr s a
Core.shallowDenote -> Equivalent {}), ..}) body :: Expr s a
body) =
Expr s a -> Maybe (Expr s a)
forall a. a -> Maybe a
Just (Binding s a -> Expr s a -> Expr s a
forall s a. Binding s a -> Expr s a -> Expr s a
Let (Binding :: forall s a.
Maybe s
-> Text
-> Maybe s
-> Maybe (Maybe s, Expr s a)
-> Maybe s
-> Expr s a
-> Binding s a
Binding { value :: Expr s a
value = Expr s a -> Expr s a
forall s a. Expr s a -> Expr s a
Assert Expr s a
v, .. }) Expr s a
body)
fixAssert (Let binding :: Binding s a
binding body :: Expr s a
body@(Expr s a -> Expr s a
forall s a. Expr s a -> Expr s a
Core.shallowDenote -> Equivalent {})) =
Expr s a -> Maybe (Expr s a)
forall a. a -> Maybe a
Just (Binding s a -> Expr s a -> Expr s a
forall s a. Binding s a -> Expr s a -> Expr s a
Let Binding s a
binding (Expr s a -> Expr s a
forall s a. Expr s a -> Expr s a
Assert Expr s a
body))
fixAssert _ =
Maybe (Expr s a)
forall a. Maybe a
Nothing
fixParentPath :: Expr s Import -> Maybe (Expr s Import)
fixParentPath :: Expr s Import -> Maybe (Expr s Import)
fixParentPath (Embed oldImport :: Import
oldImport) = do
let Import{..} = Import
oldImport
let ImportHashed{..} = ImportHashed
importHashed
case ImportType
importType of
Local Here File{ directory :: File -> Directory
directory = Directory { [Text]
components :: Directory -> [Text]
components :: [Text]
components }, .. }
| Just nonEmpty :: NonEmpty Text
nonEmpty <- [Text] -> Maybe (NonEmpty Text)
forall a. [a] -> Maybe (NonEmpty a)
NonEmpty.nonEmpty [Text]
components
, NonEmpty Text -> Text
forall a. NonEmpty a -> a
NonEmpty.last NonEmpty Text
nonEmpty Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== ".." -> do
let newDirectory :: Directory
newDirectory =
Directory :: [Text] -> Directory
Directory { components :: [Text]
components = NonEmpty Text -> [Text]
forall a. NonEmpty a -> [a]
NonEmpty.init NonEmpty Text
nonEmpty }
let newImportType :: ImportType
newImportType =
FilePrefix -> File -> ImportType
Local FilePrefix
Parent File :: Directory -> Text -> File
File{ directory :: Directory
directory = Directory
newDirectory, .. }
let newImportHashed :: ImportHashed
newImportHashed =
ImportHashed :: Maybe SHA256Digest -> ImportType -> ImportHashed
ImportHashed { importType :: ImportType
importType = ImportType
newImportType, .. }
let newImport :: Import
newImport = Import :: ImportHashed -> ImportMode -> Import
Import { importHashed :: ImportHashed
importHashed = ImportHashed
newImportHashed, .. }
Expr s Import -> Maybe (Expr s Import)
forall a. a -> Maybe a
Just (Import -> Expr s Import
forall s a. a -> Expr s a
Embed Import
newImport)
_ ->
Maybe (Expr s Import)
forall a. Maybe a
Nothing
fixParentPath _ = Maybe (Expr s Import)
forall a. Maybe a
Nothing
isOrContainsAssert :: Expr s a -> Bool
isOrContainsAssert :: Expr s a -> Bool
isOrContainsAssert (Assert _) = Bool
True
isOrContainsAssert e :: Expr s a
e = FoldLike Any (Expr s a) (Expr s a) (Expr s a) (Expr s a)
-> (Expr s a -> Bool) -> Expr s a -> Bool
forall s t a b. FoldLike Any s t a b -> (a -> Bool) -> s -> Bool
Lens.Family.anyOf FoldLike Any (Expr s a) (Expr s a) (Expr s a) (Expr s a)
forall (f :: * -> *) s a.
Applicative f =>
(Expr s a -> f (Expr s a)) -> Expr s a -> f (Expr s a)
subExpressions Expr s a -> Bool
forall s a. Expr s a -> Bool
isOrContainsAssert Expr s a
e
removeLetInLet :: Expr s a -> Maybe (Expr s a)
removeLetInLet :: Expr s a -> Maybe (Expr s a)
removeLetInLet (Let binding :: Binding s a
binding (Note _ l :: Expr s a
l@Let{})) = Expr s a -> Maybe (Expr s a)
forall a. a -> Maybe a
Just (Binding s a -> Expr s a -> Expr s a
forall s a. Binding s a -> Expr s a -> Expr s a
Let Binding s a
binding Expr s a
l)
removeLetInLet _ = Maybe (Expr s a)
forall a. Maybe a
Nothing
replaceOptionalBuildFold :: Expr s a -> Maybe (Expr s a)
replaceOptionalBuildFold :: Expr s a -> Maybe (Expr s a)
replaceOptionalBuildFold OptionalBuild =
Expr s a -> Maybe (Expr s a)
forall a. a -> Maybe a
Just
(Text -> Expr s a -> Expr s a -> Expr s a
forall s a. Text -> Expr s a -> Expr s a -> Expr s a
Lam "a" (Const -> Expr s a
forall s a. Const -> Expr s a
Const Const
Type)
(Text -> Expr s a -> Expr s a -> Expr s a
forall s a. Text -> Expr s a -> Expr s a -> Expr s a
Lam "build"
(Text -> Expr s a -> Expr s a -> Expr s a
forall s a. Text -> Expr s a -> Expr s a -> Expr s a
Pi "optional" (Const -> Expr s a
forall s a. Const -> Expr s a
Const Const
Type)
(Text -> Expr s a -> Expr s a -> Expr s a
forall s a. Text -> Expr s a -> Expr s a -> Expr s a
Pi "some" (Text -> Expr s a -> Expr s a -> Expr s a
forall s a. Text -> Expr s a -> Expr s a -> Expr s a
Pi "_" "a" "optional")
(Text -> Expr s a -> Expr s a -> Expr s a
forall s a. Text -> Expr s a -> Expr s a -> Expr s a
Pi "none" "optional" "optional")
)
)
(Expr s a -> Expr s a -> Expr s a
forall s a. Expr s a -> Expr s a -> Expr s a
App (Expr s a -> Expr s a -> Expr s a
forall s a. Expr s a -> Expr s a -> Expr s a
App (Expr s a -> Expr s a -> Expr s a
forall s a. Expr s a -> Expr s a -> Expr s a
App "build" (Expr s a -> Expr s a -> Expr s a
forall s a. Expr s a -> Expr s a -> Expr s a
App Expr s a
forall s a. Expr s a
Optional "a")) (Text -> Expr s a -> Expr s a -> Expr s a
forall s a. Text -> Expr s a -> Expr s a -> Expr s a
Lam "x" "a" (Expr s a -> Expr s a
forall s a. Expr s a -> Expr s a
Some "x"))) (Expr s a -> Expr s a -> Expr s a
forall s a. Expr s a -> Expr s a -> Expr s a
App Expr s a
forall s a. Expr s a
None "a"))
)
)
replaceOptionalBuildFold OptionalFold =
Expr s a -> Maybe (Expr s a)
forall a. a -> Maybe a
Just
(Text -> Expr s a -> Expr s a -> Expr s a
forall s a. Text -> Expr s a -> Expr s a -> Expr s a
Lam "a" (Const -> Expr s a
forall s a. Const -> Expr s a
Const Const
Type)
(Text -> Expr s a -> Expr s a -> Expr s a
forall s a. Text -> Expr s a -> Expr s a -> Expr s a
Lam "o" (Expr s a -> Expr s a -> Expr s a
forall s a. Expr s a -> Expr s a -> Expr s a
App Expr s a
forall s a. Expr s a
Optional "a")
(Text -> Expr s a -> Expr s a -> Expr s a
forall s a. Text -> Expr s a -> Expr s a -> Expr s a
Lam "optional" (Const -> Expr s a
forall s a. Const -> Expr s a
Const Const
Type)
(Text -> Expr s a -> Expr s a -> Expr s a
forall s a. Text -> Expr s a -> Expr s a -> Expr s a
Lam "some" (Text -> Expr s a -> Expr s a -> Expr s a
forall s a. Text -> Expr s a -> Expr s a -> Expr s a
Pi "_" "a" "optional")
(Text -> Expr s a -> Expr s a -> Expr s a
forall s a. Text -> Expr s a -> Expr s a -> Expr s a
Lam "none" "optional"
(Expr s a -> Expr s a -> Maybe (Expr s a) -> Expr s a
forall s a. Expr s a -> Expr s a -> Maybe (Expr s a) -> Expr s a
Merge
(Map Text (Expr s a) -> Expr s a
forall s a. Map Text (Expr s a) -> Expr s a
RecordLit
[ ("Some", "some")
, ("None", "none")
]
)
"o"
Maybe (Expr s a)
forall a. Maybe a
Nothing
)
)
)
)
)
)
replaceOptionalBuildFold _ =
Maybe (Expr s a)
forall a. Maybe a
Nothing
replaceSaturatedOptionalFold :: Expr s a -> Maybe (Expr s a)
replaceSaturatedOptionalFold :: Expr s a -> Maybe (Expr s a)
replaceSaturatedOptionalFold
(App
(Expr s a -> Expr s a
forall s a. Expr s a -> Expr s a
Core.shallowDenote -> App
(Expr s a -> Expr s a
forall s a. Expr s a -> Expr s a
Core.shallowDenote -> App
(Expr s a -> Expr s a
forall s a. Expr s a -> Expr s a
Core.shallowDenote -> App
(Expr s a -> Expr s a
forall s a. Expr s a -> Expr s a
Core.shallowDenote -> App
(Expr s a -> Expr s a
forall s a. Expr s a -> Expr s a
Core.shallowDenote -> Expr s a
OptionalFold)
_
)
o :: Expr s a
o
)
_
)
some :: Expr s a
some
)
none :: Expr s a
none
) = Expr s a -> Maybe (Expr s a)
forall a. a -> Maybe a
Just (Expr s a -> Expr s a -> Maybe (Expr s a) -> Expr s a
forall s a. Expr s a -> Expr s a -> Maybe (Expr s a) -> Expr s a
Merge (Map Text (Expr s a) -> Expr s a
forall s a. Map Text (Expr s a) -> Expr s a
RecordLit [ ("Some", Expr s a
some), ("None", Expr s a
none) ]) Expr s a
o Maybe (Expr s a)
forall a. Maybe a
Nothing)
replaceSaturatedOptionalFold _ =
Maybe (Expr s a)
forall a. Maybe a
Nothing