    {-# LANGUAGE NamedFieldPuns    #-}
    {-# LANGUAGE OverloadedLists   #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE PatternGuards     #-}
    {-# LANGUAGE RecordWildCards   #-}
    {-# LANGUAGE ViewPatterns      #-}

    -- | This module contains the implementation of the @dhall lint@ command

    module Dhall.Lint
        ( -- * Lint
          lint
        , removeUnusedBindings
        , fixAssert
        , fixParentPath
        , removeLetInLet
        , replaceOptionalBuildFold
        , replaceSaturatedOptionalFold
        , useToMap
        ) where

    import Control.Applicative ((<|>))

    import Dhall.Syntax
        ( Binding(..)
        , Chunks(..)
        , Const(..)
        , Directory(..)
        , Expr(..)
        , File(..)
        , FilePrefix(..)
        , Import(..)
        , ImportHashed(..)
        , ImportType(..)
        , Var(..)
        , subExpressions
        )

    import qualified Data.Foldable      as Foldable
    import qualified Data.List.NonEmpty as NonEmpty
    import qualified Dhall.Core         as Core
    import qualified Dhall.Map          as Map
    import qualified Dhall.Optics
    import qualified Lens.Family

    {-| Automatically improve a Dhall expression

        Currently this:

        * removes unused @let@ bindings with 'removeUnusedBindings'.
        * fixes @let a = x ≡ y@ to be @let a = assert : x ≡ y@
        * consolidates nested @let@ bindings to use a multiple-@let@ binding with 'removeLetInLet'
        * fixes paths of the form @.\/..\/foo@ to @..\/foo@
        * Replaces deprecated @Optional\/fold@ and @Optional\/build@ built-ins
    -}
    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

    -- | Remove unused `Let` bindings.
    removeUnusedBindings :: Eq a => Expr s a -> Maybe (Expr s a)
    -- Don't remove assertions!
    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

    -- | Fix `Let` bindings  that the user probably meant to be `assert`s
    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

    -- | This transforms @.\/..\/foo@ into @..\/foo@
    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

    -- | The difference between
    --
    -- > let x = 1 let y = 2 in x + y
    --
    -- and
    --
    -- > let x = 1 in let y = 2 in x + y
    --
    -- is that in the second expression, the inner 'Let' is wrapped by a 'Note'.
    --
    -- We remove such a 'Note' in order to consolidate nested let-blocks into a
    -- single one.
    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

    -- | This replaces @Optional/fold@ and @Optional/build@, both of which can be
    -- implemented within the language
    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

    -- | This replaces a saturated @Optional/fold@ with the equivalent @merge@
    -- expression
    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

    -- | This replaces a record of key-value pairs with the equivalent use of
    --   @toMap@
    --
    -- This is currently not used by @dhall lint@ because this would sort @Map@
    -- keys, which is not necessarily a behavior-preserving change, but is still
    -- made available as a convenient rewrite rule.  For example,
    -- @{json,yaml}-to-dhall@ use this rewrite to simplify their output.
    useToMap :: Expr s a -> Maybe (Expr s a)
    useToMap :: Expr s a -> Maybe (Expr s a)
    useToMap
        (ListLit
            t :: Maybe (Expr s a)
    t@(Just
                (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
    List)
                    (Expr s a -> Expr s a
    forall s a. Expr s a -> Expr s a
    Core.shallowDenote -> Record
                        (Map Text (Expr s a) -> Map Text (Expr s a)
    forall k v. Map k v -> Map k v
    Map.sort ->
                            [ ("mapKey", Core.shallowDenote -> Text)
                            , ("mapValue", _)
                            ]
                        )
                    )
                )
            )
            []
        ) =
            Expr s a -> Maybe (Expr s a)
    forall a. a -> Maybe a
    Just (Expr s a -> Maybe (Expr s a) -> Expr s a
    forall s a. Expr s a -> Maybe (Expr s a) -> Expr s a
    ToMap (Map Text (Expr s a) -> Expr s a
    forall s a. Map Text (Expr s a) -> Expr s a
    RecordLit []) Maybe (Expr s a)
    t)
    useToMap (ListLit _ keyValues :: Seq (Expr s a)
    keyValues)
        | Bool -> Bool
    not (Seq (Expr s a) -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null Seq (Expr s a)
    keyValues)
        , Just keyValues' :: Seq (Text, Expr s a)
    keyValues' <- (Expr s a -> Maybe (Text, Expr s a))
    -> Seq (Expr s a) -> Maybe (Seq (Text, Expr s a))
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse Expr s a -> Maybe (Text, Expr s a)
    forall s a. Expr s a -> Maybe (Text, Expr s a)
    convert Seq (Expr s a)
    keyValues =
            Expr s a -> Maybe (Expr s a)
    forall a. a -> Maybe a
    Just
                (Expr s a -> Maybe (Expr s a) -> Expr s a
    forall s a. Expr s a -> Maybe (Expr s a) -> Expr s a
    ToMap
                    (Map Text (Expr s a) -> Expr s a
    forall s a. Map Text (Expr s a) -> Expr s a
    RecordLit ([(Text, Expr s a)] -> Map Text (Expr s a)
    forall k v. Ord k => [(k, v)] -> Map k v
    Map.fromList (Seq (Text, Expr s a) -> [(Text, Expr s a)]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    Foldable.toList Seq (Text, Expr s a)
    keyValues')))
                    Maybe (Expr s a)
    forall a. Maybe a
    Nothing
                )
      where
        convert :: Expr s a -> Maybe (Text, Expr s a)
    convert keyValue :: Expr s a
    keyValue =
            case Expr s a -> Expr s a
    forall s a. Expr s a -> Expr s a
    Core.shallowDenote Expr s a
    keyValue of
                RecordLit
                    (Map Text (Expr s a) -> Map Text (Expr s a)
    forall k v. Map k v -> Map k v
    Map.sort ->
                        [ ("mapKey"  , (Core.shallowDenote -> TextLit (Chunks [] key)))
                        , ("mapValue", value)
                        ]
                    ) ->
                        (Text, Expr s a) -> Maybe (Text, Expr s a)
    forall a. a -> Maybe a
    Just (Text
    key, Expr s a
    value)
                _ ->
                    Maybe (Text, Expr s a)
    forall a. Maybe a
    Nothing
    useToMap _ =
        Maybe (Expr s a)
    forall a. Maybe a
    Nothing