{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Distribution.Client.BuildTargets
-- Copyright   :  (c) Duncan Coutts 2012
-- License     :  BSD-like
--
-- Maintainer  :  duncan@community.haskell.org
--
-- Handling for user-specified build targets
-----------------------------------------------------------------------------
module Distribution.Simple.BuildTarget (
    -- * Main interface
    readTargetInfos,
    readBuildTargets, -- in case you don't have LocalBuildInfo

    -- * Build targets
    BuildTarget(..),
    showBuildTarget,
    QualLevel(..),
    buildTargetComponentName,

    -- * Parsing user build targets
    UserBuildTarget,
    readUserBuildTargets,
    showUserBuildTarget,
    UserBuildTargetProblem(..),
    reportUserBuildTargetProblems,

    -- * Resolving build targets
    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 qualified Distribution.Compat.CharParsing as P

import Control.Monad ( msum )
import Data.List ( stripPrefix, groupBy, partition )
import Data.Either ( partitionEithers )
import System.FilePath as FilePath
         ( dropExtension, normalise, splitDirectories, joinPath, splitPath
         , hasTrailingPathSeparator )
import System.Directory ( doesFileExist, doesDirectoryExist )
import qualified Data.Map as Map

-- | Take a list of 'String' build targets, and parse and validate them
-- into actual 'TargetInfo's to be built/registered/whatever.
readTargetInfos :: Verbosity -> PackageDescription -> LocalBuildInfo -> [String] -> IO [TargetInfo]
readTargetInfos :: Verbosity
-> PackageDescription
-> LocalBuildInfo
-> [String]
-> IO [TargetInfo]
readTargetInfos verbosity :: Verbosity
verbosity pkg_descr :: PackageDescription
pkg_descr lbi :: LocalBuildInfo
lbi args :: [String]
args = do
    [BuildTarget]
build_targets <- Verbosity -> PackageDescription -> [String] -> IO [BuildTarget]
readBuildTargets Verbosity
verbosity PackageDescription
pkg_descr [String]
args
    Verbosity
-> PackageDescription
-> LocalBuildInfo
-> [BuildTarget]
-> IO [TargetInfo]
checkBuildTargets Verbosity
verbosity PackageDescription
pkg_descr LocalBuildInfo
lbi [BuildTarget]
build_targets

-- ------------------------------------------------------------
-- * User build targets
-- ------------------------------------------------------------

-- | Various ways that a user may specify a build target.
--
data UserBuildTarget =

     -- | A target specified by a single name. This could be a component
     -- module or file.
     --
     -- > cabal build foo
     -- > cabal build Data.Foo
     -- > cabal build Data/Foo.hs  Data/Foo.hsc
     --
     UserBuildTargetSingle String

     -- | A target specified by a qualifier and name. This could be a component
     -- name qualified by the component namespace kind, or a module or file
     -- qualified by the component name.
     --
     -- > cabal build lib:foo exe:foo
     -- > cabal build foo:Data.Foo
     -- > cabal build foo:Data/Foo.hs
     --
   | UserBuildTargetDouble String String

     -- | A fully qualified target, either a module or file qualified by a
     -- component name with the component namespace kind.
     --
     -- > cabal build lib:foo:Data/Foo.hs exe:foo:Data/Foo.hs
     -- > cabal build lib:foo:Data.Foo exe:foo:Data.Foo
     --
   | UserBuildTargetTriple String String String
  deriving (Int -> UserBuildTarget -> ShowS
[UserBuildTarget] -> ShowS
UserBuildTarget -> String
(Int -> UserBuildTarget -> ShowS)
-> (UserBuildTarget -> String)
-> ([UserBuildTarget] -> ShowS)
-> Show UserBuildTarget
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserBuildTarget] -> ShowS
$cshowList :: [UserBuildTarget] -> ShowS
show :: UserBuildTarget -> String
$cshow :: UserBuildTarget -> String
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
$cp1Ord :: Eq UserBuildTarget
Ord)


-- ------------------------------------------------------------
-- * Resolved build targets
-- ------------------------------------------------------------

-- | A fully resolved build target.
--
data BuildTarget =

     -- | A specific component
     --
     BuildTargetComponent ComponentName

     -- | A specific module within a specific component.
     --
   | BuildTargetModule ComponentName ModuleName

     -- | A specific file within a specific component.
     --
   | 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 -> String
(Int -> BuildTarget -> ShowS)
-> (BuildTarget -> String)
-> ([BuildTarget] -> ShowS)
-> Show BuildTarget
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BuildTarget] -> ShowS
$cshowList :: [BuildTarget] -> ShowS
show :: BuildTarget -> String
$cshow :: BuildTarget -> String
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 cn :: ComponentName
cn)   = ComponentName
cn
buildTargetComponentName (BuildTargetModule    cn :: ComponentName
cn _) = ComponentName
cn
buildTargetComponentName (BuildTargetFile      cn :: ComponentName
cn _) = ComponentName
cn

-- | Read a list of user-supplied build target strings and resolve them to
-- 'BuildTarget's according to a 'PackageDescription'. If there are problems
-- with any of the targets e.g. they don't exist or are misformatted, throw an
-- 'IOException'.
readBuildTargets :: Verbosity -> PackageDescription -> [String] -> IO [BuildTarget]
readBuildTargets :: Verbosity -> PackageDescription -> [String] -> IO [BuildTarget]
readBuildTargets verbosity :: Verbosity
verbosity pkg :: PackageDescription
pkg targetStrs :: [String]
targetStrs = do
    let (uproblems :: [UserBuildTargetProblem]
uproblems, utargets :: [UserBuildTarget]
utargets) = [String] -> ([UserBuildTargetProblem], [UserBuildTarget])
readUserBuildTargets [String]
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 (bproblems :: [BuildTargetProblem]
bproblems, btargets :: [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 -> NoCallStackIO (UserBuildTarget, Bool)
checkTargetExistsAsFile :: UserBuildTarget -> IO (UserBuildTarget, Bool)
checkTargetExistsAsFile t :: UserBuildTarget
t = do
    Bool
fexists <- String -> IO Bool
existsAsFile (UserBuildTarget -> String
fileComponentOfTarget UserBuildTarget
t)
    (UserBuildTarget, Bool) -> IO (UserBuildTarget, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (UserBuildTarget
t, Bool
fexists)

  where
    existsAsFile :: String -> IO Bool
existsAsFile f :: String
f = do
      Bool
exists <- String -> IO Bool
doesFileExist String
f
      case String -> [String]
splitPath String
f of
        (d :: String
d:_)   | String -> Bool
hasTrailingPathSeparator String
d -> String -> IO Bool
doesDirectoryExist String
d
        (d :: String
d:_:_) | Bool -> Bool
not Bool
exists                 -> String -> IO Bool
doesDirectoryExist String
d
        _                                    -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
exists

    fileComponentOfTarget :: UserBuildTarget -> String
fileComponentOfTarget (UserBuildTargetSingle     s1 :: String
s1) = String
s1
    fileComponentOfTarget (UserBuildTargetDouble _   s2 :: String
s2) = String
s2
    fileComponentOfTarget (UserBuildTargetTriple _ _ s3 :: String
s3) = String
s3


-- ------------------------------------------------------------
-- * Parsing user targets
-- ------------------------------------------------------------

readUserBuildTargets :: [String] -> ([UserBuildTargetProblem]
                                    ,[UserBuildTarget])
readUserBuildTargets :: [String] -> ([UserBuildTargetProblem], [UserBuildTarget])
readUserBuildTargets = [Either UserBuildTargetProblem UserBuildTarget]
-> ([UserBuildTargetProblem], [UserBuildTarget])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either UserBuildTargetProblem UserBuildTarget]
 -> ([UserBuildTargetProblem], [UserBuildTarget]))
-> ([String] -> [Either UserBuildTargetProblem UserBuildTarget])
-> [String]
-> ([UserBuildTargetProblem], [UserBuildTarget])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Either UserBuildTargetProblem UserBuildTarget)
-> [String] -> [Either UserBuildTargetProblem UserBuildTarget]
forall a b. (a -> b) -> [a] -> [b]
map String -> Either UserBuildTargetProblem UserBuildTarget
readUserBuildTarget

-- |
--
-- >>> readUserBuildTarget "comp"
-- Right (UserBuildTargetSingle "comp")
--
-- >>> readUserBuildTarget "lib:comp"
-- Right (UserBuildTargetDouble "lib" "comp")
--
-- >>> readUserBuildTarget "pkg:lib:comp"
-- Right (UserBuildTargetTriple "pkg" "lib" "comp")
--
-- >>> readUserBuildTarget "\"comp\""
-- Right (UserBuildTargetSingle "comp")
--
-- >>> readUserBuildTarget "lib:\"comp\""
-- Right (UserBuildTargetDouble "lib" "comp")
--
-- >>> readUserBuildTarget "pkg:lib:\"comp\""
-- Right (UserBuildTargetTriple "pkg" "lib" "comp")
--
-- >>> readUserBuildTarget "pkg:lib:comp:more"
-- Left (UserBuildTargetUnrecognised "pkg:lib:comp:more")
--
-- >>> readUserBuildTarget "pkg:\"lib\":comp"
-- Left (UserBuildTargetUnrecognised "pkg:\"lib\":comp")
--
readUserBuildTarget :: String -> Either UserBuildTargetProblem
                                        UserBuildTarget
readUserBuildTarget :: String -> Either UserBuildTargetProblem UserBuildTarget
readUserBuildTarget targetstr :: String
targetstr =
    case ParsecParser UserBuildTarget
-> String -> Either String UserBuildTarget
forall a. ParsecParser a -> String -> Either String a
explicitEitherParsec ParsecParser UserBuildTarget
forall (m :: * -> *). CabalParsing m => m UserBuildTarget
parseTargetApprox String
targetstr of
      Left _    -> UserBuildTargetProblem
-> Either UserBuildTargetProblem UserBuildTarget
forall a b. a -> Either a b
Left  (String -> UserBuildTargetProblem
UserBuildTargetUnrecognised String
targetstr)
      Right tgt :: UserBuildTarget
tgt -> UserBuildTarget -> Either UserBuildTargetProblem UserBuildTarget
forall a b. b -> Either a b
Right UserBuildTarget
tgt

  where
    parseTargetApprox :: CabalParsing m => m UserBuildTarget
    parseTargetApprox :: m UserBuildTarget
parseTargetApprox = do
        -- read one, two, or three tokens, where last could be "hs-string"
        (String, Maybe (String, Maybe String))
ts <- m (String, Maybe (String, Maybe String))
forall (m :: * -> *).
CabalParsing m =>
m (String, Maybe (String, Maybe String))
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 (String, Maybe (String, Maybe String))
ts of
            (a :: String
a, Nothing)           -> String -> UserBuildTarget
UserBuildTargetSingle String
a
            (a :: String
a, Just (b :: String
b, Nothing)) -> String -> String -> UserBuildTarget
UserBuildTargetDouble String
a String
b
            (a :: String
a, Just (b :: String
b, Just c :: String
c))  -> String -> String -> String -> UserBuildTarget
UserBuildTargetTriple String
a String
b String
c

    tokens :: CabalParsing m => m (String, Maybe (String, Maybe String))
    tokens :: m (String, Maybe (String, Maybe String))
tokens = (\s :: String
s -> (String
s, Maybe (String, Maybe String)
forall a. Maybe a
Nothing)) (String -> (String, Maybe (String, Maybe String)))
-> m String -> m (String, Maybe (String, Maybe String))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m String
forall (m :: * -> *). CabalParsing m => m String
parsecHaskellString
        m (String, Maybe (String, Maybe String))
-> m (String, Maybe (String, Maybe String))
-> m (String, Maybe (String, Maybe String))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (,) (String
 -> Maybe (String, Maybe String)
 -> (String, Maybe (String, Maybe String)))
-> m String
-> m (Maybe (String, Maybe String)
      -> (String, Maybe (String, Maybe String)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m String
forall (m :: * -> *). CabalParsing m => m String
token m (Maybe (String, Maybe String)
   -> (String, Maybe (String, Maybe String)))
-> m (Maybe (String, Maybe String))
-> m (String, Maybe (String, Maybe String))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m (String, Maybe String) -> m (Maybe (String, Maybe String))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char ':' m Char -> m (String, Maybe String) -> m (String, Maybe String)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m (String, Maybe String)
forall (m :: * -> *). CabalParsing m => m (String, Maybe String)
tokens2)

    tokens2 :: CabalParsing m => m (String, Maybe String)
    tokens2 :: m (String, Maybe String)
tokens2 = (\s :: String
s -> (String
s, Maybe String
forall a. Maybe a
Nothing)) (String -> (String, Maybe String))
-> m String -> m (String, Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m String
forall (m :: * -> *). CabalParsing m => m String
parsecHaskellString
        m (String, Maybe String)
-> m (String, Maybe String) -> m (String, Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (,) (String -> Maybe String -> (String, Maybe String))
-> m String -> m (Maybe String -> (String, Maybe String))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m String
forall (m :: * -> *). CabalParsing m => m String
token m (Maybe String -> (String, Maybe String))
-> m (Maybe String) -> m (String, Maybe String)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m String -> m (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char ':' m Char -> m String -> m String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (m String
forall (m :: * -> *). CabalParsing m => m String
parsecHaskellString m String -> m String -> m String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m String
forall (m :: * -> *). CabalParsing m => m String
token))

    token :: CabalParsing m => m String
    token :: m String
token  = (Char -> Bool) -> m String
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m String
P.munch1 (\x :: 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
/= ':')

data UserBuildTargetProblem
   = UserBuildTargetUnrecognised String
  deriving Int -> UserBuildTargetProblem -> ShowS
[UserBuildTargetProblem] -> ShowS
UserBuildTargetProblem -> String
(Int -> UserBuildTargetProblem -> ShowS)
-> (UserBuildTargetProblem -> String)
-> ([UserBuildTargetProblem] -> ShowS)
-> Show UserBuildTargetProblem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserBuildTargetProblem] -> ShowS
$cshowList :: [UserBuildTargetProblem] -> ShowS
show :: UserBuildTargetProblem -> String
$cshow :: UserBuildTargetProblem -> String
showsPrec :: Int -> UserBuildTargetProblem -> ShowS
$cshowsPrec :: Int -> UserBuildTargetProblem -> ShowS
Show

reportUserBuildTargetProblems :: Verbosity -> [UserBuildTargetProblem] -> IO ()
reportUserBuildTargetProblems :: Verbosity -> [UserBuildTargetProblem] -> IO ()
reportUserBuildTargetProblems verbosity :: Verbosity
verbosity problems :: [UserBuildTargetProblem]
problems = do
    case [ String
target | UserBuildTargetUnrecognised target :: String
target <- [UserBuildTargetProblem]
problems ] of
      []     -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      target :: [String]
target ->
        Verbosity -> String -> IO ()
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
                [ "Unrecognised build target '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ "'."
                | String
name <- [String]
target ]
           String -> ShowS
forall a. [a] -> [a] -> [a]
++ "Examples:\n"
           String -> ShowS
forall a. [a] -> [a] -> [a]
++ " - build foo          -- component name "
           String -> ShowS
forall a. [a] -> [a] -> [a]
++ "(library, executable, test-suite or benchmark)\n"
           String -> ShowS
forall a. [a] -> [a] -> [a]
++ " - build Data.Foo     -- module name\n"
           String -> ShowS
forall a. [a] -> [a] -> [a]
++ " - build Data/Foo.hsc -- file name\n"
           String -> ShowS
forall a. [a] -> [a] -> [a]
++ " - build lib:foo exe:foo   -- component qualified by kind\n"
           String -> ShowS
forall a. [a] -> [a] -> [a]
++ " - build foo:Data.Foo      -- module qualified by component\n"
           String -> ShowS
forall a. [a] -> [a] -> [a]
++ " - build foo:Data/Foo.hsc  -- file qualified by component"

showUserBuildTarget :: UserBuildTarget -> String
showUserBuildTarget :: UserBuildTarget -> String
showUserBuildTarget = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate ":" ([String] -> String)
-> (UserBuildTarget -> [String]) -> UserBuildTarget -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserBuildTarget -> [String]
getComponents
  where
    getComponents :: UserBuildTarget -> [String]
getComponents (UserBuildTargetSingle s1 :: String
s1)       = [String
s1]
    getComponents (UserBuildTargetDouble s1 :: String
s1 s2 :: String
s2)    = [String
s1,String
s2]
    getComponents (UserBuildTargetTriple s1 :: String
s1 s2 :: String
s2 s3 :: String
s3) = [String
s1,String
s2,String
s3]

-- | Unless you use 'QL1', this function is PARTIAL;
-- use 'showBuildTarget' instead.
showBuildTarget' :: QualLevel -> PackageId -> BuildTarget -> String
showBuildTarget' :: QualLevel -> PackageId -> BuildTarget -> String
showBuildTarget' ql :: QualLevel
ql pkgid :: PackageId
pkgid bt :: BuildTarget
bt =
    UserBuildTarget -> String
showUserBuildTarget (QualLevel -> BuildTarget -> PackageId -> UserBuildTarget
renderBuildTarget QualLevel
ql BuildTarget
bt PackageId
pkgid)

-- | Unambiguously render a 'BuildTarget', so that it can
-- be parsed in all situations.
showBuildTarget :: PackageId -> BuildTarget -> String
showBuildTarget :: PackageId -> BuildTarget -> String
showBuildTarget pkgid :: PackageId
pkgid t :: BuildTarget
t =
    QualLevel -> PackageId -> BuildTarget -> String
showBuildTarget' (BuildTarget -> QualLevel
qlBuildTarget BuildTarget
t) PackageId
pkgid BuildTarget
t
  where
    qlBuildTarget :: BuildTarget -> QualLevel
qlBuildTarget BuildTargetComponent{} = QualLevel
QL2
    qlBuildTarget _                      = QualLevel
QL3


-- ------------------------------------------------------------
-- * Resolving user targets to build targets
-- ------------------------------------------------------------

{-
stargets =
  [ BuildTargetComponent (CExeName "foo")
  , BuildTargetModule    (CExeName "foo") (mkMn "Foo")
  , BuildTargetModule    (CExeName "tst") (mkMn "Foo")
  ]
    where
    mkMn :: String -> ModuleName
    mkMn  = fromJust . simpleParse

ex_pkgid :: PackageIdentifier
Just ex_pkgid = simpleParse "thelib"
-}

-- | Given a bunch of user-specified targets, try to resolve what it is they
-- refer to.
--
resolveBuildTargets :: PackageDescription
                    -> [(UserBuildTarget, Bool)]
                    -> ([BuildTargetProblem], [BuildTarget])
resolveBuildTargets :: PackageDescription
-> [(UserBuildTarget, Bool)]
-> ([BuildTargetProblem], [BuildTarget])
resolveBuildTargets pkg :: 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 pkg :: PackageDescription
pkg userTarget :: UserBuildTarget
userTarget fexists :: 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 target :: BuildTarget
target  -> BuildTarget -> Either BuildTargetProblem BuildTarget
forall a b. b -> Either a b
Right BuildTarget
target
      Ambiguous   targets :: [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        errs :: [MatchError]
errs    -> BuildTargetProblem -> Either BuildTargetProblem BuildTarget
forall a b. a -> Either a b
Left ([MatchError] -> BuildTargetProblem
classifyMatchErrors [MatchError]
errs)

  where
    classifyMatchErrors :: [MatchError] -> BuildTargetProblem
classifyMatchErrors errs :: [MatchError]
errs
      | Bool -> Bool
not ([(String, String)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, String)]
expected) = let (things :: [String]
things, got :: String
got:_) = [(String, String)] -> ([String], [String])
forall a b. [(a, b)] -> ([a], [b])
unzip [(String, String)]
expected in
                              UserBuildTarget -> [String] -> String -> BuildTargetProblem
BuildTargetExpected UserBuildTarget
userTarget [String]
things String
got
      | Bool -> Bool
not ([(String, String)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, String)]
nosuch)   = UserBuildTarget -> [(String, String)] -> BuildTargetProblem
BuildTargetNoSuch   UserBuildTarget
userTarget [(String, String)]
nosuch
      | Bool
otherwise = String -> BuildTargetProblem
forall a. HasCallStack => String -> a
error (String -> BuildTargetProblem) -> String -> BuildTargetProblem
forall a b. (a -> b) -> a -> b
$ "resolveBuildTarget: internal error in matching"
      where
        expected :: [(String, String)]
expected = [ (String
thing, String
got) | MatchErrorExpected thing :: String
thing got :: String
got <- [MatchError]
errs ]
        nosuch :: [(String, String)]
nosuch   = [ (String
thing, String
got) | MatchErrorNoSuch   thing :: String
thing got :: String
got <- [MatchError]
errs ]


data BuildTargetProblem
   = BuildTargetExpected  UserBuildTarget [String]  String
     -- ^  [expected thing] (actually got)
   | BuildTargetNoSuch    UserBuildTarget [(String, String)]
     -- ^ [(no such thing,  actually got)]
   | BuildTargetAmbiguous UserBuildTarget [(UserBuildTarget, BuildTarget)]
  deriving Int -> BuildTargetProblem -> ShowS
[BuildTargetProblem] -> ShowS
BuildTargetProblem -> String
(Int -> BuildTargetProblem -> ShowS)
-> (BuildTargetProblem -> String)
-> ([BuildTargetProblem] -> ShowS)
-> Show BuildTargetProblem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BuildTargetProblem] -> ShowS
$cshowList :: [BuildTargetProblem] -> ShowS
show :: BuildTargetProblem -> String
$cshow :: BuildTargetProblem -> String
showsPrec :: Int -> BuildTargetProblem -> ShowS
$cshowsPrec :: Int -> BuildTargetProblem -> ShowS
Show


disambiguateBuildTargets :: PackageId -> UserBuildTarget -> [BuildTarget]
                         -> [(UserBuildTarget, BuildTarget)]
disambiguateBuildTargets :: PackageId
-> UserBuildTarget
-> [BuildTarget]
-> [(UserBuildTarget, BuildTarget)]
disambiguateBuildTargets pkgid :: PackageId
pkgid original :: UserBuildTarget
original =
    QualLevel -> [BuildTarget] -> [(UserBuildTarget, BuildTarget)]
disambiguate (UserBuildTarget -> QualLevel
userTargetQualLevel UserBuildTarget
original)
  where
    disambiguate :: QualLevel -> [BuildTarget] -> [(UserBuildTarget, BuildTarget)]
disambiguate ql :: QualLevel
ql ts :: [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
        (amb :: [BuildTarget]
amb, unamb :: [(UserBuildTarget, BuildTarget)]
unamb) = QualLevel
-> [BuildTarget]
-> ([BuildTarget], [(UserBuildTarget, BuildTarget)])
step QualLevel
ql [BuildTarget]
ts

    userTargetQualLevel :: UserBuildTarget -> QualLevel
userTargetQualLevel (UserBuildTargetSingle _    ) = QualLevel
QL1
    userTargetQualLevel (UserBuildTargetDouble _ _  ) = QualLevel
QL2
    userTargetQualLevel (UserBuildTargetTriple _ _ _) = QualLevel
QL3

    step  :: QualLevel -> [BuildTarget]
          -> ([BuildTarget], [(UserBuildTarget, BuildTarget)])
    step :: QualLevel
-> [BuildTarget]
-> ([BuildTarget], [(UserBuildTarget, BuildTarget)])
step ql :: QualLevel
ql = (\(amb :: [[(UserBuildTarget, BuildTarget)]]
amb, unamb :: [[(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 (\g :: [(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
> 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 (\t :: 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 -> String
(Int -> QualLevel -> ShowS)
-> (QualLevel -> String)
-> ([QualLevel] -> ShowS)
-> Show QualLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QualLevel] -> ShowS
$cshowList :: [QualLevel] -> ShowS
show :: QualLevel -> String
$cshow :: QualLevel -> String
showsPrec :: Int -> QualLevel -> ShowS
$cshowsPrec :: Int -> QualLevel -> ShowS
Show)

renderBuildTarget :: QualLevel -> BuildTarget -> PackageId -> UserBuildTarget
renderBuildTarget :: QualLevel -> BuildTarget -> PackageId -> UserBuildTarget
renderBuildTarget ql :: QualLevel
ql target :: BuildTarget
target pkgid :: PackageId
pkgid =
    case QualLevel
ql of
      QL1 -> String -> UserBuildTarget
UserBuildTargetSingle String
s1        where  s1 :: String
s1          = BuildTarget -> String
single BuildTarget
target
      QL2 -> String -> String -> UserBuildTarget
UserBuildTargetDouble String
s1 String
s2     where (s1 :: String
s1, s2 :: String
s2)     = BuildTarget -> (String, String)
double BuildTarget
target
      QL3 -> String -> String -> String -> UserBuildTarget
UserBuildTargetTriple String
s1 String
s2 String
s3  where (s1 :: String
s1, s2 :: String
s2, s3 :: String
s3) = BuildTarget -> (String, String, String)
triple BuildTarget
target

  where
    single :: BuildTarget -> String
single (BuildTargetComponent cn :: ComponentName
cn  ) = ComponentName -> String
dispCName ComponentName
cn
    single (BuildTargetModule    _  m :: ModuleName
m) = ModuleName -> String
forall a. Pretty a => a -> String
prettyShow ModuleName
m
    single (BuildTargetFile      _  f :: String
f) = String
f

    double :: BuildTarget -> (String, String)
double (BuildTargetComponent cn :: ComponentName
cn  ) = (ComponentName -> String
dispKind ComponentName
cn, ComponentName -> String
dispCName ComponentName
cn)
    double (BuildTargetModule    cn :: ComponentName
cn m :: ModuleName
m) = (ComponentName -> String
dispCName ComponentName
cn, ModuleName -> String
forall a. Pretty a => a -> String
prettyShow ModuleName
m)
    double (BuildTargetFile      cn :: ComponentName
cn f :: String
f) = (ComponentName -> String
dispCName ComponentName
cn, String
f)

    triple :: BuildTarget -> (String, String, String)
triple (BuildTargetComponent _   ) = String -> (String, String, String)
forall a. HasCallStack => String -> a
error "triple BuildTargetComponent"
    triple (BuildTargetModule    cn :: ComponentName
cn m :: ModuleName
m) = (ComponentName -> String
dispKind ComponentName
cn, ComponentName -> String
dispCName ComponentName
cn, ModuleName -> String
forall a. Pretty a => a -> String
prettyShow ModuleName
m)
    triple (BuildTargetFile      cn :: ComponentName
cn f :: String
f) = (ComponentName -> String
dispKind ComponentName
cn, ComponentName -> String
dispCName ComponentName
cn, String
f)

    dispCName :: ComponentName -> String
dispCName = PackageId -> ComponentName -> String
forall pkg. Package pkg => pkg -> ComponentName -> String
componentStringName PackageId
pkgid
    dispKind :: ComponentName -> String
dispKind  = ComponentKind -> String
showComponentKindShort (ComponentKind -> String)
-> (ComponentName -> ComponentKind) -> ComponentName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ComponentName -> ComponentKind
componentKind

reportBuildTargetProblems :: Verbosity -> [BuildTargetProblem] -> IO ()
reportBuildTargetProblems :: Verbosity -> [BuildTargetProblem] -> IO ()
reportBuildTargetProblems verbosity :: Verbosity
verbosity problems :: [BuildTargetProblem]
problems = do

    case [ (UserBuildTarget
t, [String]
e, String
g) | BuildTargetExpected t :: UserBuildTarget
t e :: [String]
e g :: String
g <- [BuildTargetProblem]
problems ] of
      []      -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      targets :: [(UserBuildTarget, [String], String)]
targets ->
        Verbosity -> String -> IO ()
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
          [    "Unrecognised build target '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ UserBuildTarget -> String
showUserBuildTarget UserBuildTarget
target
            String -> ShowS
forall a. [a] -> [a] -> [a]
++ "'.\n"
            String -> ShowS
forall a. [a] -> [a] -> [a]
++ "Expected a " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate " or " [String]
expected
            String -> ShowS
forall a. [a] -> [a] -> [a]
++ ", rather than '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
got String -> ShowS
forall a. [a] -> [a] -> [a]
++ "'."
          | (target :: UserBuildTarget
target, expected :: [String]
expected, got :: String
got) <- [(UserBuildTarget, [String], String)]
targets ]

    case [ (UserBuildTarget
t, [(String, String)]
e) | BuildTargetNoSuch t :: UserBuildTarget
t e :: [(String, String)]
e <- [BuildTargetProblem]
problems ] of
      []      -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      targets :: [(UserBuildTarget, [(String, String)])]
targets ->
        Verbosity -> String -> IO ()
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
          [    "Unknown build target '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ UserBuildTarget -> String
showUserBuildTarget UserBuildTarget
target
            String -> ShowS
forall a. [a] -> [a] -> [a]
++ "'.\nThere is no "
            String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate " or " [ ShowS
mungeThing String
thing String -> ShowS
forall a. [a] -> [a] -> [a]
++ " '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
got String -> ShowS
forall a. [a] -> [a] -> [a]
++ "'"
                                  | (thing :: String
thing, got :: String
got) <- [(String, String)]
nosuch ] String -> ShowS
forall a. [a] -> [a] -> [a]
++ "."
          | (target :: UserBuildTarget
target, nosuch :: [(String, String)]
nosuch) <- [(UserBuildTarget, [(String, String)])]
targets ]
        where
          mungeThing :: ShowS
mungeThing "file" = "file target"
          mungeThing thing :: String
thing  = String
thing

    case [ (UserBuildTarget
t, [(UserBuildTarget, BuildTarget)]
ts) | BuildTargetAmbiguous t :: UserBuildTarget
t ts :: [(UserBuildTarget, BuildTarget)]
ts <- [BuildTargetProblem]
problems ] of
      []      -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      targets :: [(UserBuildTarget, [(UserBuildTarget, BuildTarget)])]
targets ->
        Verbosity -> String -> IO ()
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
          [    "Ambiguous build target '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ UserBuildTarget -> String
showUserBuildTarget UserBuildTarget
target
            String -> ShowS
forall a. [a] -> [a] -> [a]
++ "'. It could be:\n "
            String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
unlines [ "   "String -> ShowS
forall a. [a] -> [a] -> [a]
++ UserBuildTarget -> String
showUserBuildTarget UserBuildTarget
ut String -> ShowS
forall a. [a] -> [a] -> [a]
++
                         " (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ BuildTarget -> String
showBuildTargetKind BuildTarget
bt String -> ShowS
forall a. [a] -> [a] -> [a]
++ ")"
                       | (ut :: UserBuildTarget
ut, bt :: BuildTarget
bt) <- [(UserBuildTarget, BuildTarget)]
amb ]
          | (target :: UserBuildTarget
target, amb :: [(UserBuildTarget, BuildTarget)]
amb) <- [(UserBuildTarget, [(UserBuildTarget, BuildTarget)])]
targets ]

  where
    showBuildTargetKind :: BuildTarget -> String
showBuildTargetKind (BuildTargetComponent _  ) = "component"
    showBuildTargetKind (BuildTargetModule    _ _) = "module"
    showBuildTargetKind (BuildTargetFile      _ _) = "file"


----------------------------------
-- Top level BuildTarget matcher
--

matchBuildTarget :: PackageDescription
                 -> UserBuildTarget -> Bool -> Match BuildTarget
matchBuildTarget :: PackageDescription -> UserBuildTarget -> Bool -> Match BuildTarget
matchBuildTarget pkg :: PackageDescription
pkg = \utarget :: UserBuildTarget
utarget fexists :: Bool
fexists ->
    case UserBuildTarget
utarget of
      UserBuildTargetSingle str1 :: String
str1 ->
        [ComponentInfo] -> String -> Bool -> Match BuildTarget
matchBuildTarget1 [ComponentInfo]
cinfo String
str1 Bool
fexists

      UserBuildTargetDouble str1 :: String
str1 str2 :: String
str2 ->
        [ComponentInfo] -> String -> String -> Bool -> Match BuildTarget
matchBuildTarget2 [ComponentInfo]
cinfo String
str1 String
str2 Bool
fexists

      UserBuildTargetTriple str1 :: String
str1 str2 :: String
str2 str3 :: String
str3 ->
        [ComponentInfo]
-> String -> String -> String -> Bool -> Match BuildTarget
matchBuildTarget3 [ComponentInfo]
cinfo String
str1 String
str2 String
str3 Bool
fexists
  where
    cinfo :: [ComponentInfo]
cinfo = PackageDescription -> [ComponentInfo]
pkgComponentInfo PackageDescription
pkg

matchBuildTarget1 :: [ComponentInfo] -> String -> Bool -> Match BuildTarget
matchBuildTarget1 :: [ComponentInfo] -> String -> Bool -> Match BuildTarget
matchBuildTarget1 cinfo :: [ComponentInfo]
cinfo str1 :: String
str1 fexists :: Bool
fexists =
                        [ComponentInfo] -> String -> Match BuildTarget
matchComponent1 [ComponentInfo]
cinfo String
str1
   Match BuildTarget -> Match BuildTarget -> Match BuildTarget
forall a. Match a -> Match a -> Match a
`matchPlusShadowing` [ComponentInfo] -> String -> Match BuildTarget
matchModule1    [ComponentInfo]
cinfo String
str1
   Match BuildTarget -> Match BuildTarget -> Match BuildTarget
forall a. Match a -> Match a -> Match a
`matchPlusShadowing` [ComponentInfo] -> String -> Bool -> Match BuildTarget
matchFile1      [ComponentInfo]
cinfo String
str1 Bool
fexists


matchBuildTarget2 :: [ComponentInfo] -> String -> String -> Bool
                  -> Match BuildTarget
matchBuildTarget2 :: [ComponentInfo] -> String -> String -> Bool -> Match BuildTarget
matchBuildTarget2 cinfo :: [ComponentInfo]
cinfo str1 :: String
str1 str2 :: String
str2 fexists :: Bool
fexists =
                        [ComponentInfo] -> String -> String -> Match BuildTarget
matchComponent2 [ComponentInfo]
cinfo String
str1 String
str2
   Match BuildTarget -> Match BuildTarget -> Match BuildTarget
forall a. Match a -> Match a -> Match a
`matchPlusShadowing` [ComponentInfo] -> String -> String -> Match BuildTarget
matchModule2    [ComponentInfo]
cinfo String
str1 String
str2
   Match BuildTarget -> Match BuildTarget -> Match BuildTarget
forall a. Match a -> Match a -> Match a
`matchPlusShadowing` [ComponentInfo] -> String -> String -> Bool -> Match BuildTarget
matchFile2      [ComponentInfo]
cinfo String
str1 String
str2 Bool
fexists


matchBuildTarget3 :: [ComponentInfo] -> String -> String -> String -> Bool
                  -> Match BuildTarget
matchBuildTarget3 :: [ComponentInfo]
-> String -> String -> String -> Bool -> Match BuildTarget
matchBuildTarget3 cinfo :: [ComponentInfo]
cinfo str1 :: String
str1 str2 :: String
str2 str3 :: String
str3 fexists :: Bool
fexists =
                        [ComponentInfo] -> String -> String -> String -> Match BuildTarget
matchModule3    [ComponentInfo]
cinfo String
str1 String
str2 String
str3
   Match BuildTarget -> Match BuildTarget -> Match BuildTarget
forall a. Match a -> Match a -> Match a
`matchPlusShadowing` [ComponentInfo]
-> String -> String -> String -> Bool -> Match BuildTarget
matchFile3      [ComponentInfo]
cinfo String
str1 String
str2 String
str3 Bool
fexists


data ComponentInfo = ComponentInfo {
       ComponentInfo -> ComponentName
cinfoName    :: ComponentName,
       ComponentInfo -> String
cinfoStrName :: ComponentStringName,
       ComponentInfo -> [String]
cinfoSrcDirs :: [FilePath],
       ComponentInfo -> [ModuleName]
cinfoModules :: [ModuleName],
       ComponentInfo -> [String]
cinfoHsFiles :: [FilePath],   -- other hs files (like main.hs)
       ComponentInfo -> [String]
cinfoAsmFiles:: [FilePath],
       ComponentInfo -> [String]
cinfoCmmFiles:: [FilePath],
       ComponentInfo -> [String]
cinfoCFiles  :: [FilePath],
       ComponentInfo -> [String]
cinfoCxxFiles:: [FilePath],
       ComponentInfo -> [String]
cinfoJsFiles :: [FilePath]
     }

type ComponentStringName = String

pkgComponentInfo :: PackageDescription -> [ComponentInfo]
pkgComponentInfo :: PackageDescription -> [ComponentInfo]
pkgComponentInfo pkg :: PackageDescription
pkg =
    [ ComponentInfo :: ComponentName
-> String
-> [String]
-> [ModuleName]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> ComponentInfo
ComponentInfo {
        cinfoName :: ComponentName
cinfoName    = Component -> ComponentName
componentName Component
c,
        cinfoStrName :: String
cinfoStrName = PackageDescription -> ComponentName -> String
forall pkg. Package pkg => pkg -> ComponentName -> String
componentStringName PackageDescription
pkg (Component -> ComponentName
componentName Component
c),
        cinfoSrcDirs :: [String]
cinfoSrcDirs = BuildInfo -> [String]
hsSourceDirs BuildInfo
bi,
        cinfoModules :: [ModuleName]
cinfoModules = Component -> [ModuleName]
componentModules Component
c,
        cinfoHsFiles :: [String]
cinfoHsFiles = Component -> [String]
componentHsFiles Component
c,
        cinfoAsmFiles :: [String]
cinfoAsmFiles= BuildInfo -> [String]
asmSources BuildInfo
bi,
        cinfoCmmFiles :: [String]
cinfoCmmFiles= BuildInfo -> [String]
cmmSources BuildInfo
bi,
        cinfoCFiles :: [String]
cinfoCFiles  = BuildInfo -> [String]
cSources BuildInfo
bi,
        cinfoCxxFiles :: [String]
cinfoCxxFiles= BuildInfo -> [String]
cxxSources BuildInfo
bi,
        cinfoJsFiles :: [String]
cinfoJsFiles = BuildInfo -> [String]
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 :: pkg -> ComponentName -> String
componentStringName pkg :: pkg
pkg (CLibName LMainLibName      ) = PackageName -> String
forall a. Pretty a => a -> String
prettyShow (pkg -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName pkg
pkg)
componentStringName _   (CLibName (LSubLibName name :: UnqualComponentName
name)) = UnqualComponentName -> String
unUnqualComponentName UnqualComponentName
name
componentStringName _   (CFLibName  name :: UnqualComponentName
name) = UnqualComponentName -> String
unUnqualComponentName UnqualComponentName
name
componentStringName _   (CExeName   name :: UnqualComponentName
name) = UnqualComponentName -> String
unUnqualComponentName UnqualComponentName
name
componentStringName _   (CTestName  name :: UnqualComponentName
name) = UnqualComponentName -> String
unUnqualComponentName UnqualComponentName
name
componentStringName _   (CBenchName name :: UnqualComponentName
name) = UnqualComponentName -> String
unUnqualComponentName UnqualComponentName
name

componentModules :: Component -> [ModuleName]
-- TODO: Use of 'explicitLibModules' here is a bit wrong:
-- a user could very well ask to build a specific signature
-- that was inherited from other packages.  To fix this
-- we have to plumb 'LocalBuildInfo' through this code.
-- Fortunately, this is only used by 'pkgComponentInfo'
-- Please don't export this function unless you plan on fixing
-- this.
componentModules :: Component -> [ModuleName]
componentModules (CLib   lib :: Library
lib)   = Library -> [ModuleName]
explicitLibModules Library
lib
componentModules (CFLib  flib :: ForeignLib
flib)  = ForeignLib -> [ModuleName]
foreignLibModules ForeignLib
flib
componentModules (CExe   exe :: Executable
exe)   = Executable -> [ModuleName]
exeModules Executable
exe
componentModules (CTest  test :: TestSuite
test)  = TestSuite -> [ModuleName]
testModules TestSuite
test
componentModules (CBench bench :: Benchmark
bench) = Benchmark -> [ModuleName]
benchmarkModules Benchmark
bench

componentHsFiles :: Component -> [FilePath]
componentHsFiles :: Component -> [String]
componentHsFiles (CExe exe :: Executable
exe) = [Executable -> String
modulePath Executable
exe]
componentHsFiles (CTest  TestSuite {
                           testInterface :: TestSuite -> TestSuiteInterface
testInterface = TestSuiteExeV10 _ mainfile :: String
mainfile
                         }) = [String
mainfile]
componentHsFiles (CBench Benchmark {
                           benchmarkInterface :: Benchmark -> BenchmarkInterface
benchmarkInterface = BenchmarkExeV10 _ mainfile :: String
mainfile
                         }) = [String
mainfile]
componentHsFiles _          = []

{-
ex_cs :: [ComponentInfo]
ex_cs =
  [ (mkC (CExeName "foo") ["src1", "src1/src2"] ["Foo", "Src2.Bar", "Bar"])
  , (mkC (CExeName "tst") ["src1", "test"]      ["Foo"])
  ]
    where
    mkC n ds ms = ComponentInfo n (componentStringName pkgid n) ds (map mkMn ms)
    mkMn :: String -> ModuleName
    mkMn  = fromJust . simpleParse
    pkgid :: PackageIdentifier
    Just pkgid = simpleParse "thelib"
-}

------------------------------
-- Matching component kinds
--

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
$cp1Ord :: Eq ComponentKind
Ord, Int -> ComponentKind -> ShowS
[ComponentKind] -> ShowS
ComponentKind -> String
(Int -> ComponentKind -> ShowS)
-> (ComponentKind -> String)
-> ([ComponentKind] -> ShowS)
-> Show ComponentKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ComponentKind] -> ShowS
$cshowList :: [ComponentKind] -> ShowS
show :: ComponentKind -> String
$cshow :: ComponentKind -> String
showsPrec :: Int -> ComponentKind -> ShowS
$cshowsPrec :: Int -> ComponentKind -> ShowS
Show)

componentKind :: ComponentName -> ComponentKind
componentKind :: ComponentName -> ComponentKind
componentKind (CLibName   _) = ComponentKind
LibKind
componentKind (CFLibName  _) = ComponentKind
FLibKind
componentKind (CExeName   _) = ComponentKind
ExeKind
componentKind (CTestName  _) = ComponentKind
TestKind
componentKind (CBenchName _) = 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 :: String -> Match ComponentKind
matchComponentKind s :: String
s
  | String
s String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["lib", "library"]                 = ComponentKind -> Match ComponentKind
forall b. b -> Match b
return' ComponentKind
LibKind
  | String
s String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["flib", "foreign-lib", "foreign-library"] = ComponentKind -> Match ComponentKind
forall b. b -> Match b
return' ComponentKind
FLibKind
  | String
s String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["exe", "executable"]              = ComponentKind -> Match ComponentKind
forall b. b -> Match b
return' ComponentKind
ExeKind
  | String
s String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["tst", "test", "test-suite"]      = ComponentKind -> Match ComponentKind
forall b. b -> Match b
return' ComponentKind
TestKind
  | String
s String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["bench", "benchmark"]             = ComponentKind -> Match ComponentKind
forall b. b -> Match b
return' ComponentKind
BenchKind
  | Bool
otherwise = String -> String -> Match ComponentKind
forall a. String -> String -> Match a
matchErrorExpected "component kind" String
s
  where
    return' :: b -> Match b
return' ck :: 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 -> String
showComponentKind LibKind   = "library"
showComponentKind FLibKind  = "foreign-library"
showComponentKind ExeKind   = "executable"
showComponentKind TestKind  = "test-suite"
showComponentKind BenchKind = "benchmark"

showComponentKindShort :: ComponentKind -> String
showComponentKindShort :: ComponentKind -> String
showComponentKindShort LibKind   = "lib"
showComponentKindShort FLibKind  = "flib"
showComponentKindShort ExeKind   = "exe"
showComponentKindShort TestKind  = "test"
showComponentKindShort BenchKind = "bench"

------------------------------
-- Matching component targets
--

matchComponent1 :: [ComponentInfo] -> String -> Match BuildTarget
matchComponent1 :: [ComponentInfo] -> String -> Match BuildTarget
matchComponent1 cs :: [ComponentInfo]
cs = \str1 :: String
str1 -> do
    String -> Match ()
guardComponentName String
str1
    ComponentInfo
c <- [ComponentInfo] -> String -> Match ComponentInfo
matchComponentName [ComponentInfo]
cs String
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] -> String -> String -> Match BuildTarget
matchComponent2 cs :: [ComponentInfo]
cs = \str1 :: String
str1 str2 :: String
str2 -> do
    ComponentKind
ckind <- String -> Match ComponentKind
matchComponentKind String
str1
    String -> Match ()
guardComponentName String
str2
    ComponentInfo
c <- [ComponentInfo] -> ComponentKind -> String -> Match ComponentInfo
matchComponentKindAndName [ComponentInfo]
cs ComponentKind
ckind String
str2
    BuildTarget -> Match BuildTarget
forall (m :: * -> *) a. Monad m => a -> m a
return (ComponentName -> BuildTarget
BuildTargetComponent (ComponentInfo -> ComponentName
cinfoName ComponentInfo
c))

-- utils:

guardComponentName :: String -> Match ()
guardComponentName :: String -> Match ()
guardComponentName s :: String
s
  | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
validComponentChar String
s
    Bool -> Bool -> Bool
&& Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s)  = Match ()
increaseConfidence
  | Bool
otherwise        = String -> String -> Match ()
forall a. String -> String -> Match a
matchErrorExpected "component name" String
s
  where
    validComponentChar :: Char -> Bool
validComponentChar c :: Char
c = Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '.'
                        Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '_' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '-' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\''

matchComponentName :: [ComponentInfo] -> String -> Match ComponentInfo
matchComponentName :: [ComponentInfo] -> String -> Match ComponentInfo
matchComponentName cs :: [ComponentInfo]
cs str :: String
str =
    String -> String -> Match ComponentInfo -> Match ComponentInfo
forall a. String -> String -> Match a -> Match a
orNoSuchThing "component" String
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 -> [(String, ComponentInfo)] -> String -> Match ComponentInfo
forall a a' b.
(Ord a, Ord a') =>
(a -> a') -> [(a, b)] -> a -> Match b
matchInexactly ShowS
caseFold
      [ (ComponentInfo -> String
cinfoStrName ComponentInfo
c, ComponentInfo
c) | ComponentInfo
c <- [ComponentInfo]
cs ]
      String
str

matchComponentKindAndName :: [ComponentInfo] -> ComponentKind -> String
                          -> Match ComponentInfo
matchComponentKindAndName :: [ComponentInfo] -> ComponentKind -> String -> Match ComponentInfo
matchComponentKindAndName cs :: [ComponentInfo]
cs ckind :: ComponentKind
ckind str :: String
str =
    String -> String -> Match ComponentInfo -> Match ComponentInfo
forall a. String -> String -> Match a -> Match a
orNoSuchThing (ComponentKind -> String
showComponentKind ComponentKind
ckind String -> ShowS
forall a. [a] -> [a] -> [a]
++ " component") String
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, String) -> (ComponentKind, String))
-> [((ComponentKind, String), ComponentInfo)]
-> (ComponentKind, String)
-> Match ComponentInfo
forall a a' b.
(Ord a, Ord a') =>
(a -> a') -> [(a, b)] -> a -> Match b
matchInexactly (\(ck :: ComponentKind
ck, cn :: String
cn) -> (ComponentKind
ck, ShowS
caseFold String
cn))
      [ ((ComponentInfo -> ComponentKind
cinfoKind ComponentInfo
c, ComponentInfo -> String
cinfoStrName ComponentInfo
c), ComponentInfo
c) | ComponentInfo
c <- [ComponentInfo]
cs ]
      (ComponentKind
ckind, String
str)


------------------------------
-- Matching module targets
--

matchModule1 :: [ComponentInfo] -> String -> Match BuildTarget
matchModule1 :: [ComponentInfo] -> String -> Match BuildTarget
matchModule1 cs :: [ComponentInfo]
cs = \str1 :: String
str1 -> do
    String -> Match ()
guardModuleName String
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] -> String -> Match ModuleName
matchModuleName [ModuleName]
ms String
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] -> String -> String -> Match BuildTarget
matchModule2 cs :: [ComponentInfo]
cs = \str1 :: String
str1 str2 :: String
str2 -> do
    String -> Match ()
guardComponentName String
str1
    String -> Match ()
guardModuleName    String
str2
    ComponentInfo
c <- [ComponentInfo] -> String -> Match ComponentInfo
matchComponentName [ComponentInfo]
cs String
str1
    let ms :: [ModuleName]
ms = ComponentInfo -> [ModuleName]
cinfoModules ComponentInfo
c
    ModuleName
m <- [ModuleName] -> String -> Match ModuleName
matchModuleName [ModuleName]
ms String
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] -> String -> String -> String -> Match BuildTarget
matchModule3 cs :: [ComponentInfo]
cs str1 :: String
str1 str2 :: String
str2 str3 :: String
str3 = do
    ComponentKind
ckind <- String -> Match ComponentKind
matchComponentKind String
str1
    String -> Match ()
guardComponentName String
str2
    ComponentInfo
c <- [ComponentInfo] -> ComponentKind -> String -> Match ComponentInfo
matchComponentKindAndName [ComponentInfo]
cs ComponentKind
ckind String
str2
    String -> Match ()
guardModuleName    String
str3
    let ms :: [ModuleName]
ms = ComponentInfo -> [ModuleName]
cinfoModules ComponentInfo
c
    ModuleName
m <- [ModuleName] -> String -> Match ModuleName
matchModuleName [ModuleName]
ms String
str3
    BuildTarget -> Match BuildTarget
forall (m :: * -> *) a. Monad m => a -> m a
return (ComponentName -> ModuleName -> BuildTarget
BuildTargetModule (ComponentInfo -> ComponentName
cinfoName ComponentInfo
c) ModuleName
m)

-- utils:

guardModuleName :: String -> Match ()
guardModuleName :: String -> Match ()
guardModuleName s :: String
s
  | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
validModuleChar String
s
    Bool -> Bool -> Bool
&& Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s)       = Match ()
increaseConfidence
  | Bool
otherwise             = String -> String -> Match ()
forall a. String -> String -> Match a
matchErrorExpected "module name" String
s
  where
    validModuleChar :: Char -> Bool
validModuleChar c :: Char
c = Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '.' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '_' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\''

matchModuleName :: [ModuleName] -> String -> Match ModuleName
matchModuleName :: [ModuleName] -> String -> Match ModuleName
matchModuleName ms :: [ModuleName]
ms str :: String
str =
    String -> String -> Match ModuleName -> Match ModuleName
forall a. String -> String -> Match a -> Match a
orNoSuchThing "module" String
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 -> [(String, ModuleName)] -> String -> Match ModuleName
forall a a' b.
(Ord a, Ord a') =>
(a -> a') -> [(a, b)] -> a -> Match b
matchInexactly ShowS
caseFold
      [ (ModuleName -> String
forall a. Pretty a => a -> String
prettyShow ModuleName
m, ModuleName
m)
      | ModuleName
m <- [ModuleName]
ms ]
      String
str


------------------------------
-- Matching file targets
--

matchFile1 :: [ComponentInfo] -> String -> Bool -> Match BuildTarget
matchFile1 :: [ComponentInfo] -> String -> Bool -> Match BuildTarget
matchFile1 cs :: [ComponentInfo]
cs str1 :: String
str1 exists :: 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
      String
filepath <- ComponentInfo -> String -> Bool -> Match String
matchComponentFile ComponentInfo
c String
str1 Bool
exists
      BuildTarget -> Match BuildTarget
forall (m :: * -> *) a. Monad m => a -> m a
return (ComponentName -> String -> BuildTarget
BuildTargetFile (ComponentInfo -> ComponentName
cinfoName ComponentInfo
c) String
filepath)


matchFile2 :: [ComponentInfo] -> String -> String -> Bool -> Match BuildTarget
matchFile2 :: [ComponentInfo] -> String -> String -> Bool -> Match BuildTarget
matchFile2 cs :: [ComponentInfo]
cs str1 :: String
str1 str2 :: String
str2 exists :: Bool
exists = do
    String -> Match ()
guardComponentName String
str1
    ComponentInfo
c <- [ComponentInfo] -> String -> Match ComponentInfo
matchComponentName [ComponentInfo]
cs String
str1
    String
filepath <- ComponentInfo -> String -> Bool -> Match String
matchComponentFile ComponentInfo
c String
str2 Bool
exists
    BuildTarget -> Match BuildTarget
forall (m :: * -> *) a. Monad m => a -> m a
return (ComponentName -> String -> BuildTarget
BuildTargetFile (ComponentInfo -> ComponentName
cinfoName ComponentInfo
c) String
filepath)


matchFile3 :: [ComponentInfo] -> String -> String -> String -> Bool
           -> Match BuildTarget
matchFile3 :: [ComponentInfo]
-> String -> String -> String -> Bool -> Match BuildTarget
matchFile3 cs :: [ComponentInfo]
cs str1 :: String
str1 str2 :: String
str2 str3 :: String
str3 exists :: Bool
exists = do
    ComponentKind
ckind <- String -> Match ComponentKind
matchComponentKind String
str1
    String -> Match ()
guardComponentName String
str2
    ComponentInfo
c <- [ComponentInfo] -> ComponentKind -> String -> Match ComponentInfo
matchComponentKindAndName [ComponentInfo]
cs ComponentKind
ckind String
str2
    String
filepath <- ComponentInfo -> String -> Bool -> Match String
matchComponentFile ComponentInfo
c String
str3 Bool
exists
    BuildTarget -> Match BuildTarget
forall (m :: * -> *) a. Monad m => a -> m a
return (ComponentName -> String -> BuildTarget
BuildTargetFile (ComponentInfo -> ComponentName
cinfoName ComponentInfo
c) String
filepath)


matchComponentFile :: ComponentInfo -> String -> Bool -> Match FilePath
matchComponentFile :: ComponentInfo -> String -> Bool -> Match String
matchComponentFile c :: ComponentInfo
c str :: String
str fexists :: Bool
fexists =
    String -> String -> Match String -> Match String
forall a. String -> String -> Match a -> Match a
expecting "file" String
str (Match String -> Match String) -> Match String -> Match String
forall a b. (a -> b) -> a -> b
$
      Match String -> Match String -> Match String
forall a. Match a -> Match a -> Match a
matchPlus
        (String -> Bool -> Match String
forall a. String -> Bool -> Match a
matchFileExists String
str Bool
fexists)
        (Match String -> Match String -> Match String
forall a. Match a -> Match a -> Match a
matchPlusShadowing
          ([Match String] -> Match String
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [ [String] -> [ModuleName] -> String -> Match String
matchModuleFileRooted   [String]
dirs [ModuleName]
ms      String
str
                , [String] -> [String] -> String -> Match String
matchOtherFileRooted    [String]
dirs [String]
hsFiles String
str ])
          ([Match String] -> Match String
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [ [ModuleName] -> String -> Match String
matchModuleFileUnrooted      [ModuleName]
ms      String
str
                , [String] -> String -> Match String
matchOtherFileUnrooted       [String]
hsFiles String
str
                , [String] -> String -> Match String
matchOtherFileUnrooted       [String]
cFiles  String
str
                , [String] -> String -> Match String
matchOtherFileUnrooted       [String]
jsFiles String
str ]))
  where
    dirs :: [String]
dirs = ComponentInfo -> [String]
cinfoSrcDirs ComponentInfo
c
    ms :: [ModuleName]
ms   = ComponentInfo -> [ModuleName]
cinfoModules ComponentInfo
c
    hsFiles :: [String]
hsFiles = ComponentInfo -> [String]
cinfoHsFiles ComponentInfo
c
    cFiles :: [String]
cFiles  = ComponentInfo -> [String]
cinfoCFiles ComponentInfo
c
    jsFiles :: [String]
jsFiles = ComponentInfo -> [String]
cinfoJsFiles ComponentInfo
c


-- utils

matchFileExists :: FilePath -> Bool -> Match a
matchFileExists :: String -> Bool -> Match a
matchFileExists _     False = Match a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
matchFileExists fname :: String
fname True  = do Match ()
increaseConfidence
                                 String -> String -> Match a
forall a. String -> String -> Match a
matchErrorNoSuch "file" String
fname

matchModuleFileUnrooted :: [ModuleName] -> String -> Match FilePath
matchModuleFileUnrooted :: [ModuleName] -> String -> Match String
matchModuleFileUnrooted ms :: [ModuleName]
ms str :: String
str = do
    let filepath :: String
filepath = ShowS
normalise String
str
    ModuleName
_ <- [ModuleName] -> String -> Match ModuleName
matchModuleFileStem [ModuleName]
ms String
filepath
    String -> Match String
forall (m :: * -> *) a. Monad m => a -> m a
return String
filepath

matchModuleFileRooted :: [FilePath] -> [ModuleName] -> String -> Match FilePath
matchModuleFileRooted :: [String] -> [ModuleName] -> String -> Match String
matchModuleFileRooted dirs :: [String]
dirs ms :: [ModuleName]
ms str :: String
str = Match String -> Match String
forall a. Eq a => Match a -> Match a
nubMatches (Match String -> Match String) -> Match String -> Match String
forall a b. (a -> b) -> a -> b
$ do
    let filepath :: String
filepath = ShowS
normalise String
str
    String
filepath' <- [String] -> String -> Match String
matchDirectoryPrefix [String]
dirs String
filepath
    ModuleName
_ <- [ModuleName] -> String -> Match ModuleName
matchModuleFileStem [ModuleName]
ms String
filepath'
    String -> Match String
forall (m :: * -> *) a. Monad m => a -> m a
return String
filepath

matchModuleFileStem :: [ModuleName] -> FilePath -> Match ModuleName
matchModuleFileStem :: [ModuleName] -> String -> Match ModuleName
matchModuleFileStem ms :: [ModuleName]
ms =
      Match ModuleName -> Match ModuleName
forall a. Match a -> Match a
increaseConfidenceFor
    (Match ModuleName -> Match ModuleName)
-> (String -> Match ModuleName) -> String -> Match ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> [(String, ModuleName)] -> String -> Match ModuleName
forall a a' b.
(Ord a, Ord a') =>
(a -> a') -> [(a, b)] -> a -> Match b
matchInexactly ShowS
caseFold
        [ (ModuleName -> String
toFilePath ModuleName
m, ModuleName
m) | ModuleName
m <- [ModuleName]
ms ]
    (String -> Match ModuleName) -> ShowS -> String -> Match ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
dropExtension

matchOtherFileRooted :: [FilePath] -> [FilePath] -> FilePath -> Match FilePath
matchOtherFileRooted :: [String] -> [String] -> String -> Match String
matchOtherFileRooted dirs :: [String]
dirs fs :: [String]
fs str :: String
str = do
    let filepath :: String
filepath = ShowS
normalise String
str
    String
filepath' <- [String] -> String -> Match String
matchDirectoryPrefix [String]
dirs String
filepath
    String
_ <- [String] -> String -> Match String
matchFile [String]
fs String
filepath'
    String -> Match String
forall (m :: * -> *) a. Monad m => a -> m a
return String
filepath

matchOtherFileUnrooted :: [FilePath] -> FilePath -> Match FilePath
matchOtherFileUnrooted :: [String] -> String -> Match String
matchOtherFileUnrooted fs :: [String]
fs str :: String
str = do
    let filepath :: String
filepath = ShowS
normalise String
str
    String
_ <- [String] -> String -> Match String
matchFile [String]
fs String
filepath
    String -> Match String
forall (m :: * -> *) a. Monad m => a -> m a
return String
filepath

matchFile :: [FilePath] -> FilePath -> Match FilePath
matchFile :: [String] -> String -> Match String
matchFile fs :: [String]
fs = Match String -> Match String
forall a. Match a -> Match a
increaseConfidenceFor
             (Match String -> Match String)
-> (String -> Match String) -> String -> Match String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> [(String, String)] -> String -> Match String
forall a a' b.
(Ord a, Ord a') =>
(a -> a') -> [(a, b)] -> a -> Match b
matchInexactly ShowS
caseFold [ (String
f, String
f) | String
f <- [String]
fs ]

matchDirectoryPrefix :: [FilePath] -> FilePath -> Match FilePath
matchDirectoryPrefix :: [String] -> String -> Match String
matchDirectoryPrefix dirs :: [String]
dirs filepath :: String
filepath =
    [String] -> Match String
forall a. [a] -> Match a
exactMatches ([String] -> Match String) -> [String] -> Match String
forall a b. (a -> b) -> a -> b
$
      [Maybe String] -> [String]
forall a. [Maybe a] -> [a]
catMaybes
       [ String -> String -> Maybe String
stripDirectory (ShowS
normalise String
dir) String
filepath | String
dir <- [String]
dirs ]
  where
    stripDirectory :: FilePath -> FilePath -> Maybe FilePath
    stripDirectory :: String -> String -> Maybe String
stripDirectory dir :: String
dir fp :: String
fp =
      [String] -> String
joinPath ([String] -> String) -> Maybe [String] -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` [String] -> [String] -> Maybe [String]
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix (String -> [String]
splitDirectories String
dir) (String -> [String]
splitDirectories String
fp)


------------------------------
-- Matching monad
--

-- | A matcher embodies a way to match some input as being some recognised
-- value. In particular it deals with multiple and ambiguous matches.
--
-- There are various matcher primitives ('matchExactly', 'matchInexactly'),
-- ways to combine matchers ('ambiguousWith', 'shadows') and finally we can
-- run a matcher against an input using 'findMatch'.
--

data Match a = NoMatch      Confidence [MatchError]
             | ExactMatch   Confidence [a]
             | InexactMatch Confidence [a]
  deriving Int -> Match a -> ShowS
[Match a] -> ShowS
Match a -> String
(Int -> Match a -> ShowS)
-> (Match a -> String) -> ([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 -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Match a] -> ShowS
$cshowList :: forall a. Show a => [Match a] -> ShowS
show :: Match a -> String
$cshow :: forall a. Show a => Match a -> String
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 -> String
(Int -> MatchError -> ShowS)
-> (MatchError -> String)
-> ([MatchError] -> ShowS)
-> Show MatchError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MatchError] -> ShowS
$cshowList :: [MatchError] -> ShowS
show :: MatchError -> String
$cshow :: MatchError -> String
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 :: Match a
empty = Match a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
      <|> :: 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 :: Match a
mzero = Match a
forall a. Match a
matchZero
  mplus :: 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 :: Match a
matchZero = Int -> [MatchError] -> Match a
forall a. Int -> [MatchError] -> Match a
NoMatch 0 []

-- | Combine two matchers. Exact matches are used over inexact matches
-- but if we have multiple exact, or inexact then the we collect all the
-- ambiguous matches.
--
matchPlus :: Match a -> Match a -> Match a
matchPlus :: Match a -> Match a -> Match a
matchPlus   (ExactMatch   d1 :: Int
d1 xs :: [a]
xs)   (ExactMatch   d2 :: Int
d2 xs' :: [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   _  _ )   (InexactMatch _  _  ) = Match a
a
matchPlus a :: Match a
a@(ExactMatch   _  _ )   (NoMatch      _  _  ) = Match a
a
matchPlus   (InexactMatch _  _ ) b :: Match a
b@(ExactMatch   _  _  ) = Match a
b
matchPlus   (InexactMatch d1 :: Int
d1 xs :: [a]
xs)   (InexactMatch d2 :: Int
d2 xs' :: [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 _  _ )   (NoMatch      _  _  ) = Match a
a
matchPlus   (NoMatch      _  _ ) b :: Match a
b@(ExactMatch   _  _  ) = Match a
b
matchPlus   (NoMatch      _  _ ) b :: Match a
b@(InexactMatch _  _  ) = Match a
b
matchPlus a :: Match a
a@(NoMatch      d1 :: Int
d1 ms :: [MatchError]
ms) b :: Match a
b@(NoMatch      d2 :: Int
d2 ms' :: [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')

-- | Combine two matchers. This is similar to 'ambiguousWith' with the
-- difference that an exact match from the left matcher shadows any exact
-- match on the right. Inexact matches are still collected however.
--
matchPlusShadowing :: Match a -> Match a -> Match a
matchPlusShadowing :: Match a -> Match a -> Match a
matchPlusShadowing a :: Match a
a@(ExactMatch _ _) (ExactMatch _ _) = Match a
a
matchPlusShadowing a :: Match a
a                   b :: 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 :: (a -> b) -> Match a -> Match b
fmap _ (NoMatch      d :: Int
d ms :: [MatchError]
ms) = Int -> [MatchError] -> Match b
forall a. Int -> [MatchError] -> Match a
NoMatch      Int
d [MatchError]
ms
  fmap f :: a -> b
f (ExactMatch   d :: Int
d xs :: [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 f :: a -> b
f (InexactMatch d :: Int
d xs :: [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 :: a -> Match a
pure a :: a
a = Int -> [a] -> Match a
forall a. Int -> [a] -> Match a
ExactMatch 0 [a
a]
  <*> :: 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 :: a -> Match a
return = a -> Match a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

  NoMatch      d :: Int
d ms :: [MatchError]
ms >>= :: Match a -> (a -> Match b) -> Match b
>>= _ = Int -> [MatchError] -> Match b
forall a. Int -> [MatchError] -> Match a
NoMatch Int
d [MatchError]
ms
  ExactMatch   d :: Int
d xs :: [a]
xs >>= f :: 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 d :: Int
d xs :: [a]
xs >>= f :: 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 :: Int -> Match a -> Match a
addDepth d' :: Int
d' (NoMatch      d :: Int
d msgs :: [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 d' :: Int
d' (ExactMatch   d :: Int
d xs :: [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 d' :: Int
d' (InexactMatch d :: Int
d xs :: [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 :: Match a -> Match a
forceInexact (ExactMatch d :: Int
d ys :: [a]
ys) = Int -> [a] -> Match a
forall a. Int -> [a] -> Match a
InexactMatch Int
d [a]
ys
forceInexact m :: Match a
m                 = Match a
m

------------------------------
-- Various match primitives
--

matchErrorExpected, matchErrorNoSuch :: String -> String -> Match a
matchErrorExpected :: String -> String -> Match a
matchErrorExpected thing :: String
thing got :: String
got = Int -> [MatchError] -> Match a
forall a. Int -> [MatchError] -> Match a
NoMatch 0 [String -> String -> MatchError
MatchErrorExpected String
thing String
got]
matchErrorNoSuch :: String -> String -> Match a
matchErrorNoSuch   thing :: String
thing got :: String
got = Int -> [MatchError] -> Match a
forall a. Int -> [MatchError] -> Match a
NoMatch 0 [String -> String -> MatchError
MatchErrorNoSuch   String
thing String
got]

expecting :: String -> String -> Match a -> Match a
expecting :: String -> String -> Match a -> Match a
expecting thing :: String
thing got :: String
got (NoMatch 0 _) = String -> String -> Match a
forall a. String -> String -> Match a
matchErrorExpected String
thing String
got
expecting _     _   m :: Match a
m             = Match a
m

orNoSuchThing :: String -> String -> Match a -> Match a
orNoSuchThing :: String -> String -> Match a -> Match a
orNoSuchThing thing :: String
thing got :: String
got (NoMatch 0 _) = String -> String -> Match a
forall a. String -> String -> Match a
matchErrorNoSuch String
thing String
got
orNoSuchThing _     _   m :: Match a
m             = Match a
m

increaseConfidence :: Match ()
increaseConfidence :: Match ()
increaseConfidence = Int -> [()] -> Match ()
forall a. Int -> [a] -> Match a
ExactMatch 1 [()]

increaseConfidenceFor :: Match a -> Match a
increaseConfidenceFor :: Match a -> Match a
increaseConfidenceFor m :: 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
>>= \r :: 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 :: Match a -> Match a
nubMatches (NoMatch      d :: Int
d msgs :: [MatchError]
msgs) = Int -> [MatchError] -> Match a
forall a. Int -> [MatchError] -> Match a
NoMatch      Int
d [MatchError]
msgs
nubMatches (ExactMatch   d :: Int
d xs :: [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 d :: Int
d xs :: [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 :: Match a -> Match a
nubMatchErrors (NoMatch      d :: Int
d msgs :: [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   d :: Int
d xs :: [a]
xs)   = Int -> [a] -> Match a
forall a. Int -> [a] -> Match a
ExactMatch   Int
d [a]
xs
nubMatchErrors (InexactMatch d :: Int
d xs :: [a]
xs)   = Int -> [a] -> Match a
forall a. Int -> [a] -> Match a
InexactMatch Int
d [a]
xs

-- | Lift a list of matches to an exact match.
--
exactMatches, inexactMatches :: [a] -> Match a

exactMatches :: [a] -> Match a
exactMatches [] = Match a
forall a. Match a
matchZero
exactMatches xs :: [a]
xs = Int -> [a] -> Match a
forall a. Int -> [a] -> Match a
ExactMatch 0 [a]
xs

inexactMatches :: [a] -> Match a
inexactMatches [] = Match a
forall a. Match a
matchZero
inexactMatches xs :: [a]
xs = Int -> [a] -> Match a
forall a. Int -> [a] -> Match a
InexactMatch 0 [a]
xs

tryEach :: [a] -> Match a
tryEach :: [a] -> Match a
tryEach = [a] -> Match a
forall a. [a] -> Match a
exactMatches


------------------------------
-- Top level match runner
--

-- | Given a matcher and a key to look up, use the matcher to find all the
-- possible matches. There may be 'None', a single 'Unambiguous' match or
-- you may have an 'Ambiguous' match with several possibilities.
--
findMatch :: Eq b => Match b -> MaybeAmbiguous b
findMatch :: Match b -> MaybeAmbiguous b
findMatch match :: Match b
match =
    case Match b
match of
      NoMatch    _ msgs :: [MatchError]
msgs -> [MatchError] -> MaybeAmbiguous b
forall a. [MatchError] -> MaybeAmbiguous a
None ([MatchError] -> [MatchError]
forall a. Eq a => [a] -> [a]
nub [MatchError]
msgs)
      ExactMatch   _ xs :: [b]
xs -> [b] -> MaybeAmbiguous b
forall a. Eq a => [a] -> MaybeAmbiguous a
checkAmbiguous [b]
xs
      InexactMatch _ xs :: [b]
xs -> [b] -> MaybeAmbiguous b
forall a. Eq a => [a] -> MaybeAmbiguous a
checkAmbiguous [b]
xs
  where
    checkAmbiguous :: [a] -> MaybeAmbiguous a
checkAmbiguous xs :: [a]
xs = case [a] -> [a]
forall a. Eq a => [a] -> [a]
nub [a]
xs of
                          [x :: a
x] -> a -> MaybeAmbiguous a
forall a. a -> MaybeAmbiguous a
Unambiguous a
x
                          xs' :: [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 -> String
(Int -> MaybeAmbiguous a -> ShowS)
-> (MaybeAmbiguous a -> String)
-> ([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 -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MaybeAmbiguous a] -> ShowS
$cshowList :: forall a. Show a => [MaybeAmbiguous a] -> ShowS
show :: MaybeAmbiguous a -> String
$cshow :: forall a. Show a => MaybeAmbiguous a -> String
showsPrec :: Int -> MaybeAmbiguous a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> MaybeAmbiguous a -> ShowS
Show


------------------------------
-- Basic matchers
--

{-
-- | A primitive matcher that looks up a value in a finite 'Map'. The
-- value must match exactly.
--
matchExactly :: forall a b. Ord a => [(a, b)] -> (a -> Match b)
matchExactly xs =
    \x -> case Map.lookup x m of
            Nothing -> matchZero
            Just ys -> ExactMatch 0 ys
  where
    m :: Ord a => Map a [b]
    m = Map.fromListWith (++) [ (k,[x]) | (k,x) <- xs ]
-}

-- | A primitive matcher that looks up a value in a finite 'Map'. It checks
-- for an exact or inexact match. We get an inexact match if the match
-- is not exact, but the canonical forms match. It takes a canonicalisation
-- function for this purpose.
--
-- So for example if we used string case fold as the canonicalisation
-- function, then we would get case insensitive matching (but it will still
-- report an exact match when the case matches too).
--
matchInexactly :: (Ord a, Ord a') =>
                        (a -> a') ->
                        [(a, b)] -> (a -> Match b)
matchInexactly :: (a -> a') -> [(a, b)] -> a -> Match b
matchInexactly cannonicalise :: a -> a'
cannonicalise xs :: [(a, b)]
xs =
    \x :: 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 ys :: [b]
ys -> [b] -> Match b
forall a. [a] -> Match a
exactMatches [b]
ys
            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 ys :: [b]
ys -> [b] -> Match b
forall a. [a] -> Match a
inexactMatches [b]
ys
                         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]) | (k :: a
k,x :: b
x) <- [(a, b)]
xs ]

    -- the map of canonicalised keys to groups of inexact matches
    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



------------------------------
-- Utils
--

caseFold :: String -> String
caseFold :: ShowS
caseFold = ShowS
lowercase


-- | Check that the given build targets are valid in the current context.
--
-- Also swizzle into a more convenient form.
--
checkBuildTargets :: Verbosity -> PackageDescription -> LocalBuildInfo -> [BuildTarget]
                  -> IO [TargetInfo]
checkBuildTargets :: Verbosity
-> PackageDescription
-> LocalBuildInfo
-> [BuildTarget]
-> IO [TargetInfo]
checkBuildTargets _ pkg_descr :: PackageDescription
pkg_descr lbi :: 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
verbosity pkg_descr :: PackageDescription
pkg_descr lbi :: LocalBuildInfo
lbi targets :: [BuildTarget]
targets = do

    let (enabled :: [(ComponentName, Maybe (Either ModuleName String))]
enabled, disabled :: [(ComponentName, ComponentDisabledReason)]
disabled) =
          [Either
   (ComponentName, Maybe (Either ModuleName String))
   (ComponentName, ComponentDisabledReason)]
-> ([(ComponentName, Maybe (Either ModuleName String))],
    [(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
                Nothing     -> (ComponentName, Maybe (Either ModuleName String))
-> Either
     (ComponentName, Maybe (Either ModuleName String))
     (ComponentName, ComponentDisabledReason)
forall a b. a -> Either a b
Left  (ComponentName, Maybe (Either ModuleName String))
target'
                Just reason :: ComponentDisabledReason
reason -> (ComponentName, ComponentDisabledReason)
-> Either
     (ComponentName, Maybe (Either ModuleName String))
     (ComponentName, ComponentDisabledReason)
forall a b. b -> Either a b
Right (ComponentName
cname, ComponentDisabledReason
reason)
            | BuildTarget
target <- [BuildTarget]
targets
            , let target' :: (ComponentName, Maybe (Either ModuleName String))
target'@(cname :: ComponentName
cname,_) = BuildTarget -> (ComponentName, Maybe (Either ModuleName String))
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 ()
      ((cname :: ComponentName
cname,reason :: ComponentDisabledReason
reason):_) -> Verbosity -> String -> IO ()
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> ComponentDisabledReason -> String
formatReason (ComponentName -> String
showComponentName ComponentName
cname) ComponentDisabledReason
reason

    [(ComponentName, Either ModuleName String)]
-> ((ComponentName, Either ModuleName String) -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [ (ComponentName
c, Either ModuleName String
t) | (c :: ComponentName
c, Just t :: Either ModuleName String
t) <- [(ComponentName, Maybe (Either ModuleName String))]
enabled ] (((ComponentName, Either ModuleName String) -> IO ()) -> IO ())
-> ((ComponentName, Either ModuleName String) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(c :: ComponentName
c, t :: Either ModuleName String
t) ->
      Verbosity -> String -> IO ()
warn Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "Ignoring '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (ModuleName -> String)
-> ShowS -> Either ModuleName String -> String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ModuleName -> String
forall a. Pretty a => a -> String
prettyShow ShowS
forall a. a -> a
id Either ModuleName String
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ ". The whole "
                    String -> ShowS
forall a. [a] -> [a] -> [a]
++ ComponentName -> String
showComponentName ComponentName
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ " will be processed. (Support for "
                    String -> ShowS
forall a. [a] -> [a] -> [a]
++ "module and file targets has not been implemented yet.)"

    -- Pick out the actual CLBIs for each of these cnames
    [TargetInfo]
enabled' <- [(ComponentName, Maybe (Either ModuleName String))]
-> ((ComponentName, Maybe (Either ModuleName String))
    -> 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 String))]
enabled (((ComponentName, Maybe (Either ModuleName String))
  -> IO TargetInfo)
 -> IO [TargetInfo])
-> ((ComponentName, Maybe (Either ModuleName String))
    -> IO TargetInfo)
-> IO [TargetInfo]
forall a b. (a -> b) -> a -> b
$ \(cname :: ComponentName
cname, _) -> do
        case PackageDescription
-> LocalBuildInfo -> ComponentName -> [TargetInfo]
componentNameTargets' PackageDescription
pkg_descr LocalBuildInfo
lbi ComponentName
cname of
            [] -> String -> IO TargetInfo
forall a. HasCallStack => String -> a
error "checkBuildTargets: nothing enabled"
            [target :: TargetInfo
target] -> TargetInfo -> IO TargetInfo
forall (m :: * -> *) a. Monad m => a -> m a
return TargetInfo
target
            _targets :: [TargetInfo]
_targets -> String -> IO TargetInfo
forall a. HasCallStack => String -> a
error "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 String))
swizzleTarget (BuildTargetComponent c :: ComponentName
c)   = (ComponentName
c, Maybe (Either ModuleName String)
forall a. Maybe a
Nothing)
    swizzleTarget (BuildTargetModule    c :: ComponentName
c m :: ModuleName
m) = (ComponentName
c, Either ModuleName String -> Maybe (Either ModuleName String)
forall a. a -> Maybe a
Just (ModuleName -> Either ModuleName String
forall a b. a -> Either a b
Left  ModuleName
m))
    swizzleTarget (BuildTargetFile      c :: ComponentName
c f :: String
f) = (ComponentName
c, Either ModuleName String -> Maybe (Either ModuleName String)
forall a. a -> Maybe a
Just (String -> Either ModuleName String
forall a b. b -> Either a b
Right String
f))

    formatReason :: String -> ComponentDisabledReason -> String
formatReason cn :: String
cn DisabledComponent =
        "Cannot process the " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
cn String -> ShowS
forall a. [a] -> [a] -> [a]
++ " because the component is marked "
     String -> ShowS
forall a. [a] -> [a] -> [a]
++ "as disabled in the .cabal file."
    formatReason cn :: String
cn DisabledAllTests =
        "Cannot process the " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
cn String -> ShowS
forall a. [a] -> [a] -> [a]
++ " because test suites are not "
     String -> ShowS
forall a. [a] -> [a] -> [a]
++ "enabled. Run configure with the flag --enable-tests"
    formatReason cn :: String
cn DisabledAllBenchmarks =
        "Cannot process the " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
cn String -> ShowS
forall a. [a] -> [a] -> [a]
++ " because benchmarks are not "
     String -> ShowS
forall a. [a] -> [a] -> [a]
++ "enabled. Re-run configure with the flag --enable-benchmarks"
    formatReason cn :: String
cn (DisabledAllButOne cn' :: String
cn') =
        "Cannot process the " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
cn String -> ShowS
forall a. [a] -> [a] -> [a]
++ " because this package was "
     String -> ShowS
forall a. [a] -> [a] -> [a]
++ "configured only to build " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
cn' String -> ShowS
forall a. [a] -> [a] -> [a]
++ ". Re-run configure "
     String -> ShowS
forall a. [a] -> [a] -> [a]
++ "with the argument " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
cn