{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ViewPatterns #-}

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

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

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

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

import Data.Coerce (coerce)
import Data.List.NonEmpty ((<|))
import Network.URI (parseURI, parseAbsoluteURI)
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
import Distribution.Simple.Utils (ordNub)

-- | 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, 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)

-- | Sorts URIs after local file paths and longer file paths after shorter ones
-- as measured by the number of path segments. If still equal, then sorting is
-- lexical.
--
-- The project itself, a single element root path, compared to any of the
-- configuration paths it imports, should always sort first. Comparing one
-- project root path against another is done lexically.
instance Ord ProjectConfigPath where
    compare :: ProjectConfigPath -> ProjectConfigPath -> Ordering
compare pa :: ProjectConfigPath
pa@(ProjectConfigPath (NonEmpty FilePath -> [FilePath]
forall a. NonEmpty a -> [a]
NE.toList -> [FilePath]
as)) pb :: ProjectConfigPath
pb@(ProjectConfigPath (NonEmpty FilePath -> [FilePath]
forall a. NonEmpty a -> [a]
NE.toList -> [FilePath]
bs)) =
        case ([FilePath]
as, [FilePath]
bs) of
            -- There should only ever be one root project path, only one path
            -- with length 1. Comparing it to itself should be EQ. Don't assume
            -- this though, do a comparison anyway when both sides have length
            -- 1.  The root path, the project itself, should always be the first
            -- path in a sorted listing.
            ([FilePath
a], [FilePath
b]) -> FilePath -> FilePath -> Ordering
forall a. Ord a => a -> a -> Ordering
compare FilePath
a FilePath
b
            ([FilePath
_], [FilePath]
_) -> Ordering
LT
            ([FilePath]
_, [FilePath
_]) -> Ordering
GT

            (FilePath
a:[FilePath]
_, FilePath
b:[FilePath]
_) -> case (FilePath -> Maybe URI
parseAbsoluteURI FilePath
a, FilePath -> Maybe URI
parseAbsoluteURI FilePath
b) of
                (Just URI
ua, Just URI
ub) -> URI -> URI -> Ordering
forall a. Ord a => a -> a -> Ordering
compare URI
ua URI
ub Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
P.<> Maybe ProjectConfigPath -> Maybe ProjectConfigPath -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Maybe ProjectConfigPath
aImporters Maybe ProjectConfigPath
bImporters
                (Just URI
_, Maybe URI
Nothing) -> Ordering
GT
                (Maybe URI
Nothing, Just URI
_) -> Ordering
LT
                (Maybe URI
Nothing, Maybe URI
Nothing) -> [FilePath] -> [FilePath] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (FilePath -> [FilePath]
splitPath FilePath
a) (FilePath -> [FilePath]
splitPath FilePath
b) Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
P.<> Maybe ProjectConfigPath -> Maybe ProjectConfigPath -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Maybe ProjectConfigPath
aImporters Maybe ProjectConfigPath
bImporters
            ([FilePath], [FilePath])
_ ->
                Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ([FilePath] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
as) ([FilePath] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
bs)
                Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
P.<> Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ([[FilePath]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[FilePath]]
aPaths) ([[FilePath]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[FilePath]]
bPaths)
                Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
P.<> [[FilePath]] -> [[FilePath]] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare [[FilePath]]
aPaths [[FilePath]]
bPaths
        where
            aPaths :: [[FilePath]]
aPaths = FilePath -> [FilePath]
splitPath (FilePath -> [FilePath]) -> [FilePath] -> [[FilePath]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FilePath]
as
            bPaths :: [[FilePath]]
bPaths = FilePath -> [FilePath]
splitPath (FilePath -> [FilePath]) -> [FilePath] -> [[FilePath]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FilePath]
bs
            aImporters :: Maybe ProjectConfigPath
aImporters = (FilePath, Maybe ProjectConfigPath) -> Maybe ProjectConfigPath
forall a b. (a, b) -> b
snd ((FilePath, Maybe ProjectConfigPath) -> Maybe ProjectConfigPath)
-> (FilePath, Maybe ProjectConfigPath) -> Maybe ProjectConfigPath
forall a b. (a -> b) -> a -> b
$ ProjectConfigPath -> (FilePath, Maybe ProjectConfigPath)
unconsProjectConfigPath ProjectConfigPath
pa
            bImporters :: Maybe ProjectConfigPath
bImporters = (FilePath, Maybe ProjectConfigPath) -> Maybe ProjectConfigPath
forall a b. (a, b) -> b
snd ((FilePath, Maybe ProjectConfigPath) -> Maybe ProjectConfigPath)
-> (FilePath, Maybe ProjectConfigPath) -> Maybe ProjectConfigPath
forall a b. (a -> b) -> a -> b
$ ProjectConfigPath -> (FilePath, Maybe ProjectConfigPath)
unconsProjectConfigPath ProjectConfigPath
pb

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
    | FilePath
p <- [FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
ordNub [ FilePath
p | ProjectConfigPath (FilePath
p :| [FilePath]
_) <- [ProjectConfigPath]
ps ]
    ]

-- | A message for a cyclical import, a "cyclical import of".
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)

-- | Check if the project config path is top-level, meaning it was not included by
-- some other project config.
isTopLevelConfigPath :: ProjectConfigPath -> Bool
isTopLevelConfigPath :: ProjectConfigPath -> Bool
isTopLevelConfigPath (ProjectConfigPath NonEmpty FilePath
p) = NonEmpty FilePath -> Int
forall a. NonEmpty a -> Int
NE.length NonEmpty FilePath
p Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1

-- | 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)

-- | Split the path into the importee and the importer path.
unconsProjectConfigPath :: ProjectConfigPath -> (FilePath, Maybe ProjectConfigPath)
unconsProjectConfigPath :: ProjectConfigPath -> (FilePath, Maybe ProjectConfigPath)
unconsProjectConfigPath ProjectConfigPath
ps = (NonEmpty FilePath -> ProjectConfigPath)
-> Maybe (NonEmpty FilePath) -> Maybe ProjectConfigPath
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty FilePath -> ProjectConfigPath
ProjectConfigPath (Maybe (NonEmpty FilePath) -> Maybe ProjectConfigPath)
-> (FilePath, Maybe (NonEmpty FilePath))
-> (FilePath, Maybe ProjectConfigPath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty FilePath -> (FilePath, Maybe (NonEmpty FilePath))
forall a. NonEmpty a -> (a, Maybe (NonEmpty a))
NE.uncons (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
    NonEmpty FilePath
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
    ProjectConfigPath -> IO ProjectConfigPath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ProjectConfigPath -> IO ProjectConfigPath)
-> ([FilePath] -> ProjectConfigPath)
-> [FilePath]
-> IO ProjectConfigPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ProjectConfigPath -> ProjectConfigPath
makeRelativeConfigPath FilePath
d (ProjectConfigPath -> ProjectConfigPath)
-> ([FilePath] -> ProjectConfigPath)
-> [FilePath]
-> ProjectConfigPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty FilePath -> ProjectConfigPath
ProjectConfigPath (NonEmpty FilePath -> ProjectConfigPath)
-> ([FilePath] -> NonEmpty FilePath)
-> [FilePath]
-> ProjectConfigPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> NonEmpty FilePath
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList ([FilePath] -> IO ProjectConfigPath)
-> [FilePath] -> IO ProjectConfigPath
forall a b. (a -> b) -> a -> b
$ NonEmpty FilePath -> [FilePath]
forall a. NonEmpty a -> [a]
NE.init NonEmpty FilePath
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"