    {-# LANGUAGE DeriveGeneric #-}

    module Distribution.Solver.Types.ProjectConfigPath
        (
        -- * Project Config Path Manipulation
          ProjectConfigPath(..)
        , projectConfigPathRoot
        , nullProjectConfigPath
        , consProjectConfigPath

        -- * Messages
        , docProjectConfigPath
        , docProjectConfigPaths
        , cyclicalImportMsg
        , docProjectConfigPathFailReason

        -- * Checks and Normalization
        , isCyclicConfigPath
        , canonicalizeConfigPath
        ) where

    import Distribution.Solver.Compat.Prelude hiding (toList, (<>))
    import Prelude (sequence)

    import Data.Coerce (coerce)
    import Data.List.NonEmpty ((<|))
    import Network.URI (parseURI)
    import System.Directory
    import System.FilePath
    import qualified Data.List.NonEmpty as NE
    import Distribution.Solver.Modular.Version (VR)
    import Distribution.Pretty (prettyShow)
    import Text.PrettyPrint

    -- | Path to a configuration file, either a singleton project root, or a longer
    -- list representing a path to an import.  The path is a non-empty list that we
    -- build up by prepending relative imports with @consProjectConfigPath@.
    --
    -- An import can be a URI, such as [a stackage
    -- cabal.config](https://www.stackage.org/nightly/cabal.config), but we do not
    -- support URIs in the middle of the path, URIs that import other URIs, or URIs
    -- that import local files.
    --
    -- List elements are relative to each other but once canonicalized, elements are
    -- relative to the directory of the project root.
    newtype ProjectConfigPath = ProjectConfigPath (NonEmpty FilePath)
        deriving (ProjectConfigPath -> ProjectConfigPath -> Bool
    (ProjectConfigPath -> ProjectConfigPath -> Bool)
    -> (ProjectConfigPath -> ProjectConfigPath -> Bool)
    -> Eq ProjectConfigPath
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: ProjectConfigPath -> ProjectConfigPath -> Bool
    == :: ProjectConfigPath -> ProjectConfigPath -> Bool
    $c/= :: ProjectConfigPath -> ProjectConfigPath -> Bool
    /= :: ProjectConfigPath -> ProjectConfigPath -> Bool
    Eq, Eq ProjectConfigPath
    Eq ProjectConfigPath =>
    (ProjectConfigPath -> ProjectConfigPath -> Ordering)
    -> (ProjectConfigPath -> ProjectConfigPath -> Bool)
    -> (ProjectConfigPath -> ProjectConfigPath -> Bool)
    -> (ProjectConfigPath -> ProjectConfigPath -> Bool)
    -> (ProjectConfigPath -> ProjectConfigPath -> Bool)
    -> (ProjectConfigPath -> ProjectConfigPath -> ProjectConfigPath)
    -> (ProjectConfigPath -> ProjectConfigPath -> ProjectConfigPath)
    -> Ord ProjectConfigPath
    ProjectConfigPath -> ProjectConfigPath -> Bool
    ProjectConfigPath -> ProjectConfigPath -> Ordering
    ProjectConfigPath -> ProjectConfigPath -> ProjectConfigPath
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: ProjectConfigPath -> ProjectConfigPath -> Ordering
    compare :: ProjectConfigPath -> ProjectConfigPath -> Ordering
    $c< :: ProjectConfigPath -> ProjectConfigPath -> Bool
    < :: ProjectConfigPath -> ProjectConfigPath -> Bool
    $c<= :: ProjectConfigPath -> ProjectConfigPath -> Bool
    <= :: ProjectConfigPath -> ProjectConfigPath -> Bool
    $c> :: ProjectConfigPath -> ProjectConfigPath -> Bool
    > :: ProjectConfigPath -> ProjectConfigPath -> Bool
    $c>= :: ProjectConfigPath -> ProjectConfigPath -> Bool
    >= :: ProjectConfigPath -> ProjectConfigPath -> Bool
    $cmax :: ProjectConfigPath -> ProjectConfigPath -> ProjectConfigPath
    max :: ProjectConfigPath -> ProjectConfigPath -> ProjectConfigPath
    $cmin :: ProjectConfigPath -> ProjectConfigPath -> ProjectConfigPath
    min :: ProjectConfigPath -> ProjectConfigPath -> ProjectConfigPath
    Ord, Int -> ProjectConfigPath -> ShowS
    [ProjectConfigPath] -> ShowS
    ProjectConfigPath -> FilePath
    (Int -> ProjectConfigPath -> ShowS)
    -> (ProjectConfigPath -> FilePath)
    -> ([ProjectConfigPath] -> ShowS)
    -> Show ProjectConfigPath
    forall a.
    (Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> ProjectConfigPath -> ShowS
    showsPrec :: Int -> ProjectConfigPath -> ShowS
    $cshow :: ProjectConfigPath -> FilePath
    show :: ProjectConfigPath -> FilePath
    $cshowList :: [ProjectConfigPath] -> ShowS
    showList :: [ProjectConfigPath] -> ShowS
    Show, (forall x. ProjectConfigPath -> Rep ProjectConfigPath x)
    -> (forall x. Rep ProjectConfigPath x -> ProjectConfigPath)
    -> Generic ProjectConfigPath
    forall x. Rep ProjectConfigPath x -> ProjectConfigPath
    forall x. ProjectConfigPath -> Rep ProjectConfigPath x
    forall a.
    (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
    $cfrom :: forall x. ProjectConfigPath -> Rep ProjectConfigPath x
    from :: forall x. ProjectConfigPath -> Rep ProjectConfigPath x
    $cto :: forall x. Rep ProjectConfigPath x -> ProjectConfigPath
    to :: forall x. Rep ProjectConfigPath x -> ProjectConfigPath
    Generic)

    instance Binary ProjectConfigPath
    instance Structured ProjectConfigPath

    -- | Renders the path like this;
    -- @
    -- D.config
    --   imported by: C.config
    --   imported by: B.config
    --   imported by: A.project
    -- @
    -- >>> render . docProjectConfigPath $ ProjectConfigPath $ "D.config" :| ["C.config", "B.config", "A.project"]
    -- "D.config\n  imported by: C.config\n  imported by: B.config\n  imported by: A.project"
    docProjectConfigPath :: ProjectConfigPath -> Doc
    docProjectConfigPath :: ProjectConfigPath -> Doc
    docProjectConfigPath (ProjectConfigPath (FilePath
    p :| [])) = FilePath -> Doc
    text FilePath
    p
    docProjectConfigPath (ProjectConfigPath (FilePath
    p :| [FilePath]
    ps)) = [Doc] -> Doc
    vcat ([Doc] -> Doc) -> [Doc] -> Doc
    forall a b. (a -> b) -> a -> b
    $
        FilePath -> Doc
    text FilePath
    p Doc -> [Doc] -> [Doc]
    forall a. a -> [a] -> [a]
    : [ FilePath -> Doc
    text FilePath
    " " Doc -> Doc -> Doc
    <+> FilePath -> Doc
    text FilePath
    "imported by:" Doc -> Doc -> Doc
    <+> FilePath -> Doc
    text FilePath
    l | FilePath
    l <- [FilePath]
    ps ]

    -- | Renders the paths as a list without showing which path imports another,
    -- like this;
    -- @
    -- - cabal.project
    -- - project-cabal/constraints.config
    -- - project-cabal/ghc-latest.config
    -- - project-cabal/ghc-options.config
    -- - project-cabal/pkgs.config
    -- - project-cabal/pkgs/benchmarks.config
    -- - project-cabal/pkgs/buildinfo.config
    -- - project-cabal/pkgs/cabal.config
    -- - project-cabal/pkgs/install.config
    -- - project-cabal/pkgs/integration-tests.config
    -- - project-cabal/pkgs/tests.config
    -- @
    --
    -- >>> :{
    --   do
    --     let ps =
    --              [ ProjectConfigPath ("cabal.project" :| [])
    --              , ProjectConfigPath ("project-cabal/constraints.config" :| ["cabal.project"])
    --              , ProjectConfigPath ("project-cabal/ghc-latest.config" :| ["cabal.project"])
    --              , ProjectConfigPath ("project-cabal/ghc-options.config" :| ["cabal.project"])
    --              , ProjectConfigPath ("project-cabal/pkgs.config" :| ["cabal.project"])
    --              , ProjectConfigPath ("project-cabal/pkgs/benchmarks.config" :| ["project-cabal/pkgs.config","cabal.project"])
    --              , ProjectConfigPath ("project-cabal/pkgs/buildinfo.config" :| ["project-cabal/pkgs.config","cabal.project"])
    --              , ProjectConfigPath ("project-cabal/pkgs/cabal.config" :| ["project-cabal/pkgs.config","cabal.project"])
    --              , ProjectConfigPath ("project-cabal/pkgs/install.config" :| ["project-cabal/pkgs.config","cabal.project"])
    --              , ProjectConfigPath ("project-cabal/pkgs/integration-tests.config" :| ["project-cabal/pkgs.config","cabal.project"])
    --              , ProjectConfigPath ("project-cabal/pkgs/tests.config" :| ["project-cabal/pkgs.config","cabal.project"])
    --              ]
    --     return . render $ docProjectConfigPaths ps
    -- :}
    -- "- cabal.project\n- project-cabal/constraints.config\n- project-cabal/ghc-latest.config\n- project-cabal/ghc-options.config\n- project-cabal/pkgs.config\n- project-cabal/pkgs/benchmarks.config\n- project-cabal/pkgs/buildinfo.config\n- project-cabal/pkgs/cabal.config\n- project-cabal/pkgs/install.config\n- project-cabal/pkgs/integration-tests.config\n- project-cabal/pkgs/tests.config"
    docProjectConfigPaths :: [ProjectConfigPath] -> Doc
    docProjectConfigPaths :: [ProjectConfigPath] -> Doc
    docProjectConfigPaths [ProjectConfigPath]
    ps = [Doc] -> Doc
    vcat
        [ FilePath -> Doc
    text FilePath
    "-" Doc -> Doc -> Doc
    <+> FilePath -> Doc
    text FilePath
    p | ProjectConfigPath (FilePath
    p :| [FilePath]
    _) <- [ProjectConfigPath]
    ps ]

    -- | A message for a cyclical import, assuming the head of the path is the
    -- duplicate.
    cyclicalImportMsg :: ProjectConfigPath -> Doc
    cyclicalImportMsg :: ProjectConfigPath -> Doc
    cyclicalImportMsg path :: ProjectConfigPath
    path@(ProjectConfigPath (FilePath
    duplicate :| [FilePath]
    _)) =
        [Doc] -> Doc
    vcat
        [ FilePath -> Doc
    text FilePath
    "cyclical import of" Doc -> Doc -> Doc
    <+> FilePath -> Doc
    text FilePath
    duplicate Doc -> Doc -> Doc
    <> Doc
    semi
        , Int -> Doc -> Doc
    nest Int
    2 (ProjectConfigPath -> Doc
    docProjectConfigPath ProjectConfigPath
    path)
        ]

    docProjectConfigPathFailReason :: VR -> ProjectConfigPath -> Doc
    docProjectConfigPathFailReason :: VR -> ProjectConfigPath -> Doc
    docProjectConfigPathFailReason VR
    vr ProjectConfigPath
    pcp
        | ProjectConfigPath (FilePath
    p :| []) <- ProjectConfigPath
    pcp =
            FilePath -> Doc
    constraint FilePath
    p
        | ProjectConfigPath (FilePath
    p :| [FilePath]
    ps) <- ProjectConfigPath
    pcp = [Doc] -> Doc
    vcat
            [ FilePath -> Doc
    constraint FilePath
    p
            , [Doc] -> Doc
    cat [Int -> Doc -> Doc
    nest Int
    2 (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $ FilePath -> Doc
    text FilePath
    "imported by:" Doc -> Doc -> Doc
    <+> FilePath -> Doc
    text FilePath
    l | FilePath
    l <- [FilePath]
    ps ]
            ]
        where
            pathRequiresVersion :: FilePath -> Doc
    pathRequiresVersion FilePath
    p = FilePath -> Doc
    text FilePath
    p Doc -> Doc -> Doc
    <+> FilePath -> Doc
    text FilePath
    "requires" Doc -> Doc -> Doc
    <+> FilePath -> Doc
    text (VR -> FilePath
    forall a. Pretty a => a -> FilePath
    prettyShow VR
    vr)
            constraint :: FilePath -> Doc
    constraint FilePath
    p = Doc -> Doc
    parens (Doc -> Doc) -> Doc -> Doc
    forall a b. (a -> b) -> a -> b
    $ FilePath -> Doc
    text FilePath
    "constraint from" Doc -> Doc -> Doc
    <+> FilePath -> Doc
    pathRequiresVersion FilePath
    p

    -- | The root of the path, the project itself.
    projectConfigPathRoot :: ProjectConfigPath -> FilePath
    projectConfigPathRoot :: ProjectConfigPath -> FilePath
    projectConfigPathRoot (ProjectConfigPath NonEmpty FilePath
    xs) = NonEmpty FilePath -> FilePath
    forall a. NonEmpty a -> a
    last NonEmpty FilePath
    xs

    -- | Used by some tests as a dummy "unused" project root.
    nullProjectConfigPath :: ProjectConfigPath
    nullProjectConfigPath :: ProjectConfigPath
    nullProjectConfigPath = NonEmpty FilePath -> ProjectConfigPath
    ProjectConfigPath (NonEmpty FilePath -> ProjectConfigPath)
    -> NonEmpty FilePath -> ProjectConfigPath
    forall a b. (a -> b) -> a -> b
    $ FilePath
    "unused" FilePath -> [FilePath] -> NonEmpty FilePath
    forall a. a -> [a] -> NonEmpty a
    :| []

    -- | Check if the path has duplicates. A cycle of imports is not allowed. This
    -- check should only be done after the path has been canonicalized with
    -- @canonicalizeConfigPath@. This is because the import path may contain paths
    -- that are the same in relation to their importers but different in relation to
    -- the project root directory.
    isCyclicConfigPath :: ProjectConfigPath -> Bool
    isCyclicConfigPath :: ProjectConfigPath -> Bool
    isCyclicConfigPath (ProjectConfigPath NonEmpty FilePath
    p) = NonEmpty FilePath -> Int
    forall a. NonEmpty a -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length NonEmpty FilePath
    p Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= NonEmpty FilePath -> Int
    forall a. NonEmpty a -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length (NonEmpty FilePath -> NonEmpty FilePath
    forall a. Eq a => NonEmpty a -> NonEmpty a
    NE.nub NonEmpty FilePath
    p)

    -- | Prepends the path of the importee to the importer path.
    consProjectConfigPath :: FilePath -> ProjectConfigPath -> ProjectConfigPath
    consProjectConfigPath :: FilePath -> ProjectConfigPath -> ProjectConfigPath
    consProjectConfigPath FilePath
    p ProjectConfigPath
    ps = NonEmpty FilePath -> ProjectConfigPath
    ProjectConfigPath (FilePath
    p FilePath -> NonEmpty FilePath -> NonEmpty FilePath
    forall a. a -> NonEmpty a -> NonEmpty a
    <| ProjectConfigPath -> NonEmpty FilePath
    forall a b. Coercible a b => a -> b
    coerce ProjectConfigPath
    ps)

    -- | Make paths relative to the directory of the root of the project, not
    -- relative to the file they were imported from.
    makeRelativeConfigPath :: FilePath -> ProjectConfigPath -> ProjectConfigPath
    makeRelativeConfigPath :: FilePath -> ProjectConfigPath -> ProjectConfigPath
    makeRelativeConfigPath FilePath
    dir (ProjectConfigPath NonEmpty FilePath
    p) =
        NonEmpty FilePath -> ProjectConfigPath
    ProjectConfigPath
        (NonEmpty FilePath -> ProjectConfigPath)
    -> NonEmpty FilePath -> ProjectConfigPath
    forall a b. (a -> b) -> a -> b
    $ (\FilePath
    segment -> (if FilePath -> Bool
    isURI FilePath
    segment then FilePath
    segment else FilePath -> ShowS
    makeRelative FilePath
    dir FilePath
    segment))
        ShowS -> NonEmpty FilePath -> NonEmpty FilePath
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NonEmpty FilePath
    p

    -- | Normalizes and canonicalizes a path removing '.' and '..' indirections.
    -- Makes the path relative to the given directory (typically the project root)
    -- instead of relative to the file it was imported from.
    --
    -- It converts paths like this:
    -- @
    -- └─ hops-0.project
    --    └─ hops/hops-1.config
    --       └─ ../hops-2.config
    --          └─ hops/hops-3.config
    --             └─ ../hops-4.config
    --                └─ hops/hops-5.config
    --                   └─ ../hops-6.config
    --                      └─ hops/hops-7.config
    --                         └─ ../hops-8.config
    --                            └─ hops/hops-9.config
    -- @
    --
    -- Into paths like this:
    -- @
    -- └─ hops-0.project
    --    └─ hops/hops-1.config
    --       └─ hops-2.config
    --          └─ hops/hops-3.config
    --             └─ hops-4.config
    --                └─ hops/hops-5.config
    --                   └─ hops-6.config
    --                      └─ hops/hops-7.config
    --                         └─ hops-8.config
    --                            └─ hops/hops-9.config
    -- @
    --
    -- That way we have @hops-8.config@ instead of
    -- @./hops/../hops/../hops/../hops/../hops-8.config@.
    --
    -- Let's see how @canonicalizePath@ works that is used in the implementation
    -- then we'll see how @canonicalizeConfigPath@ works.
    --
    -- >>> let d = testDir
    -- >>> makeRelative d <$> canonicalizePath (d </> "hops/../hops/../hops/../hops/../hops-8.config")
    -- "hops-8.config"
    --
    -- >>> let d = testDir
    -- >>> p <- canonicalizeConfigPath d (ProjectConfigPath $ (d </> "hops/../hops/../hops/../hops/../hops-8.config") :| [])
    -- >>> render $ docProjectConfigPath p
    -- "hops-8.config"
    --
    -- >>> :{
    --   do
    --     let expected = unlines
    --           [ "hops/hops-9.config"
    --           , "  imported by: hops-8.config"
    --           , "  imported by: hops/hops-7.config"
    --           , "  imported by: hops-6.config"
    --           , "  imported by: hops/hops-5.config"
    --           , "  imported by: hops-4.config"
    --           , "  imported by: hops/hops-3.config"
    --           , "  imported by: hops-2.config"
    --           , "  imported by: hops/hops-1.config"
    --           , "  imported by: hops-0.project"
    --           ]
    --     let d = testDir
    --     let configPath = ProjectConfigPath ("hops/hops-9.config" :|
    --           [ "../hops-8.config"
    --           , "hops/hops-7.config"
    --           , "../hops-6.config"
    --           , "hops/hops-5.config"
    --           , "../hops-4.config"
    --           , "hops/hops-3.config"
    --           , "../hops-2.config"
    --           , "hops/hops-1.config"
    --           , d </> "hops-0.project"])
    --     p <- canonicalizeConfigPath d configPath
    --     return $ expected == render (docProjectConfigPath p) ++ "\n"
    -- :}
    -- True
    canonicalizeConfigPath :: FilePath -> ProjectConfigPath -> IO ProjectConfigPath
    canonicalizeConfigPath :: FilePath -> ProjectConfigPath -> IO ProjectConfigPath
    canonicalizeConfigPath FilePath
    d (ProjectConfigPath NonEmpty FilePath
    p) = do
        xs <- NonEmpty (IO FilePath) -> IO (NonEmpty FilePath)
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => NonEmpty (m a) -> m (NonEmpty a)
    sequence (NonEmpty (IO FilePath) -> IO (NonEmpty FilePath))
    -> NonEmpty (IO FilePath) -> IO (NonEmpty FilePath)
    forall a b. (a -> b) -> a -> b
    $ (FilePath -> IO FilePath -> IO FilePath)
    -> IO FilePath -> NonEmpty FilePath -> NonEmpty (IO FilePath)
    forall (f :: * -> *) a b.
    Foldable f =>
    (a -> b -> b) -> b -> f a -> NonEmpty b
    NE.scanr (\FilePath
    importee -> (IO FilePath -> (FilePath -> IO FilePath) -> IO FilePath
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \FilePath
    importer ->
                if FilePath -> Bool
    isURI FilePath
    importee
                    then FilePath -> IO FilePath
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure FilePath
    importee
                    else FilePath -> IO FilePath
    canonicalizePath (FilePath -> IO FilePath) -> FilePath -> IO FilePath
    forall a b. (a -> b) -> a -> b
    $ FilePath
    d FilePath -> ShowS
    </> ShowS
    takeDirectory FilePath
    importer FilePath -> ShowS
    </> FilePath
    importee))
                (FilePath -> IO FilePath
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure FilePath
    ".") NonEmpty FilePath
    p
        return . makeRelativeConfigPath d . ProjectConfigPath . NE.fromList $ NE.init xs

    isURI :: FilePath -> Bool
    isURI :: FilePath -> Bool
    isURI = Maybe URI -> Bool
    forall a. Maybe a -> Bool
    isJust (Maybe URI -> Bool) -> (FilePath -> Maybe URI) -> FilePath -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FilePath -> Maybe URI
    parseURI

    -- $setup
    -- >>> import Data.List
    -- >>> testDir <- makeAbsolute =<< canonicalizePath "../cabal-testsuite/PackageTests/ConditionalAndImport"