{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
module Distribution.Simple.BuildTarget (
readTargetInfos,
readBuildTargets,
BuildTarget(..),
showBuildTarget,
QualLevel(..),
buildTargetComponentName,
UserBuildTarget,
readUserBuildTargets,
showUserBuildTarget,
UserBuildTargetProblem(..),
reportUserBuildTargetProblems,
resolveBuildTargets,
BuildTargetProblem(..),
reportBuildTargetProblems,
) where
import Prelude ()
import Distribution.Compat.Prelude
import Distribution.Types.TargetInfo
import Distribution.Types.LocalBuildInfo
import Distribution.Types.ComponentRequestedSpec
import Distribution.Types.ForeignLib
import Distribution.Types.UnqualComponentName
import Distribution.Package
import Distribution.PackageDescription
import Distribution.ModuleName
import Distribution.Simple.LocalBuildInfo
import Distribution.Pretty
import Distribution.Parsec
import Distribution.Simple.Utils
import Distribution.Verbosity
import Distribution.Utils.Path
import qualified Distribution.Compat.CharParsing as P
import Control.Monad ( msum )
import Data.List ( stripPrefix, groupBy )
import qualified Data.List.NonEmpty as NE
import System.FilePath as FilePath
( dropExtension, normalise, splitDirectories, joinPath, splitPath
, hasTrailingPathSeparator )
import System.Directory ( doesFileExist, doesDirectoryExist )
import qualified Data.Map as Map
readTargetInfos :: Verbosity -> PackageDescription -> LocalBuildInfo -> [String] -> IO [TargetInfo]
readTargetInfos :: Verbosity
-> PackageDescription
-> LocalBuildInfo
-> [FilePath]
-> IO [TargetInfo]
readTargetInfos Verbosity
verbosity PackageDescription
pkg_descr LocalBuildInfo
lbi [FilePath]
args = do
[BuildTarget]
build_targets <- Verbosity -> PackageDescription -> [FilePath] -> IO [BuildTarget]
readBuildTargets Verbosity
verbosity PackageDescription
pkg_descr [FilePath]
args
Verbosity
-> PackageDescription
-> LocalBuildInfo
-> [BuildTarget]
-> IO [TargetInfo]
checkBuildTargets Verbosity
verbosity PackageDescription
pkg_descr LocalBuildInfo
lbi [BuildTarget]
build_targets
data UserBuildTarget =
UserBuildTargetSingle String
| UserBuildTargetDouble String String
| UserBuildTargetTriple String String String
deriving (Int -> UserBuildTarget -> ShowS
[UserBuildTarget] -> ShowS
UserBuildTarget -> FilePath
(Int -> UserBuildTarget -> ShowS)
-> (UserBuildTarget -> FilePath)
-> ([UserBuildTarget] -> ShowS)
-> Show UserBuildTarget
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [UserBuildTarget] -> ShowS
$cshowList :: [UserBuildTarget] -> ShowS
show :: UserBuildTarget -> FilePath
$cshow :: UserBuildTarget -> FilePath
showsPrec :: Int -> UserBuildTarget -> ShowS
$cshowsPrec :: Int -> UserBuildTarget -> ShowS
Show, UserBuildTarget -> UserBuildTarget -> Bool
(UserBuildTarget -> UserBuildTarget -> Bool)
-> (UserBuildTarget -> UserBuildTarget -> Bool)
-> Eq UserBuildTarget
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserBuildTarget -> UserBuildTarget -> Bool
$c/= :: UserBuildTarget -> UserBuildTarget -> Bool
== :: UserBuildTarget -> UserBuildTarget -> Bool
$c== :: UserBuildTarget -> UserBuildTarget -> Bool
Eq, Eq UserBuildTarget
Eq UserBuildTarget
-> (UserBuildTarget -> UserBuildTarget -> Ordering)
-> (UserBuildTarget -> UserBuildTarget -> Bool)
-> (UserBuildTarget -> UserBuildTarget -> Bool)
-> (UserBuildTarget -> UserBuildTarget -> Bool)
-> (UserBuildTarget -> UserBuildTarget -> Bool)
-> (UserBuildTarget -> UserBuildTarget -> UserBuildTarget)
-> (UserBuildTarget -> UserBuildTarget -> UserBuildTarget)
-> Ord UserBuildTarget
UserBuildTarget -> UserBuildTarget -> Bool
UserBuildTarget -> UserBuildTarget -> Ordering
UserBuildTarget -> UserBuildTarget -> UserBuildTarget
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
min :: UserBuildTarget -> UserBuildTarget -> UserBuildTarget
$cmin :: UserBuildTarget -> UserBuildTarget -> UserBuildTarget
max :: UserBuildTarget -> UserBuildTarget -> UserBuildTarget
$cmax :: UserBuildTarget -> UserBuildTarget -> UserBuildTarget
>= :: UserBuildTarget -> UserBuildTarget -> Bool
$c>= :: UserBuildTarget -> UserBuildTarget -> Bool
> :: UserBuildTarget -> UserBuildTarget -> Bool
$c> :: UserBuildTarget -> UserBuildTarget -> Bool
<= :: UserBuildTarget -> UserBuildTarget -> Bool
$c<= :: UserBuildTarget -> UserBuildTarget -> Bool
< :: UserBuildTarget -> UserBuildTarget -> Bool
$c< :: UserBuildTarget -> UserBuildTarget -> Bool
compare :: UserBuildTarget -> UserBuildTarget -> Ordering
$ccompare :: UserBuildTarget -> UserBuildTarget -> Ordering
Ord)
data BuildTarget =
BuildTargetComponent ComponentName
| BuildTargetModule ComponentName ModuleName
| BuildTargetFile ComponentName FilePath
deriving (BuildTarget -> BuildTarget -> Bool
(BuildTarget -> BuildTarget -> Bool)
-> (BuildTarget -> BuildTarget -> Bool) -> Eq BuildTarget
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BuildTarget -> BuildTarget -> Bool
$c/= :: BuildTarget -> BuildTarget -> Bool
== :: BuildTarget -> BuildTarget -> Bool
$c== :: BuildTarget -> BuildTarget -> Bool
Eq, Int -> BuildTarget -> ShowS
[BuildTarget] -> ShowS
BuildTarget -> FilePath
(Int -> BuildTarget -> ShowS)
-> (BuildTarget -> FilePath)
-> ([BuildTarget] -> ShowS)
-> Show BuildTarget
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [BuildTarget] -> ShowS
$cshowList :: [BuildTarget] -> ShowS
show :: BuildTarget -> FilePath
$cshow :: BuildTarget -> FilePath
showsPrec :: Int -> BuildTarget -> ShowS
$cshowsPrec :: Int -> BuildTarget -> ShowS
Show, (forall x. BuildTarget -> Rep BuildTarget x)
-> (forall x. Rep BuildTarget x -> BuildTarget)
-> Generic BuildTarget
forall x. Rep BuildTarget x -> BuildTarget
forall x. BuildTarget -> Rep BuildTarget x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BuildTarget x -> BuildTarget
$cfrom :: forall x. BuildTarget -> Rep BuildTarget x
Generic)
instance Binary BuildTarget
buildTargetComponentName :: BuildTarget -> ComponentName
buildTargetComponentName :: BuildTarget -> ComponentName
buildTargetComponentName (BuildTargetComponent ComponentName
cn) = ComponentName
cn
buildTargetComponentName (BuildTargetModule ComponentName
cn ModuleName
_) = ComponentName
cn
buildTargetComponentName (BuildTargetFile ComponentName
cn FilePath
_) = ComponentName
cn
readBuildTargets :: Verbosity -> PackageDescription -> [String] -> IO [BuildTarget]
readBuildTargets :: Verbosity -> PackageDescription -> [FilePath] -> IO [BuildTarget]
readBuildTargets Verbosity
verbosity PackageDescription
pkg [FilePath]
targetStrs = do
let ([UserBuildTargetProblem]
uproblems, [UserBuildTarget]
utargets) = [FilePath] -> ([UserBuildTargetProblem], [UserBuildTarget])
readUserBuildTargets [FilePath]
targetStrs
Verbosity -> [UserBuildTargetProblem] -> IO ()
reportUserBuildTargetProblems Verbosity
verbosity [UserBuildTargetProblem]
uproblems
[(UserBuildTarget, Bool)]
utargets' <- (UserBuildTarget -> IO (UserBuildTarget, Bool))
-> [UserBuildTarget] -> IO [(UserBuildTarget, Bool)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse UserBuildTarget -> IO (UserBuildTarget, Bool)
checkTargetExistsAsFile [UserBuildTarget]
utargets
let ([BuildTargetProblem]
bproblems, [BuildTarget]
btargets) = PackageDescription
-> [(UserBuildTarget, Bool)]
-> ([BuildTargetProblem], [BuildTarget])
resolveBuildTargets PackageDescription
pkg [(UserBuildTarget, Bool)]
utargets'
Verbosity -> [BuildTargetProblem] -> IO ()
reportBuildTargetProblems Verbosity
verbosity [BuildTargetProblem]
bproblems
[BuildTarget] -> IO [BuildTarget]
forall (m :: * -> *) a. Monad m => a -> m a
return [BuildTarget]
btargets
checkTargetExistsAsFile :: UserBuildTarget -> IO (UserBuildTarget, Bool)
checkTargetExistsAsFile :: UserBuildTarget -> IO (UserBuildTarget, Bool)
checkTargetExistsAsFile UserBuildTarget
t = do
Bool
fexists <- FilePath -> IO Bool
existsAsFile (UserBuildTarget -> FilePath
fileComponentOfTarget UserBuildTarget
t)
(UserBuildTarget, Bool) -> IO (UserBuildTarget, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (UserBuildTarget
t, Bool
fexists)
where
existsAsFile :: FilePath -> IO Bool
existsAsFile FilePath
f = do
Bool
exists <- FilePath -> IO Bool
doesFileExist FilePath
f
case FilePath -> [FilePath]
splitPath FilePath
f of
(FilePath
d:[FilePath]
_) | FilePath -> Bool
hasTrailingPathSeparator FilePath
d -> FilePath -> IO Bool
doesDirectoryExist FilePath
d
(FilePath
d:FilePath
_:[FilePath]
_) | Bool -> Bool
not Bool
exists -> FilePath -> IO Bool
doesDirectoryExist FilePath
d
[FilePath]
_ -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
exists
fileComponentOfTarget :: UserBuildTarget -> FilePath
fileComponentOfTarget (UserBuildTargetSingle FilePath
s1) = FilePath
s1
fileComponentOfTarget (UserBuildTargetDouble FilePath
_ FilePath
s2) = FilePath
s2
fileComponentOfTarget (UserBuildTargetTriple FilePath
_ FilePath
_ FilePath
s3) = FilePath
s3
readUserBuildTargets :: [String] -> ([UserBuildTargetProblem]
,[UserBuildTarget])
readUserBuildTargets :: [FilePath] -> ([UserBuildTargetProblem], [UserBuildTarget])
readUserBuildTargets = [Either UserBuildTargetProblem UserBuildTarget]
-> ([UserBuildTargetProblem], [UserBuildTarget])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either UserBuildTargetProblem UserBuildTarget]
-> ([UserBuildTargetProblem], [UserBuildTarget]))
-> ([FilePath] -> [Either UserBuildTargetProblem UserBuildTarget])
-> [FilePath]
-> ([UserBuildTargetProblem], [UserBuildTarget])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Either UserBuildTargetProblem UserBuildTarget)
-> [FilePath] -> [Either UserBuildTargetProblem UserBuildTarget]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Either UserBuildTargetProblem UserBuildTarget
readUserBuildTarget
readUserBuildTarget :: String -> Either UserBuildTargetProblem
UserBuildTarget
readUserBuildTarget :: FilePath -> Either UserBuildTargetProblem UserBuildTarget
readUserBuildTarget FilePath
targetstr =
case ParsecParser UserBuildTarget
-> FilePath -> Either FilePath UserBuildTarget
forall a. ParsecParser a -> FilePath -> Either FilePath a
explicitEitherParsec ParsecParser UserBuildTarget
forall (m :: * -> *). CabalParsing m => m UserBuildTarget
parseTargetApprox FilePath
targetstr of
Left FilePath
_ -> UserBuildTargetProblem
-> Either UserBuildTargetProblem UserBuildTarget
forall a b. a -> Either a b
Left (FilePath -> UserBuildTargetProblem
UserBuildTargetUnrecognised FilePath
targetstr)
Right UserBuildTarget
tgt -> UserBuildTarget -> Either UserBuildTargetProblem UserBuildTarget
forall a b. b -> Either a b
Right UserBuildTarget
tgt
where
parseTargetApprox :: CabalParsing m => m UserBuildTarget
parseTargetApprox :: forall (m :: * -> *). CabalParsing m => m UserBuildTarget
parseTargetApprox = do
(FilePath, Maybe (FilePath, Maybe FilePath))
ts <- m (FilePath, Maybe (FilePath, Maybe FilePath))
forall (m :: * -> *).
CabalParsing m =>
m (FilePath, Maybe (FilePath, Maybe FilePath))
tokens
UserBuildTarget -> m UserBuildTarget
forall (m :: * -> *) a. Monad m => a -> m a
return (UserBuildTarget -> m UserBuildTarget)
-> UserBuildTarget -> m UserBuildTarget
forall a b. (a -> b) -> a -> b
$ case (FilePath, Maybe (FilePath, Maybe FilePath))
ts of
(FilePath
a, Maybe (FilePath, Maybe FilePath)
Nothing) -> FilePath -> UserBuildTarget
UserBuildTargetSingle FilePath
a
(FilePath
a, Just (FilePath
b, Maybe FilePath
Nothing)) -> FilePath -> FilePath -> UserBuildTarget
UserBuildTargetDouble FilePath
a FilePath
b
(FilePath
a, Just (FilePath
b, Just FilePath
c)) -> FilePath -> FilePath -> FilePath -> UserBuildTarget
UserBuildTargetTriple FilePath
a FilePath
b FilePath
c
tokens :: CabalParsing m => m (String, Maybe (String, Maybe String))
tokens :: forall (m :: * -> *).
CabalParsing m =>
m (FilePath, Maybe (FilePath, Maybe FilePath))
tokens = (\FilePath
s -> (FilePath
s, Maybe (FilePath, Maybe FilePath)
forall a. Maybe a
Nothing)) (FilePath -> (FilePath, Maybe (FilePath, Maybe FilePath)))
-> m FilePath -> m (FilePath, Maybe (FilePath, Maybe FilePath))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m FilePath
forall (m :: * -> *). CabalParsing m => m FilePath
parsecHaskellString
m (FilePath, Maybe (FilePath, Maybe FilePath))
-> m (FilePath, Maybe (FilePath, Maybe FilePath))
-> m (FilePath, Maybe (FilePath, Maybe FilePath))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (,) (FilePath
-> Maybe (FilePath, Maybe FilePath)
-> (FilePath, Maybe (FilePath, Maybe FilePath)))
-> m FilePath
-> m (Maybe (FilePath, Maybe FilePath)
-> (FilePath, Maybe (FilePath, Maybe FilePath)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m FilePath
forall (m :: * -> *). CabalParsing m => m FilePath
token m (Maybe (FilePath, Maybe FilePath)
-> (FilePath, Maybe (FilePath, Maybe FilePath)))
-> m (Maybe (FilePath, Maybe FilePath))
-> m (FilePath, Maybe (FilePath, Maybe FilePath))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m (FilePath, Maybe FilePath)
-> m (Maybe (FilePath, Maybe FilePath))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
':' m Char
-> m (FilePath, Maybe FilePath) -> m (FilePath, Maybe FilePath)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m (FilePath, Maybe FilePath)
forall (m :: * -> *).
CabalParsing m =>
m (FilePath, Maybe FilePath)
tokens2)
tokens2 :: CabalParsing m => m (String, Maybe String)
tokens2 :: forall (m :: * -> *).
CabalParsing m =>
m (FilePath, Maybe FilePath)
tokens2 = (\FilePath
s -> (FilePath
s, Maybe FilePath
forall a. Maybe a
Nothing)) (FilePath -> (FilePath, Maybe FilePath))
-> m FilePath -> m (FilePath, Maybe FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m FilePath
forall (m :: * -> *). CabalParsing m => m FilePath
parsecHaskellString
m (FilePath, Maybe FilePath)
-> m (FilePath, Maybe FilePath) -> m (FilePath, Maybe FilePath)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (,) (FilePath -> Maybe FilePath -> (FilePath, Maybe FilePath))
-> m FilePath -> m (Maybe FilePath -> (FilePath, Maybe FilePath))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m FilePath
forall (m :: * -> *). CabalParsing m => m FilePath
token m (Maybe FilePath -> (FilePath, Maybe FilePath))
-> m (Maybe FilePath) -> m (FilePath, Maybe FilePath)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m FilePath -> m (Maybe FilePath)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
':' m Char -> m FilePath -> m FilePath
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (m FilePath
forall (m :: * -> *). CabalParsing m => m FilePath
parsecHaskellString m FilePath -> m FilePath -> m FilePath
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m FilePath
forall (m :: * -> *). CabalParsing m => m FilePath
token))
token :: CabalParsing m => m String
token :: forall (m :: * -> *). CabalParsing m => m FilePath
token = (Char -> Bool) -> m FilePath
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m FilePath
P.munch1 (\Char
x -> Bool -> Bool
not (Char -> Bool
isSpace Char
x) Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
':')
data UserBuildTargetProblem
= UserBuildTargetUnrecognised String
deriving Int -> UserBuildTargetProblem -> ShowS
[UserBuildTargetProblem] -> ShowS
UserBuildTargetProblem -> FilePath
(Int -> UserBuildTargetProblem -> ShowS)
-> (UserBuildTargetProblem -> FilePath)
-> ([UserBuildTargetProblem] -> ShowS)
-> Show UserBuildTargetProblem
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [UserBuildTargetProblem] -> ShowS
$cshowList :: [UserBuildTargetProblem] -> ShowS
show :: UserBuildTargetProblem -> FilePath
$cshow :: UserBuildTargetProblem -> FilePath
showsPrec :: Int -> UserBuildTargetProblem -> ShowS
$cshowsPrec :: Int -> UserBuildTargetProblem -> ShowS
Show
reportUserBuildTargetProblems :: Verbosity -> [UserBuildTargetProblem] -> IO ()
reportUserBuildTargetProblems :: Verbosity -> [UserBuildTargetProblem] -> IO ()
reportUserBuildTargetProblems Verbosity
verbosity [UserBuildTargetProblem]
problems = do
case [ FilePath
target | UserBuildTargetUnrecognised FilePath
target <- [UserBuildTargetProblem]
problems ] of
[] -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
[FilePath]
target ->
Verbosity -> FilePath -> IO ()
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unlines
[ FilePath
"Unrecognised build target '" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
name FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"'."
| FilePath
name <- [FilePath]
target ]
FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"Examples:\n"
FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" - build foo -- component name "
FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"(library, executable, test-suite or benchmark)\n"
FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" - build Data.Foo -- module name\n"
FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" - build Data/Foo.hsc -- file name\n"
FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" - build lib:foo exe:foo -- component qualified by kind\n"
FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" - build foo:Data.Foo -- module qualified by component\n"
FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" - build foo:Data/Foo.hsc -- file qualified by component"
showUserBuildTarget :: UserBuildTarget -> String
showUserBuildTarget :: UserBuildTarget -> FilePath
showUserBuildTarget = FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
":" ([FilePath] -> FilePath)
-> (UserBuildTarget -> [FilePath]) -> UserBuildTarget -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserBuildTarget -> [FilePath]
getComponents
where
getComponents :: UserBuildTarget -> [FilePath]
getComponents (UserBuildTargetSingle FilePath
s1) = [FilePath
s1]
getComponents (UserBuildTargetDouble FilePath
s1 FilePath
s2) = [FilePath
s1,FilePath
s2]
getComponents (UserBuildTargetTriple FilePath
s1 FilePath
s2 FilePath
s3) = [FilePath
s1,FilePath
s2,FilePath
s3]
showBuildTarget' :: QualLevel -> PackageId -> BuildTarget -> String
showBuildTarget' :: QualLevel -> PackageId -> BuildTarget -> FilePath
showBuildTarget' QualLevel
ql PackageId
pkgid BuildTarget
bt =
UserBuildTarget -> FilePath
showUserBuildTarget (QualLevel -> BuildTarget -> PackageId -> UserBuildTarget
renderBuildTarget QualLevel
ql BuildTarget
bt PackageId
pkgid)
showBuildTarget :: PackageId -> BuildTarget -> String
showBuildTarget :: PackageId -> BuildTarget -> FilePath
showBuildTarget PackageId
pkgid BuildTarget
t =
QualLevel -> PackageId -> BuildTarget -> FilePath
showBuildTarget' (BuildTarget -> QualLevel
qlBuildTarget BuildTarget
t) PackageId
pkgid BuildTarget
t
where
qlBuildTarget :: BuildTarget -> QualLevel
qlBuildTarget BuildTargetComponent{} = QualLevel
QL2
qlBuildTarget BuildTarget
_ = QualLevel
QL3
resolveBuildTargets :: PackageDescription
-> [(UserBuildTarget, Bool)]
-> ([BuildTargetProblem], [BuildTarget])
resolveBuildTargets :: PackageDescription
-> [(UserBuildTarget, Bool)]
-> ([BuildTargetProblem], [BuildTarget])
resolveBuildTargets PackageDescription
pkg = [Either BuildTargetProblem BuildTarget]
-> ([BuildTargetProblem], [BuildTarget])
forall a b. [Either a b] -> ([a], [b])
partitionEithers
([Either BuildTargetProblem BuildTarget]
-> ([BuildTargetProblem], [BuildTarget]))
-> ([(UserBuildTarget, Bool)]
-> [Either BuildTargetProblem BuildTarget])
-> [(UserBuildTarget, Bool)]
-> ([BuildTargetProblem], [BuildTarget])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((UserBuildTarget, Bool) -> Either BuildTargetProblem BuildTarget)
-> [(UserBuildTarget, Bool)]
-> [Either BuildTargetProblem BuildTarget]
forall a b. (a -> b) -> [a] -> [b]
map ((UserBuildTarget -> Bool -> Either BuildTargetProblem BuildTarget)
-> (UserBuildTarget, Bool) -> Either BuildTargetProblem BuildTarget
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (PackageDescription
-> UserBuildTarget -> Bool -> Either BuildTargetProblem BuildTarget
resolveBuildTarget PackageDescription
pkg))
resolveBuildTarget :: PackageDescription -> UserBuildTarget -> Bool
-> Either BuildTargetProblem BuildTarget
resolveBuildTarget :: PackageDescription
-> UserBuildTarget -> Bool -> Either BuildTargetProblem BuildTarget
resolveBuildTarget PackageDescription
pkg UserBuildTarget
userTarget Bool
fexists =
case Match BuildTarget -> MaybeAmbiguous BuildTarget
forall b. Eq b => Match b -> MaybeAmbiguous b
findMatch (PackageDescription -> UserBuildTarget -> Bool -> Match BuildTarget
matchBuildTarget PackageDescription
pkg UserBuildTarget
userTarget Bool
fexists) of
Unambiguous BuildTarget
target -> BuildTarget -> Either BuildTargetProblem BuildTarget
forall a b. b -> Either a b
Right BuildTarget
target
Ambiguous [BuildTarget]
targets -> BuildTargetProblem -> Either BuildTargetProblem BuildTarget
forall a b. a -> Either a b
Left (UserBuildTarget
-> [(UserBuildTarget, BuildTarget)] -> BuildTargetProblem
BuildTargetAmbiguous UserBuildTarget
userTarget [(UserBuildTarget, BuildTarget)]
targets')
where targets' :: [(UserBuildTarget, BuildTarget)]
targets' = PackageId
-> UserBuildTarget
-> [BuildTarget]
-> [(UserBuildTarget, BuildTarget)]
disambiguateBuildTargets
(PackageDescription -> PackageId
forall pkg. Package pkg => pkg -> PackageId
packageId PackageDescription
pkg)
UserBuildTarget
userTarget
[BuildTarget]
targets
None [MatchError]
errs -> BuildTargetProblem -> Either BuildTargetProblem BuildTarget
forall a b. a -> Either a b
Left ([MatchError] -> BuildTargetProblem
classifyMatchErrors [MatchError]
errs)
where
classifyMatchErrors :: [MatchError] -> BuildTargetProblem
classifyMatchErrors [MatchError]
errs
| Just NonEmpty (FilePath, FilePath)
expected' <- [(FilePath, FilePath)] -> Maybe (NonEmpty (FilePath, FilePath))
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [(FilePath, FilePath)]
expected
= let (NonEmpty FilePath
things, FilePath
got:|[FilePath]
_) = NonEmpty (FilePath, FilePath)
-> (NonEmpty FilePath, NonEmpty FilePath)
forall (f :: * -> *) a b. Functor f => f (a, b) -> (f a, f b)
NE.unzip NonEmpty (FilePath, FilePath)
expected' in
UserBuildTarget -> [FilePath] -> FilePath -> BuildTargetProblem
BuildTargetExpected UserBuildTarget
userTarget (NonEmpty FilePath -> [FilePath]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty FilePath
things) FilePath
got
| Bool -> Bool
not ([(FilePath, FilePath)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(FilePath, FilePath)]
nosuch) = UserBuildTarget -> [(FilePath, FilePath)] -> BuildTargetProblem
BuildTargetNoSuch UserBuildTarget
userTarget [(FilePath, FilePath)]
nosuch
| Bool
otherwise = FilePath -> BuildTargetProblem
forall a. HasCallStack => FilePath -> a
error (FilePath -> BuildTargetProblem) -> FilePath -> BuildTargetProblem
forall a b. (a -> b) -> a -> b
$ FilePath
"resolveBuildTarget: internal error in matching"
where
expected :: [(FilePath, FilePath)]
expected = [ (FilePath
thing, FilePath
got) | MatchErrorExpected FilePath
thing FilePath
got <- [MatchError]
errs ]
nosuch :: [(FilePath, FilePath)]
nosuch = [ (FilePath
thing, FilePath
got) | MatchErrorNoSuch FilePath
thing FilePath
got <- [MatchError]
errs ]
data BuildTargetProblem
= BuildTargetExpected UserBuildTarget [String] String
| BuildTargetNoSuch UserBuildTarget [(String, String)]
| BuildTargetAmbiguous UserBuildTarget [(UserBuildTarget, BuildTarget)]
deriving Int -> BuildTargetProblem -> ShowS
[BuildTargetProblem] -> ShowS
BuildTargetProblem -> FilePath
(Int -> BuildTargetProblem -> ShowS)
-> (BuildTargetProblem -> FilePath)
-> ([BuildTargetProblem] -> ShowS)
-> Show BuildTargetProblem
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [BuildTargetProblem] -> ShowS
$cshowList :: [BuildTargetProblem] -> ShowS
show :: BuildTargetProblem -> FilePath
$cshow :: BuildTargetProblem -> FilePath
showsPrec :: Int -> BuildTargetProblem -> ShowS
$cshowsPrec :: Int -> BuildTargetProblem -> ShowS
Show
disambiguateBuildTargets :: PackageId -> UserBuildTarget -> [BuildTarget]
-> [(UserBuildTarget, BuildTarget)]
disambiguateBuildTargets :: PackageId
-> UserBuildTarget
-> [BuildTarget]
-> [(UserBuildTarget, BuildTarget)]
disambiguateBuildTargets PackageId
pkgid UserBuildTarget
original =
QualLevel -> [BuildTarget] -> [(UserBuildTarget, BuildTarget)]
disambiguate (UserBuildTarget -> QualLevel
userTargetQualLevel UserBuildTarget
original)
where
disambiguate :: QualLevel -> [BuildTarget] -> [(UserBuildTarget, BuildTarget)]
disambiguate QualLevel
ql [BuildTarget]
ts
| [BuildTarget] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [BuildTarget]
amb = [(UserBuildTarget, BuildTarget)]
unamb
| Bool
otherwise = [(UserBuildTarget, BuildTarget)]
unamb [(UserBuildTarget, BuildTarget)]
-> [(UserBuildTarget, BuildTarget)]
-> [(UserBuildTarget, BuildTarget)]
forall a. [a] -> [a] -> [a]
++ QualLevel -> [BuildTarget] -> [(UserBuildTarget, BuildTarget)]
disambiguate (QualLevel -> QualLevel
forall a. Enum a => a -> a
succ QualLevel
ql) [BuildTarget]
amb
where
([BuildTarget]
amb, [(UserBuildTarget, BuildTarget)]
unamb) = QualLevel
-> [BuildTarget]
-> ([BuildTarget], [(UserBuildTarget, BuildTarget)])
step QualLevel
ql [BuildTarget]
ts
userTargetQualLevel :: UserBuildTarget -> QualLevel
userTargetQualLevel (UserBuildTargetSingle FilePath
_ ) = QualLevel
QL1
userTargetQualLevel (UserBuildTargetDouble FilePath
_ FilePath
_ ) = QualLevel
QL2
userTargetQualLevel (UserBuildTargetTriple FilePath
_ FilePath
_ FilePath
_) = QualLevel
QL3
step :: QualLevel -> [BuildTarget]
-> ([BuildTarget], [(UserBuildTarget, BuildTarget)])
step :: QualLevel
-> [BuildTarget]
-> ([BuildTarget], [(UserBuildTarget, BuildTarget)])
step QualLevel
ql = (\([[(UserBuildTarget, BuildTarget)]]
amb, [[(UserBuildTarget, BuildTarget)]]
unamb) -> (((UserBuildTarget, BuildTarget) -> BuildTarget)
-> [(UserBuildTarget, BuildTarget)] -> [BuildTarget]
forall a b. (a -> b) -> [a] -> [b]
map (UserBuildTarget, BuildTarget) -> BuildTarget
forall a b. (a, b) -> b
snd ([(UserBuildTarget, BuildTarget)] -> [BuildTarget])
-> [(UserBuildTarget, BuildTarget)] -> [BuildTarget]
forall a b. (a -> b) -> a -> b
$ [[(UserBuildTarget, BuildTarget)]]
-> [(UserBuildTarget, BuildTarget)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(UserBuildTarget, BuildTarget)]]
amb, [[(UserBuildTarget, BuildTarget)]]
-> [(UserBuildTarget, BuildTarget)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(UserBuildTarget, BuildTarget)]]
unamb))
(([[(UserBuildTarget, BuildTarget)]],
[[(UserBuildTarget, BuildTarget)]])
-> ([BuildTarget], [(UserBuildTarget, BuildTarget)]))
-> ([BuildTarget]
-> ([[(UserBuildTarget, BuildTarget)]],
[[(UserBuildTarget, BuildTarget)]]))
-> [BuildTarget]
-> ([BuildTarget], [(UserBuildTarget, BuildTarget)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(UserBuildTarget, BuildTarget)] -> Bool)
-> [[(UserBuildTarget, BuildTarget)]]
-> ([[(UserBuildTarget, BuildTarget)]],
[[(UserBuildTarget, BuildTarget)]])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (\[(UserBuildTarget, BuildTarget)]
g -> [(UserBuildTarget, BuildTarget)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(UserBuildTarget, BuildTarget)]
g Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1)
([[(UserBuildTarget, BuildTarget)]]
-> ([[(UserBuildTarget, BuildTarget)]],
[[(UserBuildTarget, BuildTarget)]]))
-> ([BuildTarget] -> [[(UserBuildTarget, BuildTarget)]])
-> [BuildTarget]
-> ([[(UserBuildTarget, BuildTarget)]],
[[(UserBuildTarget, BuildTarget)]])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((UserBuildTarget, BuildTarget)
-> (UserBuildTarget, BuildTarget) -> Bool)
-> [(UserBuildTarget, BuildTarget)]
-> [[(UserBuildTarget, BuildTarget)]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (((UserBuildTarget, BuildTarget) -> UserBuildTarget)
-> (UserBuildTarget, BuildTarget)
-> (UserBuildTarget, BuildTarget)
-> Bool
forall a b. Eq a => (b -> a) -> b -> b -> Bool
equating (UserBuildTarget, BuildTarget) -> UserBuildTarget
forall a b. (a, b) -> a
fst)
([(UserBuildTarget, BuildTarget)]
-> [[(UserBuildTarget, BuildTarget)]])
-> ([BuildTarget] -> [(UserBuildTarget, BuildTarget)])
-> [BuildTarget]
-> [[(UserBuildTarget, BuildTarget)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((UserBuildTarget, BuildTarget)
-> (UserBuildTarget, BuildTarget) -> Ordering)
-> [(UserBuildTarget, BuildTarget)]
-> [(UserBuildTarget, BuildTarget)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((UserBuildTarget, BuildTarget) -> UserBuildTarget)
-> (UserBuildTarget, BuildTarget)
-> (UserBuildTarget, BuildTarget)
-> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (UserBuildTarget, BuildTarget) -> UserBuildTarget
forall a b. (a, b) -> a
fst)
([(UserBuildTarget, BuildTarget)]
-> [(UserBuildTarget, BuildTarget)])
-> ([BuildTarget] -> [(UserBuildTarget, BuildTarget)])
-> [BuildTarget]
-> [(UserBuildTarget, BuildTarget)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BuildTarget -> (UserBuildTarget, BuildTarget))
-> [BuildTarget] -> [(UserBuildTarget, BuildTarget)]
forall a b. (a -> b) -> [a] -> [b]
map (\BuildTarget
t -> (QualLevel -> BuildTarget -> PackageId -> UserBuildTarget
renderBuildTarget QualLevel
ql BuildTarget
t PackageId
pkgid, BuildTarget
t))
data QualLevel = QL1 | QL2 | QL3
deriving (Int -> QualLevel
QualLevel -> Int
QualLevel -> [QualLevel]
QualLevel -> QualLevel
QualLevel -> QualLevel -> [QualLevel]
QualLevel -> QualLevel -> QualLevel -> [QualLevel]
(QualLevel -> QualLevel)
-> (QualLevel -> QualLevel)
-> (Int -> QualLevel)
-> (QualLevel -> Int)
-> (QualLevel -> [QualLevel])
-> (QualLevel -> QualLevel -> [QualLevel])
-> (QualLevel -> QualLevel -> [QualLevel])
-> (QualLevel -> QualLevel -> QualLevel -> [QualLevel])
-> Enum QualLevel
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: QualLevel -> QualLevel -> QualLevel -> [QualLevel]
$cenumFromThenTo :: QualLevel -> QualLevel -> QualLevel -> [QualLevel]
enumFromTo :: QualLevel -> QualLevel -> [QualLevel]
$cenumFromTo :: QualLevel -> QualLevel -> [QualLevel]
enumFromThen :: QualLevel -> QualLevel -> [QualLevel]
$cenumFromThen :: QualLevel -> QualLevel -> [QualLevel]
enumFrom :: QualLevel -> [QualLevel]
$cenumFrom :: QualLevel -> [QualLevel]
fromEnum :: QualLevel -> Int
$cfromEnum :: QualLevel -> Int
toEnum :: Int -> QualLevel
$ctoEnum :: Int -> QualLevel
pred :: QualLevel -> QualLevel
$cpred :: QualLevel -> QualLevel
succ :: QualLevel -> QualLevel
$csucc :: QualLevel -> QualLevel
Enum, Int -> QualLevel -> ShowS
[QualLevel] -> ShowS
QualLevel -> FilePath
(Int -> QualLevel -> ShowS)
-> (QualLevel -> FilePath)
-> ([QualLevel] -> ShowS)
-> Show QualLevel
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [QualLevel] -> ShowS
$cshowList :: [QualLevel] -> ShowS
show :: QualLevel -> FilePath
$cshow :: QualLevel -> FilePath
showsPrec :: Int -> QualLevel -> ShowS
$cshowsPrec :: Int -> QualLevel -> ShowS
Show)
renderBuildTarget :: QualLevel -> BuildTarget -> PackageId -> UserBuildTarget
renderBuildTarget :: QualLevel -> BuildTarget -> PackageId -> UserBuildTarget
renderBuildTarget QualLevel
ql BuildTarget
target PackageId
pkgid =
case QualLevel
ql of
QualLevel
QL1 -> FilePath -> UserBuildTarget
UserBuildTargetSingle FilePath
s1 where s1 :: FilePath
s1 = BuildTarget -> FilePath
single BuildTarget
target
QualLevel
QL2 -> FilePath -> FilePath -> UserBuildTarget
UserBuildTargetDouble FilePath
s1 FilePath
s2 where (FilePath
s1, FilePath
s2) = BuildTarget -> (FilePath, FilePath)
double BuildTarget
target
QualLevel
QL3 -> FilePath -> FilePath -> FilePath -> UserBuildTarget
UserBuildTargetTriple FilePath
s1 FilePath
s2 FilePath
s3 where (FilePath
s1, FilePath
s2, FilePath
s3) = BuildTarget -> (FilePath, FilePath, FilePath)
triple BuildTarget
target
where
single :: BuildTarget -> FilePath
single (BuildTargetComponent ComponentName
cn ) = ComponentName -> FilePath
dispCName ComponentName
cn
single (BuildTargetModule ComponentName
_ ModuleName
m) = ModuleName -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow ModuleName
m
single (BuildTargetFile ComponentName
_ FilePath
f) = FilePath
f
double :: BuildTarget -> (FilePath, FilePath)
double (BuildTargetComponent ComponentName
cn ) = (ComponentName -> FilePath
dispKind ComponentName
cn, ComponentName -> FilePath
dispCName ComponentName
cn)
double (BuildTargetModule ComponentName
cn ModuleName
m) = (ComponentName -> FilePath
dispCName ComponentName
cn, ModuleName -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow ModuleName
m)
double (BuildTargetFile ComponentName
cn FilePath
f) = (ComponentName -> FilePath
dispCName ComponentName
cn, FilePath
f)
triple :: BuildTarget -> (FilePath, FilePath, FilePath)
triple (BuildTargetComponent ComponentName
_ ) = FilePath -> (FilePath, FilePath, FilePath)
forall a. HasCallStack => FilePath -> a
error FilePath
"triple BuildTargetComponent"
triple (BuildTargetModule ComponentName
cn ModuleName
m) = (ComponentName -> FilePath
dispKind ComponentName
cn, ComponentName -> FilePath
dispCName ComponentName
cn, ModuleName -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow ModuleName
m)
triple (BuildTargetFile ComponentName
cn FilePath
f) = (ComponentName -> FilePath
dispKind ComponentName
cn, ComponentName -> FilePath
dispCName ComponentName
cn, FilePath
f)
dispCName :: ComponentName -> FilePath
dispCName = PackageId -> ComponentName -> FilePath
forall pkg. Package pkg => pkg -> ComponentName -> FilePath
componentStringName PackageId
pkgid
dispKind :: ComponentName -> FilePath
dispKind = ComponentKind -> FilePath
showComponentKindShort (ComponentKind -> FilePath)
-> (ComponentName -> ComponentKind) -> ComponentName -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ComponentName -> ComponentKind
componentKind
reportBuildTargetProblems :: Verbosity -> [BuildTargetProblem] -> IO ()
reportBuildTargetProblems :: Verbosity -> [BuildTargetProblem] -> IO ()
reportBuildTargetProblems Verbosity
verbosity [BuildTargetProblem]
problems = do
case [ (UserBuildTarget
t, [FilePath]
e, FilePath
g) | BuildTargetExpected UserBuildTarget
t [FilePath]
e FilePath
g <- [BuildTargetProblem]
problems ] of
[] -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
[(UserBuildTarget, [FilePath], FilePath)]
targets ->
Verbosity -> FilePath -> IO ()
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unlines
[ FilePath
"Unrecognised build target '" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ UserBuildTarget -> FilePath
showUserBuildTarget UserBuildTarget
target
FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"'.\n"
FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"Expected a " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
" or " [FilePath]
expected
FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
", rather than '" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
got FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"'."
| (UserBuildTarget
target, [FilePath]
expected, FilePath
got) <- [(UserBuildTarget, [FilePath], FilePath)]
targets ]
case [ (UserBuildTarget
t, [(FilePath, FilePath)]
e) | BuildTargetNoSuch UserBuildTarget
t [(FilePath, FilePath)]
e <- [BuildTargetProblem]
problems ] of
[] -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
[(UserBuildTarget, [(FilePath, FilePath)])]
targets ->
Verbosity -> FilePath -> IO ()
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unlines
[ FilePath
"Unknown build target '" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ UserBuildTarget -> FilePath
showUserBuildTarget UserBuildTarget
target
FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"'.\nThere is no "
FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
" or " [ ShowS
mungeThing FilePath
thing FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" '" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
got FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"'"
| (FilePath
thing, FilePath
got) <- [(FilePath, FilePath)]
nosuch ] FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"."
| (UserBuildTarget
target, [(FilePath, FilePath)]
nosuch) <- [(UserBuildTarget, [(FilePath, FilePath)])]
targets ]
where
mungeThing :: ShowS
mungeThing FilePath
"file" = FilePath
"file target"
mungeThing FilePath
thing = FilePath
thing
case [ (UserBuildTarget
t, [(UserBuildTarget, BuildTarget)]
ts) | BuildTargetAmbiguous UserBuildTarget
t [(UserBuildTarget, BuildTarget)]
ts <- [BuildTargetProblem]
problems ] of
[] -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
[(UserBuildTarget, [(UserBuildTarget, BuildTarget)])]
targets ->
Verbosity -> FilePath -> IO ()
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unlines
[ FilePath
"Ambiguous build target '" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ UserBuildTarget -> FilePath
showUserBuildTarget UserBuildTarget
target
FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"'. It could be:\n "
FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
unlines [ FilePath
" "FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ UserBuildTarget -> FilePath
showUserBuildTarget UserBuildTarget
ut FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++
FilePath
" (" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ BuildTarget -> FilePath
showBuildTargetKind BuildTarget
bt FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
")"
| (UserBuildTarget
ut, BuildTarget
bt) <- [(UserBuildTarget, BuildTarget)]
amb ]
| (UserBuildTarget
target, [(UserBuildTarget, BuildTarget)]
amb) <- [(UserBuildTarget, [(UserBuildTarget, BuildTarget)])]
targets ]
where
showBuildTargetKind :: BuildTarget -> FilePath
showBuildTargetKind (BuildTargetComponent ComponentName
_ ) = FilePath
"component"
showBuildTargetKind (BuildTargetModule ComponentName
_ ModuleName
_) = FilePath
"module"
showBuildTargetKind (BuildTargetFile ComponentName
_ FilePath
_) = FilePath
"file"
matchBuildTarget :: PackageDescription
-> UserBuildTarget -> Bool -> Match BuildTarget
matchBuildTarget :: PackageDescription -> UserBuildTarget -> Bool -> Match BuildTarget
matchBuildTarget PackageDescription
pkg = \UserBuildTarget
utarget Bool
fexists ->
case UserBuildTarget
utarget of
UserBuildTargetSingle FilePath
str1 ->
[ComponentInfo] -> FilePath -> Bool -> Match BuildTarget
matchBuildTarget1 [ComponentInfo]
cinfo FilePath
str1 Bool
fexists
UserBuildTargetDouble FilePath
str1 FilePath
str2 ->
[ComponentInfo]
-> FilePath -> FilePath -> Bool -> Match BuildTarget
matchBuildTarget2 [ComponentInfo]
cinfo FilePath
str1 FilePath
str2 Bool
fexists
UserBuildTargetTriple FilePath
str1 FilePath
str2 FilePath
str3 ->
[ComponentInfo]
-> FilePath -> FilePath -> FilePath -> Bool -> Match BuildTarget
matchBuildTarget3 [ComponentInfo]
cinfo FilePath
str1 FilePath
str2 FilePath
str3 Bool
fexists
where
cinfo :: [ComponentInfo]
cinfo = PackageDescription -> [ComponentInfo]
pkgComponentInfo PackageDescription
pkg
matchBuildTarget1 :: [ComponentInfo] -> String -> Bool -> Match BuildTarget
matchBuildTarget1 :: [ComponentInfo] -> FilePath -> Bool -> Match BuildTarget
matchBuildTarget1 [ComponentInfo]
cinfo FilePath
str1 Bool
fexists =
[ComponentInfo] -> FilePath -> Match BuildTarget
matchComponent1 [ComponentInfo]
cinfo FilePath
str1
Match BuildTarget -> Match BuildTarget -> Match BuildTarget
forall a. Match a -> Match a -> Match a
`matchPlusShadowing` [ComponentInfo] -> FilePath -> Match BuildTarget
matchModule1 [ComponentInfo]
cinfo FilePath
str1
Match BuildTarget -> Match BuildTarget -> Match BuildTarget
forall a. Match a -> Match a -> Match a
`matchPlusShadowing` [ComponentInfo] -> FilePath -> Bool -> Match BuildTarget
matchFile1 [ComponentInfo]
cinfo FilePath
str1 Bool
fexists
matchBuildTarget2 :: [ComponentInfo] -> String -> String -> Bool
-> Match BuildTarget
matchBuildTarget2 :: [ComponentInfo]
-> FilePath -> FilePath -> Bool -> Match BuildTarget
matchBuildTarget2 [ComponentInfo]
cinfo FilePath
str1 FilePath
str2 Bool
fexists =
[ComponentInfo] -> FilePath -> FilePath -> Match BuildTarget
matchComponent2 [ComponentInfo]
cinfo FilePath
str1 FilePath
str2
Match BuildTarget -> Match BuildTarget -> Match BuildTarget
forall a. Match a -> Match a -> Match a
`matchPlusShadowing` [ComponentInfo] -> FilePath -> FilePath -> Match BuildTarget
matchModule2 [ComponentInfo]
cinfo FilePath
str1 FilePath
str2
Match BuildTarget -> Match BuildTarget -> Match BuildTarget
forall a. Match a -> Match a -> Match a
`matchPlusShadowing` [ComponentInfo]
-> FilePath -> FilePath -> Bool -> Match BuildTarget
matchFile2 [ComponentInfo]
cinfo FilePath
str1 FilePath
str2 Bool
fexists
matchBuildTarget3 :: [ComponentInfo] -> String -> String -> String -> Bool
-> Match BuildTarget
matchBuildTarget3 :: [ComponentInfo]
-> FilePath -> FilePath -> FilePath -> Bool -> Match BuildTarget
matchBuildTarget3 [ComponentInfo]
cinfo FilePath
str1 FilePath
str2 FilePath
str3 Bool
fexists =
[ComponentInfo]
-> FilePath -> FilePath -> FilePath -> Match BuildTarget
matchModule3 [ComponentInfo]
cinfo FilePath
str1 FilePath
str2 FilePath
str3
Match BuildTarget -> Match BuildTarget -> Match BuildTarget
forall a. Match a -> Match a -> Match a
`matchPlusShadowing` [ComponentInfo]
-> FilePath -> FilePath -> FilePath -> Bool -> Match BuildTarget
matchFile3 [ComponentInfo]
cinfo FilePath
str1 FilePath
str2 FilePath
str3 Bool
fexists
data ComponentInfo = ComponentInfo {
ComponentInfo -> ComponentName
cinfoName :: ComponentName,
ComponentInfo -> FilePath
cinfoStrName :: ComponentStringName,
ComponentInfo -> [FilePath]
cinfoSrcDirs :: [FilePath],
ComponentInfo -> [ModuleName]
cinfoModules :: [ModuleName],
ComponentInfo -> [FilePath]
cinfoHsFiles :: [FilePath],
ComponentInfo -> [FilePath]
cinfoAsmFiles:: [FilePath],
ComponentInfo -> [FilePath]
cinfoCmmFiles:: [FilePath],
ComponentInfo -> [FilePath]
cinfoCFiles :: [FilePath],
ComponentInfo -> [FilePath]
cinfoCxxFiles:: [FilePath],
ComponentInfo -> [FilePath]
cinfoJsFiles :: [FilePath]
}
type ComponentStringName = String
pkgComponentInfo :: PackageDescription -> [ComponentInfo]
pkgComponentInfo :: PackageDescription -> [ComponentInfo]
pkgComponentInfo PackageDescription
pkg =
[ ComponentInfo {
cinfoName :: ComponentName
cinfoName = Component -> ComponentName
componentName Component
c,
cinfoStrName :: FilePath
cinfoStrName = PackageDescription -> ComponentName -> FilePath
forall pkg. Package pkg => pkg -> ComponentName -> FilePath
componentStringName PackageDescription
pkg (Component -> ComponentName
componentName Component
c),
cinfoSrcDirs :: [FilePath]
cinfoSrcDirs = (SymbolicPath PackageDir SourceDir -> FilePath)
-> [SymbolicPath PackageDir SourceDir] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map SymbolicPath PackageDir SourceDir -> FilePath
forall from to. SymbolicPath from to -> FilePath
getSymbolicPath ([SymbolicPath PackageDir SourceDir] -> [FilePath])
-> [SymbolicPath PackageDir SourceDir] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ BuildInfo -> [SymbolicPath PackageDir SourceDir]
hsSourceDirs BuildInfo
bi,
cinfoModules :: [ModuleName]
cinfoModules = Component -> [ModuleName]
componentModules Component
c,
cinfoHsFiles :: [FilePath]
cinfoHsFiles = Component -> [FilePath]
componentHsFiles Component
c,
cinfoAsmFiles :: [FilePath]
cinfoAsmFiles= BuildInfo -> [FilePath]
asmSources BuildInfo
bi,
cinfoCmmFiles :: [FilePath]
cinfoCmmFiles= BuildInfo -> [FilePath]
cmmSources BuildInfo
bi,
cinfoCFiles :: [FilePath]
cinfoCFiles = BuildInfo -> [FilePath]
cSources BuildInfo
bi,
cinfoCxxFiles :: [FilePath]
cinfoCxxFiles= BuildInfo -> [FilePath]
cxxSources BuildInfo
bi,
cinfoJsFiles :: [FilePath]
cinfoJsFiles = BuildInfo -> [FilePath]
jsSources BuildInfo
bi
}
| Component
c <- PackageDescription -> [Component]
pkgComponents PackageDescription
pkg
, let bi :: BuildInfo
bi = Component -> BuildInfo
componentBuildInfo Component
c ]
componentStringName :: Package pkg => pkg -> ComponentName -> ComponentStringName
componentStringName :: forall pkg. Package pkg => pkg -> ComponentName -> FilePath
componentStringName pkg
pkg (CLibName LibraryName
LMainLibName ) = PackageName -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow (pkg -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName pkg
pkg)
componentStringName pkg
_ (CLibName (LSubLibName UnqualComponentName
name)) = UnqualComponentName -> FilePath
unUnqualComponentName UnqualComponentName
name
componentStringName pkg
_ (CFLibName UnqualComponentName
name) = UnqualComponentName -> FilePath
unUnqualComponentName UnqualComponentName
name
componentStringName pkg
_ (CExeName UnqualComponentName
name) = UnqualComponentName -> FilePath
unUnqualComponentName UnqualComponentName
name
componentStringName pkg
_ (CTestName UnqualComponentName
name) = UnqualComponentName -> FilePath
unUnqualComponentName UnqualComponentName
name
componentStringName pkg
_ (CBenchName UnqualComponentName
name) = UnqualComponentName -> FilePath
unUnqualComponentName UnqualComponentName
name
componentModules :: Component -> [ModuleName]
componentModules :: Component -> [ModuleName]
componentModules (CLib Library
lib) = Library -> [ModuleName]
explicitLibModules Library
lib
componentModules (CFLib ForeignLib
flib) = ForeignLib -> [ModuleName]
foreignLibModules ForeignLib
flib
componentModules (CExe Executable
exe) = Executable -> [ModuleName]
exeModules Executable
exe
componentModules (CTest TestSuite
test) = TestSuite -> [ModuleName]
testModules TestSuite
test
componentModules (CBench Benchmark
bench) = Benchmark -> [ModuleName]
benchmarkModules Benchmark
bench
componentHsFiles :: Component -> [FilePath]
componentHsFiles :: Component -> [FilePath]
componentHsFiles (CExe Executable
exe) = [Executable -> FilePath
modulePath Executable
exe]
componentHsFiles (CTest TestSuite {
testInterface :: TestSuite -> TestSuiteInterface
testInterface = TestSuiteExeV10 Version
_ FilePath
mainfile
}) = [FilePath
mainfile]
componentHsFiles (CBench Benchmark {
benchmarkInterface :: Benchmark -> BenchmarkInterface
benchmarkInterface = BenchmarkExeV10 Version
_ FilePath
mainfile
}) = [FilePath
mainfile]
componentHsFiles Component
_ = []
data ComponentKind = LibKind | FLibKind | ExeKind | TestKind | BenchKind
deriving (ComponentKind -> ComponentKind -> Bool
(ComponentKind -> ComponentKind -> Bool)
-> (ComponentKind -> ComponentKind -> Bool) -> Eq ComponentKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ComponentKind -> ComponentKind -> Bool
$c/= :: ComponentKind -> ComponentKind -> Bool
== :: ComponentKind -> ComponentKind -> Bool
$c== :: ComponentKind -> ComponentKind -> Bool
Eq, Eq ComponentKind
Eq ComponentKind
-> (ComponentKind -> ComponentKind -> Ordering)
-> (ComponentKind -> ComponentKind -> Bool)
-> (ComponentKind -> ComponentKind -> Bool)
-> (ComponentKind -> ComponentKind -> Bool)
-> (ComponentKind -> ComponentKind -> Bool)
-> (ComponentKind -> ComponentKind -> ComponentKind)
-> (ComponentKind -> ComponentKind -> ComponentKind)
-> Ord ComponentKind
ComponentKind -> ComponentKind -> Bool
ComponentKind -> ComponentKind -> Ordering
ComponentKind -> ComponentKind -> ComponentKind
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
min :: ComponentKind -> ComponentKind -> ComponentKind
$cmin :: ComponentKind -> ComponentKind -> ComponentKind
max :: ComponentKind -> ComponentKind -> ComponentKind
$cmax :: ComponentKind -> ComponentKind -> ComponentKind
>= :: ComponentKind -> ComponentKind -> Bool
$c>= :: ComponentKind -> ComponentKind -> Bool
> :: ComponentKind -> ComponentKind -> Bool
$c> :: ComponentKind -> ComponentKind -> Bool
<= :: ComponentKind -> ComponentKind -> Bool
$c<= :: ComponentKind -> ComponentKind -> Bool
< :: ComponentKind -> ComponentKind -> Bool
$c< :: ComponentKind -> ComponentKind -> Bool
compare :: ComponentKind -> ComponentKind -> Ordering
$ccompare :: ComponentKind -> ComponentKind -> Ordering
Ord, Int -> ComponentKind -> ShowS
[ComponentKind] -> ShowS
ComponentKind -> FilePath
(Int -> ComponentKind -> ShowS)
-> (ComponentKind -> FilePath)
-> ([ComponentKind] -> ShowS)
-> Show ComponentKind
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ComponentKind] -> ShowS
$cshowList :: [ComponentKind] -> ShowS
show :: ComponentKind -> FilePath
$cshow :: ComponentKind -> FilePath
showsPrec :: Int -> ComponentKind -> ShowS
$cshowsPrec :: Int -> ComponentKind -> ShowS
Show, Int -> ComponentKind
ComponentKind -> Int
ComponentKind -> [ComponentKind]
ComponentKind -> ComponentKind
ComponentKind -> ComponentKind -> [ComponentKind]
ComponentKind -> ComponentKind -> ComponentKind -> [ComponentKind]
(ComponentKind -> ComponentKind)
-> (ComponentKind -> ComponentKind)
-> (Int -> ComponentKind)
-> (ComponentKind -> Int)
-> (ComponentKind -> [ComponentKind])
-> (ComponentKind -> ComponentKind -> [ComponentKind])
-> (ComponentKind -> ComponentKind -> [ComponentKind])
-> (ComponentKind
-> ComponentKind -> ComponentKind -> [ComponentKind])
-> Enum ComponentKind
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ComponentKind -> ComponentKind -> ComponentKind -> [ComponentKind]
$cenumFromThenTo :: ComponentKind -> ComponentKind -> ComponentKind -> [ComponentKind]
enumFromTo :: ComponentKind -> ComponentKind -> [ComponentKind]
$cenumFromTo :: ComponentKind -> ComponentKind -> [ComponentKind]
enumFromThen :: ComponentKind -> ComponentKind -> [ComponentKind]
$cenumFromThen :: ComponentKind -> ComponentKind -> [ComponentKind]
enumFrom :: ComponentKind -> [ComponentKind]
$cenumFrom :: ComponentKind -> [ComponentKind]
fromEnum :: ComponentKind -> Int
$cfromEnum :: ComponentKind -> Int
toEnum :: Int -> ComponentKind
$ctoEnum :: Int -> ComponentKind
pred :: ComponentKind -> ComponentKind
$cpred :: ComponentKind -> ComponentKind
succ :: ComponentKind -> ComponentKind
$csucc :: ComponentKind -> ComponentKind
Enum, ComponentKind
ComponentKind -> ComponentKind -> Bounded ComponentKind
forall a. a -> a -> Bounded a
maxBound :: ComponentKind
$cmaxBound :: ComponentKind
minBound :: ComponentKind
$cminBound :: ComponentKind
Bounded)
componentKind :: ComponentName -> ComponentKind
componentKind :: ComponentName -> ComponentKind
componentKind (CLibName LibraryName
_) = ComponentKind
LibKind
componentKind (CFLibName UnqualComponentName
_) = ComponentKind
FLibKind
componentKind (CExeName UnqualComponentName
_) = ComponentKind
ExeKind
componentKind (CTestName UnqualComponentName
_) = ComponentKind
TestKind
componentKind (CBenchName UnqualComponentName
_) = ComponentKind
BenchKind
cinfoKind :: ComponentInfo -> ComponentKind
cinfoKind :: ComponentInfo -> ComponentKind
cinfoKind = ComponentName -> ComponentKind
componentKind (ComponentName -> ComponentKind)
-> (ComponentInfo -> ComponentName)
-> ComponentInfo
-> ComponentKind
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ComponentInfo -> ComponentName
cinfoName
matchComponentKind :: String -> Match ComponentKind
matchComponentKind :: FilePath -> Match ComponentKind
matchComponentKind FilePath
s
| FilePath
s FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath
"lib", FilePath
"library"] = ComponentKind -> Match ComponentKind
forall {b}. b -> Match b
return' ComponentKind
LibKind
| FilePath
s FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath
"flib", FilePath
"foreign-lib", FilePath
"foreign-library"] = ComponentKind -> Match ComponentKind
forall {b}. b -> Match b
return' ComponentKind
FLibKind
| FilePath
s FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath
"exe", FilePath
"executable"] = ComponentKind -> Match ComponentKind
forall {b}. b -> Match b
return' ComponentKind
ExeKind
| FilePath
s FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath
"tst", FilePath
"test", FilePath
"test-suite"] = ComponentKind -> Match ComponentKind
forall {b}. b -> Match b
return' ComponentKind
TestKind
| FilePath
s FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath
"bench", FilePath
"benchmark"] = ComponentKind -> Match ComponentKind
forall {b}. b -> Match b
return' ComponentKind
BenchKind
| Bool
otherwise = FilePath -> FilePath -> Match ComponentKind
forall a. FilePath -> FilePath -> Match a
matchErrorExpected FilePath
"component kind" FilePath
s
where
return' :: b -> Match b
return' b
ck = Match ()
increaseConfidence Match () -> Match b -> Match b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> b -> Match b
forall (m :: * -> *) a. Monad m => a -> m a
return b
ck
showComponentKind :: ComponentKind -> String
showComponentKind :: ComponentKind -> FilePath
showComponentKind ComponentKind
LibKind = FilePath
"library"
showComponentKind ComponentKind
FLibKind = FilePath
"foreign-library"
showComponentKind ComponentKind
ExeKind = FilePath
"executable"
showComponentKind ComponentKind
TestKind = FilePath
"test-suite"
showComponentKind ComponentKind
BenchKind = FilePath
"benchmark"
showComponentKindShort :: ComponentKind -> String
showComponentKindShort :: ComponentKind -> FilePath
showComponentKindShort ComponentKind
LibKind = FilePath
"lib"
showComponentKindShort ComponentKind
FLibKind = FilePath
"flib"
showComponentKindShort ComponentKind
ExeKind = FilePath
"exe"
showComponentKindShort ComponentKind
TestKind = FilePath
"test"
showComponentKindShort ComponentKind
BenchKind = FilePath
"bench"
matchComponent1 :: [ComponentInfo] -> String -> Match BuildTarget
matchComponent1 :: [ComponentInfo] -> FilePath -> Match BuildTarget
matchComponent1 [ComponentInfo]
cs = \FilePath
str1 -> do
FilePath -> Match ()
guardComponentName FilePath
str1
ComponentInfo
c <- [ComponentInfo] -> FilePath -> Match ComponentInfo
matchComponentName [ComponentInfo]
cs FilePath
str1
BuildTarget -> Match BuildTarget
forall (m :: * -> *) a. Monad m => a -> m a
return (ComponentName -> BuildTarget
BuildTargetComponent (ComponentInfo -> ComponentName
cinfoName ComponentInfo
c))
matchComponent2 :: [ComponentInfo] -> String -> String -> Match BuildTarget
matchComponent2 :: [ComponentInfo] -> FilePath -> FilePath -> Match BuildTarget
matchComponent2 [ComponentInfo]
cs = \FilePath
str1 FilePath
str2 -> do
ComponentKind
ckind <- FilePath -> Match ComponentKind
matchComponentKind FilePath
str1
FilePath -> Match ()
guardComponentName FilePath
str2
ComponentInfo
c <- [ComponentInfo] -> ComponentKind -> FilePath -> Match ComponentInfo
matchComponentKindAndName [ComponentInfo]
cs ComponentKind
ckind FilePath
str2
BuildTarget -> Match BuildTarget
forall (m :: * -> *) a. Monad m => a -> m a
return (ComponentName -> BuildTarget
BuildTargetComponent (ComponentInfo -> ComponentName
cinfoName ComponentInfo
c))
guardComponentName :: String -> Match ()
guardComponentName :: FilePath -> Match ()
guardComponentName FilePath
s
| (Char -> Bool) -> FilePath -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
validComponentChar FilePath
s
Bool -> Bool -> Bool
&& Bool -> Bool
not (FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
s) = Match ()
increaseConfidence
| Bool
otherwise = FilePath -> FilePath -> Match ()
forall a. FilePath -> FilePath -> Match a
matchErrorExpected FilePath
"component name" FilePath
s
where
validComponentChar :: Char -> Bool
validComponentChar Char
c = Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.'
Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\''
matchComponentName :: [ComponentInfo] -> String -> Match ComponentInfo
matchComponentName :: [ComponentInfo] -> FilePath -> Match ComponentInfo
matchComponentName [ComponentInfo]
cs FilePath
str =
FilePath -> FilePath -> Match ComponentInfo -> Match ComponentInfo
forall a. FilePath -> FilePath -> Match a -> Match a
orNoSuchThing FilePath
"component" FilePath
str
(Match ComponentInfo -> Match ComponentInfo)
-> Match ComponentInfo -> Match ComponentInfo
forall a b. (a -> b) -> a -> b
$ Match ComponentInfo -> Match ComponentInfo
forall a. Match a -> Match a
increaseConfidenceFor
(Match ComponentInfo -> Match ComponentInfo)
-> Match ComponentInfo -> Match ComponentInfo
forall a b. (a -> b) -> a -> b
$ ShowS
-> [(FilePath, ComponentInfo)] -> FilePath -> Match ComponentInfo
forall a a' b.
(Ord a, Ord a') =>
(a -> a') -> [(a, b)] -> a -> Match b
matchInexactly ShowS
caseFold
[ (ComponentInfo -> FilePath
cinfoStrName ComponentInfo
c, ComponentInfo
c) | ComponentInfo
c <- [ComponentInfo]
cs ]
FilePath
str
matchComponentKindAndName :: [ComponentInfo] -> ComponentKind -> String
-> Match ComponentInfo
matchComponentKindAndName :: [ComponentInfo] -> ComponentKind -> FilePath -> Match ComponentInfo
matchComponentKindAndName [ComponentInfo]
cs ComponentKind
ckind FilePath
str =
FilePath -> FilePath -> Match ComponentInfo -> Match ComponentInfo
forall a. FilePath -> FilePath -> Match a -> Match a
orNoSuchThing (ComponentKind -> FilePath
showComponentKind ComponentKind
ckind FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" component") FilePath
str
(Match ComponentInfo -> Match ComponentInfo)
-> Match ComponentInfo -> Match ComponentInfo
forall a b. (a -> b) -> a -> b
$ Match ComponentInfo -> Match ComponentInfo
forall a. Match a -> Match a
increaseConfidenceFor
(Match ComponentInfo -> Match ComponentInfo)
-> Match ComponentInfo -> Match ComponentInfo
forall a b. (a -> b) -> a -> b
$ ((ComponentKind, FilePath) -> (ComponentKind, FilePath))
-> [((ComponentKind, FilePath), ComponentInfo)]
-> (ComponentKind, FilePath)
-> Match ComponentInfo
forall a a' b.
(Ord a, Ord a') =>
(a -> a') -> [(a, b)] -> a -> Match b
matchInexactly (\(ComponentKind
ck, FilePath
cn) -> (ComponentKind
ck, ShowS
caseFold FilePath
cn))
[ ((ComponentInfo -> ComponentKind
cinfoKind ComponentInfo
c, ComponentInfo -> FilePath
cinfoStrName ComponentInfo
c), ComponentInfo
c) | ComponentInfo
c <- [ComponentInfo]
cs ]
(ComponentKind
ckind, FilePath
str)
matchModule1 :: [ComponentInfo] -> String -> Match BuildTarget
matchModule1 :: [ComponentInfo] -> FilePath -> Match BuildTarget
matchModule1 [ComponentInfo]
cs = \FilePath
str1 -> do
FilePath -> Match ()
guardModuleName FilePath
str1
Match BuildTarget -> Match BuildTarget
forall a. Match a -> Match a
nubMatchErrors (Match BuildTarget -> Match BuildTarget)
-> Match BuildTarget -> Match BuildTarget
forall a b. (a -> b) -> a -> b
$ do
ComponentInfo
c <- [ComponentInfo] -> Match ComponentInfo
forall a. [a] -> Match a
tryEach [ComponentInfo]
cs
let ms :: [ModuleName]
ms = ComponentInfo -> [ModuleName]
cinfoModules ComponentInfo
c
ModuleName
m <- [ModuleName] -> FilePath -> Match ModuleName
matchModuleName [ModuleName]
ms FilePath
str1
BuildTarget -> Match BuildTarget
forall (m :: * -> *) a. Monad m => a -> m a
return (ComponentName -> ModuleName -> BuildTarget
BuildTargetModule (ComponentInfo -> ComponentName
cinfoName ComponentInfo
c) ModuleName
m)
matchModule2 :: [ComponentInfo] -> String -> String -> Match BuildTarget
matchModule2 :: [ComponentInfo] -> FilePath -> FilePath -> Match BuildTarget
matchModule2 [ComponentInfo]
cs = \FilePath
str1 FilePath
str2 -> do
FilePath -> Match ()
guardComponentName FilePath
str1
FilePath -> Match ()
guardModuleName FilePath
str2
ComponentInfo
c <- [ComponentInfo] -> FilePath -> Match ComponentInfo
matchComponentName [ComponentInfo]
cs FilePath
str1
let ms :: [ModuleName]
ms = ComponentInfo -> [ModuleName]
cinfoModules ComponentInfo
c
ModuleName
m <- [ModuleName] -> FilePath -> Match ModuleName
matchModuleName [ModuleName]
ms FilePath
str2
BuildTarget -> Match BuildTarget
forall (m :: * -> *) a. Monad m => a -> m a
return (ComponentName -> ModuleName -> BuildTarget
BuildTargetModule (ComponentInfo -> ComponentName
cinfoName ComponentInfo
c) ModuleName
m)
matchModule3 :: [ComponentInfo] -> String -> String -> String
-> Match BuildTarget
matchModule3 :: [ComponentInfo]
-> FilePath -> FilePath -> FilePath -> Match BuildTarget
matchModule3 [ComponentInfo]
cs FilePath
str1 FilePath
str2 FilePath
str3 = do
ComponentKind
ckind <- FilePath -> Match ComponentKind
matchComponentKind FilePath
str1
FilePath -> Match ()
guardComponentName FilePath
str2
ComponentInfo
c <- [ComponentInfo] -> ComponentKind -> FilePath -> Match ComponentInfo
matchComponentKindAndName [ComponentInfo]
cs ComponentKind
ckind FilePath
str2
FilePath -> Match ()
guardModuleName FilePath
str3
let ms :: [ModuleName]
ms = ComponentInfo -> [ModuleName]
cinfoModules ComponentInfo
c
ModuleName
m <- [ModuleName] -> FilePath -> Match ModuleName
matchModuleName [ModuleName]
ms FilePath
str3
BuildTarget -> Match BuildTarget
forall (m :: * -> *) a. Monad m => a -> m a
return (ComponentName -> ModuleName -> BuildTarget
BuildTargetModule (ComponentInfo -> ComponentName
cinfoName ComponentInfo
c) ModuleName
m)
guardModuleName :: String -> Match ()
guardModuleName :: FilePath -> Match ()
guardModuleName FilePath
s
| (Char -> Bool) -> FilePath -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
validModuleChar FilePath
s
Bool -> Bool -> Bool
&& Bool -> Bool
not (FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
s) = Match ()
increaseConfidence
| Bool
otherwise = FilePath -> FilePath -> Match ()
forall a. FilePath -> FilePath -> Match a
matchErrorExpected FilePath
"module name" FilePath
s
where
validModuleChar :: Char -> Bool
validModuleChar Char
c = Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\''
matchModuleName :: [ModuleName] -> String -> Match ModuleName
matchModuleName :: [ModuleName] -> FilePath -> Match ModuleName
matchModuleName [ModuleName]
ms FilePath
str =
FilePath -> FilePath -> Match ModuleName -> Match ModuleName
forall a. FilePath -> FilePath -> Match a -> Match a
orNoSuchThing FilePath
"module" FilePath
str
(Match ModuleName -> Match ModuleName)
-> Match ModuleName -> Match ModuleName
forall a b. (a -> b) -> a -> b
$ Match ModuleName -> Match ModuleName
forall a. Match a -> Match a
increaseConfidenceFor
(Match ModuleName -> Match ModuleName)
-> Match ModuleName -> Match ModuleName
forall a b. (a -> b) -> a -> b
$ ShowS -> [(FilePath, ModuleName)] -> FilePath -> Match ModuleName
forall a a' b.
(Ord a, Ord a') =>
(a -> a') -> [(a, b)] -> a -> Match b
matchInexactly ShowS
caseFold
[ (ModuleName -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow ModuleName
m, ModuleName
m)
| ModuleName
m <- [ModuleName]
ms ]
FilePath
str
matchFile1 :: [ComponentInfo] -> String -> Bool -> Match BuildTarget
matchFile1 :: [ComponentInfo] -> FilePath -> Bool -> Match BuildTarget
matchFile1 [ComponentInfo]
cs FilePath
str1 Bool
exists =
Match BuildTarget -> Match BuildTarget
forall a. Match a -> Match a
nubMatchErrors (Match BuildTarget -> Match BuildTarget)
-> Match BuildTarget -> Match BuildTarget
forall a b. (a -> b) -> a -> b
$ do
ComponentInfo
c <- [ComponentInfo] -> Match ComponentInfo
forall a. [a] -> Match a
tryEach [ComponentInfo]
cs
FilePath
filepath <- ComponentInfo -> FilePath -> Bool -> Match FilePath
matchComponentFile ComponentInfo
c FilePath
str1 Bool
exists
BuildTarget -> Match BuildTarget
forall (m :: * -> *) a. Monad m => a -> m a
return (ComponentName -> FilePath -> BuildTarget
BuildTargetFile (ComponentInfo -> ComponentName
cinfoName ComponentInfo
c) FilePath
filepath)
matchFile2 :: [ComponentInfo] -> String -> String -> Bool -> Match BuildTarget
matchFile2 :: [ComponentInfo]
-> FilePath -> FilePath -> Bool -> Match BuildTarget
matchFile2 [ComponentInfo]
cs FilePath
str1 FilePath
str2 Bool
exists = do
FilePath -> Match ()
guardComponentName FilePath
str1
ComponentInfo
c <- [ComponentInfo] -> FilePath -> Match ComponentInfo
matchComponentName [ComponentInfo]
cs FilePath
str1
FilePath
filepath <- ComponentInfo -> FilePath -> Bool -> Match FilePath
matchComponentFile ComponentInfo
c FilePath
str2 Bool
exists
BuildTarget -> Match BuildTarget
forall (m :: * -> *) a. Monad m => a -> m a
return (ComponentName -> FilePath -> BuildTarget
BuildTargetFile (ComponentInfo -> ComponentName
cinfoName ComponentInfo
c) FilePath
filepath)
matchFile3 :: [ComponentInfo] -> String -> String -> String -> Bool
-> Match BuildTarget
matchFile3 :: [ComponentInfo]
-> FilePath -> FilePath -> FilePath -> Bool -> Match BuildTarget
matchFile3 [ComponentInfo]
cs FilePath
str1 FilePath
str2 FilePath
str3 Bool
exists = do
ComponentKind
ckind <- FilePath -> Match ComponentKind
matchComponentKind FilePath
str1
FilePath -> Match ()
guardComponentName FilePath
str2
ComponentInfo
c <- [ComponentInfo] -> ComponentKind -> FilePath -> Match ComponentInfo
matchComponentKindAndName [ComponentInfo]
cs ComponentKind
ckind FilePath
str2
FilePath
filepath <- ComponentInfo -> FilePath -> Bool -> Match FilePath
matchComponentFile ComponentInfo
c FilePath
str3 Bool
exists
BuildTarget -> Match BuildTarget
forall (m :: * -> *) a. Monad m => a -> m a
return (ComponentName -> FilePath -> BuildTarget
BuildTargetFile (ComponentInfo -> ComponentName
cinfoName ComponentInfo
c) FilePath
filepath)
matchComponentFile :: ComponentInfo -> String -> Bool -> Match FilePath
matchComponentFile :: ComponentInfo -> FilePath -> Bool -> Match FilePath
matchComponentFile ComponentInfo
c FilePath
str Bool
fexists =
FilePath -> FilePath -> Match FilePath -> Match FilePath
forall a. FilePath -> FilePath -> Match a -> Match a
expecting FilePath
"file" FilePath
str (Match FilePath -> Match FilePath)
-> Match FilePath -> Match FilePath
forall a b. (a -> b) -> a -> b
$
Match FilePath -> Match FilePath -> Match FilePath
forall a. Match a -> Match a -> Match a
matchPlus
(FilePath -> Bool -> Match FilePath
forall a. FilePath -> Bool -> Match a
matchFileExists FilePath
str Bool
fexists)
(Match FilePath -> Match FilePath -> Match FilePath
forall a. Match a -> Match a -> Match a
matchPlusShadowing
([Match FilePath] -> Match FilePath
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [ [FilePath] -> [ModuleName] -> FilePath -> Match FilePath
matchModuleFileRooted [FilePath]
dirs [ModuleName]
ms FilePath
str
, [FilePath] -> [FilePath] -> FilePath -> Match FilePath
matchOtherFileRooted [FilePath]
dirs [FilePath]
hsFiles FilePath
str ])
([Match FilePath] -> Match FilePath
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [ [ModuleName] -> FilePath -> Match FilePath
matchModuleFileUnrooted [ModuleName]
ms FilePath
str
, [FilePath] -> FilePath -> Match FilePath
matchOtherFileUnrooted [FilePath]
hsFiles FilePath
str
, [FilePath] -> FilePath -> Match FilePath
matchOtherFileUnrooted [FilePath]
cFiles FilePath
str
, [FilePath] -> FilePath -> Match FilePath
matchOtherFileUnrooted [FilePath]
jsFiles FilePath
str ]))
where
dirs :: [FilePath]
dirs = ComponentInfo -> [FilePath]
cinfoSrcDirs ComponentInfo
c
ms :: [ModuleName]
ms = ComponentInfo -> [ModuleName]
cinfoModules ComponentInfo
c
hsFiles :: [FilePath]
hsFiles = ComponentInfo -> [FilePath]
cinfoHsFiles ComponentInfo
c
cFiles :: [FilePath]
cFiles = ComponentInfo -> [FilePath]
cinfoCFiles ComponentInfo
c
jsFiles :: [FilePath]
jsFiles = ComponentInfo -> [FilePath]
cinfoJsFiles ComponentInfo
c
matchFileExists :: FilePath -> Bool -> Match a
matchFileExists :: forall a. FilePath -> Bool -> Match a
matchFileExists FilePath
_ Bool
False = Match a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
matchFileExists FilePath
fname Bool
True = do Match ()
increaseConfidence
FilePath -> FilePath -> Match a
forall a. FilePath -> FilePath -> Match a
matchErrorNoSuch FilePath
"file" FilePath
fname
matchModuleFileUnrooted :: [ModuleName] -> String -> Match FilePath
matchModuleFileUnrooted :: [ModuleName] -> FilePath -> Match FilePath
matchModuleFileUnrooted [ModuleName]
ms FilePath
str = do
let filepath :: FilePath
filepath = ShowS
normalise FilePath
str
ModuleName
_ <- [ModuleName] -> FilePath -> Match ModuleName
matchModuleFileStem [ModuleName]
ms FilePath
filepath
FilePath -> Match FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
filepath
matchModuleFileRooted :: [FilePath] -> [ModuleName] -> String -> Match FilePath
matchModuleFileRooted :: [FilePath] -> [ModuleName] -> FilePath -> Match FilePath
matchModuleFileRooted [FilePath]
dirs [ModuleName]
ms FilePath
str = Match FilePath -> Match FilePath
forall a. Eq a => Match a -> Match a
nubMatches (Match FilePath -> Match FilePath)
-> Match FilePath -> Match FilePath
forall a b. (a -> b) -> a -> b
$ do
let filepath :: FilePath
filepath = ShowS
normalise FilePath
str
FilePath
filepath' <- [FilePath] -> FilePath -> Match FilePath
matchDirectoryPrefix [FilePath]
dirs FilePath
filepath
ModuleName
_ <- [ModuleName] -> FilePath -> Match ModuleName
matchModuleFileStem [ModuleName]
ms FilePath
filepath'
FilePath -> Match FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
filepath
matchModuleFileStem :: [ModuleName] -> FilePath -> Match ModuleName
matchModuleFileStem :: [ModuleName] -> FilePath -> Match ModuleName
matchModuleFileStem [ModuleName]
ms =
Match ModuleName -> Match ModuleName
forall a. Match a -> Match a
increaseConfidenceFor
(Match ModuleName -> Match ModuleName)
-> (FilePath -> Match ModuleName) -> FilePath -> Match ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> [(FilePath, ModuleName)] -> FilePath -> Match ModuleName
forall a a' b.
(Ord a, Ord a') =>
(a -> a') -> [(a, b)] -> a -> Match b
matchInexactly ShowS
caseFold
[ (ModuleName -> FilePath
toFilePath ModuleName
m, ModuleName
m) | ModuleName
m <- [ModuleName]
ms ]
(FilePath -> Match ModuleName)
-> ShowS -> FilePath -> Match ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
dropExtension
matchOtherFileRooted :: [FilePath] -> [FilePath] -> FilePath -> Match FilePath
matchOtherFileRooted :: [FilePath] -> [FilePath] -> FilePath -> Match FilePath
matchOtherFileRooted [FilePath]
dirs [FilePath]
fs FilePath
str = do
let filepath :: FilePath
filepath = ShowS
normalise FilePath
str
FilePath
filepath' <- [FilePath] -> FilePath -> Match FilePath
matchDirectoryPrefix [FilePath]
dirs FilePath
filepath
FilePath
_ <- [FilePath] -> FilePath -> Match FilePath
matchFile [FilePath]
fs FilePath
filepath'
FilePath -> Match FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
filepath
matchOtherFileUnrooted :: [FilePath] -> FilePath -> Match FilePath
matchOtherFileUnrooted :: [FilePath] -> FilePath -> Match FilePath
matchOtherFileUnrooted [FilePath]
fs FilePath
str = do
let filepath :: FilePath
filepath = ShowS
normalise FilePath
str
FilePath
_ <- [FilePath] -> FilePath -> Match FilePath
matchFile [FilePath]
fs FilePath
filepath
FilePath -> Match FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
filepath
matchFile :: [FilePath] -> FilePath -> Match FilePath
matchFile :: [FilePath] -> FilePath -> Match FilePath
matchFile [FilePath]
fs = Match FilePath -> Match FilePath
forall a. Match a -> Match a
increaseConfidenceFor
(Match FilePath -> Match FilePath)
-> (FilePath -> Match FilePath) -> FilePath -> Match FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> [(FilePath, FilePath)] -> FilePath -> Match FilePath
forall a a' b.
(Ord a, Ord a') =>
(a -> a') -> [(a, b)] -> a -> Match b
matchInexactly ShowS
caseFold [ (FilePath
f, FilePath
f) | FilePath
f <- [FilePath]
fs ]
matchDirectoryPrefix :: [FilePath] -> FilePath -> Match FilePath
matchDirectoryPrefix :: [FilePath] -> FilePath -> Match FilePath
matchDirectoryPrefix [FilePath]
dirs FilePath
filepath =
[FilePath] -> Match FilePath
forall a. [a] -> Match a
exactMatches ([FilePath] -> Match FilePath) -> [FilePath] -> Match FilePath
forall a b. (a -> b) -> a -> b
$
[Maybe FilePath] -> [FilePath]
forall a. [Maybe a] -> [a]
catMaybes
[ FilePath -> FilePath -> Maybe FilePath
stripDirectory (ShowS
normalise FilePath
dir) FilePath
filepath | FilePath
dir <- [FilePath]
dirs ]
where
stripDirectory :: FilePath -> FilePath -> Maybe FilePath
stripDirectory :: FilePath -> FilePath -> Maybe FilePath
stripDirectory FilePath
dir FilePath
fp =
[FilePath] -> FilePath
joinPath ([FilePath] -> FilePath) -> Maybe [FilePath] -> Maybe FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` [FilePath] -> [FilePath] -> Maybe [FilePath]
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix (FilePath -> [FilePath]
splitDirectories FilePath
dir) (FilePath -> [FilePath]
splitDirectories FilePath
fp)
data Match a = NoMatch Confidence [MatchError]
| ExactMatch Confidence [a]
| InexactMatch Confidence [a]
deriving Int -> Match a -> ShowS
[Match a] -> ShowS
Match a -> FilePath
(Int -> Match a -> ShowS)
-> (Match a -> FilePath) -> ([Match a] -> ShowS) -> Show (Match a)
forall a. Show a => Int -> Match a -> ShowS
forall a. Show a => [Match a] -> ShowS
forall a. Show a => Match a -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Match a] -> ShowS
$cshowList :: forall a. Show a => [Match a] -> ShowS
show :: Match a -> FilePath
$cshow :: forall a. Show a => Match a -> FilePath
showsPrec :: Int -> Match a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Match a -> ShowS
Show
type Confidence = Int
data MatchError = MatchErrorExpected String String
| MatchErrorNoSuch String String
deriving (Int -> MatchError -> ShowS
[MatchError] -> ShowS
MatchError -> FilePath
(Int -> MatchError -> ShowS)
-> (MatchError -> FilePath)
-> ([MatchError] -> ShowS)
-> Show MatchError
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [MatchError] -> ShowS
$cshowList :: [MatchError] -> ShowS
show :: MatchError -> FilePath
$cshow :: MatchError -> FilePath
showsPrec :: Int -> MatchError -> ShowS
$cshowsPrec :: Int -> MatchError -> ShowS
Show, MatchError -> MatchError -> Bool
(MatchError -> MatchError -> Bool)
-> (MatchError -> MatchError -> Bool) -> Eq MatchError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MatchError -> MatchError -> Bool
$c/= :: MatchError -> MatchError -> Bool
== :: MatchError -> MatchError -> Bool
$c== :: MatchError -> MatchError -> Bool
Eq)
instance Alternative Match where
empty :: forall a. Match a
empty = Match a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
<|> :: forall a. Match a -> Match a -> Match a
(<|>) = Match a -> Match a -> Match a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus
instance MonadPlus Match where
mzero :: forall a. Match a
mzero = Match a
forall a. Match a
matchZero
mplus :: forall a. Match a -> Match a -> Match a
mplus = Match a -> Match a -> Match a
forall a. Match a -> Match a -> Match a
matchPlus
matchZero :: Match a
matchZero :: forall a. Match a
matchZero = Int -> [MatchError] -> Match a
forall a. Int -> [MatchError] -> Match a
NoMatch Int
0 []
matchPlus :: Match a -> Match a -> Match a
matchPlus :: forall a. Match a -> Match a -> Match a
matchPlus (ExactMatch Int
d1 [a]
xs) (ExactMatch Int
d2 [a]
xs') =
Int -> [a] -> Match a
forall a. Int -> [a] -> Match a
ExactMatch (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
d1 Int
d2) ([a]
xs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
xs')
matchPlus a :: Match a
a@(ExactMatch Int
_ [a]
_ ) (InexactMatch Int
_ [a]
_ ) = Match a
a
matchPlus a :: Match a
a@(ExactMatch Int
_ [a]
_ ) (NoMatch Int
_ [MatchError]
_ ) = Match a
a
matchPlus (InexactMatch Int
_ [a]
_ ) b :: Match a
b@(ExactMatch Int
_ [a]
_ ) = Match a
b
matchPlus (InexactMatch Int
d1 [a]
xs) (InexactMatch Int
d2 [a]
xs') =
Int -> [a] -> Match a
forall a. Int -> [a] -> Match a
InexactMatch (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
d1 Int
d2) ([a]
xs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
xs')
matchPlus a :: Match a
a@(InexactMatch Int
_ [a]
_ ) (NoMatch Int
_ [MatchError]
_ ) = Match a
a
matchPlus (NoMatch Int
_ [MatchError]
_ ) b :: Match a
b@(ExactMatch Int
_ [a]
_ ) = Match a
b
matchPlus (NoMatch Int
_ [MatchError]
_ ) b :: Match a
b@(InexactMatch Int
_ [a]
_ ) = Match a
b
matchPlus a :: Match a
a@(NoMatch Int
d1 [MatchError]
ms) b :: Match a
b@(NoMatch Int
d2 [MatchError]
ms')
| Int
d1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
d2 = Match a
a
| Int
d1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
d2 = Match a
b
| Bool
otherwise = Int -> [MatchError] -> Match a
forall a. Int -> [MatchError] -> Match a
NoMatch Int
d1 ([MatchError]
ms [MatchError] -> [MatchError] -> [MatchError]
forall a. [a] -> [a] -> [a]
++ [MatchError]
ms')
matchPlusShadowing :: Match a -> Match a -> Match a
matchPlusShadowing :: forall a. Match a -> Match a -> Match a
matchPlusShadowing a :: Match a
a@(ExactMatch Int
_ [a]
_) (ExactMatch Int
_ [a]
_) = Match a
a
matchPlusShadowing Match a
a Match a
b = Match a -> Match a -> Match a
forall a. Match a -> Match a -> Match a
matchPlus Match a
a Match a
b
instance Functor Match where
fmap :: forall a b. (a -> b) -> Match a -> Match b
fmap a -> b
_ (NoMatch Int
d [MatchError]
ms) = Int -> [MatchError] -> Match b
forall a. Int -> [MatchError] -> Match a
NoMatch Int
d [MatchError]
ms
fmap a -> b
f (ExactMatch Int
d [a]
xs) = Int -> [b] -> Match b
forall a. Int -> [a] -> Match a
ExactMatch Int
d ((a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f [a]
xs)
fmap a -> b
f (InexactMatch Int
d [a]
xs) = Int -> [b] -> Match b
forall a. Int -> [a] -> Match a
InexactMatch Int
d ((a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f [a]
xs)
instance Applicative Match where
pure :: forall {b}. b -> Match b
pure a
a = Int -> [a] -> Match a
forall a. Int -> [a] -> Match a
ExactMatch Int
0 [a
a]
<*> :: forall a b. Match (a -> b) -> Match a -> Match b
(<*>) = Match (a -> b) -> Match a -> Match b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance Monad Match where
return :: forall {b}. b -> Match b
return = a -> Match a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
NoMatch Int
d [MatchError]
ms >>= :: forall a b. Match a -> (a -> Match b) -> Match b
>>= a -> Match b
_ = Int -> [MatchError] -> Match b
forall a. Int -> [MatchError] -> Match a
NoMatch Int
d [MatchError]
ms
ExactMatch Int
d [a]
xs >>= a -> Match b
f = Int -> Match b -> Match b
forall a. Int -> Match a -> Match a
addDepth Int
d
(Match b -> Match b) -> Match b -> Match b
forall a b. (a -> b) -> a -> b
$ (Match b -> Match b -> Match b) -> Match b -> [Match b] -> Match b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Match b -> Match b -> Match b
forall a. Match a -> Match a -> Match a
matchPlus Match b
forall a. Match a
matchZero ((a -> Match b) -> [a] -> [Match b]
forall a b. (a -> b) -> [a] -> [b]
map a -> Match b
f [a]
xs)
InexactMatch Int
d [a]
xs >>= a -> Match b
f = Int -> Match b -> Match b
forall a. Int -> Match a -> Match a
addDepth Int
d (Match b -> Match b) -> (Match b -> Match b) -> Match b -> Match b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Match b -> Match b
forall a. Match a -> Match a
forceInexact
(Match b -> Match b) -> Match b -> Match b
forall a b. (a -> b) -> a -> b
$ (Match b -> Match b -> Match b) -> Match b -> [Match b] -> Match b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Match b -> Match b -> Match b
forall a. Match a -> Match a -> Match a
matchPlus Match b
forall a. Match a
matchZero ((a -> Match b) -> [a] -> [Match b]
forall a b. (a -> b) -> [a] -> [b]
map a -> Match b
f [a]
xs)
addDepth :: Confidence -> Match a -> Match a
addDepth :: forall a. Int -> Match a -> Match a
addDepth Int
d' (NoMatch Int
d [MatchError]
msgs) = Int -> [MatchError] -> Match a
forall a. Int -> [MatchError] -> Match a
NoMatch (Int
d'Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
d) [MatchError]
msgs
addDepth Int
d' (ExactMatch Int
d [a]
xs) = Int -> [a] -> Match a
forall a. Int -> [a] -> Match a
ExactMatch (Int
d'Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
d) [a]
xs
addDepth Int
d' (InexactMatch Int
d [a]
xs) = Int -> [a] -> Match a
forall a. Int -> [a] -> Match a
InexactMatch (Int
d'Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
d) [a]
xs
forceInexact :: Match a -> Match a
forceInexact :: forall a. Match a -> Match a
forceInexact (ExactMatch Int
d [a]
ys) = Int -> [a] -> Match a
forall a. Int -> [a] -> Match a
InexactMatch Int
d [a]
ys
forceInexact Match a
m = Match a
m
matchErrorExpected, matchErrorNoSuch :: String -> String -> Match a
matchErrorExpected :: forall a. FilePath -> FilePath -> Match a
matchErrorExpected FilePath
thing FilePath
got = Int -> [MatchError] -> Match a
forall a. Int -> [MatchError] -> Match a
NoMatch Int
0 [FilePath -> FilePath -> MatchError
MatchErrorExpected FilePath
thing FilePath
got]
matchErrorNoSuch :: forall a. FilePath -> FilePath -> Match a
matchErrorNoSuch FilePath
thing FilePath
got = Int -> [MatchError] -> Match a
forall a. Int -> [MatchError] -> Match a
NoMatch Int
0 [FilePath -> FilePath -> MatchError
MatchErrorNoSuch FilePath
thing FilePath
got]
expecting :: String -> String -> Match a -> Match a
expecting :: forall a. FilePath -> FilePath -> Match a -> Match a
expecting FilePath
thing FilePath
got (NoMatch Int
0 [MatchError]
_) = FilePath -> FilePath -> Match a
forall a. FilePath -> FilePath -> Match a
matchErrorExpected FilePath
thing FilePath
got
expecting FilePath
_ FilePath
_ Match a
m = Match a
m
orNoSuchThing :: String -> String -> Match a -> Match a
orNoSuchThing :: forall a. FilePath -> FilePath -> Match a -> Match a
orNoSuchThing FilePath
thing FilePath
got (NoMatch Int
0 [MatchError]
_) = FilePath -> FilePath -> Match a
forall a. FilePath -> FilePath -> Match a
matchErrorNoSuch FilePath
thing FilePath
got
orNoSuchThing FilePath
_ FilePath
_ Match a
m = Match a
m
increaseConfidence :: Match ()
increaseConfidence :: Match ()
increaseConfidence = Int -> [()] -> Match ()
forall a. Int -> [a] -> Match a
ExactMatch Int
1 [()]
increaseConfidenceFor :: Match a -> Match a
increaseConfidenceFor :: forall a. Match a -> Match a
increaseConfidenceFor Match a
m = Match a
m Match a -> (a -> Match a) -> Match a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
r -> Match ()
increaseConfidence Match () -> Match a -> Match a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> Match a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r
nubMatches :: Eq a => Match a -> Match a
nubMatches :: forall a. Eq a => Match a -> Match a
nubMatches (NoMatch Int
d [MatchError]
msgs) = Int -> [MatchError] -> Match a
forall a. Int -> [MatchError] -> Match a
NoMatch Int
d [MatchError]
msgs
nubMatches (ExactMatch Int
d [a]
xs) = Int -> [a] -> Match a
forall a. Int -> [a] -> Match a
ExactMatch Int
d ([a] -> [a]
forall a. Eq a => [a] -> [a]
nub [a]
xs)
nubMatches (InexactMatch Int
d [a]
xs) = Int -> [a] -> Match a
forall a. Int -> [a] -> Match a
InexactMatch Int
d ([a] -> [a]
forall a. Eq a => [a] -> [a]
nub [a]
xs)
nubMatchErrors :: Match a -> Match a
nubMatchErrors :: forall a. Match a -> Match a
nubMatchErrors (NoMatch Int
d [MatchError]
msgs) = Int -> [MatchError] -> Match a
forall a. Int -> [MatchError] -> Match a
NoMatch Int
d ([MatchError] -> [MatchError]
forall a. Eq a => [a] -> [a]
nub [MatchError]
msgs)
nubMatchErrors (ExactMatch Int
d [a]
xs) = Int -> [a] -> Match a
forall a. Int -> [a] -> Match a
ExactMatch Int
d [a]
xs
nubMatchErrors (InexactMatch Int
d [a]
xs) = Int -> [a] -> Match a
forall a. Int -> [a] -> Match a
InexactMatch Int
d [a]
xs
exactMatches, inexactMatches :: [a] -> Match a
exactMatches :: forall a. [a] -> Match a
exactMatches [] = Match a
forall a. Match a
matchZero
exactMatches [a]
xs = Int -> [a] -> Match a
forall a. Int -> [a] -> Match a
ExactMatch Int
0 [a]
xs
inexactMatches :: forall a. [a] -> Match a
inexactMatches [] = Match a
forall a. Match a
matchZero
inexactMatches [a]
xs = Int -> [a] -> Match a
forall a. Int -> [a] -> Match a
InexactMatch Int
0 [a]
xs
tryEach :: [a] -> Match a
tryEach :: forall a. [a] -> Match a
tryEach = [a] -> Match a
forall a. [a] -> Match a
exactMatches
findMatch :: Eq b => Match b -> MaybeAmbiguous b
findMatch :: forall b. Eq b => Match b -> MaybeAmbiguous b
findMatch Match b
match =
case Match b
match of
NoMatch Int
_ [MatchError]
msgs -> [MatchError] -> MaybeAmbiguous b
forall a. [MatchError] -> MaybeAmbiguous a
None ([MatchError] -> [MatchError]
forall a. Eq a => [a] -> [a]
nub [MatchError]
msgs)
ExactMatch Int
_ [b]
xs -> [b] -> MaybeAmbiguous b
forall {a}. Eq a => [a] -> MaybeAmbiguous a
checkAmbiguous [b]
xs
InexactMatch Int
_ [b]
xs -> [b] -> MaybeAmbiguous b
forall {a}. Eq a => [a] -> MaybeAmbiguous a
checkAmbiguous [b]
xs
where
checkAmbiguous :: [a] -> MaybeAmbiguous a
checkAmbiguous [a]
xs = case [a] -> [a]
forall a. Eq a => [a] -> [a]
nub [a]
xs of
[a
x] -> a -> MaybeAmbiguous a
forall a. a -> MaybeAmbiguous a
Unambiguous a
x
[a]
xs' -> [a] -> MaybeAmbiguous a
forall a. [a] -> MaybeAmbiguous a
Ambiguous [a]
xs'
data MaybeAmbiguous a = None [MatchError] | Unambiguous a | Ambiguous [a]
deriving Int -> MaybeAmbiguous a -> ShowS
[MaybeAmbiguous a] -> ShowS
MaybeAmbiguous a -> FilePath
(Int -> MaybeAmbiguous a -> ShowS)
-> (MaybeAmbiguous a -> FilePath)
-> ([MaybeAmbiguous a] -> ShowS)
-> Show (MaybeAmbiguous a)
forall a. Show a => Int -> MaybeAmbiguous a -> ShowS
forall a. Show a => [MaybeAmbiguous a] -> ShowS
forall a. Show a => MaybeAmbiguous a -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [MaybeAmbiguous a] -> ShowS
$cshowList :: forall a. Show a => [MaybeAmbiguous a] -> ShowS
show :: MaybeAmbiguous a -> FilePath
$cshow :: forall a. Show a => MaybeAmbiguous a -> FilePath
showsPrec :: Int -> MaybeAmbiguous a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> MaybeAmbiguous a -> ShowS
Show
matchInexactly :: (Ord a, Ord a') =>
(a -> a') ->
[(a, b)] -> (a -> Match b)
matchInexactly :: forall a a' b.
(Ord a, Ord a') =>
(a -> a') -> [(a, b)] -> a -> Match b
matchInexactly a -> a'
cannonicalise [(a, b)]
xs =
\a
x -> case a -> Map a [b] -> Maybe [b]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup a
x Map a [b]
m of
Just [b]
ys -> [b] -> Match b
forall a. [a] -> Match a
exactMatches [b]
ys
Maybe [b]
Nothing -> case a' -> Map a' [b] -> Maybe [b]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (a -> a'
cannonicalise a
x) Map a' [b]
m' of
Just [b]
ys -> [b] -> Match b
forall a. [a] -> Match a
inexactMatches [b]
ys
Maybe [b]
Nothing -> Match b
forall a. Match a
matchZero
where
m :: Map a [b]
m = ([b] -> [b] -> [b]) -> [(a, [b])] -> Map a [b]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith [b] -> [b] -> [b]
forall a. [a] -> [a] -> [a]
(++) [ (a
k,[b
x]) | (a
k,b
x) <- [(a, b)]
xs ]
m' :: Map a' [b]
m' = ([b] -> [b] -> [b]) -> (a -> a') -> Map a [b] -> Map a' [b]
forall k2 a k1.
Ord k2 =>
(a -> a -> a) -> (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeysWith [b] -> [b] -> [b]
forall a. [a] -> [a] -> [a]
(++) a -> a'
cannonicalise Map a [b]
m
caseFold :: String -> String
caseFold :: ShowS
caseFold = ShowS
lowercase
checkBuildTargets :: Verbosity -> PackageDescription -> LocalBuildInfo -> [BuildTarget]
-> IO [TargetInfo]
checkBuildTargets :: Verbosity
-> PackageDescription
-> LocalBuildInfo
-> [BuildTarget]
-> IO [TargetInfo]
checkBuildTargets Verbosity
_ PackageDescription
pkg_descr LocalBuildInfo
lbi [] =
[TargetInfo] -> IO [TargetInfo]
forall (m :: * -> *) a. Monad m => a -> m a
return (PackageDescription -> LocalBuildInfo -> [TargetInfo]
allTargetsInBuildOrder' PackageDescription
pkg_descr LocalBuildInfo
lbi)
checkBuildTargets Verbosity
verbosity PackageDescription
pkg_descr LocalBuildInfo
lbi [BuildTarget]
targets = do
let ([(ComponentName, Maybe (Either ModuleName FilePath))]
enabled, [(ComponentName, ComponentDisabledReason)]
disabled) =
[Either
(ComponentName, Maybe (Either ModuleName FilePath))
(ComponentName, ComponentDisabledReason)]
-> ([(ComponentName, Maybe (Either ModuleName FilePath))],
[(ComponentName, ComponentDisabledReason)])
forall a b. [Either a b] -> ([a], [b])
partitionEithers
[ case ComponentRequestedSpec
-> Component -> Maybe ComponentDisabledReason
componentDisabledReason (LocalBuildInfo -> ComponentRequestedSpec
componentEnabledSpec LocalBuildInfo
lbi) Component
comp of
Maybe ComponentDisabledReason
Nothing -> (ComponentName, Maybe (Either ModuleName FilePath))
-> Either
(ComponentName, Maybe (Either ModuleName FilePath))
(ComponentName, ComponentDisabledReason)
forall a b. a -> Either a b
Left (ComponentName, Maybe (Either ModuleName FilePath))
target'
Just ComponentDisabledReason
reason -> (ComponentName, ComponentDisabledReason)
-> Either
(ComponentName, Maybe (Either ModuleName FilePath))
(ComponentName, ComponentDisabledReason)
forall a b. b -> Either a b
Right (ComponentName
cname, ComponentDisabledReason
reason)
| BuildTarget
target <- [BuildTarget]
targets
, let target' :: (ComponentName, Maybe (Either ModuleName FilePath))
target'@(ComponentName
cname,Maybe (Either ModuleName FilePath)
_) = BuildTarget -> (ComponentName, Maybe (Either ModuleName FilePath))
swizzleTarget BuildTarget
target
, let comp :: Component
comp = PackageDescription -> ComponentName -> Component
getComponent PackageDescription
pkg_descr ComponentName
cname ]
case [(ComponentName, ComponentDisabledReason)]
disabled of
[] -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
((ComponentName
cname,ComponentDisabledReason
reason):[(ComponentName, ComponentDisabledReason)]
_) -> Verbosity -> FilePath -> IO ()
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> ComponentDisabledReason -> FilePath
formatReason (ComponentName -> FilePath
showComponentName ComponentName
cname) ComponentDisabledReason
reason
[(ComponentName, Either ModuleName FilePath)]
-> ((ComponentName, Either ModuleName FilePath) -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [ (ComponentName
c, Either ModuleName FilePath
t) | (ComponentName
c, Just Either ModuleName FilePath
t) <- [(ComponentName, Maybe (Either ModuleName FilePath))]
enabled ] (((ComponentName, Either ModuleName FilePath) -> IO ()) -> IO ())
-> ((ComponentName, Either ModuleName FilePath) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(ComponentName
c, Either ModuleName FilePath
t) ->
Verbosity -> FilePath -> IO ()
warn Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Ignoring '" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ (ModuleName -> FilePath)
-> ShowS -> Either ModuleName FilePath -> FilePath
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ModuleName -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow ShowS
forall a. a -> a
id Either ModuleName FilePath
t FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
". The whole "
FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ ComponentName -> FilePath
showComponentName ComponentName
c FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" will be processed. (Support for "
FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"module and file targets has not been implemented yet.)"
[TargetInfo]
enabled' <- [(ComponentName, Maybe (Either ModuleName FilePath))]
-> ((ComponentName, Maybe (Either ModuleName FilePath))
-> IO TargetInfo)
-> IO [TargetInfo]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [(ComponentName, Maybe (Either ModuleName FilePath))]
enabled (((ComponentName, Maybe (Either ModuleName FilePath))
-> IO TargetInfo)
-> IO [TargetInfo])
-> ((ComponentName, Maybe (Either ModuleName FilePath))
-> IO TargetInfo)
-> IO [TargetInfo]
forall a b. (a -> b) -> a -> b
$ \(ComponentName
cname, Maybe (Either ModuleName FilePath)
_) -> do
case PackageDescription
-> LocalBuildInfo -> ComponentName -> [TargetInfo]
componentNameTargets' PackageDescription
pkg_descr LocalBuildInfo
lbi ComponentName
cname of
[] -> FilePath -> IO TargetInfo
forall a. HasCallStack => FilePath -> a
error FilePath
"checkBuildTargets: nothing enabled"
[TargetInfo
target] -> TargetInfo -> IO TargetInfo
forall (m :: * -> *) a. Monad m => a -> m a
return TargetInfo
target
[TargetInfo]
_targets -> FilePath -> IO TargetInfo
forall a. HasCallStack => FilePath -> a
error FilePath
"checkBuildTargets: multiple copies enabled"
[TargetInfo] -> IO [TargetInfo]
forall (m :: * -> *) a. Monad m => a -> m a
return [TargetInfo]
enabled'
where
swizzleTarget :: BuildTarget -> (ComponentName, Maybe (Either ModuleName FilePath))
swizzleTarget (BuildTargetComponent ComponentName
c) = (ComponentName
c, Maybe (Either ModuleName FilePath)
forall a. Maybe a
Nothing)
swizzleTarget (BuildTargetModule ComponentName
c ModuleName
m) = (ComponentName
c, Either ModuleName FilePath -> Maybe (Either ModuleName FilePath)
forall a. a -> Maybe a
Just (ModuleName -> Either ModuleName FilePath
forall a b. a -> Either a b
Left ModuleName
m))
swizzleTarget (BuildTargetFile ComponentName
c FilePath
f) = (ComponentName
c, Either ModuleName FilePath -> Maybe (Either ModuleName FilePath)
forall a. a -> Maybe a
Just (FilePath -> Either ModuleName FilePath
forall a b. b -> Either a b
Right FilePath
f))
formatReason :: FilePath -> ComponentDisabledReason -> FilePath
formatReason FilePath
cn ComponentDisabledReason
DisabledComponent =
FilePath
"Cannot process the " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
cn FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" because the component is marked "
FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"as disabled in the .cabal file."
formatReason FilePath
cn ComponentDisabledReason
DisabledAllTests =
FilePath
"Cannot process the " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
cn FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" because test suites are not "
FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"enabled. Run configure with the flag --enable-tests"
formatReason FilePath
cn ComponentDisabledReason
DisabledAllBenchmarks =
FilePath
"Cannot process the " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
cn FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" because benchmarks are not "
FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"enabled. Re-run configure with the flag --enable-benchmarks"
formatReason FilePath
cn (DisabledAllButOne FilePath
cn') =
FilePath
"Cannot process the " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
cn FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" because this package was "
FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"configured only to build " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
cn' FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
". Re-run configure "
FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
"with the argument " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
cn