    {-# 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
        , addPreludeExtensions
        , removeLetInLet
        , useToMap
        ) where

    import Control.Applicative ((<|>))

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

    import qualified Data.Foldable      as Foldable
    import qualified Data.List.NonEmpty as NonEmpty
    import qualified Data.Text          as Text
    import qualified Dhall.Core         as Core
    import qualified Dhall.Map
    import qualified Lens.Micro         as Lens

    {-| 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@
    -}
    lint :: Eq s => Expr s Import -> Expr s Import
    lint :: forall s. Eq s => 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
    Lens.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)
    rewrite
      where
        rewrite :: Expr s Import -> Maybe (Expr s Import)
    rewrite 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 a. Maybe a -> Maybe a -> Maybe a
    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 a. Maybe a -> Maybe a -> Maybe a
    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 a. Maybe a -> Maybe a -> Maybe a
    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 a. Maybe a -> Maybe a -> Maybe a
    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)
    addPreludeExtensions     Expr s Import
    e

    -- | Remove unused `Let` bindings.
    removeUnusedBindings :: Eq a => Expr s a -> Maybe (Expr s a)
    -- Don't remove assertions!
    removeUnusedBindings :: forall a s. Eq a => Expr s a -> Maybe (Expr s a)
    removeUnusedBindings (Let (Binding Maybe s
    _ Text
    _ Maybe s
    _ Maybe (Maybe s, Expr s a)
    _ Maybe s
    _ Expr s a
    e) Expr s a
    _)
        | 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 Maybe s
    _ Text
    a Maybe s
    _ Maybe (Maybe s, Expr s a)
    _ Maybe s
    _ Expr s a
    _) Expr s a
    d)
        | Bool -> Bool
    not (Text -> Int -> Var
    V Text
    a Int
    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 (-Int
    1) (Text -> Int -> Var
    V Text
    a Int
    0) Expr s a
    d)
    removeUnusedBindings Expr s a
    _ = 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 :: forall s a. 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 {}), Maybe s
    Maybe (Maybe s, Expr s a)
    Text
    bindingSrc0 :: Maybe s
    variable :: Text
    bindingSrc1 :: Maybe s
    annotation :: Maybe (Maybe s, Expr s a)
    bindingSrc2 :: Maybe s
    bindingSrc2 :: forall s a. Binding s a -> Maybe s
    annotation :: forall s a. Binding s a -> Maybe (Maybe s, Expr s a)
    bindingSrc1 :: forall s a. Binding s a -> Maybe s
    variable :: forall s a. Binding s a -> Text
    bindingSrc0 :: forall s a. Binding s a -> Maybe s
    ..}) 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 { 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, Maybe s
    Maybe (Maybe s, Expr s a)
    Text
    bindingSrc0 :: Maybe s
    variable :: Text
    bindingSrc1 :: Maybe s
    annotation :: Maybe (Maybe s, Expr s a)
    bindingSrc2 :: Maybe s
    bindingSrc2 :: Maybe s
    annotation :: Maybe (Maybe s, Expr s a)
    bindingSrc1 :: Maybe s
    variable :: Text
    bindingSrc0 :: Maybe s
    .. }) Expr s a
    body)
    fixAssert (Let 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 Expr s a
    _ =
        Maybe (Expr s a)
    forall a. Maybe a
    Nothing

    -- | This transforms @.\/..\/foo@ into @..\/foo@
    fixParentPath :: Expr s Import -> Maybe (Expr s Import)
    fixParentPath :: forall {s}. Expr s Import -> Maybe (Expr s Import)
    fixParentPath (Embed Import
    oldImport) = do
        let Import{ImportHashed
    ImportMode
    importHashed :: ImportHashed
    importMode :: ImportMode
    importMode :: Import -> ImportMode
    importHashed :: Import -> ImportHashed
    ..} = Import
    oldImport

        let ImportHashed{Maybe SHA256Digest
    ImportType
    hash :: Maybe SHA256Digest
    importType :: ImportType
    importType :: ImportHashed -> ImportType
    hash :: ImportHashed -> Maybe SHA256Digest
    ..} = ImportHashed
    importHashed

        case ImportType
    importType of
            Local FilePrefix
    Here File{ directory :: File -> Directory
    directory = Directory { [Text]
    components :: [Text]
    components :: Directory -> [Text]
    components }, Text
    file :: Text
    file :: File -> Text
    .. }
                | Just 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
    == Text
    ".." -> do
                    let newDirectory :: Directory
    newDirectory =
                            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 :: Directory
    directory = Directory
    newDirectory, Text
    file :: Text
    file :: Text
    .. }

                    let newImportHashed :: ImportHashed
    newImportHashed =
                            ImportHashed { importType :: ImportType
    importType = ImportType
    newImportType, Maybe SHA256Digest
    hash :: Maybe SHA256Digest
    hash :: Maybe SHA256Digest
    .. }

                    let newImport :: Import
    newImport = Import { importHashed :: ImportHashed
    importHashed = ImportHashed
    newImportHashed, ImportMode
    importMode :: ImportMode
    importMode :: ImportMode
    .. }

                    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)
            ImportType
    _ ->
                Maybe (Expr s Import)
    forall a. Maybe a
    Nothing
    fixParentPath Expr s Import
    _  = Maybe (Expr s Import)
    forall a. Maybe a
    Nothing

    {-| This transforms @https://prelude.dhall-lang.org/…/foo@ to
        @https://prelude.dhall-lang.org/…/foo.dhall@
    -}
    addPreludeExtensions :: Expr s Import -> Maybe (Expr s Import)
    addPreludeExtensions :: forall {s}. Expr s Import -> Maybe (Expr s Import)
    addPreludeExtensions (Embed Import
    oldImport) = do
        let Import{ importHashed :: Import -> ImportHashed
    importHashed = ImportHashed
    oldImportHashed, ImportMode
    importMode :: Import -> ImportMode
    importMode :: ImportMode
    .. } = Import
    oldImport

        let ImportHashed{ importType :: ImportHashed -> ImportType
    importType = ImportType
    oldImportType, Maybe SHA256Digest
    hash :: ImportHashed -> Maybe SHA256Digest
    hash :: Maybe SHA256Digest
    .. } = ImportHashed
    oldImportHashed

        case ImportType
    oldImportType of
            Remote URL{ path :: URL -> File
    path = File
    oldPath, Maybe Text
    Maybe (Expr Src Import)
    Text
    Scheme
    scheme :: Scheme
    authority :: Text
    query :: Maybe Text
    headers :: Maybe (Expr Src Import)
    headers :: URL -> Maybe (Expr Src Import)
    query :: URL -> Maybe Text
    authority :: URL -> Text
    scheme :: URL -> Scheme
    ..}
                | Text
    authority Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "prelude.dhall-lang.org" ->
                    case File
    oldPath of
                        File{ file :: File -> Text
    file = Text
    oldFile, Directory
    directory :: File -> Directory
    directory :: Directory
    .. }
                            | Bool -> Bool
    not (Text -> Text -> Bool
    Text.isSuffixOf Text
    ".dhall" Text
    oldFile) -> do
                                let newFile :: Text
    newFile = Text
    oldFile Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    ".dhall"

                                let newPath :: File
    newPath = File{ file :: Text
    file = Text
    newFile, Directory
    directory :: Directory
    directory :: Directory
    .. }

                                let newImportType :: ImportType
    newImportType = URL -> ImportType
    Remote URL{ path :: File
    path = File
    newPath, Maybe Text
    Maybe (Expr Src Import)
    Text
    Scheme
    scheme :: Scheme
    authority :: Text
    query :: Maybe Text
    headers :: Maybe (Expr Src Import)
    headers :: Maybe (Expr Src Import)
    query :: Maybe Text
    authority :: Text
    scheme :: Scheme
    .. }

                                let newImportHashed :: ImportHashed
    newImportHashed =
                                        ImportHashed{ importType :: ImportType
    importType = ImportType
    newImportType, Maybe SHA256Digest
    hash :: Maybe SHA256Digest
    hash :: Maybe SHA256Digest
    .. }

                                let newImport :: Import
    newImport =
                                        Import{ importHashed :: ImportHashed
    importHashed = ImportHashed
    newImportHashed, ImportMode
    importMode :: ImportMode
    importMode :: ImportMode
    .. }

                                Expr s Import -> Maybe (Expr s Import)
    forall a. a -> Maybe a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Import -> Expr s Import
    forall s a. a -> Expr s a
    Embed Import
    newImport)
                        File
    _ ->
                            Maybe (Expr s Import)
    forall a. Maybe a
    Nothing
            ImportType
    _ -> do
                Nothing
    addPreludeExtensions Expr s Import
    _ = Maybe (Expr s Import)
    forall a. Maybe a
    Nothing

    isOrContainsAssert :: Expr s a -> Bool
    isOrContainsAssert :: forall s a. Expr s a -> Bool
    isOrContainsAssert (Assert Expr s a
    _) = Bool
    True
    isOrContainsAssert Expr s a
    e = Getting Any (Expr s a) (Expr s a)
    -> (Expr s a -> Bool) -> Expr s a -> Bool
    forall s a. Getting Any s a -> (a -> Bool) -> s -> Bool
    Lens.anyOf Getting Any (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 :: forall s a. Expr s a -> Maybe (Expr s a)
    removeLetInLet (Let Binding s a
    binding (Note s
    _ 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 Expr s a
    _ = 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 :: forall s a. 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 (RecordField s a) -> Map Text (RecordField s a)
    forall k v. Map k v -> Map k v
    Dhall.Map.sort ->
                            [ (Text
    "mapKey", Expr s a -> Expr s a
    forall s a. Expr s a -> Expr s a
    Core.shallowDenote (Expr s a -> Expr s a)
    -> (RecordField s a -> Expr s a) -> RecordField s a -> Expr s a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . RecordField s a -> Expr s a
    forall s a. RecordField s a -> Expr s a
    Core.recordFieldValue -> Expr s a
    Text)
                            , (Text
    "mapValue", RecordField s a
    _)
                            ]
                        )
                    )
                )
            )
            []
        ) =
            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 (RecordField s a) -> Expr s a
    forall s a. Map Text (RecordField s a) -> Expr s a
    RecordLit []) Maybe (Expr s a)
    t)
    useToMap (ListLit Maybe (Expr s a)
    _ Seq (Expr s a)
    keyValues)
        | Bool -> Bool
    not (Seq (Expr s a) -> Bool
    forall a. Seq a -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null Seq (Expr s a)
    keyValues)
        , Just Seq (Text, RecordField s a)
    keyValues' <- (Expr s a -> Maybe (Text, RecordField s a))
    -> Seq (Expr s a) -> Maybe (Seq (Text, RecordField s a))
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Seq a -> f (Seq b)
    traverse Expr s a -> Maybe (Text, RecordField s a)
    forall {s} {a}. Expr s a -> Maybe (Text, RecordField 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 (RecordField s a) -> Expr s a
    forall s a. Map Text (RecordField s a) -> Expr s a
    RecordLit ([(Text, RecordField s a)] -> Map Text (RecordField s a)
    forall k v. Ord k => [(k, v)] -> Map k v
    Dhall.Map.fromList (Seq (Text, RecordField s a) -> [(Text, RecordField s a)]
    forall a. Seq a -> [a]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    Foldable.toList Seq (Text, RecordField s a)
    keyValues')))
                    Maybe (Expr s a)
    forall a. Maybe a
    Nothing
                )
      where
        convert :: Expr s a -> Maybe (Text, RecordField s a)
    convert 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 (RecordField s a) -> Map Text (RecordField s a)
    forall k v. Map k v -> Map k v
    Dhall.Map.sort ->
                        [ (Text
    "mapKey"  , Expr s a -> Expr s a
    forall s a. Expr s a -> Expr s a
    Core.shallowDenote (Expr s a -> Expr s a)
    -> (RecordField s a -> Expr s a) -> RecordField s a -> Expr s a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . RecordField s a -> Expr s a
    forall s a. RecordField s a -> Expr s a
    Core.recordFieldValue -> TextLit (Chunks [] Text
    key))
                        , (Text
    "mapValue", RecordField s a
    value)
                        ]
                    ) ->
                        (Text, RecordField s a) -> Maybe (Text, RecordField s a)
    forall a. a -> Maybe a
    Just (Text
    key, RecordField s a
    value)
                Expr s a
    _ ->
                    Maybe (Text, RecordField s a)
    forall a. Maybe a
    Nothing
    useToMap Expr s a
    _ =
        Maybe (Expr s a)
    forall a. Maybe a
    Nothing