{-# LANGUAGE CPP, DeriveGeneric, DeriveFunctor,
             RecordWildCards, NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- TODO
{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Distribution.Client.TargetSelector
-- Copyright   :  (c) Duncan Coutts 2012, 2015, 2016
-- License     :  BSD-like
--
-- Maintainer  :  duncan@community.haskell.org
--
-- Handling for user-specified target selectors.
--
-----------------------------------------------------------------------------
module Distribution.Client.TargetSelector (

    -- * Target selectors
    TargetSelector(..),
    TargetImplicitCwd(..),
    ComponentKind(..),
    ComponentKindFilter,
    SubComponentTarget(..),
    QualLevel(..),
    componentKind,

    -- * Reading target selectors
    readTargetSelectors,
    TargetSelectorProblem(..),
    reportTargetSelectorProblems,
    showTargetSelector,
    TargetString(..),
    showTargetString,
    parseTargetString,
    -- ** non-IO
    readTargetSelectorsWith,
    DirActions(..),
    defaultDirActions,
  ) where

import Prelude ()
import Distribution.Client.Compat.Prelude

import Distribution.Package
         ( Package(..), PackageId, PackageName, packageName )
import Distribution.Types.UnqualComponentName
         ( UnqualComponentName, mkUnqualComponentName, unUnqualComponentName
         , packageNameToUnqualComponentName )
import Distribution.Client.Types
         ( PackageLocation(..), PackageSpecifier(..) )

import Distribution.PackageDescription
         ( PackageDescription
         , Executable(..)
         , TestSuite(..), TestSuiteInterface(..), testModules
         , Benchmark(..), BenchmarkInterface(..), benchmarkModules
         , BuildInfo(..), explicitLibModules, exeModules )
import Distribution.PackageDescription.Configuration
         ( flattenPackageDescription )
import Distribution.Solver.Types.SourcePackage
         ( SourcePackage(..) )
import Distribution.ModuleName
         ( ModuleName, toFilePath )
import Distribution.Simple.LocalBuildInfo
         ( Component(..), ComponentName(..), LibraryName(..)
         , pkgComponents, componentName, componentBuildInfo )
import Distribution.Types.ForeignLib

import Distribution.Simple.Utils
         ( die', lowercase, ordNub )
import Distribution.Client.Utils
         ( makeRelativeCanonical )

import Data.List
         ( stripPrefix, groupBy )
import qualified Data.List.NonEmpty as NE
import qualified Data.Map.Lazy   as Map.Lazy
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import Control.Arrow ((&&&))
import Control.Monad
  hiding ( mfilter )
import qualified Distribution.Deprecated.ReadP as Parse
import Distribution.Deprecated.ReadP
         ( (+++), (<++) )
import Distribution.Deprecated.ParseUtils
         ( readPToMaybe )
import System.FilePath as FilePath
         ( takeExtension, dropExtension
         , splitDirectories, joinPath, splitPath )
import qualified System.Directory as IO
         ( doesFileExist, doesDirectoryExist, canonicalizePath
         , getCurrentDirectory )
import System.FilePath
         ( (</>), (<.>), normalise, dropTrailingPathSeparator, equalFilePath )
import Text.EditDistance
         ( defaultEditCosts, restrictedDamerauLevenshteinDistance )
import Distribution.Utils.Path

import qualified Prelude (foldr1)

-- ------------------------------------------------------------
-- * Target selector terms
-- ------------------------------------------------------------

-- | A target selector is expression selecting a set of components (as targets
-- for a actions like @build@, @run@, @test@ etc). A target selector
-- corresponds to the user syntax for referring to targets on the command line.
--
-- From the users point of view a target can be many things: packages, dirs,
-- component names, files etc. Internally we consider a target to be a specific
-- component (or module\/file within a component), and all the users' notions
-- of targets are just different ways of referring to these component targets.
--
-- So target selectors are expressions in the sense that they are interpreted
-- to refer to one or more components. For example a 'TargetPackage' gets
-- interpreted differently by different commands to refer to all or a subset
-- of components within the package.
--
-- The syntax has lots of optional parts:
--
-- > [ package name | package dir | package .cabal file ]
-- > [ [lib:|exe:] component name ]
-- > [ module name | source file ]
--
data TargetSelector =

     -- | One (or more) packages as a whole, or all the components of a
     -- particular kind within the package(s).
     --
     -- These are always packages that are local to the project. In the case
     -- that there is more than one, they all share the same directory location.
     --
     TargetPackage TargetImplicitCwd [PackageId] (Maybe ComponentKindFilter)

     -- | A package specified by name. This may refer to @extra-packages@ from
     -- the @cabal.project@ file, or a dependency of a known project package or
     -- could refer to a package from a hackage archive. It needs further
     -- context to resolve to a specific package.
     --
   | TargetPackageNamed PackageName (Maybe ComponentKindFilter)

     -- | All packages, or all components of a particular kind in all packages.
     --
   | TargetAllPackages (Maybe ComponentKindFilter)

     -- | A specific component in a package within the project.
     --
   | TargetComponent PackageId ComponentName SubComponentTarget

     -- | A component in a package, but where it cannot be verified that the
     -- package has such a component, or because the package is itself not
     -- known.
     --
   | TargetComponentUnknown PackageName
                            (Either UnqualComponentName ComponentName)
                            SubComponentTarget
  deriving (TargetSelector -> TargetSelector -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TargetSelector -> TargetSelector -> Bool
$c/= :: TargetSelector -> TargetSelector -> Bool
== :: TargetSelector -> TargetSelector -> Bool
$c== :: TargetSelector -> TargetSelector -> Bool
Eq, Eq TargetSelector
TargetSelector -> TargetSelector -> Bool
TargetSelector -> TargetSelector -> Ordering
TargetSelector -> TargetSelector -> TargetSelector
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 :: TargetSelector -> TargetSelector -> TargetSelector
$cmin :: TargetSelector -> TargetSelector -> TargetSelector
max :: TargetSelector -> TargetSelector -> TargetSelector
$cmax :: TargetSelector -> TargetSelector -> TargetSelector
>= :: TargetSelector -> TargetSelector -> Bool
$c>= :: TargetSelector -> TargetSelector -> Bool
> :: TargetSelector -> TargetSelector -> Bool
$c> :: TargetSelector -> TargetSelector -> Bool
<= :: TargetSelector -> TargetSelector -> Bool
$c<= :: TargetSelector -> TargetSelector -> Bool
< :: TargetSelector -> TargetSelector -> Bool
$c< :: TargetSelector -> TargetSelector -> Bool
compare :: TargetSelector -> TargetSelector -> Ordering
$ccompare :: TargetSelector -> TargetSelector -> Ordering
Ord, Int -> TargetSelector -> ShowS
[TargetSelector] -> ShowS
TargetSelector -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [TargetSelector] -> ShowS
$cshowList :: [TargetSelector] -> ShowS
show :: TargetSelector -> FilePath
$cshow :: TargetSelector -> FilePath
showsPrec :: Int -> TargetSelector -> ShowS
$cshowsPrec :: Int -> TargetSelector -> ShowS
Show, forall x. Rep TargetSelector x -> TargetSelector
forall x. TargetSelector -> Rep TargetSelector x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TargetSelector x -> TargetSelector
$cfrom :: forall x. TargetSelector -> Rep TargetSelector x
Generic)

-- | Does this 'TargetPackage' selector arise from syntax referring to a
-- package in the current directory (e.g. @tests@ or no giving no explicit
-- target at all) or does it come from syntax referring to a package name
-- or location.
--
data TargetImplicitCwd = TargetImplicitCwd | TargetExplicitNamed
  deriving (TargetImplicitCwd -> TargetImplicitCwd -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TargetImplicitCwd -> TargetImplicitCwd -> Bool
$c/= :: TargetImplicitCwd -> TargetImplicitCwd -> Bool
== :: TargetImplicitCwd -> TargetImplicitCwd -> Bool
$c== :: TargetImplicitCwd -> TargetImplicitCwd -> Bool
Eq, Eq TargetImplicitCwd
TargetImplicitCwd -> TargetImplicitCwd -> Bool
TargetImplicitCwd -> TargetImplicitCwd -> Ordering
TargetImplicitCwd -> TargetImplicitCwd -> TargetImplicitCwd
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 :: TargetImplicitCwd -> TargetImplicitCwd -> TargetImplicitCwd
$cmin :: TargetImplicitCwd -> TargetImplicitCwd -> TargetImplicitCwd
max :: TargetImplicitCwd -> TargetImplicitCwd -> TargetImplicitCwd
$cmax :: TargetImplicitCwd -> TargetImplicitCwd -> TargetImplicitCwd
>= :: TargetImplicitCwd -> TargetImplicitCwd -> Bool
$c>= :: TargetImplicitCwd -> TargetImplicitCwd -> Bool
> :: TargetImplicitCwd -> TargetImplicitCwd -> Bool
$c> :: TargetImplicitCwd -> TargetImplicitCwd -> Bool
<= :: TargetImplicitCwd -> TargetImplicitCwd -> Bool
$c<= :: TargetImplicitCwd -> TargetImplicitCwd -> Bool
< :: TargetImplicitCwd -> TargetImplicitCwd -> Bool
$c< :: TargetImplicitCwd -> TargetImplicitCwd -> Bool
compare :: TargetImplicitCwd -> TargetImplicitCwd -> Ordering
$ccompare :: TargetImplicitCwd -> TargetImplicitCwd -> Ordering
Ord, Int -> TargetImplicitCwd -> ShowS
[TargetImplicitCwd] -> ShowS
TargetImplicitCwd -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [TargetImplicitCwd] -> ShowS
$cshowList :: [TargetImplicitCwd] -> ShowS
show :: TargetImplicitCwd -> FilePath
$cshow :: TargetImplicitCwd -> FilePath
showsPrec :: Int -> TargetImplicitCwd -> ShowS
$cshowsPrec :: Int -> TargetImplicitCwd -> ShowS
Show, forall x. Rep TargetImplicitCwd x -> TargetImplicitCwd
forall x. TargetImplicitCwd -> Rep TargetImplicitCwd x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TargetImplicitCwd x -> TargetImplicitCwd
$cfrom :: forall x. TargetImplicitCwd -> Rep TargetImplicitCwd x
Generic)

data ComponentKind = LibKind | FLibKind | ExeKind | TestKind | BenchKind
  deriving (ComponentKind -> ComponentKind -> Bool
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
ComponentKind -> ComponentKind -> Bool
ComponentKind -> ComponentKind -> Ordering
ComponentKind -> ComponentKind -> ComponentKind
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ComponentKind -> ComponentKind -> ComponentKind
$cmin :: ComponentKind -> ComponentKind -> ComponentKind
max :: ComponentKind -> ComponentKind -> ComponentKind
$cmax :: ComponentKind -> ComponentKind -> ComponentKind
>= :: ComponentKind -> ComponentKind -> Bool
$c>= :: ComponentKind -> ComponentKind -> Bool
> :: ComponentKind -> ComponentKind -> Bool
$c> :: ComponentKind -> ComponentKind -> Bool
<= :: ComponentKind -> ComponentKind -> Bool
$c<= :: ComponentKind -> ComponentKind -> Bool
< :: ComponentKind -> ComponentKind -> Bool
$c< :: ComponentKind -> ComponentKind -> Bool
compare :: ComponentKind -> ComponentKind -> Ordering
$ccompare :: ComponentKind -> ComponentKind -> Ordering
Ord, Int -> ComponentKind
ComponentKind -> Int
ComponentKind -> [ComponentKind]
ComponentKind -> ComponentKind
ComponentKind -> ComponentKind -> [ComponentKind]
ComponentKind -> ComponentKind -> ComponentKind -> [ComponentKind]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ComponentKind -> ComponentKind -> ComponentKind -> [ComponentKind]
$cenumFromThenTo :: ComponentKind -> ComponentKind -> ComponentKind -> [ComponentKind]
enumFromTo :: ComponentKind -> ComponentKind -> [ComponentKind]
$cenumFromTo :: ComponentKind -> ComponentKind -> [ComponentKind]
enumFromThen :: ComponentKind -> ComponentKind -> [ComponentKind]
$cenumFromThen :: ComponentKind -> ComponentKind -> [ComponentKind]
enumFrom :: ComponentKind -> [ComponentKind]
$cenumFrom :: ComponentKind -> [ComponentKind]
fromEnum :: ComponentKind -> Int
$cfromEnum :: ComponentKind -> Int
toEnum :: Int -> ComponentKind
$ctoEnum :: Int -> ComponentKind
pred :: ComponentKind -> ComponentKind
$cpred :: ComponentKind -> ComponentKind
succ :: ComponentKind -> ComponentKind
$csucc :: ComponentKind -> ComponentKind
Enum, Int -> ComponentKind -> ShowS
[ComponentKind] -> ShowS
ComponentKind -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ComponentKind] -> ShowS
$cshowList :: [ComponentKind] -> ShowS
show :: ComponentKind -> FilePath
$cshow :: ComponentKind -> FilePath
showsPrec :: Int -> ComponentKind -> ShowS
$cshowsPrec :: Int -> ComponentKind -> ShowS
Show)

type ComponentKindFilter = ComponentKind

-- | Either the component as a whole or detail about a file or module target
-- within a component.
--
data SubComponentTarget =

     -- | The component as a whole
     WholeComponent

     -- | A specific module within a component.
   | ModuleTarget ModuleName

     -- | A specific file within a component. Note that this does not carry the
     -- file extension.
   | FileTarget   FilePath
  deriving (SubComponentTarget -> SubComponentTarget -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SubComponentTarget -> SubComponentTarget -> Bool
$c/= :: SubComponentTarget -> SubComponentTarget -> Bool
== :: SubComponentTarget -> SubComponentTarget -> Bool
$c== :: SubComponentTarget -> SubComponentTarget -> Bool
Eq, Eq SubComponentTarget
SubComponentTarget -> SubComponentTarget -> Bool
SubComponentTarget -> SubComponentTarget -> Ordering
SubComponentTarget -> SubComponentTarget -> SubComponentTarget
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 :: SubComponentTarget -> SubComponentTarget -> SubComponentTarget
$cmin :: SubComponentTarget -> SubComponentTarget -> SubComponentTarget
max :: SubComponentTarget -> SubComponentTarget -> SubComponentTarget
$cmax :: SubComponentTarget -> SubComponentTarget -> SubComponentTarget
>= :: SubComponentTarget -> SubComponentTarget -> Bool
$c>= :: SubComponentTarget -> SubComponentTarget -> Bool
> :: SubComponentTarget -> SubComponentTarget -> Bool
$c> :: SubComponentTarget -> SubComponentTarget -> Bool
<= :: SubComponentTarget -> SubComponentTarget -> Bool
$c<= :: SubComponentTarget -> SubComponentTarget -> Bool
< :: SubComponentTarget -> SubComponentTarget -> Bool
$c< :: SubComponentTarget -> SubComponentTarget -> Bool
compare :: SubComponentTarget -> SubComponentTarget -> Ordering
$ccompare :: SubComponentTarget -> SubComponentTarget -> Ordering
Ord, Int -> SubComponentTarget -> ShowS
[SubComponentTarget] -> ShowS
SubComponentTarget -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [SubComponentTarget] -> ShowS
$cshowList :: [SubComponentTarget] -> ShowS
show :: SubComponentTarget -> FilePath
$cshow :: SubComponentTarget -> FilePath
showsPrec :: Int -> SubComponentTarget -> ShowS
$cshowsPrec :: Int -> SubComponentTarget -> ShowS
Show, forall x. Rep SubComponentTarget x -> SubComponentTarget
forall x. SubComponentTarget -> Rep SubComponentTarget x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SubComponentTarget x -> SubComponentTarget
$cfrom :: forall x. SubComponentTarget -> Rep SubComponentTarget x
Generic)

instance Binary SubComponentTarget
instance Structured SubComponentTarget


-- ------------------------------------------------------------
-- * Top level, do everything
-- ------------------------------------------------------------


-- | Parse a bunch of command line args as 'TargetSelector's, failing with an
-- error if any are unrecognised. The possible target selectors are based on
-- the available packages (and their locations).
--
readTargetSelectors :: [PackageSpecifier (SourcePackage (PackageLocation a))]
                    -> Maybe ComponentKindFilter
                    -- ^ This parameter is used when there are ambiguous selectors.
                    --   If it is 'Just', then we attempt to resolve ambiguity
                    --   by applying it, since otherwise there is no way to allow
                    --   contextually valid yet syntactically ambiguous selectors.
                    --   (#4676, #5461)
                    -> [String]
                    -> IO (Either [TargetSelectorProblem] [TargetSelector])
readTargetSelectors :: forall a.
[PackageSpecifier (SourcePackage (PackageLocation a))]
-> Maybe ComponentKind
-> [FilePath]
-> IO (Either [TargetSelectorProblem] [TargetSelector])
readTargetSelectors = forall (m :: * -> *) a.
(Applicative m, Monad m) =>
DirActions m
-> [PackageSpecifier (SourcePackage (PackageLocation a))]
-> Maybe ComponentKind
-> [FilePath]
-> m (Either [TargetSelectorProblem] [TargetSelector])
readTargetSelectorsWith DirActions IO
defaultDirActions

readTargetSelectorsWith :: (Applicative m, Monad m) => DirActions m
                        -> [PackageSpecifier (SourcePackage (PackageLocation a))]
                        -> Maybe ComponentKindFilter
                        -> [String]
                        -> m (Either [TargetSelectorProblem] [TargetSelector])
readTargetSelectorsWith :: forall (m :: * -> *) a.
(Applicative m, Monad m) =>
DirActions m
-> [PackageSpecifier (SourcePackage (PackageLocation a))]
-> Maybe ComponentKind
-> [FilePath]
-> m (Either [TargetSelectorProblem] [TargetSelector])
readTargetSelectorsWith dirActions :: DirActions m
dirActions@DirActions{} [PackageSpecifier (SourcePackage (PackageLocation a))]
pkgs Maybe ComponentKind
mfilter [FilePath]
targetStrs =
    case [FilePath] -> ([FilePath], [TargetString])
parseTargetStrings [FilePath]
targetStrs of
      ([], [TargetString]
usertargets) -> do
        [TargetStringFileStatus]
usertargets' <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (m :: * -> *).
(Applicative m, Monad m) =>
DirActions m -> TargetString -> m TargetStringFileStatus
getTargetStringFileStatus DirActions m
dirActions) [TargetString]
usertargets
        KnownTargets
knowntargets <- forall (m :: * -> *) a.
(Applicative m, Monad m) =>
DirActions m
-> [PackageSpecifier (SourcePackage (PackageLocation a))]
-> m KnownTargets
getKnownTargets DirActions m
dirActions [PackageSpecifier (SourcePackage (PackageLocation a))]
pkgs
        case KnownTargets
-> [TargetStringFileStatus]
-> Maybe ComponentKind
-> ([TargetSelectorProblem], [TargetSelector])
resolveTargetSelectors KnownTargets
knowntargets [TargetStringFileStatus]
usertargets' Maybe ComponentKind
mfilter of
          ([], [TargetSelector]
btargets) -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right [TargetSelector]
btargets)
          ([TargetSelectorProblem]
problems, [TargetSelector]
_)  -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left [TargetSelectorProblem]
problems)
      ([FilePath]
strs, [TargetString]
_)          -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left (forall a b. (a -> b) -> [a] -> [b]
map FilePath -> TargetSelectorProblem
TargetSelectorUnrecognised [FilePath]
strs))


data DirActions m = DirActions {
       forall (m :: * -> *). DirActions m -> FilePath -> m Bool
doesFileExist       :: FilePath -> m Bool,
       forall (m :: * -> *). DirActions m -> FilePath -> m Bool
doesDirectoryExist  :: FilePath -> m Bool,
       forall (m :: * -> *). DirActions m -> FilePath -> m FilePath
canonicalizePath    :: FilePath -> m FilePath,
       forall (m :: * -> *). DirActions m -> m FilePath
getCurrentDirectory :: m FilePath
     }

defaultDirActions :: DirActions IO
defaultDirActions :: DirActions IO
defaultDirActions =
    DirActions {
      doesFileExist :: FilePath -> IO Bool
doesFileExist       = FilePath -> IO Bool
IO.doesFileExist,
      doesDirectoryExist :: FilePath -> IO Bool
doesDirectoryExist  = FilePath -> IO Bool
IO.doesDirectoryExist,
      -- Workaround for <https://github.com/haskell/directory/issues/63>
      canonicalizePath :: FilePath -> IO FilePath
canonicalizePath    = FilePath -> IO FilePath
IO.canonicalizePath forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
dropTrailingPathSeparator,
      getCurrentDirectory :: IO FilePath
getCurrentDirectory = IO FilePath
IO.getCurrentDirectory
    }

makeRelativeToCwd :: Applicative m => DirActions m -> FilePath -> m FilePath
makeRelativeToCwd :: forall (m :: * -> *).
Applicative m =>
DirActions m -> FilePath -> m FilePath
makeRelativeToCwd DirActions{m FilePath
FilePath -> m Bool
FilePath -> m FilePath
getCurrentDirectory :: m FilePath
canonicalizePath :: FilePath -> m FilePath
doesDirectoryExist :: FilePath -> m Bool
doesFileExist :: FilePath -> m Bool
getCurrentDirectory :: forall (m :: * -> *). DirActions m -> m FilePath
canonicalizePath :: forall (m :: * -> *). DirActions m -> FilePath -> m FilePath
doesDirectoryExist :: forall (m :: * -> *). DirActions m -> FilePath -> m Bool
doesFileExist :: forall (m :: * -> *). DirActions m -> FilePath -> m Bool
..} FilePath
path =
    FilePath -> ShowS
makeRelativeCanonical forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> m FilePath
canonicalizePath FilePath
path forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m FilePath
getCurrentDirectory


-- ------------------------------------------------------------
-- * Parsing target strings
-- ------------------------------------------------------------

-- | The outline parse of a target selector. It takes one of the forms:
--
-- > str1
-- > str1:str2
-- > str1:str2:str3
-- > str1:str2:str3:str4
--
data TargetString =
     TargetString1 String
   | TargetString2 String String
   | TargetString3 String String String
   | TargetString4 String String String String
   | TargetString5 String String String String String
   | TargetString7 String String String String String String String
  deriving (Int -> TargetString -> ShowS
[TargetString] -> ShowS
TargetString -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [TargetString] -> ShowS
$cshowList :: [TargetString] -> ShowS
show :: TargetString -> FilePath
$cshow :: TargetString -> FilePath
showsPrec :: Int -> TargetString -> ShowS
$cshowsPrec :: Int -> TargetString -> ShowS
Show, TargetString -> TargetString -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TargetString -> TargetString -> Bool
$c/= :: TargetString -> TargetString -> Bool
== :: TargetString -> TargetString -> Bool
$c== :: TargetString -> TargetString -> Bool
Eq)

-- | Parse a bunch of 'TargetString's (purely without throwing exceptions).
--
parseTargetStrings :: [String] -> ([String], [TargetString])
parseTargetStrings :: [FilePath] -> ([FilePath], [TargetString])
parseTargetStrings =
    forall a b. [Either a b] -> ([a], [b])
partitionEithers
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\FilePath
str -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left FilePath
str) forall a b. b -> Either a b
Right (FilePath -> Maybe TargetString
parseTargetString FilePath
str))

parseTargetString :: String -> Maybe TargetString
parseTargetString :: FilePath -> Maybe TargetString
parseTargetString =
    forall a. ReadP a a -> FilePath -> Maybe a
readPToMaybe forall r. ReadP r TargetString
parseTargetApprox
  where
    parseTargetApprox :: Parse.ReadP r TargetString
    parseTargetApprox :: forall r. ReadP r TargetString
parseTargetApprox =
          (do FilePath
a <- forall {r}. ReadP r FilePath
tokenQ
              forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> TargetString
TargetString1 FilePath
a))
      forall r a. ReadP r a -> ReadP r a -> ReadP r a
+++ (do FilePath
a <- forall {r}. ReadP r FilePath
tokenQ0
              Char
_ <- forall r. Char -> ReadP r Char
Parse.char Char
':'
              FilePath
b <- forall {r}. ReadP r FilePath
tokenQ
              forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> FilePath -> TargetString
TargetString2 FilePath
a FilePath
b))
      forall r a. ReadP r a -> ReadP r a -> ReadP r a
+++ (do FilePath
a <- forall {r}. ReadP r FilePath
tokenQ0
              Char
_ <- forall r. Char -> ReadP r Char
Parse.char Char
':'
              FilePath
b <- forall {r}. ReadP r FilePath
tokenQ
              Char
_ <- forall r. Char -> ReadP r Char
Parse.char Char
':'
              FilePath
c <- forall {r}. ReadP r FilePath
tokenQ
              forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> FilePath -> FilePath -> TargetString
TargetString3 FilePath
a FilePath
b FilePath
c))
      forall r a. ReadP r a -> ReadP r a -> ReadP r a
+++ (do FilePath
a <- forall {r}. ReadP r FilePath
tokenQ0
              Char
_ <- forall r. Char -> ReadP r Char
Parse.char Char
':'
              FilePath
b <- forall {r}. ReadP r FilePath
token
              Char
_ <- forall r. Char -> ReadP r Char
Parse.char Char
':'
              FilePath
c <- forall {r}. ReadP r FilePath
tokenQ
              Char
_ <- forall r. Char -> ReadP r Char
Parse.char Char
':'
              FilePath
d <- forall {r}. ReadP r FilePath
tokenQ
              forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> FilePath -> FilePath -> FilePath -> TargetString
TargetString4 FilePath
a FilePath
b FilePath
c FilePath
d))
      forall r a. ReadP r a -> ReadP r a -> ReadP r a
+++ (do FilePath
a <- forall {r}. ReadP r FilePath
tokenQ0
              Char
_ <- forall r. Char -> ReadP r Char
Parse.char Char
':'
              FilePath
b <- forall {r}. ReadP r FilePath
token
              Char
_ <- forall r. Char -> ReadP r Char
Parse.char Char
':'
              FilePath
c <- forall {r}. ReadP r FilePath
tokenQ
              Char
_ <- forall r. Char -> ReadP r Char
Parse.char Char
':'
              FilePath
d <- forall {r}. ReadP r FilePath
tokenQ
              Char
_ <- forall r. Char -> ReadP r Char
Parse.char Char
':'
              FilePath
e <- forall {r}. ReadP r FilePath
tokenQ
              forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
-> FilePath -> FilePath -> FilePath -> FilePath -> TargetString
TargetString5 FilePath
a FilePath
b FilePath
c FilePath
d FilePath
e))
      forall r a. ReadP r a -> ReadP r a -> ReadP r a
+++ (do FilePath
a <- forall {r}. ReadP r FilePath
tokenQ0
              Char
_ <- forall r. Char -> ReadP r Char
Parse.char Char
':'
              FilePath
b <- forall {r}. ReadP r FilePath
token
              Char
_ <- forall r. Char -> ReadP r Char
Parse.char Char
':'
              FilePath
c <- forall {r}. ReadP r FilePath
tokenQ
              Char
_ <- forall r. Char -> ReadP r Char
Parse.char Char
':'
              FilePath
d <- forall {r}. ReadP r FilePath
tokenQ
              Char
_ <- forall r. Char -> ReadP r Char
Parse.char Char
':'
              FilePath
e <- forall {r}. ReadP r FilePath
tokenQ
              Char
_ <- forall r. Char -> ReadP r Char
Parse.char Char
':'
              FilePath
f <- forall {r}. ReadP r FilePath
tokenQ
              Char
_ <- forall r. Char -> ReadP r Char
Parse.char Char
':'
              FilePath
g <- forall {r}. ReadP r FilePath
tokenQ
              forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> TargetString
TargetString7 FilePath
a FilePath
b FilePath
c FilePath
d FilePath
e FilePath
f FilePath
g))

    token :: ReadP r FilePath
token  = forall r. (Char -> Bool) -> ReadP r FilePath
Parse.munch1 (\Char
x -> Bool -> Bool
not (Char -> Bool
isSpace Char
x) Bool -> Bool -> Bool
&& Char
x forall a. Eq a => a -> a -> Bool
/= Char
':')
    tokenQ :: ReadP r FilePath
tokenQ = forall {r}. ReadP r FilePath
parseHaskellString forall a r. ReadP a a -> ReadP r a -> ReadP r a
<++ forall {r}. ReadP r FilePath
token
    token0 :: ReadP r FilePath
token0 = forall r. (Char -> Bool) -> ReadP r FilePath
Parse.munch (\Char
x -> Bool -> Bool
not (Char -> Bool
isSpace Char
x) Bool -> Bool -> Bool
&& Char
x forall a. Eq a => a -> a -> Bool
/= Char
':')
    tokenQ0 :: ReadP r FilePath
tokenQ0= forall {r}. ReadP r FilePath
parseHaskellString forall a r. ReadP a a -> ReadP r a -> ReadP r a
<++ forall {r}. ReadP r FilePath
token0
    parseHaskellString :: Parse.ReadP r String
    parseHaskellString :: forall {r}. ReadP r FilePath
parseHaskellString = forall a r. ReadS a -> ReadP r a
Parse.readS_to_P forall a. Read a => ReadS a
reads


-- | Render a 'TargetString' back as the external syntax. This is mainly for
-- error messages.
--
showTargetString :: TargetString -> String
showTargetString :: TargetString -> FilePath
showTargetString = forall a. [a] -> [[a]] -> [a]
intercalate FilePath
":" forall b c a. (b -> c) -> (a -> b) -> a -> c
. TargetString -> [FilePath]
components
  where
    components :: TargetString -> [FilePath]
components (TargetString1 FilePath
s1)          = [FilePath
s1]
    components (TargetString2 FilePath
s1 FilePath
s2)       = [FilePath
s1,FilePath
s2]
    components (TargetString3 FilePath
s1 FilePath
s2 FilePath
s3)    = [FilePath
s1,FilePath
s2,FilePath
s3]
    components (TargetString4 FilePath
s1 FilePath
s2 FilePath
s3 FilePath
s4) = [FilePath
s1,FilePath
s2,FilePath
s3,FilePath
s4]
    components (TargetString5 FilePath
s1 FilePath
s2 FilePath
s3 FilePath
s4 FilePath
s5)       = [FilePath
s1,FilePath
s2,FilePath
s3,FilePath
s4,FilePath
s5]
    components (TargetString7 FilePath
s1 FilePath
s2 FilePath
s3 FilePath
s4 FilePath
s5 FilePath
s6 FilePath
s7) = [FilePath
s1,FilePath
s2,FilePath
s3,FilePath
s4,FilePath
s5,FilePath
s6,FilePath
s7]

showTargetSelector :: TargetSelector -> String
showTargetSelector :: TargetSelector -> FilePath
showTargetSelector TargetSelector
ts =
  case [ TargetStringFileStatus
t | QualLevel
ql <- [QualLevel
QL1 .. QualLevel
QLFull]
           , TargetStringFileStatus
t  <- QualLevel -> TargetSelector -> [TargetStringFileStatus]
renderTargetSelector QualLevel
ql TargetSelector
ts ]
  of (TargetStringFileStatus
t':[TargetStringFileStatus]
_) -> TargetString -> FilePath
showTargetString (TargetStringFileStatus -> TargetString
forgetFileStatus TargetStringFileStatus
t')
     [] -> FilePath
""

showTargetSelectorKind :: TargetSelector -> String
showTargetSelectorKind :: TargetSelector -> FilePath
showTargetSelectorKind TargetSelector
bt = case TargetSelector
bt of
  TargetPackage TargetImplicitCwd
TargetExplicitNamed [PackageId]
_ Maybe ComponentKind
Nothing  -> FilePath
"package"
  TargetPackage TargetImplicitCwd
TargetExplicitNamed [PackageId]
_ (Just ComponentKind
_) -> FilePath
"package:filter"
  TargetPackage TargetImplicitCwd
TargetImplicitCwd   [PackageId]
_ Maybe ComponentKind
Nothing  -> FilePath
"cwd-package"
  TargetPackage TargetImplicitCwd
TargetImplicitCwd   [PackageId]
_ (Just ComponentKind
_) -> FilePath
"cwd-package:filter"
  TargetPackageNamed                PackageName
_ Maybe ComponentKind
Nothing  -> FilePath
"named-package"
  TargetPackageNamed                PackageName
_ (Just ComponentKind
_) -> FilePath
"named-package:filter"
  TargetAllPackages Maybe ComponentKind
Nothing                    -> FilePath
"package *"
  TargetAllPackages (Just ComponentKind
_)                   -> FilePath
"package *:filter"
  TargetComponent        PackageId
_ ComponentName
_ SubComponentTarget
WholeComponent    -> FilePath
"component"
  TargetComponent        PackageId
_ ComponentName
_ ModuleTarget{}    -> FilePath
"module"
  TargetComponent        PackageId
_ ComponentName
_ FileTarget{}      -> FilePath
"file"
  TargetComponentUnknown PackageName
_ Either UnqualComponentName ComponentName
_ SubComponentTarget
WholeComponent    -> FilePath
"unknown-component"
  TargetComponentUnknown PackageName
_ Either UnqualComponentName ComponentName
_ ModuleTarget{}    -> FilePath
"unknown-module"
  TargetComponentUnknown PackageName
_ Either UnqualComponentName ComponentName
_ FileTarget{}      -> FilePath
"unknown-file"


-- ------------------------------------------------------------
-- * Checking if targets exist as files
-- ------------------------------------------------------------

data TargetStringFileStatus =
     TargetStringFileStatus1 String FileStatus
   | TargetStringFileStatus2 String FileStatus String
   | TargetStringFileStatus3 String FileStatus String String
   | TargetStringFileStatus4 String String String String
   | TargetStringFileStatus5 String String String String String
   | TargetStringFileStatus7 String String String String String String String
  deriving (TargetStringFileStatus -> TargetStringFileStatus -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TargetStringFileStatus -> TargetStringFileStatus -> Bool
$c/= :: TargetStringFileStatus -> TargetStringFileStatus -> Bool
== :: TargetStringFileStatus -> TargetStringFileStatus -> Bool
$c== :: TargetStringFileStatus -> TargetStringFileStatus -> Bool
Eq, Eq TargetStringFileStatus
TargetStringFileStatus -> TargetStringFileStatus -> Bool
TargetStringFileStatus -> TargetStringFileStatus -> Ordering
TargetStringFileStatus
-> TargetStringFileStatus -> TargetStringFileStatus
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 :: TargetStringFileStatus
-> TargetStringFileStatus -> TargetStringFileStatus
$cmin :: TargetStringFileStatus
-> TargetStringFileStatus -> TargetStringFileStatus
max :: TargetStringFileStatus
-> TargetStringFileStatus -> TargetStringFileStatus
$cmax :: TargetStringFileStatus
-> TargetStringFileStatus -> TargetStringFileStatus
>= :: TargetStringFileStatus -> TargetStringFileStatus -> Bool
$c>= :: TargetStringFileStatus -> TargetStringFileStatus -> Bool
> :: TargetStringFileStatus -> TargetStringFileStatus -> Bool
$c> :: TargetStringFileStatus -> TargetStringFileStatus -> Bool
<= :: TargetStringFileStatus -> TargetStringFileStatus -> Bool
$c<= :: TargetStringFileStatus -> TargetStringFileStatus -> Bool
< :: TargetStringFileStatus -> TargetStringFileStatus -> Bool
$c< :: TargetStringFileStatus -> TargetStringFileStatus -> Bool
compare :: TargetStringFileStatus -> TargetStringFileStatus -> Ordering
$ccompare :: TargetStringFileStatus -> TargetStringFileStatus -> Ordering
Ord, Int -> TargetStringFileStatus -> ShowS
[TargetStringFileStatus] -> ShowS
TargetStringFileStatus -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [TargetStringFileStatus] -> ShowS
$cshowList :: [TargetStringFileStatus] -> ShowS
show :: TargetStringFileStatus -> FilePath
$cshow :: TargetStringFileStatus -> FilePath
showsPrec :: Int -> TargetStringFileStatus -> ShowS
$cshowsPrec :: Int -> TargetStringFileStatus -> ShowS
Show)

data FileStatus = FileStatusExistsFile FilePath -- the canonicalised filepath
                | FileStatusExistsDir  FilePath -- the canonicalised filepath
                | FileStatusNotExists  Bool -- does the parent dir exist even?
  deriving (FileStatus -> FileStatus -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileStatus -> FileStatus -> Bool
$c/= :: FileStatus -> FileStatus -> Bool
== :: FileStatus -> FileStatus -> Bool
$c== :: FileStatus -> FileStatus -> Bool
Eq, Eq FileStatus
FileStatus -> FileStatus -> Bool
FileStatus -> FileStatus -> Ordering
FileStatus -> FileStatus -> FileStatus
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 :: FileStatus -> FileStatus -> FileStatus
$cmin :: FileStatus -> FileStatus -> FileStatus
max :: FileStatus -> FileStatus -> FileStatus
$cmax :: FileStatus -> FileStatus -> FileStatus
>= :: FileStatus -> FileStatus -> Bool
$c>= :: FileStatus -> FileStatus -> Bool
> :: FileStatus -> FileStatus -> Bool
$c> :: FileStatus -> FileStatus -> Bool
<= :: FileStatus -> FileStatus -> Bool
$c<= :: FileStatus -> FileStatus -> Bool
< :: FileStatus -> FileStatus -> Bool
$c< :: FileStatus -> FileStatus -> Bool
compare :: FileStatus -> FileStatus -> Ordering
$ccompare :: FileStatus -> FileStatus -> Ordering
Ord, Int -> FileStatus -> ShowS
[FileStatus] -> ShowS
FileStatus -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [FileStatus] -> ShowS
$cshowList :: [FileStatus] -> ShowS
show :: FileStatus -> FilePath
$cshow :: FileStatus -> FilePath
showsPrec :: Int -> FileStatus -> ShowS
$cshowsPrec :: Int -> FileStatus -> ShowS
Show)

noFileStatus :: FileStatus
noFileStatus :: FileStatus
noFileStatus = Bool -> FileStatus
FileStatusNotExists Bool
False

getTargetStringFileStatus :: (Applicative m, Monad m) => DirActions m
                          -> TargetString -> m TargetStringFileStatus
getTargetStringFileStatus :: forall (m :: * -> *).
(Applicative m, Monad m) =>
DirActions m -> TargetString -> m TargetStringFileStatus
getTargetStringFileStatus DirActions{m FilePath
FilePath -> m Bool
FilePath -> m FilePath
getCurrentDirectory :: m FilePath
canonicalizePath :: FilePath -> m FilePath
doesDirectoryExist :: FilePath -> m Bool
doesFileExist :: FilePath -> m Bool
getCurrentDirectory :: forall (m :: * -> *). DirActions m -> m FilePath
canonicalizePath :: forall (m :: * -> *). DirActions m -> FilePath -> m FilePath
doesDirectoryExist :: forall (m :: * -> *). DirActions m -> FilePath -> m Bool
doesFileExist :: forall (m :: * -> *). DirActions m -> FilePath -> m Bool
..} TargetString
t =
    case TargetString
t of
      TargetString1 FilePath
s1 ->
        (\FileStatus
f1 -> FilePath -> FileStatus -> TargetStringFileStatus
TargetStringFileStatus1 FilePath
s1 FileStatus
f1)          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> m FileStatus
fileStatus FilePath
s1
      TargetString2 FilePath
s1 FilePath
s2 ->
        (\FileStatus
f1 -> FilePath -> FileStatus -> FilePath -> TargetStringFileStatus
TargetStringFileStatus2 FilePath
s1 FileStatus
f1 FilePath
s2)       forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> m FileStatus
fileStatus FilePath
s1
      TargetString3 FilePath
s1 FilePath
s2 FilePath
s3 ->
        (\FileStatus
f1 -> FilePath
-> FileStatus -> FilePath -> FilePath -> TargetStringFileStatus
TargetStringFileStatus3 FilePath
s1 FileStatus
f1 FilePath
s2 FilePath
s3)    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> m FileStatus
fileStatus FilePath
s1
      TargetString4 FilePath
s1 FilePath
s2 FilePath
s3 FilePath
s4 ->
        forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
-> FilePath -> FilePath -> FilePath -> TargetStringFileStatus
TargetStringFileStatus4 FilePath
s1 FilePath
s2 FilePath
s3 FilePath
s4)
      TargetString5 FilePath
s1 FilePath
s2 FilePath
s3 FilePath
s4 FilePath
s5 ->
        forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> TargetStringFileStatus
TargetStringFileStatus5 FilePath
s1 FilePath
s2 FilePath
s3 FilePath
s4 FilePath
s5)
      TargetString7 FilePath
s1 FilePath
s2 FilePath
s3 FilePath
s4 FilePath
s5 FilePath
s6 FilePath
s7 ->
        forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> TargetStringFileStatus
TargetStringFileStatus7 FilePath
s1 FilePath
s2 FilePath
s3 FilePath
s4 FilePath
s5 FilePath
s6 FilePath
s7)
  where
    fileStatus :: FilePath -> m FileStatus
fileStatus FilePath
f = do
      Bool
fexists <- FilePath -> m Bool
doesFileExist FilePath
f
      Bool
dexists <- FilePath -> m Bool
doesDirectoryExist FilePath
f
      case FilePath -> [FilePath]
splitPath FilePath
f of
        [FilePath]
_ | Bool
fexists -> FilePath -> FileStatus
FileStatusExistsFile forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> m FilePath
canonicalizePath FilePath
f
          | Bool
dexists -> FilePath -> FileStatus
FileStatusExistsDir  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> m FilePath
canonicalizePath FilePath
f
        (FilePath
d:[FilePath]
_)       -> Bool -> FileStatus
FileStatusNotExists  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> m Bool
doesDirectoryExist FilePath
d
        [FilePath]
_           -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> FileStatus
FileStatusNotExists Bool
False)

forgetFileStatus :: TargetStringFileStatus -> TargetString
forgetFileStatus :: TargetStringFileStatus -> TargetString
forgetFileStatus TargetStringFileStatus
t = case TargetStringFileStatus
t of
    TargetStringFileStatus1 FilePath
s1 FileStatus
_          -> FilePath -> TargetString
TargetString1 FilePath
s1
    TargetStringFileStatus2 FilePath
s1 FileStatus
_ FilePath
s2       -> FilePath -> FilePath -> TargetString
TargetString2 FilePath
s1 FilePath
s2
    TargetStringFileStatus3 FilePath
s1 FileStatus
_ FilePath
s2 FilePath
s3    -> FilePath -> FilePath -> FilePath -> TargetString
TargetString3 FilePath
s1 FilePath
s2 FilePath
s3
    TargetStringFileStatus4 FilePath
s1   FilePath
s2 FilePath
s3 FilePath
s4 -> FilePath -> FilePath -> FilePath -> FilePath -> TargetString
TargetString4 FilePath
s1 FilePath
s2 FilePath
s3 FilePath
s4
    TargetStringFileStatus5 FilePath
s1   FilePath
s2 FilePath
s3 FilePath
s4
                                       FilePath
s5 -> FilePath
-> FilePath -> FilePath -> FilePath -> FilePath -> TargetString
TargetString5 FilePath
s1 FilePath
s2 FilePath
s3 FilePath
s4 FilePath
s5
    TargetStringFileStatus7 FilePath
s1   FilePath
s2 FilePath
s3 FilePath
s4
                                 FilePath
s5 FilePath
s6 FilePath
s7 -> FilePath
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> TargetString
TargetString7 FilePath
s1 FilePath
s2 FilePath
s3 FilePath
s4 FilePath
s5 FilePath
s6 FilePath
s7

getFileStatus :: TargetStringFileStatus -> Maybe FileStatus
getFileStatus :: TargetStringFileStatus -> Maybe FileStatus
getFileStatus (TargetStringFileStatus1 FilePath
_ FileStatus
f)     = forall a. a -> Maybe a
Just FileStatus
f
getFileStatus (TargetStringFileStatus2 FilePath
_ FileStatus
f FilePath
_)   = forall a. a -> Maybe a
Just FileStatus
f
getFileStatus (TargetStringFileStatus3 FilePath
_ FileStatus
f FilePath
_ FilePath
_) = forall a. a -> Maybe a
Just FileStatus
f
getFileStatus TargetStringFileStatus
_                                 = forall a. Maybe a
Nothing

setFileStatus :: FileStatus -> TargetStringFileStatus -> TargetStringFileStatus
setFileStatus :: FileStatus -> TargetStringFileStatus -> TargetStringFileStatus
setFileStatus FileStatus
f (TargetStringFileStatus1 FilePath
s1 FileStatus
_)       = FilePath -> FileStatus -> TargetStringFileStatus
TargetStringFileStatus1 FilePath
s1 FileStatus
f
setFileStatus FileStatus
f (TargetStringFileStatus2 FilePath
s1 FileStatus
_ FilePath
s2)    = FilePath -> FileStatus -> FilePath -> TargetStringFileStatus
TargetStringFileStatus2 FilePath
s1 FileStatus
f FilePath
s2
setFileStatus FileStatus
f (TargetStringFileStatus3 FilePath
s1 FileStatus
_ FilePath
s2 FilePath
s3) = FilePath
-> FileStatus -> FilePath -> FilePath -> TargetStringFileStatus
TargetStringFileStatus3 FilePath
s1 FileStatus
f FilePath
s2 FilePath
s3
setFileStatus FileStatus
_ TargetStringFileStatus
t                                    = TargetStringFileStatus
t

copyFileStatus :: TargetStringFileStatus -> TargetStringFileStatus -> TargetStringFileStatus
copyFileStatus :: TargetStringFileStatus
-> TargetStringFileStatus -> TargetStringFileStatus
copyFileStatus TargetStringFileStatus
src TargetStringFileStatus
dst =
    case TargetStringFileStatus -> Maybe FileStatus
getFileStatus TargetStringFileStatus
src of
      Just FileStatus
f -> FileStatus -> TargetStringFileStatus -> TargetStringFileStatus
setFileStatus FileStatus
f TargetStringFileStatus
dst
      Maybe FileStatus
Nothing -> TargetStringFileStatus
dst

-- ------------------------------------------------------------
-- * Resolving target strings to target selectors
-- ------------------------------------------------------------


-- | Given a bunch of user-specified targets, try to resolve what it is they
-- refer to.
--
resolveTargetSelectors :: KnownTargets
                       -> [TargetStringFileStatus]
                       -> Maybe ComponentKindFilter
                       -> ([TargetSelectorProblem],
                           [TargetSelector])
-- default local dir target if there's no given target:
resolveTargetSelectors :: KnownTargets
-> [TargetStringFileStatus]
-> Maybe ComponentKind
-> ([TargetSelectorProblem], [TargetSelector])
resolveTargetSelectors (KnownTargets{knownPackagesAll :: KnownTargets -> [KnownPackage]
knownPackagesAll = []}) [] Maybe ComponentKind
_ =
    ([TargetSelectorProblem
TargetSelectorNoTargetsInProject], [])

-- if the component kind filter is just exes, we don't want to suggest "all" as a target.
resolveTargetSelectors (KnownTargets{knownPackagesPrimary :: KnownTargets -> [KnownPackage]
knownPackagesPrimary = []}) [] Maybe ComponentKind
ckf =
    ([Bool -> TargetSelectorProblem
TargetSelectorNoTargetsInCwd (Maybe ComponentKind
ckf forall a. Eq a => a -> a -> Bool
/= forall a. a -> Maybe a
Just ComponentKind
ExeKind) ], [])

resolveTargetSelectors (KnownTargets{[KnownPackage]
knownPackagesPrimary :: [KnownPackage]
knownPackagesPrimary :: KnownTargets -> [KnownPackage]
knownPackagesPrimary}) [] Maybe ComponentKind
_ =
    ([], [TargetImplicitCwd
-> [PackageId] -> Maybe ComponentKind -> TargetSelector
TargetPackage TargetImplicitCwd
TargetImplicitCwd [PackageId]
pkgids forall a. Maybe a
Nothing])
  where
    pkgids :: [PackageId]
pkgids = [ PackageId
pinfoId | KnownPackage{PackageId
pinfoId :: KnownPackage -> PackageId
pinfoId :: PackageId
pinfoId} <- [KnownPackage]
knownPackagesPrimary ]

resolveTargetSelectors KnownTargets
knowntargets [TargetStringFileStatus]
targetStrs Maybe ComponentKind
mfilter =
    forall a b. [Either a b] -> ([a], [b])
partitionEithers
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (KnownTargets
-> Maybe ComponentKind
-> TargetStringFileStatus
-> Either TargetSelectorProblem TargetSelector
resolveTargetSelector KnownTargets
knowntargets Maybe ComponentKind
mfilter)
  forall a b. (a -> b) -> a -> b
$ [TargetStringFileStatus]
targetStrs

resolveTargetSelector :: KnownTargets
                      -> Maybe ComponentKindFilter
                      -> TargetStringFileStatus
                      -> Either TargetSelectorProblem TargetSelector
resolveTargetSelector :: KnownTargets
-> Maybe ComponentKind
-> TargetStringFileStatus
-> Either TargetSelectorProblem TargetSelector
resolveTargetSelector knowntargets :: KnownTargets
knowntargets@KnownTargets{[KnownComponent]
[KnownPackage]
knownComponentsOther :: KnownTargets -> [KnownComponent]
knownComponentsPrimary :: KnownTargets -> [KnownComponent]
knownComponentsAll :: KnownTargets -> [KnownComponent]
knownPackagesOther :: KnownTargets -> [KnownPackage]
knownComponentsOther :: [KnownComponent]
knownComponentsPrimary :: [KnownComponent]
knownComponentsAll :: [KnownComponent]
knownPackagesOther :: [KnownPackage]
knownPackagesPrimary :: [KnownPackage]
knownPackagesAll :: [KnownPackage]
knownPackagesPrimary :: KnownTargets -> [KnownPackage]
knownPackagesAll :: KnownTargets -> [KnownPackage]
..} Maybe ComponentKind
mfilter TargetStringFileStatus
targetStrStatus =
    case forall a. Match a -> MaybeAmbiguous a
findMatch (TargetStringFileStatus -> Match TargetSelector
matcher TargetStringFileStatus
targetStrStatus) of

      Unambiguous TargetSelector
_
        | Bool
projectIsEmpty -> forall a b. a -> Either a b
Left TargetSelectorProblem
TargetSelectorNoTargetsInProject

      Unambiguous (TargetPackage TargetImplicitCwd
TargetImplicitCwd [] Maybe ComponentKind
_)
                         -> forall a b. a -> Either a b
Left (TargetString -> TargetSelectorProblem
TargetSelectorNoCurrentPackage TargetString
targetStr)

      Unambiguous TargetSelector
target -> forall a b. b -> Either a b
Right TargetSelector
target

      None [MatchError]
errs
        | Bool
projectIsEmpty       -> forall a b. a -> Either a b
Left TargetSelectorProblem
TargetSelectorNoTargetsInProject
        | Bool
otherwise            -> forall a b. a -> Either a b
Left ([MatchError] -> TargetSelectorProblem
classifyMatchErrors [MatchError]
errs)

      Ambiguous MatchClass
_          [TargetSelector]
targets
        | Just ComponentKind
kfilter <- Maybe ComponentKind
mfilter
        , [TargetSelector
target] <- ComponentKind -> [TargetSelector] -> [TargetSelector]
applyKindFilter ComponentKind
kfilter [TargetSelector]
targets -> forall a b. b -> Either a b
Right TargetSelector
target

      Ambiguous MatchClass
exactMatch [TargetSelector]
targets ->
        case (TargetStringFileStatus -> Match TargetSelector)
-> TargetStringFileStatus
-> MatchClass
-> [TargetSelector]
-> Either
     [(TargetSelector, [(TargetString, [TargetSelector])])]
     [(TargetString, TargetSelector)]
disambiguateTargetSelectors
               TargetStringFileStatus -> Match TargetSelector
matcher TargetStringFileStatus
targetStrStatus MatchClass
exactMatch
               [TargetSelector]
targets of
          Right [(TargetString, TargetSelector)]
targets'   -> forall a b. a -> Either a b
Left (TargetString
-> [(TargetString, TargetSelector)] -> TargetSelectorProblem
TargetSelectorAmbiguous TargetString
targetStr [(TargetString, TargetSelector)]
targets')
          Left ((TargetSelector
m, [(TargetString, [TargetSelector])]
ms):[(TargetSelector, [(TargetString, [TargetSelector])])]
_) -> forall a b. a -> Either a b
Left (TargetString
-> TargetSelector
-> [(TargetString, [TargetSelector])]
-> TargetSelectorProblem
MatchingInternalError TargetString
targetStr TargetSelector
m [(TargetString, [TargetSelector])]
ms)
          Left []          -> forall a. FilePath -> a
internalError FilePath
"resolveTargetSelector"
  where
    matcher :: TargetStringFileStatus -> Match TargetSelector
matcher = KnownTargets -> TargetStringFileStatus -> Match TargetSelector
matchTargetSelector KnownTargets
knowntargets

    targetStr :: TargetString
targetStr = TargetStringFileStatus -> TargetString
forgetFileStatus TargetStringFileStatus
targetStrStatus

    projectIsEmpty :: Bool
projectIsEmpty = forall (t :: * -> *) a. Foldable t => t a -> Bool
null [KnownPackage]
knownPackagesAll

    classifyMatchErrors :: [MatchError] -> TargetSelectorProblem
classifyMatchErrors [MatchError]
errs
      | Just NonEmpty (FilePath, FilePath)
expectedNE <- forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [(FilePath, FilePath)]
expected
      = let (NonEmpty FilePath
things, FilePath
got:|[FilePath]
_) = forall (f :: * -> *) a b. Functor f => f (a, b) -> (f a, f b)
NE.unzip NonEmpty (FilePath, FilePath)
expectedNE in
        TargetString -> [FilePath] -> FilePath -> TargetSelectorProblem
TargetSelectorExpected TargetString
targetStr (forall a. NonEmpty a -> [a]
NE.toList NonEmpty FilePath
things) FilePath
got

      | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Maybe (FilePath, FilePath), FilePath, FilePath, [FilePath])]
nosuch)
      = TargetString
-> [(Maybe (FilePath, FilePath), FilePath, FilePath, [FilePath])]
-> TargetSelectorProblem
TargetSelectorNoSuch TargetString
targetStr [(Maybe (FilePath, FilePath), FilePath, FilePath, [FilePath])]
nosuch

      | Bool
otherwise
      = forall a. FilePath -> a
internalError forall a b. (a -> b) -> a -> b
$ FilePath
"classifyMatchErrors: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show [MatchError]
errs
      where
        expected :: [(FilePath, FilePath)]
expected = [ (FilePath
thing, FilePath
got)
                   | (Maybe (FilePath, FilePath)
_, MatchErrorExpected FilePath
thing FilePath
got)
                           <- forall a b. (a -> b) -> [a] -> [b]
map (Maybe (FilePath, FilePath)
-> MatchError -> (Maybe (FilePath, FilePath), MatchError)
innerErr forall a. Maybe a
Nothing) [MatchError]
errs ]
        -- Trim the list of alternatives by dropping duplicates and
        -- retaining only at most three most similar (by edit distance) ones.
        nosuch :: [(Maybe (FilePath, FilePath), FilePath, FilePath, [FilePath])]
nosuch   = forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey forall {a} {b}.
(a, b, FilePath)
-> Set FilePath
-> [(a, b, FilePath, [FilePath])]
-> [(a, b, FilePath, [FilePath])]
genResults [] forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith forall a. Ord a => Set a -> Set a -> Set a
Set.union forall a b. (a -> b) -> a -> b
$
          [ ((Maybe (FilePath, FilePath)
inside, FilePath
thing, FilePath
got), forall a. Ord a => [a] -> Set a
Set.fromList [FilePath]
alts)
          | (Maybe (FilePath, FilePath)
inside, MatchErrorNoSuch FilePath
thing FilePath
got [FilePath]
alts)
            <- forall a b. (a -> b) -> [a] -> [b]
map (Maybe (FilePath, FilePath)
-> MatchError -> (Maybe (FilePath, FilePath), MatchError)
innerErr forall a. Maybe a
Nothing) [MatchError]
errs
          ]

        genResults :: (a, b, FilePath)
-> Set FilePath
-> [(a, b, FilePath, [FilePath])]
-> [(a, b, FilePath, [FilePath])]
genResults (a
inside, b
thing, FilePath
got) Set FilePath
alts [(a, b, FilePath, [FilePath])]
acc = (
            a
inside
          , b
thing
          , FilePath
got
          , forall a. Int -> [a] -> [a]
take Int
maxResults
            forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst
            forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
takeWhile forall {a}. (a, Int) -> Bool
distanceLow
            forall a b. (a -> b) -> a -> b
$ forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall a b. (a, b) -> b
snd)
            forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map FilePath -> (FilePath, Int)
addLevDist
            forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
Set.toList Set FilePath
alts
          ) forall a. a -> [a] -> [a]
: [(a, b, FilePath, [FilePath])]
acc
          where
            addLevDist :: FilePath -> (FilePath, Int)
addLevDist = forall a. a -> a
id forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& EditCosts -> FilePath -> FilePath -> Int
restrictedDamerauLevenshteinDistance
                                EditCosts
defaultEditCosts FilePath
got

            distanceLow :: (a, Int) -> Bool
distanceLow (a
_, Int
dist) = Int
dist forall a. Ord a => a -> a -> Bool
< forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
got forall a. Integral a => a -> a -> a
`div` Int
2

            maxResults :: Int
maxResults = Int
3

        innerErr :: Maybe (FilePath, FilePath)
-> MatchError -> (Maybe (FilePath, FilePath), MatchError)
innerErr Maybe (FilePath, FilePath)
_ (MatchErrorIn FilePath
kind FilePath
thing MatchError
m)
                     = Maybe (FilePath, FilePath)
-> MatchError -> (Maybe (FilePath, FilePath), MatchError)
innerErr (forall a. a -> Maybe a
Just (FilePath
kind,FilePath
thing)) MatchError
m
        innerErr Maybe (FilePath, FilePath)
c MatchError
m = (Maybe (FilePath, FilePath)
c,MatchError
m)

    applyKindFilter :: ComponentKindFilter -> [TargetSelector] -> [TargetSelector]
    applyKindFilter :: ComponentKind -> [TargetSelector] -> [TargetSelector]
applyKindFilter ComponentKind
kfilter = forall a. (a -> Bool) -> [a] -> [a]
filter TargetSelector -> Bool
go
      where
        go :: TargetSelector -> Bool
go (TargetPackage      TargetImplicitCwd
_ [PackageId]
_ (Just ComponentKind
filter')) = ComponentKind
kfilter forall a. Eq a => a -> a -> Bool
== ComponentKind
filter'
        go (TargetPackageNamed PackageName
_   (Just ComponentKind
filter')) = ComponentKind
kfilter forall a. Eq a => a -> a -> Bool
== ComponentKind
filter'
        go (TargetAllPackages      (Just ComponentKind
filter')) = ComponentKind
kfilter forall a. Eq a => a -> a -> Bool
== ComponentKind
filter'
        go (TargetComponent PackageId
_ ComponentName
cname SubComponentTarget
_)
          | CLibName    LibraryName
_ <- ComponentName
cname                 = ComponentKind
kfilter forall a. Eq a => a -> a -> Bool
== ComponentKind
LibKind
          | CFLibName   UnqualComponentName
_ <- ComponentName
cname                 = ComponentKind
kfilter forall a. Eq a => a -> a -> Bool
== ComponentKind
FLibKind
          | CExeName    UnqualComponentName
_ <- ComponentName
cname                 = ComponentKind
kfilter forall a. Eq a => a -> a -> Bool
== ComponentKind
ExeKind
          | CTestName   UnqualComponentName
_ <- ComponentName
cname                 = ComponentKind
kfilter forall a. Eq a => a -> a -> Bool
== ComponentKind
TestKind
          | CBenchName  UnqualComponentName
_ <- ComponentName
cname                 = ComponentKind
kfilter forall a. Eq a => a -> a -> Bool
== ComponentKind
BenchKind
        go TargetSelector
_                                       = Bool
True

-- | The various ways that trying to resolve a 'TargetString' to a
-- 'TargetSelector' can fail.
--
data TargetSelectorProblem
   = TargetSelectorExpected TargetString [String]  String
     -- ^  [expected thing] (actually got)
   | TargetSelectorNoSuch  TargetString
                           [(Maybe (String, String), String, String, [String])]
     -- ^ [([in thing], no such thing,  actually got, alternatives)]
   | TargetSelectorAmbiguous  TargetString
                              [(TargetString, TargetSelector)]

   | MatchingInternalError TargetString TargetSelector
                           [(TargetString, [TargetSelector])]
   | TargetSelectorUnrecognised String
     -- ^ Syntax error when trying to parse a target string.
   | TargetSelectorNoCurrentPackage TargetString
   | TargetSelectorNoTargetsInCwd Bool
     -- ^ bool that flags when it is acceptable to suggest "all" as a target
   | TargetSelectorNoTargetsInProject
   | TargetSelectorNoScript TargetString
  deriving (Int -> TargetSelectorProblem -> ShowS
[TargetSelectorProblem] -> ShowS
TargetSelectorProblem -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [TargetSelectorProblem] -> ShowS
$cshowList :: [TargetSelectorProblem] -> ShowS
show :: TargetSelectorProblem -> FilePath
$cshow :: TargetSelectorProblem -> FilePath
showsPrec :: Int -> TargetSelectorProblem -> ShowS
$cshowsPrec :: Int -> TargetSelectorProblem -> ShowS
Show, TargetSelectorProblem -> TargetSelectorProblem -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TargetSelectorProblem -> TargetSelectorProblem -> Bool
$c/= :: TargetSelectorProblem -> TargetSelectorProblem -> Bool
== :: TargetSelectorProblem -> TargetSelectorProblem -> Bool
$c== :: TargetSelectorProblem -> TargetSelectorProblem -> Bool
Eq)

-- | Qualification levels.
-- Given the filepath src/F, executable component A, and package foo:
data QualLevel = QL1    -- ^ @src/F@
               | QL2    -- ^ @foo:src/F | A:src/F@
               | QL3    -- ^ @foo:A:src/F | exe:A:src/F@
               | QLFull -- ^ @pkg:foo:exe:A:file:src/F@
  deriving (QualLevel -> QualLevel -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QualLevel -> QualLevel -> Bool
$c/= :: QualLevel -> QualLevel -> Bool
== :: QualLevel -> QualLevel -> Bool
$c== :: QualLevel -> QualLevel -> Bool
Eq, Int -> QualLevel
QualLevel -> Int
QualLevel -> [QualLevel]
QualLevel -> QualLevel
QualLevel -> QualLevel -> [QualLevel]
QualLevel -> QualLevel -> QualLevel -> [QualLevel]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: QualLevel -> QualLevel -> QualLevel -> [QualLevel]
$cenumFromThenTo :: QualLevel -> QualLevel -> QualLevel -> [QualLevel]
enumFromTo :: QualLevel -> QualLevel -> [QualLevel]
$cenumFromTo :: QualLevel -> QualLevel -> [QualLevel]
enumFromThen :: QualLevel -> QualLevel -> [QualLevel]
$cenumFromThen :: QualLevel -> QualLevel -> [QualLevel]
enumFrom :: QualLevel -> [QualLevel]
$cenumFrom :: QualLevel -> [QualLevel]
fromEnum :: QualLevel -> Int
$cfromEnum :: QualLevel -> Int
toEnum :: Int -> QualLevel
$ctoEnum :: Int -> QualLevel
pred :: QualLevel -> QualLevel
$cpred :: QualLevel -> QualLevel
succ :: QualLevel -> QualLevel
$csucc :: QualLevel -> QualLevel
Enum, Int -> QualLevel -> ShowS
[QualLevel] -> ShowS
QualLevel -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [QualLevel] -> ShowS
$cshowList :: [QualLevel] -> ShowS
show :: QualLevel -> FilePath
$cshow :: QualLevel -> FilePath
showsPrec :: Int -> QualLevel -> ShowS
$cshowsPrec :: Int -> QualLevel -> ShowS
Show)

disambiguateTargetSelectors
  :: (TargetStringFileStatus -> Match TargetSelector)
  -> TargetStringFileStatus -> MatchClass
  -> [TargetSelector]
  -> Either [(TargetSelector, [(TargetString, [TargetSelector])])]
            [(TargetString, TargetSelector)]
disambiguateTargetSelectors :: (TargetStringFileStatus -> Match TargetSelector)
-> TargetStringFileStatus
-> MatchClass
-> [TargetSelector]
-> Either
     [(TargetSelector, [(TargetString, [TargetSelector])])]
     [(TargetString, TargetSelector)]
disambiguateTargetSelectors TargetStringFileStatus -> Match TargetSelector
matcher TargetStringFileStatus
matchInput MatchClass
exactMatch [TargetSelector]
matchResults =
    case forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either
   (TargetSelector, [(TargetString, [TargetSelector])])
   (TargetString, TargetSelector)]
results of
      (errs :: [(TargetSelector, [(TargetString, [TargetSelector])])]
errs@((TargetSelector, [(TargetString, [TargetSelector])])
_:[(TargetSelector, [(TargetString, [TargetSelector])])]
_), [(TargetString, TargetSelector)]
_) -> forall a b. a -> Either a b
Left [(TargetSelector, [(TargetString, [TargetSelector])])]
errs
      ([], [(TargetString, TargetSelector)]
ok)        -> forall a b. b -> Either a b
Right [(TargetString, TargetSelector)]
ok
  where
    -- So, here's the strategy. We take the original match results, and make a
    -- table of all their renderings at all qualification levels.
    -- Note there can be multiple renderings at each qualification level.

    -- Note that renderTargetSelector won't immediately work on any file syntax
    -- When rendering syntax, the FileStatus is always FileStatusNotExists,
    -- which will never match on syntaxForm1File!
    -- Because matchPackageDirectoryPrefix expects a FileStatusExistsFile.
    -- So we need to copy over the file status from the input
    -- TargetStringFileStatus, onto the new rendered TargetStringFileStatus
    matchResultsRenderings :: [(TargetSelector, [TargetStringFileStatus])]
    matchResultsRenderings :: [(TargetSelector, [TargetStringFileStatus])]
matchResultsRenderings =
      [ (TargetSelector
matchResult, [TargetStringFileStatus]
matchRenderings)
      | TargetSelector
matchResult <- [TargetSelector]
matchResults
      , let matchRenderings :: [TargetStringFileStatus]
matchRenderings =
              [ TargetStringFileStatus
-> TargetStringFileStatus -> TargetStringFileStatus
copyFileStatus TargetStringFileStatus
matchInput TargetStringFileStatus
rendering
              | QualLevel
ql <- [QualLevel
QL1 .. QualLevel
QLFull]
              , TargetStringFileStatus
rendering <- QualLevel -> TargetSelector -> [TargetStringFileStatus]
renderTargetSelector QualLevel
ql TargetSelector
matchResult ]
      ]

    -- Of course the point is that we're looking for renderings that are
    -- unambiguous matches. So we build another memo table of all the matches
    -- for all of those renderings. So by looking up in this table we can see
    -- if we've got an unambiguous match.

    memoisedMatches :: Map TargetStringFileStatus (Match TargetSelector)
    memoisedMatches :: Map TargetStringFileStatus (Match TargetSelector)
memoisedMatches =
        -- avoid recomputing the main one if it was an exact match
        (if MatchClass
exactMatch forall a. Eq a => a -> a -> Bool
== MatchClass
Exact
           then forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert TargetStringFileStatus
matchInput (forall a. MatchClass -> Int -> [a] -> Match a
Match MatchClass
Exact Int
0 [TargetSelector]
matchResults)
           else forall a. a -> a
id)
      forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
Map.Lazy.fromList
        -- (matcher rendering) should *always* be a Match! Otherwise we will hit
        -- the internal error later on.
          [ (TargetStringFileStatus
rendering, TargetStringFileStatus -> Match TargetSelector
matcher TargetStringFileStatus
rendering)
          | TargetStringFileStatus
rendering <- forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a b. (a, b) -> b
snd [(TargetSelector, [TargetStringFileStatus])]
matchResultsRenderings ]

    -- Finally, for each of the match results, we go through all their
    -- possible renderings (in order of qualification level, though remember
    -- there can be multiple renderings per level), and find the first one
    -- that has an unambiguous match.
    results :: [Either (TargetSelector, [(TargetString, [TargetSelector])])
                       (TargetString, TargetSelector)]
    results :: [Either
   (TargetSelector, [(TargetString, [TargetSelector])])
   (TargetString, TargetSelector)]
results =
      [ case TargetSelector
-> [TargetStringFileStatus] -> Maybe TargetStringFileStatus
findUnambiguous TargetSelector
originalMatch [TargetStringFileStatus]
matchRenderings of
          Just TargetStringFileStatus
unambiguousRendering ->
            forall a b. b -> Either a b
Right ( TargetStringFileStatus -> TargetString
forgetFileStatus TargetStringFileStatus
unambiguousRendering
                  , TargetSelector
originalMatch)

          -- This case is an internal error, but we bubble it up and report it
          Maybe TargetStringFileStatus
Nothing ->
            forall a b. a -> Either a b
Left  ( TargetSelector
originalMatch
                  , [ (TargetStringFileStatus -> TargetString
forgetFileStatus TargetStringFileStatus
rendering, [TargetSelector]
matches)
                    | TargetStringFileStatus
rendering <- [TargetStringFileStatus]
matchRenderings
                    , let Match MatchClass
m Int
_ [TargetSelector]
matches =
                            Map TargetStringFileStatus (Match TargetSelector)
memoisedMatches forall k a. Ord k => Map k a -> k -> a
Map.! TargetStringFileStatus
rendering
                    , MatchClass
m forall a. Eq a => a -> a -> Bool
/= MatchClass
Inexact
                    ] )

      | (TargetSelector
originalMatch, [TargetStringFileStatus]
matchRenderings) <- [(TargetSelector, [TargetStringFileStatus])]
matchResultsRenderings ]

    findUnambiguous :: TargetSelector
                    -> [TargetStringFileStatus]
                    -> Maybe TargetStringFileStatus
    findUnambiguous :: TargetSelector
-> [TargetStringFileStatus] -> Maybe TargetStringFileStatus
findUnambiguous TargetSelector
_ []     = forall a. Maybe a
Nothing
    findUnambiguous TargetSelector
t (TargetStringFileStatus
r:[TargetStringFileStatus]
rs) =
      case Map TargetStringFileStatus (Match TargetSelector)
memoisedMatches forall k a. Ord k => Map k a -> k -> a
Map.! TargetStringFileStatus
r of
        Match MatchClass
Exact Int
_ [TargetSelector
t'] | TargetSelector
t forall a. Eq a => a -> a -> Bool
== TargetSelector
t'
                          -> forall a. a -> Maybe a
Just TargetStringFileStatus
r
        Match MatchClass
Exact   Int
_ [TargetSelector]
_ -> TargetSelector
-> [TargetStringFileStatus] -> Maybe TargetStringFileStatus
findUnambiguous TargetSelector
t [TargetStringFileStatus]
rs
        Match MatchClass
Unknown Int
_ [TargetSelector]
_ -> TargetSelector
-> [TargetStringFileStatus] -> Maybe TargetStringFileStatus
findUnambiguous TargetSelector
t [TargetStringFileStatus]
rs
        Match MatchClass
Inexact Int
_ [TargetSelector]
_ -> forall a. FilePath -> a
internalError FilePath
"Match Inexact"
        NoMatch       Int
_ [MatchError]
_ -> forall a. FilePath -> a
internalError FilePath
"NoMatch"

internalError :: String -> a
internalError :: forall a. FilePath -> a
internalError FilePath
msg =
  forall a. HasCallStack => FilePath -> a
error forall a b. (a -> b) -> a -> b
$ FilePath
"TargetSelector: internal error: " forall a. [a] -> [a] -> [a]
++ FilePath
msg


-- | Throw an exception with a formatted message if there are any problems.
--
reportTargetSelectorProblems :: Verbosity -> [TargetSelectorProblem] -> IO a
reportTargetSelectorProblems :: forall a. Verbosity -> [TargetSelectorProblem] -> IO a
reportTargetSelectorProblems Verbosity
verbosity [TargetSelectorProblem]
problems = do

    case [ FilePath
str | TargetSelectorUnrecognised FilePath
str <- [TargetSelectorProblem]
problems ] of
      []      -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
      [FilePath]
targets ->
        forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unlines
          [ FilePath
"Unrecognised target syntax for '" forall a. [a] -> [a] -> [a]
++ FilePath
name forall a. [a] -> [a] -> [a]
++ FilePath
"'."
          | FilePath
name <- [FilePath]
targets ]

    case [ (TargetString
t, TargetSelector
m, [(TargetString, [TargetSelector])]
ms) | MatchingInternalError TargetString
t TargetSelector
m [(TargetString, [TargetSelector])]
ms <- [TargetSelectorProblem]
problems ] of
      [] -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
      ((TargetString
target, TargetSelector
originalMatch, [(TargetString, [TargetSelector])]
renderingsAndMatches):[(TargetString, TargetSelector,
  [(TargetString, [TargetSelector])])]
_) ->
        forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ FilePath
"Internal error in target matching: could not make an "
           forall a. [a] -> [a] -> [a]
++ FilePath
"unambiguous fully qualified target selector for '"
           forall a. [a] -> [a] -> [a]
++ TargetString -> FilePath
showTargetString TargetString
target forall a. [a] -> [a] -> [a]
++ FilePath
"'.\n"
           forall a. [a] -> [a] -> [a]
++ FilePath
"We made the target '" forall a. [a] -> [a] -> [a]
++ TargetSelector -> FilePath
showTargetSelector TargetSelector
originalMatch forall a. [a] -> [a] -> [a]
++ FilePath
"' ("
           forall a. [a] -> [a] -> [a]
++ TargetSelector -> FilePath
showTargetSelectorKind TargetSelector
originalMatch forall a. [a] -> [a] -> [a]
++ FilePath
") that was expected to "
           forall a. [a] -> [a] -> [a]
++ FilePath
"be unambiguous but matches the following targets:\n"
           forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
unlines
                [ FilePath
"'" forall a. [a] -> [a] -> [a]
++ TargetString -> FilePath
showTargetString TargetString
rendering forall a. [a] -> [a] -> [a]
++ FilePath
"', matching:"
                  forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (FilePath
"\n  - " forall a. [a] -> [a] -> [a]
++)
                       [ TargetSelector -> FilePath
showTargetSelector TargetSelector
match forall a. [a] -> [a] -> [a]
++
                         FilePath
" (" forall a. [a] -> [a] -> [a]
++ TargetSelector -> FilePath
showTargetSelectorKind TargetSelector
match forall a. [a] -> [a] -> [a]
++ FilePath
")"
                       | TargetSelector
match <- [TargetSelector]
matches ]
                | (TargetString
rendering, [TargetSelector]
matches) <- [(TargetString, [TargetSelector])]
renderingsAndMatches ]
           forall a. [a] -> [a] -> [a]
++ FilePath
"\nNote: Cabal expects to be able to make a single fully "
           forall a. [a] -> [a] -> [a]
++ FilePath
"qualified name for a target or provide a more specific error. "
           forall a. [a] -> [a] -> [a]
++ FilePath
"Our failure to do so is a bug in cabal. "
           forall a. [a] -> [a] -> [a]
++ FilePath
"Tracking issue: https://github.com/haskell/cabal/issues/8684"
           forall a. [a] -> [a] -> [a]
++ FilePath
"\n\nHint: this may be caused by trying to build a package that "
           forall a. [a] -> [a] -> [a]
++ FilePath
"exists in the project directory but is missing from "
           forall a. [a] -> [a] -> [a]
++ FilePath
"the 'packages' stanza in your cabal project file."

    case [ (TargetString
t, [FilePath]
e, FilePath
g) | TargetSelectorExpected TargetString
t [FilePath]
e FilePath
g <- [TargetSelectorProblem]
problems ] of
      []      -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
      [(TargetString, [FilePath], FilePath)]
targets ->
        forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unlines
          [    FilePath
"Unrecognised target '" forall a. [a] -> [a] -> [a]
++ TargetString -> FilePath
showTargetString TargetString
target
            forall a. [a] -> [a] -> [a]
++ FilePath
"'.\n"
            forall a. [a] -> [a] -> [a]
++ FilePath
"Expected a " forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate FilePath
" or " [FilePath]
expected
            forall a. [a] -> [a] -> [a]
++ FilePath
", rather than '" forall a. [a] -> [a] -> [a]
++ FilePath
got forall a. [a] -> [a] -> [a]
++ FilePath
"'."
          | (TargetString
target, [FilePath]
expected, FilePath
got) <- [(TargetString, [FilePath], FilePath)]
targets ]

    case [ (TargetString
t, [(Maybe (FilePath, FilePath), FilePath, FilePath, [FilePath])]
e) | TargetSelectorNoSuch TargetString
t [(Maybe (FilePath, FilePath), FilePath, FilePath, [FilePath])]
e <- [TargetSelectorProblem]
problems ] of
      []      -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
      [(TargetString,
  [(Maybe (FilePath, FilePath), FilePath, FilePath, [FilePath])])]
targets ->
        forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unlines
          [ FilePath
"Unknown target '" forall a. [a] -> [a] -> [a]
++ TargetString -> FilePath
showTargetString TargetString
target forall a. [a] -> [a] -> [a]
++
            FilePath
"'.\n" forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
unlines
            [    (case Maybe (FilePath, FilePath)
inside of
                    Just (FilePath
kind, FilePath
"")
                            -> FilePath
"The " forall a. [a] -> [a] -> [a]
++ FilePath
kind forall a. [a] -> [a] -> [a]
++ FilePath
" has no "
                    Just (FilePath
kind, FilePath
thing)
                            -> FilePath
"The " forall a. [a] -> [a] -> [a]
++ FilePath
kind forall a. [a] -> [a] -> [a]
++ FilePath
" " forall a. [a] -> [a] -> [a]
++ FilePath
thing forall a. [a] -> [a] -> [a]
++ FilePath
" has no "
                    Maybe (FilePath, FilePath)
Nothing -> FilePath
"There is no ")
              forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate FilePath
" or " [ ShowS
mungeThing FilePath
thing forall a. [a] -> [a] -> [a]
++ FilePath
" '" forall a. [a] -> [a] -> [a]
++ FilePath
got forall a. [a] -> [a] -> [a]
++ FilePath
"'"
                                    | (FilePath
thing, FilePath
got, [FilePath]
_alts) <- [(FilePath, FilePath, [FilePath])]
nosuch' ] forall a. [a] -> [a] -> [a]
++ FilePath
"."
              forall a. [a] -> [a] -> [a]
++ if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(FilePath, [FilePath])]
alternatives then FilePath
"" else
                 FilePath
"\nPerhaps you meant " forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate FilePath
";\nor "
                 [ FilePath
"the " forall a. [a] -> [a] -> [a]
++ FilePath
thing forall a. [a] -> [a] -> [a]
++ FilePath
" '" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate FilePath
"' or '" [FilePath]
alts forall a. [a] -> [a] -> [a]
++ FilePath
"'?"
                 | (FilePath
thing, [FilePath]
alts) <- [(FilePath, [FilePath])]
alternatives ]
            | (Maybe (FilePath, FilePath)
inside, [(FilePath, FilePath, [FilePath])]
nosuch') <- forall {a} {b} {c}.
[(Maybe (FilePath, FilePath), a, b, c)]
-> [(Maybe (FilePath, FilePath), [(a, b, c)])]
groupByContainer [(Maybe (FilePath, FilePath), FilePath, FilePath, [FilePath])]
nosuch
            , let alternatives :: [(FilePath, [FilePath])]
alternatives =
                    [ (FilePath
thing, [FilePath]
alts)
                    | (FilePath
thing,FilePath
_got,alts :: [FilePath]
alts@(FilePath
_:[FilePath]
_)) <- [(FilePath, FilePath, [FilePath])]
nosuch' ]
            ]
          | (TargetString
target, [(Maybe (FilePath, FilePath), FilePath, FilePath, [FilePath])]
nosuch) <- [(TargetString,
  [(Maybe (FilePath, FilePath), FilePath, FilePath, [FilePath])])]
targets
          , let groupByContainer :: [(Maybe (FilePath, FilePath), a, b, c)]
-> [(Maybe (FilePath, FilePath), [(a, b, c)])]
groupByContainer =
                    forall a b. (a -> b) -> [a] -> [b]
map (\g :: [(Maybe (FilePath, FilePath), a, b, c)]
g@((Maybe (FilePath, FilePath)
inside,a
_,b
_,c
_):[(Maybe (FilePath, FilePath), a, b, c)]
_) ->
                            (Maybe (FilePath, FilePath)
inside, [   (a
thing,b
got,c
alts)
                                     | (Maybe (FilePath, FilePath)
_,a
thing,b
got,c
alts) <- [(Maybe (FilePath, FilePath), a, b, c)]
g ]))
                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (forall a. Eq a => a -> a -> Bool
(==)    forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (\(Maybe (FilePath, FilePath)
x,a
_,b
_,c
_) -> Maybe (FilePath, FilePath)
x))
                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy  (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (\(Maybe (FilePath, FilePath)
x,a
_,b
_,c
_) -> Maybe (FilePath, FilePath)
x))
          ]
        where
          mungeThing :: ShowS
mungeThing FilePath
"file" = FilePath
"file target"
          mungeThing FilePath
thing  = FilePath
thing

    case [ (TargetString
t, [(TargetString, TargetSelector)]
ts) | TargetSelectorAmbiguous TargetString
t [(TargetString, TargetSelector)]
ts <- [TargetSelectorProblem]
problems ] of
      []      -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
      [(TargetString, [(TargetString, TargetSelector)])]
targets ->
        forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unlines
          [    FilePath
"Ambiguous target '" forall a. [a] -> [a] -> [a]
++ TargetString -> FilePath
showTargetString TargetString
target
            forall a. [a] -> [a] -> [a]
++ FilePath
"'. It could be:\n "
            forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
unlines [ FilePath
"   "forall a. [a] -> [a] -> [a]
++ TargetString -> FilePath
showTargetString TargetString
ut forall a. [a] -> [a] -> [a]
++
                         FilePath
" (" forall a. [a] -> [a] -> [a]
++ TargetSelector -> FilePath
showTargetSelectorKind TargetSelector
bt forall a. [a] -> [a] -> [a]
++ FilePath
")"
                       | (TargetString
ut, TargetSelector
bt) <- [(TargetString, TargetSelector)]
amb ]
          | (TargetString
target, [(TargetString, TargetSelector)]
amb) <- [(TargetString, [(TargetString, TargetSelector)])]
targets ]

    case [ TargetString
t | TargetSelectorNoCurrentPackage TargetString
t <- [TargetSelectorProblem]
problems ] of
      []       -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
      TargetString
target:[TargetString]
_ ->
        forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity forall a b. (a -> b) -> a -> b
$
            FilePath
"The target '" forall a. [a] -> [a] -> [a]
++ TargetString -> FilePath
showTargetString TargetString
target forall a. [a] -> [a] -> [a]
++ FilePath
"' refers to the "
         forall a. [a] -> [a] -> [a]
++ FilePath
"components in the package in the current directory, but there "
         forall a. [a] -> [a] -> [a]
++ FilePath
"is no package in the current directory (or at least not listed "
         forall a. [a] -> [a] -> [a]
++ FilePath
"as part of the project)."
        --TODO: report a different error if there is a .cabal file but it's
        -- not a member of the project

    case [ () | TargetSelectorNoTargetsInCwd Bool
True <- [TargetSelectorProblem]
problems ] of
      []  -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
      ()
_:[()]
_ ->
        forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity forall a b. (a -> b) -> a -> b
$
            FilePath
"No targets given and there is no package in the current "
         forall a. [a] -> [a] -> [a]
++ FilePath
"directory. Use the target 'all' for all packages in the "
         forall a. [a] -> [a] -> [a]
++ FilePath
"project or specify packages or components by name or location. "
         forall a. [a] -> [a] -> [a]
++ FilePath
"See 'cabal build --help' for more details on target options."

    case [ () | TargetSelectorNoTargetsInCwd Bool
False <- [TargetSelectorProblem]
problems ] of
      []  -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
      ()
_:[()]
_ ->
        forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity forall a b. (a -> b) -> a -> b
$
            FilePath
"No targets given and there is no package in the current "
         forall a. [a] -> [a] -> [a]
++ FilePath
"directory. Specify packages or components by name or location. "
         forall a. [a] -> [a] -> [a]
++ FilePath
"See 'cabal build --help' for more details on target options."

    case [ () | TargetSelectorProblem
TargetSelectorNoTargetsInProject <- [TargetSelectorProblem]
problems ] of
      []  -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
      ()
_:[()]
_ ->
        forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity forall a b. (a -> b) -> a -> b
$
            FilePath
"There is no <pkgname>.cabal package file or cabal.project file. "
         forall a. [a] -> [a] -> [a]
++ FilePath
"To build packages locally you need at minimum a <pkgname>.cabal "
         forall a. [a] -> [a] -> [a]
++ FilePath
"file. You can use 'cabal init' to create one.\n"
         forall a. [a] -> [a] -> [a]
++ FilePath
"\n"
         forall a. [a] -> [a] -> [a]
++ FilePath
"For non-trivial projects you will also want a cabal.project "
         forall a. [a] -> [a] -> [a]
++ FilePath
"file in the root directory of your project. This file lists the "
         forall a. [a] -> [a] -> [a]
++ FilePath
"packages in your project and all other build configuration. "
         forall a. [a] -> [a] -> [a]
++ FilePath
"See the Cabal user guide for full details."

    case [ TargetString
t | TargetSelectorNoScript TargetString
t <- [TargetSelectorProblem]
problems ] of
      []  -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
      TargetString
target:[TargetString]
_ ->
        forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity forall a b. (a -> b) -> a -> b
$
            FilePath
"The script '" forall a. [a] -> [a] -> [a]
++ TargetString -> FilePath
showTargetString TargetString
target forall a. [a] -> [a] -> [a]
++ FilePath
"' does not exist, "
         forall a. [a] -> [a] -> [a]
++ FilePath
"and only script targets may contain whitespace characters or end "
         forall a. [a] -> [a] -> [a]
++ FilePath
"with ':'"

    forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"reportTargetSelectorProblems: internal error"


----------------------------------
-- Syntax type
--

-- | Syntax for the 'TargetSelector': the matcher and renderer
--
data Syntax = Syntax QualLevel Matcher Renderer
            | AmbiguousAlternatives Syntax Syntax
            | ShadowingAlternatives Syntax Syntax

type Matcher  = TargetStringFileStatus -> Match TargetSelector
type Renderer = TargetSelector -> [TargetStringFileStatus]

foldSyntax :: (a -> a -> a) -> (a -> a -> a)
           -> (QualLevel -> Matcher -> Renderer -> a)
           -> (Syntax -> a)
foldSyntax :: forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (QualLevel
    -> (TargetStringFileStatus -> Match TargetSelector)
    -> (TargetSelector -> [TargetStringFileStatus])
    -> a)
-> Syntax
-> a
foldSyntax a -> a -> a
ambiguous a -> a -> a
unambiguous QualLevel
-> (TargetStringFileStatus -> Match TargetSelector)
-> (TargetSelector -> [TargetStringFileStatus])
-> a
syntax = Syntax -> a
go
  where
    go :: Syntax -> a
go (Syntax QualLevel
ql TargetStringFileStatus -> Match TargetSelector
match TargetSelector -> [TargetStringFileStatus]
render)    = QualLevel
-> (TargetStringFileStatus -> Match TargetSelector)
-> (TargetSelector -> [TargetStringFileStatus])
-> a
syntax QualLevel
ql TargetStringFileStatus -> Match TargetSelector
match TargetSelector -> [TargetStringFileStatus]
render
    go (AmbiguousAlternatives Syntax
a Syntax
b) = a -> a -> a
ambiguous   (Syntax -> a
go Syntax
a) (Syntax -> a
go Syntax
b)
    go (ShadowingAlternatives Syntax
a Syntax
b) = a -> a -> a
unambiguous (Syntax -> a
go Syntax
a) (Syntax -> a
go Syntax
b)


----------------------------------
-- Top level renderer and matcher
--

renderTargetSelector :: QualLevel -> TargetSelector
                     -> [TargetStringFileStatus]
renderTargetSelector :: QualLevel -> TargetSelector -> [TargetStringFileStatus]
renderTargetSelector QualLevel
ql TargetSelector
ts =
    forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (QualLevel
    -> (TargetStringFileStatus -> Match TargetSelector)
    -> (TargetSelector -> [TargetStringFileStatus])
    -> a)
-> Syntax
-> a
foldSyntax
      forall a. [a] -> [a] -> [a]
(++) forall a. [a] -> [a] -> [a]
(++)
      (\QualLevel
ql' TargetStringFileStatus -> Match TargetSelector
_ TargetSelector -> [TargetStringFileStatus]
render -> forall (f :: * -> *). Alternative f => Bool -> f ()
guard (QualLevel
ql forall a. Eq a => a -> a -> Bool
== QualLevel
ql') forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TargetSelector -> [TargetStringFileStatus]
render TargetSelector
ts)
      Syntax
syntax
  where
    syntax :: Syntax
syntax = KnownTargets -> Syntax
syntaxForms KnownTargets
emptyKnownTargets
                         -- don't need known targets for rendering

matchTargetSelector :: KnownTargets
                    -> TargetStringFileStatus
                    -> Match TargetSelector
matchTargetSelector :: KnownTargets -> TargetStringFileStatus -> Match TargetSelector
matchTargetSelector KnownTargets
knowntargets = \TargetStringFileStatus
usertarget ->
    forall a. (a -> a -> Bool) -> Match a -> Match a
nubMatchesBy forall a. Eq a => a -> a -> Bool
(==) forall a b. (a -> b) -> a -> b
$

    let ql :: QualLevel
ql = TargetStringFileStatus -> QualLevel
targetQualLevel TargetStringFileStatus
usertarget in
    forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (QualLevel
    -> (TargetStringFileStatus -> Match TargetSelector)
    -> (TargetSelector -> [TargetStringFileStatus])
    -> a)
-> Syntax
-> a
foldSyntax
      forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) forall a. Match a -> Match a -> Match a
(<//>)
      (\QualLevel
ql' TargetStringFileStatus -> Match TargetSelector
match TargetSelector -> [TargetStringFileStatus]
_ -> forall (f :: * -> *). Alternative f => Bool -> f ()
guard (QualLevel
ql forall a. Eq a => a -> a -> Bool
== QualLevel
ql') forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TargetStringFileStatus -> Match TargetSelector
match TargetStringFileStatus
usertarget)
      Syntax
syntax
  where
    syntax :: Syntax
syntax = KnownTargets -> Syntax
syntaxForms KnownTargets
knowntargets

    targetQualLevel :: TargetStringFileStatus -> QualLevel
targetQualLevel TargetStringFileStatus1{} = QualLevel
QL1
    targetQualLevel TargetStringFileStatus2{} = QualLevel
QL2
    targetQualLevel TargetStringFileStatus3{} = QualLevel
QL3
    targetQualLevel TargetStringFileStatus4{} = QualLevel
QLFull
    targetQualLevel TargetStringFileStatus5{} = QualLevel
QLFull
    targetQualLevel TargetStringFileStatus7{} = QualLevel
QLFull


----------------------------------
-- Syntax forms
--

-- | All the forms of syntax for 'TargetSelector'.
--
syntaxForms :: KnownTargets -> Syntax
syntaxForms :: KnownTargets -> Syntax
syntaxForms KnownTargets {
              knownPackagesAll :: KnownTargets -> [KnownPackage]
knownPackagesAll       = [KnownPackage]
pinfo,
              knownPackagesPrimary :: KnownTargets -> [KnownPackage]
knownPackagesPrimary   = [KnownPackage]
ppinfo,
              knownComponentsAll :: KnownTargets -> [KnownComponent]
knownComponentsAll     = [KnownComponent]
cinfo,
              knownComponentsPrimary :: KnownTargets -> [KnownComponent]
knownComponentsPrimary = [KnownComponent]
pcinfo,
              knownComponentsOther :: KnownTargets -> [KnownComponent]
knownComponentsOther   = [KnownComponent]
ocinfo
            } =
    -- The various forms of syntax here are ambiguous in many cases.
    -- Our policy is by default we expose that ambiguity and report
    -- ambiguous matches. In certain cases we override the ambiguity
    -- by having some forms shadow others.
    --
    -- We make modules shadow files because module name "Q" clashes
    -- with file "Q" with no extension but these refer to the same
    -- thing anyway so it's not a useful ambiguity. Other cases are
    -- not ambiguous like "Q" vs "Q.hs" or "Data.Q" vs "Data/Q".

    [Syntax] -> Syntax
ambiguousAlternatives
        -- convenient single-component forms
      [ [Syntax] -> Syntax
shadowingAlternatives
          [ [Syntax] -> Syntax
ambiguousAlternatives
              [ Syntax
syntaxForm1All
              , [KnownPackage] -> Syntax
syntaxForm1Filter        [KnownPackage]
ppinfo
              , [Syntax] -> Syntax
shadowingAlternatives
                  [ [KnownComponent] -> Syntax
syntaxForm1Component [KnownComponent]
pcinfo
                  , [KnownPackage] -> Syntax
syntaxForm1Package   [KnownPackage]
pinfo
                  ]
              ]
          , [KnownComponent] -> Syntax
syntaxForm1Component [KnownComponent]
ocinfo
          , [KnownComponent] -> Syntax
syntaxForm1Module    [KnownComponent]
cinfo
          , [KnownPackage] -> Syntax
syntaxForm1File      [KnownPackage]
pinfo
          ]

        -- two-component partially qualified forms
        -- fully qualified form for 'all'
      , Syntax
syntaxForm2MetaAll
      , Syntax
syntaxForm2AllFilter
      , [KnownPackage] -> Syntax
syntaxForm2NamespacePackage [KnownPackage]
pinfo
      , [KnownPackage] -> Syntax
syntaxForm2PackageComponent [KnownPackage]
pinfo
      , [KnownPackage] -> Syntax
syntaxForm2PackageFilter    [KnownPackage]
pinfo
      , [KnownComponent] -> Syntax
syntaxForm2KindComponent    [KnownComponent]
cinfo
      , [Syntax] -> Syntax
shadowingAlternatives
          [ [KnownPackage] -> Syntax
syntaxForm2PackageModule   [KnownPackage]
pinfo
          , [KnownPackage] -> Syntax
syntaxForm2PackageFile     [KnownPackage]
pinfo
          ]
      , [Syntax] -> Syntax
shadowingAlternatives
          [ [KnownComponent] -> Syntax
syntaxForm2ComponentModule [KnownComponent]
cinfo
          , [KnownComponent] -> Syntax
syntaxForm2ComponentFile   [KnownComponent]
cinfo
          ]

        -- rarely used partially qualified forms
      , [KnownPackage] -> Syntax
syntaxForm3PackageKindComponent   [KnownPackage]
pinfo
      , [Syntax] -> Syntax
shadowingAlternatives
          [ [KnownPackage] -> Syntax
syntaxForm3PackageComponentModule [KnownPackage]
pinfo
          , [KnownPackage] -> Syntax
syntaxForm3PackageComponentFile   [KnownPackage]
pinfo
          ]
      , [Syntax] -> Syntax
shadowingAlternatives
          [ [KnownComponent] -> Syntax
syntaxForm3KindComponentModule    [KnownComponent]
cinfo
          , [KnownComponent] -> Syntax
syntaxForm3KindComponentFile      [KnownComponent]
cinfo
          ]
      , [KnownPackage] -> Syntax
syntaxForm3NamespacePackageFilter [KnownPackage]
pinfo

        -- fully-qualified forms for all and cwd with filter
      , Syntax
syntaxForm3MetaAllFilter
      , [KnownPackage] -> Syntax
syntaxForm3MetaCwdFilter [KnownPackage]
ppinfo

        -- fully-qualified form for package and package with filter
      , [KnownPackage] -> Syntax
syntaxForm3MetaNamespacePackage       [KnownPackage]
pinfo
      , [KnownPackage] -> Syntax
syntaxForm4MetaNamespacePackageFilter [KnownPackage]
pinfo

        -- fully-qualified forms for component, module and file
      , [KnownPackage] -> Syntax
syntaxForm5MetaNamespacePackageKindComponent                [KnownPackage]
pinfo
      , [KnownPackage] -> Syntax
syntaxForm7MetaNamespacePackageKindComponentNamespaceModule [KnownPackage]
pinfo
      , [KnownPackage] -> Syntax
syntaxForm7MetaNamespacePackageKindComponentNamespaceFile   [KnownPackage]
pinfo
      ]
  where
    ambiguousAlternatives :: [Syntax] -> Syntax
ambiguousAlternatives = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
Prelude.foldr1 Syntax -> Syntax -> Syntax
AmbiguousAlternatives
    shadowingAlternatives :: [Syntax] -> Syntax
shadowingAlternatives = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
Prelude.foldr1 Syntax -> Syntax -> Syntax
ShadowingAlternatives


-- | Syntax: "all" to select all packages in the project
--
-- > cabal build all
--
syntaxForm1All :: Syntax
syntaxForm1All :: Syntax
syntaxForm1All =
  (TargetSelector -> [TargetStringFileStatus]) -> Match1 -> Syntax
syntaxForm1 TargetSelector -> [TargetStringFileStatus]
render forall a b. (a -> b) -> a -> b
$ \FilePath
str1 FileStatus
_fstatus1 -> do
    FilePath -> Match ()
guardMetaAll FilePath
str1
    forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ComponentKind -> TargetSelector
TargetAllPackages forall a. Maybe a
Nothing)
  where
    render :: TargetSelector -> [TargetStringFileStatus]
render (TargetAllPackages Maybe ComponentKind
Nothing) =
      [FilePath -> FileStatus -> TargetStringFileStatus
TargetStringFileStatus1 FilePath
"all" FileStatus
noFileStatus]
    render TargetSelector
_ = []

-- | Syntax: filter
--
-- > cabal build tests
--
syntaxForm1Filter :: [KnownPackage] -> Syntax
syntaxForm1Filter :: [KnownPackage] -> Syntax
syntaxForm1Filter [KnownPackage]
ps =
  (TargetSelector -> [TargetStringFileStatus]) -> Match1 -> Syntax
syntaxForm1 TargetSelector -> [TargetStringFileStatus]
render forall a b. (a -> b) -> a -> b
$ \FilePath
str1 FileStatus
_fstatus1 -> do
    ComponentKind
kfilter <- FilePath -> Match ComponentKind
matchComponentKindFilter FilePath
str1
    forall (m :: * -> *) a. Monad m => a -> m a
return (TargetImplicitCwd
-> [PackageId] -> Maybe ComponentKind -> TargetSelector
TargetPackage TargetImplicitCwd
TargetImplicitCwd [PackageId]
pids (forall a. a -> Maybe a
Just ComponentKind
kfilter))
  where
    pids :: [PackageId]
pids = [ PackageId
pinfoId | KnownPackage{PackageId
pinfoId :: PackageId
pinfoId :: KnownPackage -> PackageId
pinfoId} <- [KnownPackage]
ps ]
    render :: TargetSelector -> [TargetStringFileStatus]
render (TargetPackage TargetImplicitCwd
TargetImplicitCwd [PackageId]
_ (Just ComponentKind
kfilter)) =
      [FilePath -> FileStatus -> TargetStringFileStatus
TargetStringFileStatus1 (ComponentKind -> FilePath
dispF ComponentKind
kfilter) FileStatus
noFileStatus]
    render TargetSelector
_ = []


-- | Syntax: package (name, dir or file)
--
-- > cabal build foo
-- > cabal build ../bar ../bar/bar.cabal
--
syntaxForm1Package :: [KnownPackage] -> Syntax
syntaxForm1Package :: [KnownPackage] -> Syntax
syntaxForm1Package [KnownPackage]
pinfo =
  (TargetSelector -> [TargetStringFileStatus]) -> Match1 -> Syntax
syntaxForm1 TargetSelector -> [TargetStringFileStatus]
render forall a b. (a -> b) -> a -> b
$ \FilePath
str1 FileStatus
fstatus1 -> do
    FilePath -> FileStatus -> Match ()
guardPackage            FilePath
str1 FileStatus
fstatus1
    KnownPackage
p <- [KnownPackage] -> FilePath -> FileStatus -> Match KnownPackage
matchPackage [KnownPackage]
pinfo FilePath
str1 FileStatus
fstatus1
    case KnownPackage
p of
      KnownPackage{PackageId
pinfoId :: PackageId
pinfoId :: KnownPackage -> PackageId
pinfoId} ->
        forall (m :: * -> *) a. Monad m => a -> m a
return (TargetImplicitCwd
-> [PackageId] -> Maybe ComponentKind -> TargetSelector
TargetPackage TargetImplicitCwd
TargetExplicitNamed [PackageId
pinfoId] forall a. Maybe a
Nothing)
      KnownPackageName PackageName
pn ->
        forall (m :: * -> *) a. Monad m => a -> m a
return (PackageName -> Maybe ComponentKind -> TargetSelector
TargetPackageNamed PackageName
pn forall a. Maybe a
Nothing)
  where
    render :: TargetSelector -> [TargetStringFileStatus]
render (TargetPackage TargetImplicitCwd
TargetExplicitNamed [PackageId
p] Maybe ComponentKind
Nothing) =
      [FilePath -> FileStatus -> TargetStringFileStatus
TargetStringFileStatus1 (forall p. Package p => p -> FilePath
dispP PackageId
p) FileStatus
noFileStatus]
    render (TargetPackageNamed PackageName
pn Maybe ComponentKind
Nothing) =
      [FilePath -> FileStatus -> TargetStringFileStatus
TargetStringFileStatus1 (PackageName -> FilePath
dispPN PackageName
pn) FileStatus
noFileStatus]
    render TargetSelector
_ = []

-- | Syntax: component
--
-- > cabal build foo
--
syntaxForm1Component :: [KnownComponent] -> Syntax
syntaxForm1Component :: [KnownComponent] -> Syntax
syntaxForm1Component [KnownComponent]
cs =
  (TargetSelector -> [TargetStringFileStatus]) -> Match1 -> Syntax
syntaxForm1 TargetSelector -> [TargetStringFileStatus]
render forall a b. (a -> b) -> a -> b
$ \FilePath
str1 FileStatus
_fstatus1 -> do
    FilePath -> Match ()
guardComponentName FilePath
str1
    KnownComponent
c <- [KnownComponent] -> FilePath -> Match KnownComponent
matchComponentName [KnownComponent]
cs FilePath
str1
    forall (m :: * -> *) a. Monad m => a -> m a
return (PackageId -> ComponentName -> SubComponentTarget -> TargetSelector
TargetComponent (KnownComponent -> PackageId
cinfoPackageId KnownComponent
c) (KnownComponent -> ComponentName
cinfoName KnownComponent
c) SubComponentTarget
WholeComponent)
  where
    render :: TargetSelector -> [TargetStringFileStatus]
render (TargetComponent PackageId
p ComponentName
c SubComponentTarget
WholeComponent) =
      [FilePath -> FileStatus -> TargetStringFileStatus
TargetStringFileStatus1 (PackageId -> ComponentName -> FilePath
dispC PackageId
p ComponentName
c) FileStatus
noFileStatus]
    render TargetSelector
_ = []

-- | Syntax: module
--
-- > cabal build Data.Foo
--
syntaxForm1Module :: [KnownComponent] -> Syntax
syntaxForm1Module :: [KnownComponent] -> Syntax
syntaxForm1Module [KnownComponent]
cs =
  (TargetSelector -> [TargetStringFileStatus]) -> Match1 -> Syntax
syntaxForm1 TargetSelector -> [TargetStringFileStatus]
render forall a b. (a -> b) -> a -> b
$  \FilePath
str1 FileStatus
_fstatus1 -> do
    FilePath -> Match ()
guardModuleName FilePath
str1
    let ms :: [(ModuleName, KnownComponent)]
ms = [ (ModuleName
m,KnownComponent
c) | KnownComponent
c <- [KnownComponent]
cs, ModuleName
m <- KnownComponent -> [ModuleName]
cinfoModules KnownComponent
c ]
    (ModuleName
m,KnownComponent
c) <- forall a. [(ModuleName, a)] -> FilePath -> Match (ModuleName, a)
matchModuleNameAnd [(ModuleName, KnownComponent)]
ms FilePath
str1
    forall (m :: * -> *) a. Monad m => a -> m a
return (PackageId -> ComponentName -> SubComponentTarget -> TargetSelector
TargetComponent (KnownComponent -> PackageId
cinfoPackageId KnownComponent
c) (KnownComponent -> ComponentName
cinfoName KnownComponent
c) (ModuleName -> SubComponentTarget
ModuleTarget ModuleName
m))
  where
    render :: TargetSelector -> [TargetStringFileStatus]
render (TargetComponent PackageId
_p ComponentName
_c (ModuleTarget ModuleName
m)) =
      [FilePath -> FileStatus -> TargetStringFileStatus
TargetStringFileStatus1 (ModuleName -> FilePath
dispM ModuleName
m) FileStatus
noFileStatus]
    render TargetSelector
_ = []

-- | Syntax: file name
--
-- > cabal build Data/Foo.hs bar/Main.hsc
--
syntaxForm1File :: [KnownPackage] -> Syntax
syntaxForm1File :: [KnownPackage] -> Syntax
syntaxForm1File [KnownPackage]
ps =
    -- Note there's a bit of an inconsistency here vs the other syntax forms
    -- for files. For the single-part syntax the target has to point to a file
    -- that exists (due to our use of matchPackageDirectoryPrefix), whereas for
    -- all the other forms we don't require that.
  (TargetSelector -> [TargetStringFileStatus]) -> Match1 -> Syntax
syntaxForm1 TargetSelector -> [TargetStringFileStatus]
render forall a b. (a -> b) -> a -> b
$ \FilePath
str1 FileStatus
fstatus1 ->
    forall a. FilePath -> FilePath -> Match a -> Match a
expecting FilePath
"file" FilePath
str1 forall a b. (a -> b) -> a -> b
$ do
    (FilePath
pkgfile, ~KnownPackage{PackageId
pinfoId :: PackageId
pinfoId :: KnownPackage -> PackageId
pinfoId, [KnownComponent]
pinfoComponents :: KnownPackage -> [KnownComponent]
pinfoComponents :: [KnownComponent]
pinfoComponents})
      -- always returns the KnownPackage case
      <- [KnownPackage] -> FileStatus -> Match (FilePath, KnownPackage)
matchPackageDirectoryPrefix [KnownPackage]
ps FileStatus
fstatus1
    forall a. FilePath -> FilePath -> Match a -> Match a
orNoThingIn FilePath
"package" (forall a. Pretty a => a -> FilePath
prettyShow (forall pkg. Package pkg => pkg -> PackageName
packageName PackageId
pinfoId)) forall a b. (a -> b) -> a -> b
$ do
      (FilePath
filepath, KnownComponent
c) <- [KnownComponent] -> FilePath -> Match (FilePath, KnownComponent)
matchComponentFile [KnownComponent]
pinfoComponents FilePath
pkgfile
      forall (m :: * -> *) a. Monad m => a -> m a
return (PackageId -> ComponentName -> SubComponentTarget -> TargetSelector
TargetComponent PackageId
pinfoId (KnownComponent -> ComponentName
cinfoName KnownComponent
c) (FilePath -> SubComponentTarget
FileTarget FilePath
filepath))
  where
    render :: TargetSelector -> [TargetStringFileStatus]
render (TargetComponent PackageId
_p ComponentName
_c (FileTarget FilePath
f)) =
      [FilePath -> FileStatus -> TargetStringFileStatus
TargetStringFileStatus1 FilePath
f FileStatus
noFileStatus]
    render TargetSelector
_ = []

---

-- | Syntax:  :all
--
-- > cabal build :all
--
syntaxForm2MetaAll :: Syntax
syntaxForm2MetaAll :: Syntax
syntaxForm2MetaAll =
  (TargetSelector -> [TargetStringFileStatus]) -> Match2 -> Syntax
syntaxForm2 TargetSelector -> [TargetStringFileStatus]
render forall a b. (a -> b) -> a -> b
$ \FilePath
str1 FileStatus
_fstatus1 FilePath
str2 -> do
    FilePath -> Match ()
guardNamespaceMeta FilePath
str1
    FilePath -> Match ()
guardMetaAll FilePath
str2
    forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ComponentKind -> TargetSelector
TargetAllPackages forall a. Maybe a
Nothing)
  where
    render :: TargetSelector -> [TargetStringFileStatus]
render (TargetAllPackages Maybe ComponentKind
Nothing) =
      [FilePath -> FileStatus -> FilePath -> TargetStringFileStatus
TargetStringFileStatus2 FilePath
"" FileStatus
noFileStatus FilePath
"all"]
    render TargetSelector
_ = []

-- | Syntax:  all : filer
--
-- > cabal build all:tests
--
syntaxForm2AllFilter :: Syntax
syntaxForm2AllFilter :: Syntax
syntaxForm2AllFilter =
  (TargetSelector -> [TargetStringFileStatus]) -> Match2 -> Syntax
syntaxForm2 TargetSelector -> [TargetStringFileStatus]
render forall a b. (a -> b) -> a -> b
$ \FilePath
str1 FileStatus
_fstatus1 FilePath
str2 -> do
    FilePath -> Match ()
guardMetaAll FilePath
str1
    ComponentKind
kfilter <- FilePath -> Match ComponentKind
matchComponentKindFilter FilePath
str2
    forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ComponentKind -> TargetSelector
TargetAllPackages (forall a. a -> Maybe a
Just ComponentKind
kfilter))
  where
    render :: TargetSelector -> [TargetStringFileStatus]
render (TargetAllPackages (Just ComponentKind
kfilter)) =
      [FilePath -> FileStatus -> FilePath -> TargetStringFileStatus
TargetStringFileStatus2 FilePath
"all" FileStatus
noFileStatus (ComponentKind -> FilePath
dispF ComponentKind
kfilter)]
    render TargetSelector
_ = []

-- | Syntax:  package : filer
--
-- > cabal build foo:tests
--
syntaxForm2PackageFilter :: [KnownPackage] -> Syntax
syntaxForm2PackageFilter :: [KnownPackage] -> Syntax
syntaxForm2PackageFilter [KnownPackage]
ps =
  (TargetSelector -> [TargetStringFileStatus]) -> Match2 -> Syntax
syntaxForm2 TargetSelector -> [TargetStringFileStatus]
render forall a b. (a -> b) -> a -> b
$ \FilePath
str1 FileStatus
fstatus1 FilePath
str2 -> do
    FilePath -> FileStatus -> Match ()
guardPackage         FilePath
str1 FileStatus
fstatus1
    KnownPackage
p <- [KnownPackage] -> FilePath -> FileStatus -> Match KnownPackage
matchPackage [KnownPackage]
ps FilePath
str1 FileStatus
fstatus1
    ComponentKind
kfilter <- FilePath -> Match ComponentKind
matchComponentKindFilter FilePath
str2
    case KnownPackage
p of
      KnownPackage{PackageId
pinfoId :: PackageId
pinfoId :: KnownPackage -> PackageId
pinfoId} ->
        forall (m :: * -> *) a. Monad m => a -> m a
return (TargetImplicitCwd
-> [PackageId] -> Maybe ComponentKind -> TargetSelector
TargetPackage TargetImplicitCwd
TargetExplicitNamed [PackageId
pinfoId] (forall a. a -> Maybe a
Just ComponentKind
kfilter))
      KnownPackageName PackageName
pn ->
        forall (m :: * -> *) a. Monad m => a -> m a
return (PackageName -> Maybe ComponentKind -> TargetSelector
TargetPackageNamed PackageName
pn (forall a. a -> Maybe a
Just ComponentKind
kfilter))
  where
    render :: TargetSelector -> [TargetStringFileStatus]
render (TargetPackage TargetImplicitCwd
TargetExplicitNamed [PackageId
p] (Just ComponentKind
kfilter)) =
      [FilePath -> FileStatus -> FilePath -> TargetStringFileStatus
TargetStringFileStatus2 (forall p. Package p => p -> FilePath
dispP PackageId
p) FileStatus
noFileStatus (ComponentKind -> FilePath
dispF ComponentKind
kfilter)]
    render (TargetPackageNamed PackageName
pn (Just ComponentKind
kfilter)) =
      [FilePath -> FileStatus -> FilePath -> TargetStringFileStatus
TargetStringFileStatus2 (PackageName -> FilePath
dispPN PackageName
pn) FileStatus
noFileStatus (ComponentKind -> FilePath
dispF ComponentKind
kfilter)]
    render TargetSelector
_ = []

-- | Syntax: pkg : package name
--
-- > cabal build pkg:foo
--
syntaxForm2NamespacePackage :: [KnownPackage] -> Syntax
syntaxForm2NamespacePackage :: [KnownPackage] -> Syntax
syntaxForm2NamespacePackage [KnownPackage]
pinfo =
  (TargetSelector -> [TargetStringFileStatus]) -> Match2 -> Syntax
syntaxForm2 TargetSelector -> [TargetStringFileStatus]
render forall a b. (a -> b) -> a -> b
$ \FilePath
str1 FileStatus
_fstatus1 FilePath
str2 -> do
    FilePath -> Match ()
guardNamespacePackage   FilePath
str1
    FilePath -> Match ()
guardPackageName        FilePath
str2
    KnownPackage
p <- [KnownPackage] -> FilePath -> FileStatus -> Match KnownPackage
matchPackage [KnownPackage]
pinfo FilePath
str2 FileStatus
noFileStatus
    case KnownPackage
p of
      KnownPackage{PackageId
pinfoId :: PackageId
pinfoId :: KnownPackage -> PackageId
pinfoId} ->
        forall (m :: * -> *) a. Monad m => a -> m a
return (TargetImplicitCwd
-> [PackageId] -> Maybe ComponentKind -> TargetSelector
TargetPackage TargetImplicitCwd
TargetExplicitNamed [PackageId
pinfoId] forall a. Maybe a
Nothing)
      KnownPackageName PackageName
pn ->
        forall (m :: * -> *) a. Monad m => a -> m a
return (PackageName -> Maybe ComponentKind -> TargetSelector
TargetPackageNamed PackageName
pn forall a. Maybe a
Nothing)
  where
    render :: TargetSelector -> [TargetStringFileStatus]
render (TargetPackage TargetImplicitCwd
TargetExplicitNamed [PackageId
p] Maybe ComponentKind
Nothing) =
      [FilePath -> FileStatus -> FilePath -> TargetStringFileStatus
TargetStringFileStatus2 FilePath
"pkg" FileStatus
noFileStatus (forall p. Package p => p -> FilePath
dispP PackageId
p)]
    render (TargetPackageNamed PackageName
pn Maybe ComponentKind
Nothing) =
      [FilePath -> FileStatus -> FilePath -> TargetStringFileStatus
TargetStringFileStatus2 FilePath
"pkg" FileStatus
noFileStatus (PackageName -> FilePath
dispPN PackageName
pn)]
    render TargetSelector
_ = []

-- | Syntax: package : component
--
-- > cabal build foo:foo
-- > cabal build ./foo:foo
-- > cabal build ./foo.cabal:foo
--
syntaxForm2PackageComponent :: [KnownPackage] -> Syntax
syntaxForm2PackageComponent :: [KnownPackage] -> Syntax
syntaxForm2PackageComponent [KnownPackage]
ps =
  (TargetSelector -> [TargetStringFileStatus]) -> Match2 -> Syntax
syntaxForm2 TargetSelector -> [TargetStringFileStatus]
render forall a b. (a -> b) -> a -> b
$ \FilePath
str1 FileStatus
fstatus1 FilePath
str2 -> do
    FilePath -> FileStatus -> Match ()
guardPackage         FilePath
str1 FileStatus
fstatus1
    FilePath -> Match ()
guardComponentName   FilePath
str2
    KnownPackage
p <- [KnownPackage] -> FilePath -> FileStatus -> Match KnownPackage
matchPackage [KnownPackage]
ps FilePath
str1 FileStatus
fstatus1
    case KnownPackage
p of
      KnownPackage{PackageId
pinfoId :: PackageId
pinfoId :: KnownPackage -> PackageId
pinfoId, [KnownComponent]
pinfoComponents :: [KnownComponent]
pinfoComponents :: KnownPackage -> [KnownComponent]
pinfoComponents} ->
        forall a. FilePath -> FilePath -> Match a -> Match a
orNoThingIn FilePath
"package" (forall a. Pretty a => a -> FilePath
prettyShow (forall pkg. Package pkg => pkg -> PackageName
packageName PackageId
pinfoId)) forall a b. (a -> b) -> a -> b
$ do
          KnownComponent
c <- [KnownComponent] -> FilePath -> Match KnownComponent
matchComponentName [KnownComponent]
pinfoComponents FilePath
str2
          forall (m :: * -> *) a. Monad m => a -> m a
return (PackageId -> ComponentName -> SubComponentTarget -> TargetSelector
TargetComponent PackageId
pinfoId (KnownComponent -> ComponentName
cinfoName KnownComponent
c) SubComponentTarget
WholeComponent)
        --TODO: the error here ought to say there's no component by that name in
        -- this package, and name the package
      KnownPackageName PackageName
pn ->
        let cn :: UnqualComponentName
cn = FilePath -> UnqualComponentName
mkUnqualComponentName FilePath
str2 in
        forall (m :: * -> *) a. Monad m => a -> m a
return (PackageName
-> Either UnqualComponentName ComponentName
-> SubComponentTarget
-> TargetSelector
TargetComponentUnknown PackageName
pn (forall a b. a -> Either a b
Left UnqualComponentName
cn) SubComponentTarget
WholeComponent)
  where
    render :: TargetSelector -> [TargetStringFileStatus]
render (TargetComponent PackageId
p ComponentName
c SubComponentTarget
WholeComponent) =
      [FilePath -> FileStatus -> FilePath -> TargetStringFileStatus
TargetStringFileStatus2 (forall p. Package p => p -> FilePath
dispP PackageId
p) FileStatus
noFileStatus (PackageId -> ComponentName -> FilePath
dispC PackageId
p ComponentName
c)]
    render (TargetComponentUnknown PackageName
pn (Left UnqualComponentName
cn) SubComponentTarget
WholeComponent) =
      [FilePath -> FileStatus -> FilePath -> TargetStringFileStatus
TargetStringFileStatus2 (PackageName -> FilePath
dispPN PackageName
pn) FileStatus
noFileStatus (forall a. Pretty a => a -> FilePath
prettyShow UnqualComponentName
cn)]
    render TargetSelector
_ = []

-- | Syntax: namespace : component
--
-- > cabal build lib:foo exe:foo
--
syntaxForm2KindComponent :: [KnownComponent] -> Syntax
syntaxForm2KindComponent :: [KnownComponent] -> Syntax
syntaxForm2KindComponent [KnownComponent]
cs =
  (TargetSelector -> [TargetStringFileStatus]) -> Match2 -> Syntax
syntaxForm2 TargetSelector -> [TargetStringFileStatus]
render forall a b. (a -> b) -> a -> b
$ \FilePath
str1 FileStatus
_fstatus1 FilePath
str2 -> do
    ComponentKind
ckind <- FilePath -> Match ComponentKind
matchComponentKind FilePath
str1
    FilePath -> Match ()
guardComponentName FilePath
str2
    KnownComponent
c <- [KnownComponent]
-> ComponentKind -> FilePath -> Match KnownComponent
matchComponentKindAndName [KnownComponent]
cs ComponentKind
ckind FilePath
str2
    forall (m :: * -> *) a. Monad m => a -> m a
return (PackageId -> ComponentName -> SubComponentTarget -> TargetSelector
TargetComponent (KnownComponent -> PackageId
cinfoPackageId KnownComponent
c) (KnownComponent -> ComponentName
cinfoName KnownComponent
c) SubComponentTarget
WholeComponent)
  where
    render :: TargetSelector -> [TargetStringFileStatus]
render (TargetComponent PackageId
p ComponentName
c SubComponentTarget
WholeComponent) =
      [FilePath -> FileStatus -> FilePath -> TargetStringFileStatus
TargetStringFileStatus2 (ComponentName -> FilePath
dispCK ComponentName
c) FileStatus
noFileStatus (PackageId -> ComponentName -> FilePath
dispC PackageId
p ComponentName
c)]
    render TargetSelector
_ = []

-- | Syntax: package : module
--
-- > cabal build foo:Data.Foo
-- > cabal build ./foo:Data.Foo
-- > cabal build ./foo.cabal:Data.Foo
--
syntaxForm2PackageModule :: [KnownPackage] -> Syntax
syntaxForm2PackageModule :: [KnownPackage] -> Syntax
syntaxForm2PackageModule [KnownPackage]
ps =
  (TargetSelector -> [TargetStringFileStatus]) -> Match2 -> Syntax
syntaxForm2 TargetSelector -> [TargetStringFileStatus]
render forall a b. (a -> b) -> a -> b
$ \FilePath
str1 FileStatus
fstatus1 FilePath
str2 -> do
    FilePath -> FileStatus -> Match ()
guardPackage         FilePath
str1 FileStatus
fstatus1
    FilePath -> Match ()
guardModuleName      FilePath
str2
    KnownPackage
p <- [KnownPackage] -> FilePath -> FileStatus -> Match KnownPackage
matchPackage [KnownPackage]
ps FilePath
str1 FileStatus
fstatus1
    case KnownPackage
p of
      KnownPackage{PackageId
pinfoId :: PackageId
pinfoId :: KnownPackage -> PackageId
pinfoId, [KnownComponent]
pinfoComponents :: [KnownComponent]
pinfoComponents :: KnownPackage -> [KnownComponent]
pinfoComponents} ->
        forall a. FilePath -> FilePath -> Match a -> Match a
orNoThingIn FilePath
"package" (forall a. Pretty a => a -> FilePath
prettyShow (forall pkg. Package pkg => pkg -> PackageName
packageName PackageId
pinfoId)) forall a b. (a -> b) -> a -> b
$ do
          let ms :: [(ModuleName, KnownComponent)]
ms = [ (ModuleName
m,KnownComponent
c) | KnownComponent
c <- [KnownComponent]
pinfoComponents, ModuleName
m <- KnownComponent -> [ModuleName]
cinfoModules KnownComponent
c ]
          (ModuleName
m,KnownComponent
c) <- forall a. [(ModuleName, a)] -> FilePath -> Match (ModuleName, a)
matchModuleNameAnd [(ModuleName, KnownComponent)]
ms FilePath
str2
          forall (m :: * -> *) a. Monad m => a -> m a
return (PackageId -> ComponentName -> SubComponentTarget -> TargetSelector
TargetComponent PackageId
pinfoId (KnownComponent -> ComponentName
cinfoName KnownComponent
c) (ModuleName -> SubComponentTarget
ModuleTarget ModuleName
m))
      KnownPackageName PackageName
pn -> do
        ModuleName
m <- FilePath -> Match ModuleName
matchModuleNameUnknown FilePath
str2
        -- We assume the primary library component of the package:
        forall (m :: * -> *) a. Monad m => a -> m a
return (PackageName
-> Either UnqualComponentName ComponentName
-> SubComponentTarget
-> TargetSelector
TargetComponentUnknown PackageName
pn (forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ LibraryName -> ComponentName
CLibName LibraryName
LMainLibName) (ModuleName -> SubComponentTarget
ModuleTarget ModuleName
m))
  where
    render :: TargetSelector -> [TargetStringFileStatus]
render (TargetComponent PackageId
p ComponentName
_c (ModuleTarget ModuleName
m)) =
      [FilePath -> FileStatus -> FilePath -> TargetStringFileStatus
TargetStringFileStatus2 (forall p. Package p => p -> FilePath
dispP PackageId
p) FileStatus
noFileStatus (ModuleName -> FilePath
dispM ModuleName
m)]
    render TargetSelector
_ = []

-- | Syntax: component : module
--
-- > cabal build foo:Data.Foo
--
syntaxForm2ComponentModule :: [KnownComponent] -> Syntax
syntaxForm2ComponentModule :: [KnownComponent] -> Syntax
syntaxForm2ComponentModule [KnownComponent]
cs =
  (TargetSelector -> [TargetStringFileStatus]) -> Match2 -> Syntax
syntaxForm2 TargetSelector -> [TargetStringFileStatus]
render forall a b. (a -> b) -> a -> b
$ \FilePath
str1 FileStatus
_fstatus1 FilePath
str2 -> do
    FilePath -> Match ()
guardComponentName FilePath
str1
    FilePath -> Match ()
guardModuleName    FilePath
str2
    KnownComponent
c <- [KnownComponent] -> FilePath -> Match KnownComponent
matchComponentName [KnownComponent]
cs FilePath
str1
    forall a. FilePath -> FilePath -> Match a -> Match a
orNoThingIn FilePath
"component" (KnownComponent -> FilePath
cinfoStrName KnownComponent
c) forall a b. (a -> b) -> a -> b
$ do
      let ms :: [ModuleName]
ms = KnownComponent -> [ModuleName]
cinfoModules KnownComponent
c
      ModuleName
m <- [ModuleName] -> FilePath -> Match ModuleName
matchModuleName [ModuleName]
ms FilePath
str2
      forall (m :: * -> *) a. Monad m => a -> m a
return (PackageId -> ComponentName -> SubComponentTarget -> TargetSelector
TargetComponent (KnownComponent -> PackageId
cinfoPackageId KnownComponent
c) (KnownComponent -> ComponentName
cinfoName KnownComponent
c)
                              (ModuleName -> SubComponentTarget
ModuleTarget ModuleName
m))
  where
    render :: TargetSelector -> [TargetStringFileStatus]
render (TargetComponent PackageId
p ComponentName
c (ModuleTarget ModuleName
m)) =
      [FilePath -> FileStatus -> FilePath -> TargetStringFileStatus
TargetStringFileStatus2 (PackageId -> ComponentName -> FilePath
dispC PackageId
p ComponentName
c) FileStatus
noFileStatus (ModuleName -> FilePath
dispM ModuleName
m)]
    render TargetSelector
_ = []

-- | Syntax: package : filename
--
-- > cabal build foo:Data/Foo.hs
-- > cabal build ./foo:Data/Foo.hs
-- > cabal build ./foo.cabal:Data/Foo.hs
--
syntaxForm2PackageFile :: [KnownPackage] -> Syntax
syntaxForm2PackageFile :: [KnownPackage] -> Syntax
syntaxForm2PackageFile [KnownPackage]
ps =
  (TargetSelector -> [TargetStringFileStatus]) -> Match2 -> Syntax
syntaxForm2 TargetSelector -> [TargetStringFileStatus]
render forall a b. (a -> b) -> a -> b
$ \FilePath
str1 FileStatus
fstatus1 FilePath
str2 -> do
    FilePath -> FileStatus -> Match ()
guardPackage         FilePath
str1 FileStatus
fstatus1
    KnownPackage
p <- [KnownPackage] -> FilePath -> FileStatus -> Match KnownPackage
matchPackage [KnownPackage]
ps FilePath
str1 FileStatus
fstatus1
    case KnownPackage
p of
      KnownPackage{PackageId
pinfoId :: PackageId
pinfoId :: KnownPackage -> PackageId
pinfoId, [KnownComponent]
pinfoComponents :: [KnownComponent]
pinfoComponents :: KnownPackage -> [KnownComponent]
pinfoComponents} ->
        forall a. FilePath -> FilePath -> Match a -> Match a
orNoThingIn FilePath
"package" (forall a. Pretty a => a -> FilePath
prettyShow (forall pkg. Package pkg => pkg -> PackageName
packageName PackageId
pinfoId)) forall a b. (a -> b) -> a -> b
$ do
          (FilePath
filepath, KnownComponent
c) <- [KnownComponent] -> FilePath -> Match (FilePath, KnownComponent)
matchComponentFile [KnownComponent]
pinfoComponents FilePath
str2
          forall (m :: * -> *) a. Monad m => a -> m a
return (PackageId -> ComponentName -> SubComponentTarget -> TargetSelector
TargetComponent PackageId
pinfoId (KnownComponent -> ComponentName
cinfoName KnownComponent
c) (FilePath -> SubComponentTarget
FileTarget FilePath
filepath))
      KnownPackageName PackageName
pn ->
        let filepath :: FilePath
filepath = FilePath
str2 in
        -- We assume the primary library component of the package:
        forall (m :: * -> *) a. Monad m => a -> m a
return (PackageName
-> Either UnqualComponentName ComponentName
-> SubComponentTarget
-> TargetSelector
TargetComponentUnknown PackageName
pn (forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ LibraryName -> ComponentName
CLibName LibraryName
LMainLibName) (FilePath -> SubComponentTarget
FileTarget FilePath
filepath))
  where
    render :: TargetSelector -> [TargetStringFileStatus]
render (TargetComponent PackageId
p ComponentName
_c (FileTarget FilePath
f)) =
      [FilePath -> FileStatus -> FilePath -> TargetStringFileStatus
TargetStringFileStatus2 (forall p. Package p => p -> FilePath
dispP PackageId
p) FileStatus
noFileStatus FilePath
f]
    render TargetSelector
_ = []

-- | Syntax: component : filename
--
-- > cabal build foo:Data/Foo.hs
--
syntaxForm2ComponentFile :: [KnownComponent] -> Syntax
syntaxForm2ComponentFile :: [KnownComponent] -> Syntax
syntaxForm2ComponentFile [KnownComponent]
cs =
  (TargetSelector -> [TargetStringFileStatus]) -> Match2 -> Syntax
syntaxForm2 TargetSelector -> [TargetStringFileStatus]
render forall a b. (a -> b) -> a -> b
$ \FilePath
str1 FileStatus
_fstatus1 FilePath
str2 -> do
    FilePath -> Match ()
guardComponentName FilePath
str1
    KnownComponent
c <- [KnownComponent] -> FilePath -> Match KnownComponent
matchComponentName [KnownComponent]
cs FilePath
str1
    forall a. FilePath -> FilePath -> Match a -> Match a
orNoThingIn FilePath
"component" (KnownComponent -> FilePath
cinfoStrName KnownComponent
c) forall a b. (a -> b) -> a -> b
$ do
      (FilePath
filepath, KnownComponent
_) <- [KnownComponent] -> FilePath -> Match (FilePath, KnownComponent)
matchComponentFile [KnownComponent
c] FilePath
str2
      forall (m :: * -> *) a. Monad m => a -> m a
return (PackageId -> ComponentName -> SubComponentTarget -> TargetSelector
TargetComponent (KnownComponent -> PackageId
cinfoPackageId KnownComponent
c) (KnownComponent -> ComponentName
cinfoName KnownComponent
c)
                              (FilePath -> SubComponentTarget
FileTarget FilePath
filepath))
  where
    render :: TargetSelector -> [TargetStringFileStatus]
render (TargetComponent PackageId
p ComponentName
c (FileTarget FilePath
f)) =
      [FilePath -> FileStatus -> FilePath -> TargetStringFileStatus
TargetStringFileStatus2 (PackageId -> ComponentName -> FilePath
dispC PackageId
p ComponentName
c) FileStatus
noFileStatus FilePath
f]
    render TargetSelector
_ = []

---

-- | Syntax: :all : filter
--
-- > cabal build :all:tests
--
syntaxForm3MetaAllFilter :: Syntax
syntaxForm3MetaAllFilter :: Syntax
syntaxForm3MetaAllFilter =
  (TargetSelector -> [TargetStringFileStatus]) -> Match3 -> Syntax
syntaxForm3 TargetSelector -> [TargetStringFileStatus]
render forall a b. (a -> b) -> a -> b
$ \FilePath
str1 FileStatus
_fstatus1 FilePath
str2 FilePath
str3 -> do
    FilePath -> Match ()
guardNamespaceMeta FilePath
str1
    FilePath -> Match ()
guardMetaAll FilePath
str2
    ComponentKind
kfilter <- FilePath -> Match ComponentKind
matchComponentKindFilter FilePath
str3
    forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ComponentKind -> TargetSelector
TargetAllPackages (forall a. a -> Maybe a
Just ComponentKind
kfilter))
  where
    render :: TargetSelector -> [TargetStringFileStatus]
render (TargetAllPackages (Just ComponentKind
kfilter)) =
      [FilePath
-> FileStatus -> FilePath -> FilePath -> TargetStringFileStatus
TargetStringFileStatus3 FilePath
"" FileStatus
noFileStatus FilePath
"all" (ComponentKind -> FilePath
dispF ComponentKind
kfilter)]
    render TargetSelector
_ = []

syntaxForm3MetaCwdFilter :: [KnownPackage] -> Syntax
syntaxForm3MetaCwdFilter :: [KnownPackage] -> Syntax
syntaxForm3MetaCwdFilter [KnownPackage]
ps =
  (TargetSelector -> [TargetStringFileStatus]) -> Match3 -> Syntax
syntaxForm3 TargetSelector -> [TargetStringFileStatus]
render forall a b. (a -> b) -> a -> b
$ \FilePath
str1 FileStatus
_fstatus1 FilePath
str2 FilePath
str3 -> do
    FilePath -> Match ()
guardNamespaceMeta FilePath
str1
    FilePath -> Match ()
guardNamespaceCwd FilePath
str2
    ComponentKind
kfilter <- FilePath -> Match ComponentKind
matchComponentKindFilter FilePath
str3
    forall (m :: * -> *) a. Monad m => a -> m a
return (TargetImplicitCwd
-> [PackageId] -> Maybe ComponentKind -> TargetSelector
TargetPackage TargetImplicitCwd
TargetImplicitCwd [PackageId]
pids (forall a. a -> Maybe a
Just ComponentKind
kfilter))
  where
    pids :: [PackageId]
pids = [ PackageId
pinfoId | KnownPackage{PackageId
pinfoId :: PackageId
pinfoId :: KnownPackage -> PackageId
pinfoId} <- [KnownPackage]
ps ]
    render :: TargetSelector -> [TargetStringFileStatus]
render (TargetPackage TargetImplicitCwd
TargetImplicitCwd [PackageId]
_ (Just ComponentKind
kfilter)) =
      [FilePath
-> FileStatus -> FilePath -> FilePath -> TargetStringFileStatus
TargetStringFileStatus3 FilePath
"" FileStatus
noFileStatus FilePath
"cwd" (ComponentKind -> FilePath
dispF ComponentKind
kfilter)]
    render TargetSelector
_ = []

-- | Syntax: :pkg : package name
--
-- > cabal build :pkg:foo
--
syntaxForm3MetaNamespacePackage :: [KnownPackage] -> Syntax
syntaxForm3MetaNamespacePackage :: [KnownPackage] -> Syntax
syntaxForm3MetaNamespacePackage [KnownPackage]
pinfo =
  (TargetSelector -> [TargetStringFileStatus]) -> Match3 -> Syntax
syntaxForm3 TargetSelector -> [TargetStringFileStatus]
render forall a b. (a -> b) -> a -> b
$ \FilePath
str1 FileStatus
_fstatus1 FilePath
str2 FilePath
str3 -> do
    FilePath -> Match ()
guardNamespaceMeta      FilePath
str1
    FilePath -> Match ()
guardNamespacePackage   FilePath
str2
    FilePath -> Match ()
guardPackageName        FilePath
str3
    KnownPackage
p <- [KnownPackage] -> FilePath -> FileStatus -> Match KnownPackage
matchPackage [KnownPackage]
pinfo FilePath
str3 FileStatus
noFileStatus
    case KnownPackage
p of
      KnownPackage{PackageId
pinfoId :: PackageId
pinfoId :: KnownPackage -> PackageId
pinfoId} ->
        forall (m :: * -> *) a. Monad m => a -> m a
return (TargetImplicitCwd
-> [PackageId] -> Maybe ComponentKind -> TargetSelector
TargetPackage TargetImplicitCwd
TargetExplicitNamed [PackageId
pinfoId] forall a. Maybe a
Nothing)
      KnownPackageName PackageName
pn ->
        forall (m :: * -> *) a. Monad m => a -> m a
return (PackageName -> Maybe ComponentKind -> TargetSelector
TargetPackageNamed PackageName
pn forall a. Maybe a
Nothing)
  where
    render :: TargetSelector -> [TargetStringFileStatus]
render (TargetPackage TargetImplicitCwd
TargetExplicitNamed [PackageId
p] Maybe ComponentKind
Nothing) =
      [FilePath
-> FileStatus -> FilePath -> FilePath -> TargetStringFileStatus
TargetStringFileStatus3 FilePath
"" FileStatus
noFileStatus FilePath
"pkg" (forall p. Package p => p -> FilePath
dispP PackageId
p)]
    render (TargetPackageNamed PackageName
pn Maybe ComponentKind
Nothing) =
      [FilePath
-> FileStatus -> FilePath -> FilePath -> TargetStringFileStatus
TargetStringFileStatus3 FilePath
"" FileStatus
noFileStatus FilePath
"pkg" (PackageName -> FilePath
dispPN PackageName
pn)]
    render TargetSelector
_ = []

-- | Syntax: package : namespace : component
--
-- > cabal build foo:lib:foo
-- > cabal build foo/:lib:foo
-- > cabal build foo.cabal:lib:foo
--
syntaxForm3PackageKindComponent :: [KnownPackage] -> Syntax
syntaxForm3PackageKindComponent :: [KnownPackage] -> Syntax
syntaxForm3PackageKindComponent [KnownPackage]
ps =
  (TargetSelector -> [TargetStringFileStatus]) -> Match3 -> Syntax
syntaxForm3 TargetSelector -> [TargetStringFileStatus]
render forall a b. (a -> b) -> a -> b
$ \FilePath
str1 FileStatus
fstatus1 FilePath
str2 FilePath
str3 -> do
    FilePath -> FileStatus -> Match ()
guardPackage         FilePath
str1 FileStatus
fstatus1
    ComponentKind
ckind <- FilePath -> Match ComponentKind
matchComponentKind FilePath
str2
    FilePath -> Match ()
guardComponentName   FilePath
str3
    KnownPackage
p <- [KnownPackage] -> FilePath -> FileStatus -> Match KnownPackage
matchPackage [KnownPackage]
ps FilePath
str1 FileStatus
fstatus1
    case KnownPackage
p of
      KnownPackage{PackageId
pinfoId :: PackageId
pinfoId :: KnownPackage -> PackageId
pinfoId, [KnownComponent]
pinfoComponents :: [KnownComponent]
pinfoComponents :: KnownPackage -> [KnownComponent]
pinfoComponents} ->
        forall a. FilePath -> FilePath -> Match a -> Match a
orNoThingIn FilePath
"package" (forall a. Pretty a => a -> FilePath
prettyShow (forall pkg. Package pkg => pkg -> PackageName
packageName PackageId
pinfoId)) forall a b. (a -> b) -> a -> b
$ do
          KnownComponent
c <- [KnownComponent]
-> ComponentKind -> FilePath -> Match KnownComponent
matchComponentKindAndName [KnownComponent]
pinfoComponents ComponentKind
ckind FilePath
str3
          forall (m :: * -> *) a. Monad m => a -> m a
return (PackageId -> ComponentName -> SubComponentTarget -> TargetSelector
TargetComponent PackageId
pinfoId (KnownComponent -> ComponentName
cinfoName KnownComponent
c) SubComponentTarget
WholeComponent)
      KnownPackageName PackageName
pn ->
        let cn :: ComponentName
cn = PackageName
-> ComponentKind -> UnqualComponentName -> ComponentName
mkComponentName PackageName
pn ComponentKind
ckind (FilePath -> UnqualComponentName
mkUnqualComponentName FilePath
str3) in
        forall (m :: * -> *) a. Monad m => a -> m a
return (PackageName
-> Either UnqualComponentName ComponentName
-> SubComponentTarget
-> TargetSelector
TargetComponentUnknown PackageName
pn (forall a b. b -> Either a b
Right ComponentName
cn) SubComponentTarget
WholeComponent)
  where
    render :: TargetSelector -> [TargetStringFileStatus]
render (TargetComponent PackageId
p ComponentName
c SubComponentTarget
WholeComponent) =
      [FilePath
-> FileStatus -> FilePath -> FilePath -> TargetStringFileStatus
TargetStringFileStatus3 (forall p. Package p => p -> FilePath
dispP PackageId
p) FileStatus
noFileStatus (ComponentName -> FilePath
dispCK ComponentName
c) (PackageId -> ComponentName -> FilePath
dispC PackageId
p ComponentName
c)]
    render (TargetComponentUnknown PackageName
pn (Right ComponentName
c) SubComponentTarget
WholeComponent) =
      [FilePath
-> FileStatus -> FilePath -> FilePath -> TargetStringFileStatus
TargetStringFileStatus3 (PackageName -> FilePath
dispPN PackageName
pn) FileStatus
noFileStatus (ComponentName -> FilePath
dispCK ComponentName
c) (PackageName -> ComponentName -> FilePath
dispC' PackageName
pn ComponentName
c)]
    render TargetSelector
_ = []

-- | Syntax: package : component : module
--
-- > cabal build foo:foo:Data.Foo
-- > cabal build foo/:foo:Data.Foo
-- > cabal build foo.cabal:foo:Data.Foo
--
syntaxForm3PackageComponentModule :: [KnownPackage] -> Syntax
syntaxForm3PackageComponentModule :: [KnownPackage] -> Syntax
syntaxForm3PackageComponentModule [KnownPackage]
ps =
  (TargetSelector -> [TargetStringFileStatus]) -> Match3 -> Syntax
syntaxForm3 TargetSelector -> [TargetStringFileStatus]
render forall a b. (a -> b) -> a -> b
$ \FilePath
str1 FileStatus
fstatus1 FilePath
str2 FilePath
str3 -> do
    FilePath -> FileStatus -> Match ()
guardPackage FilePath
str1 FileStatus
fstatus1
    FilePath -> Match ()
guardComponentName FilePath
str2
    FilePath -> Match ()
guardModuleName    FilePath
str3
    KnownPackage
p <- [KnownPackage] -> FilePath -> FileStatus -> Match KnownPackage
matchPackage [KnownPackage]
ps FilePath
str1 FileStatus
fstatus1
    case KnownPackage
p of
      KnownPackage{PackageId
pinfoId :: PackageId
pinfoId :: KnownPackage -> PackageId
pinfoId, [KnownComponent]
pinfoComponents :: [KnownComponent]
pinfoComponents :: KnownPackage -> [KnownComponent]
pinfoComponents} ->
        forall a. FilePath -> FilePath -> Match a -> Match a
orNoThingIn FilePath
"package" (forall a. Pretty a => a -> FilePath
prettyShow (forall pkg. Package pkg => pkg -> PackageName
packageName PackageId
pinfoId)) forall a b. (a -> b) -> a -> b
$ do
          KnownComponent
c <- [KnownComponent] -> FilePath -> Match KnownComponent
matchComponentName [KnownComponent]
pinfoComponents FilePath
str2
          forall a. FilePath -> FilePath -> Match a -> Match a
orNoThingIn FilePath
"component" (KnownComponent -> FilePath
cinfoStrName KnownComponent
c) forall a b. (a -> b) -> a -> b
$ do
            let ms :: [ModuleName]
ms = KnownComponent -> [ModuleName]
cinfoModules KnownComponent
c
            ModuleName
m <- [ModuleName] -> FilePath -> Match ModuleName
matchModuleName [ModuleName]
ms FilePath
str3
            forall (m :: * -> *) a. Monad m => a -> m a
return (PackageId -> ComponentName -> SubComponentTarget -> TargetSelector
TargetComponent PackageId
pinfoId (KnownComponent -> ComponentName
cinfoName KnownComponent
c) (ModuleName -> SubComponentTarget
ModuleTarget ModuleName
m))
      KnownPackageName PackageName
pn -> do
        let cn :: UnqualComponentName
cn = FilePath -> UnqualComponentName
mkUnqualComponentName  FilePath
str2
        ModuleName
m     <- FilePath -> Match ModuleName
matchModuleNameUnknown FilePath
str3
        forall (m :: * -> *) a. Monad m => a -> m a
return (PackageName
-> Either UnqualComponentName ComponentName
-> SubComponentTarget
-> TargetSelector
TargetComponentUnknown PackageName
pn (forall a b. a -> Either a b
Left UnqualComponentName
cn) (ModuleName -> SubComponentTarget
ModuleTarget ModuleName
m))
  where
    render :: TargetSelector -> [TargetStringFileStatus]
render (TargetComponent PackageId
p ComponentName
c (ModuleTarget ModuleName
m)) =
      [FilePath
-> FileStatus -> FilePath -> FilePath -> TargetStringFileStatus
TargetStringFileStatus3 (forall p. Package p => p -> FilePath
dispP PackageId
p) FileStatus
noFileStatus (PackageId -> ComponentName -> FilePath
dispC PackageId
p ComponentName
c) (ModuleName -> FilePath
dispM ModuleName
m)]
    render (TargetComponentUnknown PackageName
pn (Left UnqualComponentName
c) (ModuleTarget ModuleName
m)) =
      [FilePath
-> FileStatus -> FilePath -> FilePath -> TargetStringFileStatus
TargetStringFileStatus3 (PackageName -> FilePath
dispPN PackageName
pn) FileStatus
noFileStatus (UnqualComponentName -> FilePath
dispCN UnqualComponentName
c) (ModuleName -> FilePath
dispM ModuleName
m)]
    render TargetSelector
_ = []

-- | Syntax: namespace : component : module
--
-- > cabal build lib:foo:Data.Foo
--
syntaxForm3KindComponentModule :: [KnownComponent] -> Syntax
syntaxForm3KindComponentModule :: [KnownComponent] -> Syntax
syntaxForm3KindComponentModule [KnownComponent]
cs =
  (TargetSelector -> [TargetStringFileStatus]) -> Match3 -> Syntax
syntaxForm3 TargetSelector -> [TargetStringFileStatus]
render forall a b. (a -> b) -> a -> b
$ \FilePath
str1 FileStatus
_fstatus1 FilePath
str2 FilePath
str3 -> do
    ComponentKind
ckind <- FilePath -> Match ComponentKind
matchComponentKind FilePath
str1
    FilePath -> Match ()
guardComponentName FilePath
str2
    FilePath -> Match ()
guardModuleName    FilePath
str3
    KnownComponent
c <- [KnownComponent]
-> ComponentKind -> FilePath -> Match KnownComponent
matchComponentKindAndName [KnownComponent]
cs ComponentKind
ckind FilePath
str2
    forall a. FilePath -> FilePath -> Match a -> Match a
orNoThingIn FilePath
"component" (KnownComponent -> FilePath
cinfoStrName KnownComponent
c) forall a b. (a -> b) -> a -> b
$ do
      let ms :: [ModuleName]
ms = KnownComponent -> [ModuleName]
cinfoModules KnownComponent
c
      ModuleName
m <- [ModuleName] -> FilePath -> Match ModuleName
matchModuleName [ModuleName]
ms FilePath
str3
      forall (m :: * -> *) a. Monad m => a -> m a
return (PackageId -> ComponentName -> SubComponentTarget -> TargetSelector
TargetComponent (KnownComponent -> PackageId
cinfoPackageId KnownComponent
c) (KnownComponent -> ComponentName
cinfoName KnownComponent
c)
                              (ModuleName -> SubComponentTarget
ModuleTarget ModuleName
m))
  where
    render :: TargetSelector -> [TargetStringFileStatus]
render (TargetComponent PackageId
p ComponentName
c (ModuleTarget ModuleName
m)) =
      [FilePath
-> FileStatus -> FilePath -> FilePath -> TargetStringFileStatus
TargetStringFileStatus3 (ComponentName -> FilePath
dispCK ComponentName
c) FileStatus
noFileStatus (PackageId -> ComponentName -> FilePath
dispC PackageId
p ComponentName
c) (ModuleName -> FilePath
dispM ModuleName
m)]
    render TargetSelector
_ = []

-- | Syntax: package : component : filename
--
-- > cabal build foo:foo:Data/Foo.hs
-- > cabal build foo/:foo:Data/Foo.hs
-- > cabal build foo.cabal:foo:Data/Foo.hs
--
syntaxForm3PackageComponentFile :: [KnownPackage] -> Syntax
syntaxForm3PackageComponentFile :: [KnownPackage] -> Syntax
syntaxForm3PackageComponentFile [KnownPackage]
ps =
  (TargetSelector -> [TargetStringFileStatus]) -> Match3 -> Syntax
syntaxForm3 TargetSelector -> [TargetStringFileStatus]
render forall a b. (a -> b) -> a -> b
$ \FilePath
str1 FileStatus
fstatus1 FilePath
str2 FilePath
str3 -> do
    FilePath -> FileStatus -> Match ()
guardPackage         FilePath
str1 FileStatus
fstatus1
    FilePath -> Match ()
guardComponentName   FilePath
str2
    KnownPackage
p <- [KnownPackage] -> FilePath -> FileStatus -> Match KnownPackage
matchPackage [KnownPackage]
ps FilePath
str1 FileStatus
fstatus1
    case KnownPackage
p of
      KnownPackage{PackageId
pinfoId :: PackageId
pinfoId :: KnownPackage -> PackageId
pinfoId, [KnownComponent]
pinfoComponents :: [KnownComponent]
pinfoComponents :: KnownPackage -> [KnownComponent]
pinfoComponents} ->
        forall a. FilePath -> FilePath -> Match a -> Match a
orNoThingIn FilePath
"package" (forall a. Pretty a => a -> FilePath
prettyShow (forall pkg. Package pkg => pkg -> PackageName
packageName PackageId
pinfoId)) forall a b. (a -> b) -> a -> b
$ do
          KnownComponent
c <- [KnownComponent] -> FilePath -> Match KnownComponent
matchComponentName [KnownComponent]
pinfoComponents FilePath
str2
          forall a. FilePath -> FilePath -> Match a -> Match a
orNoThingIn FilePath
"component" (KnownComponent -> FilePath
cinfoStrName KnownComponent
c) forall a b. (a -> b) -> a -> b
$ do
            (FilePath
filepath, KnownComponent
_) <- [KnownComponent] -> FilePath -> Match (FilePath, KnownComponent)
matchComponentFile [KnownComponent
c] FilePath
str3
            forall (m :: * -> *) a. Monad m => a -> m a
return (PackageId -> ComponentName -> SubComponentTarget -> TargetSelector
TargetComponent PackageId
pinfoId (KnownComponent -> ComponentName
cinfoName KnownComponent
c) (FilePath -> SubComponentTarget
FileTarget FilePath
filepath))
      KnownPackageName PackageName
pn ->
        let cn :: UnqualComponentName
cn = FilePath -> UnqualComponentName
mkUnqualComponentName FilePath
str2
            filepath :: FilePath
filepath = FilePath
str3 in
        forall (m :: * -> *) a. Monad m => a -> m a
return (PackageName
-> Either UnqualComponentName ComponentName
-> SubComponentTarget
-> TargetSelector
TargetComponentUnknown PackageName
pn (forall a b. a -> Either a b
Left UnqualComponentName
cn) (FilePath -> SubComponentTarget
FileTarget FilePath
filepath))
  where
    render :: TargetSelector -> [TargetStringFileStatus]
render (TargetComponent PackageId
p ComponentName
c (FileTarget FilePath
f)) =
      [FilePath
-> FileStatus -> FilePath -> FilePath -> TargetStringFileStatus
TargetStringFileStatus3 (forall p. Package p => p -> FilePath
dispP PackageId
p) FileStatus
noFileStatus (PackageId -> ComponentName -> FilePath
dispC PackageId
p ComponentName
c) FilePath
f]
    render (TargetComponentUnknown PackageName
pn (Left UnqualComponentName
c) (FileTarget FilePath
f)) =
      [FilePath
-> FileStatus -> FilePath -> FilePath -> TargetStringFileStatus
TargetStringFileStatus3 (PackageName -> FilePath
dispPN PackageName
pn) FileStatus
noFileStatus (UnqualComponentName -> FilePath
dispCN UnqualComponentName
c) FilePath
f]
    render TargetSelector
_ = []

-- | Syntax: namespace : component : filename
--
-- > cabal build lib:foo:Data/Foo.hs
--
syntaxForm3KindComponentFile :: [KnownComponent] -> Syntax
syntaxForm3KindComponentFile :: [KnownComponent] -> Syntax
syntaxForm3KindComponentFile [KnownComponent]
cs =
  (TargetSelector -> [TargetStringFileStatus]) -> Match3 -> Syntax
syntaxForm3 TargetSelector -> [TargetStringFileStatus]
render forall a b. (a -> b) -> a -> b
$ \FilePath
str1 FileStatus
_fstatus1 FilePath
str2 FilePath
str3 -> do
    ComponentKind
ckind <- FilePath -> Match ComponentKind
matchComponentKind FilePath
str1
    FilePath -> Match ()
guardComponentName FilePath
str2
    KnownComponent
c <- [KnownComponent]
-> ComponentKind -> FilePath -> Match KnownComponent
matchComponentKindAndName [KnownComponent]
cs ComponentKind
ckind FilePath
str2
    forall a. FilePath -> FilePath -> Match a -> Match a
orNoThingIn FilePath
"component" (KnownComponent -> FilePath
cinfoStrName KnownComponent
c) forall a b. (a -> b) -> a -> b
$ do
      (FilePath
filepath, KnownComponent
_) <- [KnownComponent] -> FilePath -> Match (FilePath, KnownComponent)
matchComponentFile [KnownComponent
c] FilePath
str3
      forall (m :: * -> *) a. Monad m => a -> m a
return (PackageId -> ComponentName -> SubComponentTarget -> TargetSelector
TargetComponent (KnownComponent -> PackageId
cinfoPackageId KnownComponent
c) (KnownComponent -> ComponentName
cinfoName KnownComponent
c)
                              (FilePath -> SubComponentTarget
FileTarget FilePath
filepath))
  where
    render :: TargetSelector -> [TargetStringFileStatus]
render (TargetComponent PackageId
p ComponentName
c (FileTarget FilePath
f)) =
      [FilePath
-> FileStatus -> FilePath -> FilePath -> TargetStringFileStatus
TargetStringFileStatus3 (ComponentName -> FilePath
dispCK ComponentName
c) FileStatus
noFileStatus (PackageId -> ComponentName -> FilePath
dispC PackageId
p ComponentName
c) FilePath
f]
    render TargetSelector
_ = []

syntaxForm3NamespacePackageFilter :: [KnownPackage] -> Syntax
syntaxForm3NamespacePackageFilter :: [KnownPackage] -> Syntax
syntaxForm3NamespacePackageFilter [KnownPackage]
ps =
  (TargetSelector -> [TargetStringFileStatus]) -> Match3 -> Syntax
syntaxForm3 TargetSelector -> [TargetStringFileStatus]
render forall a b. (a -> b) -> a -> b
$ \FilePath
str1 FileStatus
_fstatus1 FilePath
str2 FilePath
str3 -> do
    FilePath -> Match ()
guardNamespacePackage FilePath
str1
    FilePath -> Match ()
guardPackageName      FilePath
str2
    KnownPackage
p <- [KnownPackage] -> FilePath -> FileStatus -> Match KnownPackage
matchPackage  [KnownPackage]
ps FilePath
str2 FileStatus
noFileStatus
    ComponentKind
kfilter <- FilePath -> Match ComponentKind
matchComponentKindFilter FilePath
str3
    case KnownPackage
p of
      KnownPackage{PackageId
pinfoId :: PackageId
pinfoId :: KnownPackage -> PackageId
pinfoId} ->
        forall (m :: * -> *) a. Monad m => a -> m a
return (TargetImplicitCwd
-> [PackageId] -> Maybe ComponentKind -> TargetSelector
TargetPackage TargetImplicitCwd
TargetExplicitNamed [PackageId
pinfoId] (forall a. a -> Maybe a
Just ComponentKind
kfilter))
      KnownPackageName PackageName
pn ->
        forall (m :: * -> *) a. Monad m => a -> m a
return (PackageName -> Maybe ComponentKind -> TargetSelector
TargetPackageNamed PackageName
pn (forall a. a -> Maybe a
Just ComponentKind
kfilter))
  where
    render :: TargetSelector -> [TargetStringFileStatus]
render (TargetPackage TargetImplicitCwd
TargetExplicitNamed [PackageId
p] (Just ComponentKind
kfilter)) =
      [FilePath
-> FileStatus -> FilePath -> FilePath -> TargetStringFileStatus
TargetStringFileStatus3 FilePath
"pkg" FileStatus
noFileStatus (forall p. Package p => p -> FilePath
dispP PackageId
p) (ComponentKind -> FilePath
dispF ComponentKind
kfilter)]
    render (TargetPackageNamed PackageName
pn (Just ComponentKind
kfilter)) =
      [FilePath
-> FileStatus -> FilePath -> FilePath -> TargetStringFileStatus
TargetStringFileStatus3 FilePath
"pkg" FileStatus
noFileStatus (PackageName -> FilePath
dispPN PackageName
pn) (ComponentKind -> FilePath
dispF ComponentKind
kfilter)]
    render TargetSelector
_ = []

--

syntaxForm4MetaNamespacePackageFilter :: [KnownPackage] -> Syntax
syntaxForm4MetaNamespacePackageFilter :: [KnownPackage] -> Syntax
syntaxForm4MetaNamespacePackageFilter [KnownPackage]
ps =
  (TargetSelector -> [TargetStringFileStatus]) -> Match4 -> Syntax
syntaxForm4 TargetSelector -> [TargetStringFileStatus]
render forall a b. (a -> b) -> a -> b
$ \FilePath
str1 FilePath
str2 FilePath
str3 FilePath
str4 -> do
    FilePath -> Match ()
guardNamespaceMeta    FilePath
str1
    FilePath -> Match ()
guardNamespacePackage FilePath
str2
    FilePath -> Match ()
guardPackageName      FilePath
str3
    KnownPackage
p <- [KnownPackage] -> FilePath -> FileStatus -> Match KnownPackage
matchPackage  [KnownPackage]
ps FilePath
str3 FileStatus
noFileStatus
    ComponentKind
kfilter <- FilePath -> Match ComponentKind
matchComponentKindFilter FilePath
str4
    case KnownPackage
p of
      KnownPackage{PackageId
pinfoId :: PackageId
pinfoId :: KnownPackage -> PackageId
pinfoId} ->
        forall (m :: * -> *) a. Monad m => a -> m a
return (TargetImplicitCwd
-> [PackageId] -> Maybe ComponentKind -> TargetSelector
TargetPackage TargetImplicitCwd
TargetExplicitNamed [PackageId
pinfoId] (forall a. a -> Maybe a
Just ComponentKind
kfilter))
      KnownPackageName PackageName
pn ->
        forall (m :: * -> *) a. Monad m => a -> m a
return (PackageName -> Maybe ComponentKind -> TargetSelector
TargetPackageNamed PackageName
pn (forall a. a -> Maybe a
Just ComponentKind
kfilter))
  where
    render :: TargetSelector -> [TargetStringFileStatus]
render (TargetPackage TargetImplicitCwd
TargetExplicitNamed [PackageId
p] (Just ComponentKind
kfilter)) =
      [FilePath
-> FilePath -> FilePath -> FilePath -> TargetStringFileStatus
TargetStringFileStatus4 FilePath
"" FilePath
"pkg" (forall p. Package p => p -> FilePath
dispP PackageId
p) (ComponentKind -> FilePath
dispF ComponentKind
kfilter)]
    render (TargetPackageNamed PackageName
pn (Just ComponentKind
kfilter)) =
      [FilePath
-> FilePath -> FilePath -> FilePath -> TargetStringFileStatus
TargetStringFileStatus4 FilePath
"" FilePath
"pkg" (PackageName -> FilePath
dispPN PackageName
pn) (ComponentKind -> FilePath
dispF ComponentKind
kfilter)]
    render TargetSelector
_ = []

-- | Syntax: :pkg : package : namespace : component
--
-- > cabal build :pkg:foo:lib:foo
--
syntaxForm5MetaNamespacePackageKindComponent :: [KnownPackage] -> Syntax
syntaxForm5MetaNamespacePackageKindComponent :: [KnownPackage] -> Syntax
syntaxForm5MetaNamespacePackageKindComponent [KnownPackage]
ps =
  (TargetSelector -> [TargetStringFileStatus]) -> Match5 -> Syntax
syntaxForm5 TargetSelector -> [TargetStringFileStatus]
render forall a b. (a -> b) -> a -> b
$ \FilePath
str1 FilePath
str2 FilePath
str3 FilePath
str4 FilePath
str5 -> do
    FilePath -> Match ()
guardNamespaceMeta    FilePath
str1
    FilePath -> Match ()
guardNamespacePackage FilePath
str2
    FilePath -> Match ()
guardPackageName      FilePath
str3
    ComponentKind
ckind <- FilePath -> Match ComponentKind
matchComponentKind FilePath
str4
    FilePath -> Match ()
guardComponentName    FilePath
str5
    KnownPackage
p <- [KnownPackage] -> FilePath -> FileStatus -> Match KnownPackage
matchPackage  [KnownPackage]
ps FilePath
str3 FileStatus
noFileStatus
    case KnownPackage
p of
      KnownPackage{PackageId
pinfoId :: PackageId
pinfoId :: KnownPackage -> PackageId
pinfoId, [KnownComponent]
pinfoComponents :: [KnownComponent]
pinfoComponents :: KnownPackage -> [KnownComponent]
pinfoComponents} ->
        forall a. FilePath -> FilePath -> Match a -> Match a
orNoThingIn FilePath
"package" (forall a. Pretty a => a -> FilePath
prettyShow (forall pkg. Package pkg => pkg -> PackageName
packageName PackageId
pinfoId)) forall a b. (a -> b) -> a -> b
$ do
          KnownComponent
c <- [KnownComponent]
-> ComponentKind -> FilePath -> Match KnownComponent
matchComponentKindAndName [KnownComponent]
pinfoComponents ComponentKind
ckind FilePath
str5
          forall (m :: * -> *) a. Monad m => a -> m a
return (PackageId -> ComponentName -> SubComponentTarget -> TargetSelector
TargetComponent PackageId
pinfoId (KnownComponent -> ComponentName
cinfoName KnownComponent
c) SubComponentTarget
WholeComponent)
      KnownPackageName PackageName
pn ->
        let cn :: ComponentName
cn = PackageName
-> ComponentKind -> UnqualComponentName -> ComponentName
mkComponentName PackageName
pn ComponentKind
ckind (FilePath -> UnqualComponentName
mkUnqualComponentName FilePath
str5) in
        forall (m :: * -> *) a. Monad m => a -> m a
return (PackageName
-> Either UnqualComponentName ComponentName
-> SubComponentTarget
-> TargetSelector
TargetComponentUnknown PackageName
pn (forall a b. b -> Either a b
Right ComponentName
cn) SubComponentTarget
WholeComponent)
  where
    render :: TargetSelector -> [TargetStringFileStatus]
render (TargetComponent PackageId
p ComponentName
c SubComponentTarget
WholeComponent) =
      [FilePath
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> TargetStringFileStatus
TargetStringFileStatus5 FilePath
"" FilePath
"pkg" (forall p. Package p => p -> FilePath
dispP PackageId
p) (ComponentName -> FilePath
dispCK ComponentName
c) (PackageId -> ComponentName -> FilePath
dispC PackageId
p ComponentName
c)]
    render (TargetComponentUnknown PackageName
pn (Right ComponentName
c) SubComponentTarget
WholeComponent) =
      [FilePath
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> TargetStringFileStatus
TargetStringFileStatus5 FilePath
"" FilePath
"pkg" (PackageName -> FilePath
dispPN PackageName
pn) (ComponentName -> FilePath
dispCK ComponentName
c) (PackageName -> ComponentName -> FilePath
dispC' PackageName
pn ComponentName
c)]
    render TargetSelector
_ = []

-- | Syntax: :pkg : package : namespace : component : module : module
--
-- > cabal build :pkg:foo:lib:foo:module:Data.Foo
--
syntaxForm7MetaNamespacePackageKindComponentNamespaceModule
  :: [KnownPackage] -> Syntax
syntaxForm7MetaNamespacePackageKindComponentNamespaceModule :: [KnownPackage] -> Syntax
syntaxForm7MetaNamespacePackageKindComponentNamespaceModule [KnownPackage]
ps =
  (TargetSelector -> [TargetStringFileStatus]) -> Match7 -> Syntax
syntaxForm7 TargetSelector -> [TargetStringFileStatus]
render forall a b. (a -> b) -> a -> b
$ \FilePath
str1 FilePath
str2 FilePath
str3 FilePath
str4 FilePath
str5 FilePath
str6 FilePath
str7 -> do
    FilePath -> Match ()
guardNamespaceMeta    FilePath
str1
    FilePath -> Match ()
guardNamespacePackage FilePath
str2
    FilePath -> Match ()
guardPackageName      FilePath
str3
    ComponentKind
ckind <- FilePath -> Match ComponentKind
matchComponentKind FilePath
str4
    FilePath -> Match ()
guardComponentName    FilePath
str5
    FilePath -> Match ()
guardNamespaceModule  FilePath
str6
    KnownPackage
p <- [KnownPackage] -> FilePath -> FileStatus -> Match KnownPackage
matchPackage  [KnownPackage]
ps FilePath
str3 FileStatus
noFileStatus
    case KnownPackage
p of
      KnownPackage{PackageId
pinfoId :: PackageId
pinfoId :: KnownPackage -> PackageId
pinfoId, [KnownComponent]
pinfoComponents :: [KnownComponent]
pinfoComponents :: KnownPackage -> [KnownComponent]
pinfoComponents} ->
        forall a. FilePath -> FilePath -> Match a -> Match a
orNoThingIn FilePath
"package" (forall a. Pretty a => a -> FilePath
prettyShow (forall pkg. Package pkg => pkg -> PackageName
packageName PackageId
pinfoId)) forall a b. (a -> b) -> a -> b
$ do
          KnownComponent
c <- [KnownComponent]
-> ComponentKind -> FilePath -> Match KnownComponent
matchComponentKindAndName [KnownComponent]
pinfoComponents ComponentKind
ckind FilePath
str5
          forall a. FilePath -> FilePath -> Match a -> Match a
orNoThingIn FilePath
"component" (KnownComponent -> FilePath
cinfoStrName KnownComponent
c) forall a b. (a -> b) -> a -> b
$ do
            let ms :: [ModuleName]
ms = KnownComponent -> [ModuleName]
cinfoModules KnownComponent
c
            ModuleName
m <- [ModuleName] -> FilePath -> Match ModuleName
matchModuleName [ModuleName]
ms FilePath
str7
            forall (m :: * -> *) a. Monad m => a -> m a
return (PackageId -> ComponentName -> SubComponentTarget -> TargetSelector
TargetComponent PackageId
pinfoId (KnownComponent -> ComponentName
cinfoName KnownComponent
c) (ModuleName -> SubComponentTarget
ModuleTarget ModuleName
m))
      KnownPackageName PackageName
pn -> do
        let cn :: ComponentName
cn = PackageName
-> ComponentKind -> UnqualComponentName -> ComponentName
mkComponentName PackageName
pn ComponentKind
ckind (FilePath -> UnqualComponentName
mkUnqualComponentName FilePath
str2)
        ModuleName
m <- FilePath -> Match ModuleName
matchModuleNameUnknown FilePath
str7
        forall (m :: * -> *) a. Monad m => a -> m a
return (PackageName
-> Either UnqualComponentName ComponentName
-> SubComponentTarget
-> TargetSelector
TargetComponentUnknown PackageName
pn (forall a b. b -> Either a b
Right ComponentName
cn) (ModuleName -> SubComponentTarget
ModuleTarget ModuleName
m))
  where
    render :: TargetSelector -> [TargetStringFileStatus]
render (TargetComponent PackageId
p ComponentName
c (ModuleTarget ModuleName
m)) =
      [FilePath
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> TargetStringFileStatus
TargetStringFileStatus7 FilePath
"" FilePath
"pkg" (forall p. Package p => p -> FilePath
dispP PackageId
p)
                               (ComponentName -> FilePath
dispCK ComponentName
c) (PackageId -> ComponentName -> FilePath
dispC PackageId
p ComponentName
c)
                               FilePath
"module" (ModuleName -> FilePath
dispM ModuleName
m)]
    render (TargetComponentUnknown PackageName
pn (Right ComponentName
c) (ModuleTarget ModuleName
m)) =
      [FilePath
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> TargetStringFileStatus
TargetStringFileStatus7 FilePath
"" FilePath
"pkg" (PackageName -> FilePath
dispPN PackageName
pn)
                               (ComponentName -> FilePath
dispCK ComponentName
c) (PackageName -> ComponentName -> FilePath
dispC' PackageName
pn ComponentName
c)
                               FilePath
"module" (ModuleName -> FilePath
dispM ModuleName
m)]
    render TargetSelector
_ = []

-- | Syntax: :pkg : package : namespace : component : file : filename
--
-- > cabal build :pkg:foo:lib:foo:file:Data/Foo.hs
--
syntaxForm7MetaNamespacePackageKindComponentNamespaceFile
  :: [KnownPackage] -> Syntax
syntaxForm7MetaNamespacePackageKindComponentNamespaceFile :: [KnownPackage] -> Syntax
syntaxForm7MetaNamespacePackageKindComponentNamespaceFile [KnownPackage]
ps =
  (TargetSelector -> [TargetStringFileStatus]) -> Match7 -> Syntax
syntaxForm7 TargetSelector -> [TargetStringFileStatus]
render forall a b. (a -> b) -> a -> b
$ \FilePath
str1 FilePath
str2 FilePath
str3 FilePath
str4 FilePath
str5 FilePath
str6 FilePath
str7 -> do
    FilePath -> Match ()
guardNamespaceMeta    FilePath
str1
    FilePath -> Match ()
guardNamespacePackage FilePath
str2
    FilePath -> Match ()
guardPackageName      FilePath
str3
    ComponentKind
ckind <- FilePath -> Match ComponentKind
matchComponentKind FilePath
str4
    FilePath -> Match ()
guardComponentName    FilePath
str5
    FilePath -> Match ()
guardNamespaceFile    FilePath
str6
    KnownPackage
p <- [KnownPackage] -> FilePath -> FileStatus -> Match KnownPackage
matchPackage  [KnownPackage]
ps FilePath
str3 FileStatus
noFileStatus
    case KnownPackage
p of
      KnownPackage{PackageId
pinfoId :: PackageId
pinfoId :: KnownPackage -> PackageId
pinfoId, [KnownComponent]
pinfoComponents :: [KnownComponent]
pinfoComponents :: KnownPackage -> [KnownComponent]
pinfoComponents} ->
        forall a. FilePath -> FilePath -> Match a -> Match a
orNoThingIn FilePath
"package" (forall a. Pretty a => a -> FilePath
prettyShow (forall pkg. Package pkg => pkg -> PackageName
packageName PackageId
pinfoId)) forall a b. (a -> b) -> a -> b
$ do
          KnownComponent
c <- [KnownComponent]
-> ComponentKind -> FilePath -> Match KnownComponent
matchComponentKindAndName [KnownComponent]
pinfoComponents ComponentKind
ckind FilePath
str5
          forall a. FilePath -> FilePath -> Match a -> Match a
orNoThingIn FilePath
"component" (KnownComponent -> FilePath
cinfoStrName KnownComponent
c) forall a b. (a -> b) -> a -> b
$ do
            (FilePath
filepath,KnownComponent
_) <- [KnownComponent] -> FilePath -> Match (FilePath, KnownComponent)
matchComponentFile [KnownComponent
c] FilePath
str7
            forall (m :: * -> *) a. Monad m => a -> m a
return (PackageId -> ComponentName -> SubComponentTarget -> TargetSelector
TargetComponent PackageId
pinfoId (KnownComponent -> ComponentName
cinfoName KnownComponent
c) (FilePath -> SubComponentTarget
FileTarget FilePath
filepath))
      KnownPackageName PackageName
pn ->
        let cn :: ComponentName
cn       = PackageName
-> ComponentKind -> UnqualComponentName -> ComponentName
mkComponentName PackageName
pn ComponentKind
ckind (FilePath -> UnqualComponentName
mkUnqualComponentName FilePath
str5)
            filepath :: FilePath
filepath = FilePath
str7 in
        forall (m :: * -> *) a. Monad m => a -> m a
return (PackageName
-> Either UnqualComponentName ComponentName
-> SubComponentTarget
-> TargetSelector
TargetComponentUnknown PackageName
pn (forall a b. b -> Either a b
Right ComponentName
cn) (FilePath -> SubComponentTarget
FileTarget FilePath
filepath))
  where
    render :: TargetSelector -> [TargetStringFileStatus]
render (TargetComponent PackageId
p ComponentName
c (FileTarget FilePath
f)) =
      [FilePath
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> TargetStringFileStatus
TargetStringFileStatus7 FilePath
"" FilePath
"pkg" (forall p. Package p => p -> FilePath
dispP PackageId
p)
                               (ComponentName -> FilePath
dispCK ComponentName
c) (PackageId -> ComponentName -> FilePath
dispC PackageId
p ComponentName
c)
                               FilePath
"file" FilePath
f]
    render (TargetComponentUnknown PackageName
pn (Right ComponentName
c) (FileTarget FilePath
f)) =
      [FilePath
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> FilePath
-> TargetStringFileStatus
TargetStringFileStatus7 FilePath
"" FilePath
"pkg" (PackageName -> FilePath
dispPN PackageName
pn)
                               (ComponentName -> FilePath
dispCK ComponentName
c) (PackageName -> ComponentName -> FilePath
dispC' PackageName
pn ComponentName
c)
                               FilePath
"file" FilePath
f]
    render TargetSelector
_ = []


---------------------------------------
-- Syntax utils
--

type Match1 = String -> FileStatus -> Match TargetSelector
type Match2 = String -> FileStatus -> String
              -> Match TargetSelector
type Match3 = String -> FileStatus -> String -> String
              -> Match TargetSelector
type Match4 = String -> String -> String -> String
              -> Match TargetSelector
type Match5 = String -> String -> String -> String -> String
              -> Match TargetSelector
type Match7 = String -> String -> String -> String -> String -> String -> String
              -> Match TargetSelector

syntaxForm1 :: Renderer -> Match1 -> Syntax
syntaxForm2 :: Renderer -> Match2 -> Syntax
syntaxForm3 :: Renderer -> Match3 -> Syntax
syntaxForm4 :: Renderer -> Match4 -> Syntax
syntaxForm5 :: Renderer -> Match5 -> Syntax
syntaxForm7 :: Renderer -> Match7 -> Syntax

syntaxForm1 :: (TargetSelector -> [TargetStringFileStatus]) -> Match1 -> Syntax
syntaxForm1 TargetSelector -> [TargetStringFileStatus]
render Match1
f =
    QualLevel
-> (TargetStringFileStatus -> Match TargetSelector)
-> (TargetSelector -> [TargetStringFileStatus])
-> Syntax
Syntax QualLevel
QL1 TargetStringFileStatus -> Match TargetSelector
match TargetSelector -> [TargetStringFileStatus]
render
  where
    match :: TargetStringFileStatus -> Match TargetSelector
match = \(TargetStringFileStatus1 FilePath
str1 FileStatus
fstatus1) ->
              Match1
f FilePath
str1 FileStatus
fstatus1

syntaxForm2 :: (TargetSelector -> [TargetStringFileStatus]) -> Match2 -> Syntax
syntaxForm2 TargetSelector -> [TargetStringFileStatus]
render Match2
f =
    QualLevel
-> (TargetStringFileStatus -> Match TargetSelector)
-> (TargetSelector -> [TargetStringFileStatus])
-> Syntax
Syntax QualLevel
QL2 TargetStringFileStatus -> Match TargetSelector
match TargetSelector -> [TargetStringFileStatus]
render
  where
    match :: TargetStringFileStatus -> Match TargetSelector
match = \(TargetStringFileStatus2 FilePath
str1 FileStatus
fstatus1 FilePath
str2) ->
              Match2
f FilePath
str1 FileStatus
fstatus1 FilePath
str2

syntaxForm3 :: (TargetSelector -> [TargetStringFileStatus]) -> Match3 -> Syntax
syntaxForm3 TargetSelector -> [TargetStringFileStatus]
render Match3
f =
    QualLevel
-> (TargetStringFileStatus -> Match TargetSelector)
-> (TargetSelector -> [TargetStringFileStatus])
-> Syntax
Syntax QualLevel
QL3 TargetStringFileStatus -> Match TargetSelector
match TargetSelector -> [TargetStringFileStatus]
render
  where
    match :: TargetStringFileStatus -> Match TargetSelector
match = \(TargetStringFileStatus3 FilePath
str1 FileStatus
fstatus1 FilePath
str2 FilePath
str3) ->
              Match3
f FilePath
str1 FileStatus
fstatus1 FilePath
str2 FilePath
str3

syntaxForm4 :: (TargetSelector -> [TargetStringFileStatus]) -> Match4 -> Syntax
syntaxForm4 TargetSelector -> [TargetStringFileStatus]
render Match4
f =
    QualLevel
-> (TargetStringFileStatus -> Match TargetSelector)
-> (TargetSelector -> [TargetStringFileStatus])
-> Syntax
Syntax QualLevel
QLFull TargetStringFileStatus -> Match TargetSelector
match TargetSelector -> [TargetStringFileStatus]
render
  where
    match :: TargetStringFileStatus -> Match TargetSelector
match (TargetStringFileStatus4 FilePath
str1 FilePath
str2 FilePath
str3 FilePath
str4)
            = Match4
f FilePath
str1 FilePath
str2 FilePath
str3 FilePath
str4
    match TargetStringFileStatus
_ = forall (m :: * -> *) a. MonadPlus m => m a
mzero

syntaxForm5 :: (TargetSelector -> [TargetStringFileStatus]) -> Match5 -> Syntax
syntaxForm5 TargetSelector -> [TargetStringFileStatus]
render Match5
f =
    QualLevel
-> (TargetStringFileStatus -> Match TargetSelector)
-> (TargetSelector -> [TargetStringFileStatus])
-> Syntax
Syntax QualLevel
QLFull TargetStringFileStatus -> Match TargetSelector
match TargetSelector -> [TargetStringFileStatus]
render
  where
    match :: TargetStringFileStatus -> Match TargetSelector
match (TargetStringFileStatus5 FilePath
str1 FilePath
str2 FilePath
str3 FilePath
str4 FilePath
str5)
            = Match5
f FilePath
str1 FilePath
str2 FilePath
str3 FilePath
str4 FilePath
str5
    match TargetStringFileStatus
_ = forall (m :: * -> *) a. MonadPlus m => m a
mzero

syntaxForm7 :: (TargetSelector -> [TargetStringFileStatus]) -> Match7 -> Syntax
syntaxForm7 TargetSelector -> [TargetStringFileStatus]
render Match7
f =
    QualLevel
-> (TargetStringFileStatus -> Match TargetSelector)
-> (TargetSelector -> [TargetStringFileStatus])
-> Syntax
Syntax QualLevel
QLFull TargetStringFileStatus -> Match TargetSelector
match TargetSelector -> [TargetStringFileStatus]
render
  where
    match :: TargetStringFileStatus -> Match TargetSelector
match (TargetStringFileStatus7 FilePath
str1 FilePath
str2 FilePath
str3 FilePath
str4 FilePath
str5 FilePath
str6 FilePath
str7)
            = Match7
f FilePath
str1 FilePath
str2 FilePath
str3 FilePath
str4 FilePath
str5 FilePath
str6 FilePath
str7
    match TargetStringFileStatus
_ = forall (m :: * -> *) a. MonadPlus m => m a
mzero

dispP :: Package p => p -> String
dispP :: forall p. Package p => p -> FilePath
dispP = forall a. Pretty a => a -> FilePath
prettyShow forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall pkg. Package pkg => pkg -> PackageName
packageName

dispPN :: PackageName -> String
dispPN :: PackageName -> FilePath
dispPN = forall a. Pretty a => a -> FilePath
prettyShow

dispC :: PackageId -> ComponentName -> String
dispC :: PackageId -> ComponentName -> FilePath
dispC = PackageName -> ComponentName -> FilePath
componentStringName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall pkg. Package pkg => pkg -> PackageName
packageName

dispC' :: PackageName -> ComponentName -> String
dispC' :: PackageName -> ComponentName -> FilePath
dispC' = PackageName -> ComponentName -> FilePath
componentStringName

dispCN :: UnqualComponentName -> String
dispCN :: UnqualComponentName -> FilePath
dispCN = forall a. Pretty a => a -> FilePath
prettyShow

dispK :: ComponentKind -> String
dispK :: ComponentKind -> FilePath
dispK = ComponentKind -> FilePath
showComponentKindShort

dispCK :: ComponentName -> String
dispCK :: ComponentName -> FilePath
dispCK = ComponentKind -> FilePath
dispK forall b c a. (b -> c) -> (a -> b) -> a -> c
. ComponentName -> ComponentKind
componentKind

dispF :: ComponentKind -> String
dispF :: ComponentKind -> FilePath
dispF = ComponentKind -> FilePath
showComponentKindFilterShort

dispM :: ModuleName -> String
dispM :: ModuleName -> FilePath
dispM = forall a. Pretty a => a -> FilePath
prettyShow


-------------------------------
-- Package and component info
--

data KnownTargets = KnownTargets {
       KnownTargets -> [KnownPackage]
knownPackagesAll       :: [KnownPackage],
       KnownTargets -> [KnownPackage]
knownPackagesPrimary   :: [KnownPackage],
       KnownTargets -> [KnownPackage]
knownPackagesOther     :: [KnownPackage],
       KnownTargets -> [KnownComponent]
knownComponentsAll     :: [KnownComponent],
       KnownTargets -> [KnownComponent]
knownComponentsPrimary :: [KnownComponent],
       KnownTargets -> [KnownComponent]
knownComponentsOther   :: [KnownComponent]
     }
  deriving Int -> KnownTargets -> ShowS
[KnownTargets] -> ShowS
KnownTargets -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [KnownTargets] -> ShowS
$cshowList :: [KnownTargets] -> ShowS
show :: KnownTargets -> FilePath
$cshow :: KnownTargets -> FilePath
showsPrec :: Int -> KnownTargets -> ShowS
$cshowsPrec :: Int -> KnownTargets -> ShowS
Show

data KnownPackage =
     KnownPackage {
       KnownPackage -> PackageId
pinfoId          :: PackageId,
       KnownPackage -> Maybe (FilePath, FilePath)
pinfoDirectory   :: Maybe (FilePath, FilePath),
       KnownPackage -> Maybe (FilePath, FilePath)
pinfoPackageFile :: Maybe (FilePath, FilePath),
       KnownPackage -> [KnownComponent]
pinfoComponents  :: [KnownComponent]
     }
   | KnownPackageName {
       KnownPackage -> PackageName
pinfoName        :: PackageName
     }
  deriving Int -> KnownPackage -> ShowS
[KnownPackage] -> ShowS
KnownPackage -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [KnownPackage] -> ShowS
$cshowList :: [KnownPackage] -> ShowS
show :: KnownPackage -> FilePath
$cshow :: KnownPackage -> FilePath
showsPrec :: Int -> KnownPackage -> ShowS
$cshowsPrec :: Int -> KnownPackage -> ShowS
Show

data KnownComponent = KnownComponent {
       KnownComponent -> ComponentName
cinfoName      :: ComponentName,
       KnownComponent -> FilePath
cinfoStrName   :: ComponentStringName,
       KnownComponent -> PackageId
cinfoPackageId :: PackageId,
       KnownComponent -> [FilePath]
cinfoSrcDirs   :: [FilePath],
       KnownComponent -> [ModuleName]
cinfoModules   :: [ModuleName],
       KnownComponent -> [FilePath]
cinfoHsFiles   :: [FilePath],   -- other hs files (like main.hs)
       KnownComponent -> [FilePath]
cinfoCFiles    :: [FilePath],
       KnownComponent -> [FilePath]
cinfoJsFiles   :: [FilePath]
     }
  deriving Int -> KnownComponent -> ShowS
[KnownComponent] -> ShowS
KnownComponent -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [KnownComponent] -> ShowS
$cshowList :: [KnownComponent] -> ShowS
show :: KnownComponent -> FilePath
$cshow :: KnownComponent -> FilePath
showsPrec :: Int -> KnownComponent -> ShowS
$cshowsPrec :: Int -> KnownComponent -> ShowS
Show

type ComponentStringName = String

knownPackageName :: KnownPackage -> PackageName
knownPackageName :: KnownPackage -> PackageName
knownPackageName KnownPackage{PackageId
pinfoId :: PackageId
pinfoId :: KnownPackage -> PackageId
pinfoId}       = forall pkg. Package pkg => pkg -> PackageName
packageName PackageId
pinfoId
knownPackageName KnownPackageName{PackageName
pinfoName :: PackageName
pinfoName :: KnownPackage -> PackageName
pinfoName} = PackageName
pinfoName

emptyKnownTargets :: KnownTargets
emptyKnownTargets :: KnownTargets
emptyKnownTargets = [KnownPackage]
-> [KnownPackage]
-> [KnownPackage]
-> [KnownComponent]
-> [KnownComponent]
-> [KnownComponent]
-> KnownTargets
KnownTargets [] [] [] [] [] []

getKnownTargets :: forall m a. (Applicative m, Monad m)
                => DirActions m
                -> [PackageSpecifier (SourcePackage (PackageLocation a))]
                -> m KnownTargets
getKnownTargets :: forall (m :: * -> *) a.
(Applicative m, Monad m) =>
DirActions m
-> [PackageSpecifier (SourcePackage (PackageLocation a))]
-> m KnownTargets
getKnownTargets dirActions :: DirActions m
dirActions@DirActions{m FilePath
FilePath -> m Bool
FilePath -> m FilePath
getCurrentDirectory :: m FilePath
canonicalizePath :: FilePath -> m FilePath
doesDirectoryExist :: FilePath -> m Bool
doesFileExist :: FilePath -> m Bool
getCurrentDirectory :: forall (m :: * -> *). DirActions m -> m FilePath
canonicalizePath :: forall (m :: * -> *). DirActions m -> FilePath -> m FilePath
doesDirectoryExist :: forall (m :: * -> *). DirActions m -> FilePath -> m Bool
doesFileExist :: forall (m :: * -> *). DirActions m -> FilePath -> m Bool
..} [PackageSpecifier (SourcePackage (PackageLocation a))]
pkgs = do
    [KnownPackage]
pinfo <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (m :: * -> *) a.
(Applicative m, Monad m) =>
DirActions m
-> PackageSpecifier (SourcePackage (PackageLocation a))
-> m KnownPackage
collectKnownPackageInfo DirActions m
dirActions) [PackageSpecifier (SourcePackage (PackageLocation a))]
pkgs
    FilePath
cwd   <- m FilePath
getCurrentDirectory
    ([KnownPackage]
ppinfo, [KnownPackage]
opinfo) <- FilePath -> [KnownPackage] -> m ([KnownPackage], [KnownPackage])
selectPrimaryPackage FilePath
cwd [KnownPackage]
pinfo
    forall (m :: * -> *) a. Monad m => a -> m a
return KnownTargets {
      knownPackagesAll :: [KnownPackage]
knownPackagesAll       = [KnownPackage]
pinfo,
      knownPackagesPrimary :: [KnownPackage]
knownPackagesPrimary   = [KnownPackage]
ppinfo,
      knownPackagesOther :: [KnownPackage]
knownPackagesOther     = [KnownPackage]
opinfo,
      knownComponentsAll :: [KnownComponent]
knownComponentsAll     = [KnownPackage] -> [KnownComponent]
allComponentsIn [KnownPackage]
pinfo,
      knownComponentsPrimary :: [KnownComponent]
knownComponentsPrimary = [KnownPackage] -> [KnownComponent]
allComponentsIn [KnownPackage]
ppinfo,
      knownComponentsOther :: [KnownComponent]
knownComponentsOther   = [KnownPackage] -> [KnownComponent]
allComponentsIn [KnownPackage]
opinfo
    }
  where
    mPkgDir :: KnownPackage -> Maybe FilePath
    mPkgDir :: KnownPackage -> Maybe FilePath
mPkgDir KnownPackage { pinfoDirectory :: KnownPackage -> Maybe (FilePath, FilePath)
pinfoDirectory = Just (FilePath
dir,FilePath
_) } = forall a. a -> Maybe a
Just FilePath
dir
    mPkgDir KnownPackage
_ = forall a. Maybe a
Nothing

    selectPrimaryPackage :: FilePath
                         -> [KnownPackage]
                         -> m ([KnownPackage], [KnownPackage])
    selectPrimaryPackage :: FilePath -> [KnownPackage] -> m ([KnownPackage], [KnownPackage])
selectPrimaryPackage FilePath
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return ([] , [])
    selectPrimaryPackage FilePath
cwd (KnownPackage
pkg : [KnownPackage]
packages) = do
      ([KnownPackage]
ppinfo, [KnownPackage]
opinfo) <- FilePath -> [KnownPackage] -> m ([KnownPackage], [KnownPackage])
selectPrimaryPackage FilePath
cwd [KnownPackage]
packages
      Bool
isPkgDirCwd <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False) (forall (m :: * -> *).
(Applicative m, Monad m) =>
DirActions m -> FilePath -> FilePath -> m Bool
compareFilePath DirActions m
dirActions FilePath
cwd) (KnownPackage -> Maybe FilePath
mPkgDir KnownPackage
pkg)
      forall (m :: * -> *) a. Monad m => a -> m a
return (if Bool
isPkgDirCwd then (KnownPackage
pkg forall a. a -> [a] -> [a]
: [KnownPackage]
ppinfo, [KnownPackage]
opinfo) else ([KnownPackage]
ppinfo, KnownPackage
pkg forall a. a -> [a] -> [a]
: [KnownPackage]
opinfo))

    allComponentsIn :: [KnownPackage] -> [KnownComponent]
allComponentsIn [KnownPackage]
ps =
      [ KnownComponent
c | KnownPackage{[KnownComponent]
pinfoComponents :: [KnownComponent]
pinfoComponents :: KnownPackage -> [KnownComponent]
pinfoComponents} <- [KnownPackage]
ps, KnownComponent
c <- [KnownComponent]
pinfoComponents ]


collectKnownPackageInfo :: (Applicative m, Monad m) => DirActions m
                        -> PackageSpecifier (SourcePackage (PackageLocation a))
                        -> m KnownPackage
collectKnownPackageInfo :: forall (m :: * -> *) a.
(Applicative m, Monad m) =>
DirActions m
-> PackageSpecifier (SourcePackage (PackageLocation a))
-> m KnownPackage
collectKnownPackageInfo DirActions m
_ (NamedPackage PackageName
pkgname [PackageProperty]
_props) =
    forall (m :: * -> *) a. Monad m => a -> m a
return (PackageName -> KnownPackage
KnownPackageName PackageName
pkgname)
collectKnownPackageInfo dirActions :: DirActions m
dirActions@DirActions{m FilePath
FilePath -> m Bool
FilePath -> m FilePath
getCurrentDirectory :: m FilePath
canonicalizePath :: FilePath -> m FilePath
doesDirectoryExist :: FilePath -> m Bool
doesFileExist :: FilePath -> m Bool
getCurrentDirectory :: forall (m :: * -> *). DirActions m -> m FilePath
canonicalizePath :: forall (m :: * -> *). DirActions m -> FilePath -> m FilePath
doesDirectoryExist :: forall (m :: * -> *). DirActions m -> FilePath -> m Bool
doesFileExist :: forall (m :: * -> *). DirActions m -> FilePath -> m Bool
..}
                  (SpecificSourcePackage SourcePackage {
                    srcpkgDescription :: forall loc. SourcePackage loc -> GenericPackageDescription
srcpkgDescription = GenericPackageDescription
pkg,
                    srcpkgSource :: forall loc. SourcePackage loc -> loc
srcpkgSource      = PackageLocation a
loc
                  }) = do
    (Maybe (FilePath, FilePath)
pkgdir, Maybe (FilePath, FilePath)
pkgfile) <-
      case PackageLocation a
loc of
        --TODO: local tarballs, remote tarballs etc
        LocalUnpackedPackage FilePath
dir -> do
          FilePath
dirabs <- FilePath -> m FilePath
canonicalizePath FilePath
dir
          FilePath
dirrel <- forall (m :: * -> *).
Applicative m =>
DirActions m -> FilePath -> m FilePath
makeRelativeToCwd DirActions m
dirActions FilePath
dirabs
          --TODO: ought to get this earlier in project reading
          let fileabs :: FilePath
fileabs = FilePath
dirabs FilePath -> ShowS
</> forall a. Pretty a => a -> FilePath
prettyShow (forall pkg. Package pkg => pkg -> PackageName
packageName GenericPackageDescription
pkg) FilePath -> ShowS
<.> FilePath
"cabal"
              filerel :: FilePath
filerel = FilePath
dirrel FilePath -> ShowS
</> forall a. Pretty a => a -> FilePath
prettyShow (forall pkg. Package pkg => pkg -> PackageName
packageName GenericPackageDescription
pkg) FilePath -> ShowS
<.> FilePath
"cabal"
          Bool
exists <- FilePath -> m Bool
doesFileExist FilePath
fileabs
          forall (m :: * -> *) a. Monad m => a -> m a
return ( forall a. a -> Maybe a
Just (FilePath
dirabs, FilePath
dirrel)
                 , if Bool
exists then forall a. a -> Maybe a
Just (FilePath
fileabs, FilePath
filerel) else forall a. Maybe a
Nothing
                 )
        PackageLocation a
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
    let pinfo :: KnownPackage
pinfo =
          KnownPackage {
            pinfoId :: PackageId
pinfoId          = forall pkg. Package pkg => pkg -> PackageId
packageId GenericPackageDescription
pkg,
            pinfoDirectory :: Maybe (FilePath, FilePath)
pinfoDirectory   = Maybe (FilePath, FilePath)
pkgdir,
            pinfoPackageFile :: Maybe (FilePath, FilePath)
pinfoPackageFile = Maybe (FilePath, FilePath)
pkgfile,
            pinfoComponents :: [KnownComponent]
pinfoComponents  = PackageDescription -> [KnownComponent]
collectKnownComponentInfo
                                 (GenericPackageDescription -> PackageDescription
flattenPackageDescription GenericPackageDescription
pkg)
          }
    forall (m :: * -> *) a. Monad m => a -> m a
return KnownPackage
pinfo


collectKnownComponentInfo :: PackageDescription -> [KnownComponent]
collectKnownComponentInfo :: PackageDescription -> [KnownComponent]
collectKnownComponentInfo PackageDescription
pkg =
    [ KnownComponent {
        cinfoName :: ComponentName
cinfoName      = Component -> ComponentName
componentName Component
c,
        cinfoStrName :: FilePath
cinfoStrName   = PackageName -> ComponentName -> FilePath
componentStringName (forall pkg. Package pkg => pkg -> PackageName
packageName PackageDescription
pkg) (Component -> ComponentName
componentName Component
c),
        cinfoPackageId :: PackageId
cinfoPackageId = forall pkg. Package pkg => pkg -> PackageId
packageId PackageDescription
pkg,
        cinfoSrcDirs :: [FilePath]
cinfoSrcDirs   = forall a. Ord a => [a] -> [a]
ordNub (forall a b. (a -> b) -> [a] -> [b]
map forall from to. SymbolicPath from to -> FilePath
getSymbolicPath (BuildInfo -> [SymbolicPath PackageDir SourceDir]
hsSourceDirs BuildInfo
bi)),
        cinfoModules :: [ModuleName]
cinfoModules   = forall a. Ord a => [a] -> [a]
ordNub (Component -> [ModuleName]
componentModules Component
c),
        cinfoHsFiles :: [FilePath]
cinfoHsFiles   = forall a. Ord a => [a] -> [a]
ordNub (Component -> [FilePath]
componentHsFiles Component
c),
        cinfoCFiles :: [FilePath]
cinfoCFiles    = forall a. Ord a => [a] -> [a]
ordNub (BuildInfo -> [FilePath]
cSources BuildInfo
bi),
        cinfoJsFiles :: [FilePath]
cinfoJsFiles   = forall a. Ord a => [a] -> [a]
ordNub (BuildInfo -> [FilePath]
jsSources BuildInfo
bi)
      }
    | Component
c <- PackageDescription -> [Component]
pkgComponents PackageDescription
pkg
    , let bi :: BuildInfo
bi = Component -> BuildInfo
componentBuildInfo Component
c ]


componentStringName :: PackageName -> ComponentName -> ComponentStringName
componentStringName :: PackageName -> ComponentName -> FilePath
componentStringName PackageName
pkgname (CLibName LibraryName
LMainLibName) = forall a. Pretty a => a -> FilePath
prettyShow PackageName
pkgname
componentStringName PackageName
_ (CLibName (LSubLibName UnqualComponentName
name)) = UnqualComponentName -> FilePath
unUnqualComponentName UnqualComponentName
name
componentStringName PackageName
_ (CFLibName UnqualComponentName
name)  = UnqualComponentName -> FilePath
unUnqualComponentName UnqualComponentName
name
componentStringName PackageName
_ (CExeName   UnqualComponentName
name) = UnqualComponentName -> FilePath
unUnqualComponentName UnqualComponentName
name
componentStringName PackageName
_ (CTestName  UnqualComponentName
name) = UnqualComponentName -> FilePath
unUnqualComponentName UnqualComponentName
name
componentStringName PackageName
_ (CBenchName UnqualComponentName
name) = UnqualComponentName -> FilePath
unUnqualComponentName UnqualComponentName
name

componentModules :: Component -> [ModuleName]
-- I think it's unlikely users will ask to build a requirement
-- which is not mentioned locally.
componentModules :: Component -> [ModuleName]
componentModules (CLib   Library
lib)   = Library -> [ModuleName]
explicitLibModules Library
lib
componentModules (CFLib  ForeignLib
flib)  = ForeignLib -> [ModuleName]
foreignLibModules ForeignLib
flib
componentModules (CExe   Executable
exe)   = Executable -> [ModuleName]
exeModules Executable
exe
componentModules (CTest  TestSuite
test)  = TestSuite -> [ModuleName]
testModules TestSuite
test
componentModules (CBench Benchmark
bench) = Benchmark -> [ModuleName]
benchmarkModules Benchmark
bench

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


------------------------------
-- Matching meta targets
--

guardNamespaceMeta :: String -> Match ()
guardNamespaceMeta :: FilePath -> Match ()
guardNamespaceMeta = [FilePath] -> FilePath -> FilePath -> Match ()
guardToken [FilePath
""] FilePath
"meta namespace"

guardMetaAll :: String -> Match ()
guardMetaAll :: FilePath -> Match ()
guardMetaAll = [FilePath] -> FilePath -> FilePath -> Match ()
guardToken [FilePath
"all"] FilePath
"meta-target 'all'"

guardNamespacePackage :: String -> Match ()
guardNamespacePackage :: FilePath -> Match ()
guardNamespacePackage = [FilePath] -> FilePath -> FilePath -> Match ()
guardToken [FilePath
"pkg", FilePath
"package"] FilePath
"'pkg' namespace"

guardNamespaceCwd :: String -> Match ()
guardNamespaceCwd :: FilePath -> Match ()
guardNamespaceCwd = [FilePath] -> FilePath -> FilePath -> Match ()
guardToken [FilePath
"cwd"] FilePath
"'cwd' namespace"

guardNamespaceModule :: String -> Match ()
guardNamespaceModule :: FilePath -> Match ()
guardNamespaceModule = [FilePath] -> FilePath -> FilePath -> Match ()
guardToken [FilePath
"mod", FilePath
"module"] FilePath
"'module' namespace"

guardNamespaceFile :: String -> Match ()
guardNamespaceFile :: FilePath -> Match ()
guardNamespaceFile = [FilePath] -> FilePath -> FilePath -> Match ()
guardToken [FilePath
"file"] FilePath
"'file' namespace"

guardToken :: [String] -> String -> String -> Match ()
guardToken :: [FilePath] -> FilePath -> FilePath -> Match ()
guardToken [FilePath]
tokens FilePath
msg FilePath
s
  | ShowS
caseFold FilePath
s forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
tokens = Match ()
increaseConfidence
  | Bool
otherwise                = forall a. FilePath -> FilePath -> Match a
matchErrorExpected FilePath
msg FilePath
s


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

componentKind :: ComponentName -> ComponentKind
componentKind :: ComponentName -> ComponentKind
componentKind (CLibName LibraryName
_)   = ComponentKind
LibKind
componentKind (CFLibName UnqualComponentName
_)  = ComponentKind
FLibKind
componentKind (CExeName   UnqualComponentName
_) = ComponentKind
ExeKind
componentKind (CTestName  UnqualComponentName
_) = ComponentKind
TestKind
componentKind (CBenchName UnqualComponentName
_) = ComponentKind
BenchKind

cinfoKind :: KnownComponent -> ComponentKind
cinfoKind :: KnownComponent -> ComponentKind
cinfoKind = ComponentName -> ComponentKind
componentKind forall b c a. (b -> c) -> (a -> b) -> a -> c
. KnownComponent -> ComponentName
cinfoName

matchComponentKind :: String -> Match ComponentKind
matchComponentKind :: FilePath -> Match ComponentKind
matchComponentKind FilePath
s
  | FilePath
s' forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
liblabels   = Match ()
increaseConfidence forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ComponentKind
LibKind
  | FilePath
s' forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
fliblabels  = Match ()
increaseConfidence forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ComponentKind
FLibKind
  | FilePath
s' forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
exelabels   = Match ()
increaseConfidence forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ComponentKind
ExeKind
  | FilePath
s' forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
testlabels  = Match ()
increaseConfidence forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ComponentKind
TestKind
  | FilePath
s' forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
benchlabels = Match ()
increaseConfidence forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ComponentKind
BenchKind
  | Bool
otherwise             = forall a. FilePath -> FilePath -> Match a
matchErrorExpected FilePath
"component kind" FilePath
s
  where
    s' :: FilePath
s'         = ShowS
caseFold FilePath
s
    liblabels :: [FilePath]
liblabels   = [FilePath
"lib", FilePath
"library"]
    fliblabels :: [FilePath]
fliblabels  = [FilePath
"flib", FilePath
"foreign-library"]
    exelabels :: [FilePath]
exelabels   = [FilePath
"exe", FilePath
"executable"]
    testlabels :: [FilePath]
testlabels  = [FilePath
"tst", FilePath
"test", FilePath
"test-suite"]
    benchlabels :: [FilePath]
benchlabels = [FilePath
"bench", FilePath
"benchmark"]

matchComponentKindFilter :: String -> Match ComponentKind
matchComponentKindFilter :: FilePath -> Match ComponentKind
matchComponentKindFilter FilePath
s
  | FilePath
s' forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
liblabels   = Match ()
increaseConfidence forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ComponentKind
LibKind
  | FilePath
s' forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
fliblabels  = Match ()
increaseConfidence forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ComponentKind
FLibKind
  | FilePath
s' forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
exelabels   = Match ()
increaseConfidence forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ComponentKind
ExeKind
  | FilePath
s' forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
testlabels  = Match ()
increaseConfidence forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ComponentKind
TestKind
  | FilePath
s' forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
benchlabels = Match ()
increaseConfidence forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ComponentKind
BenchKind
  | Bool
otherwise             = forall a. FilePath -> FilePath -> Match a
matchErrorExpected FilePath
"component kind filter" FilePath
s
  where
    s' :: FilePath
s'          = ShowS
caseFold FilePath
s
    liblabels :: [FilePath]
liblabels   = [FilePath
"libs", FilePath
"libraries"]
    fliblabels :: [FilePath]
fliblabels  = [FilePath
"flibs", FilePath
"foreign-libraries"]
    exelabels :: [FilePath]
exelabels   = [FilePath
"exes", FilePath
"executables"]
    testlabels :: [FilePath]
testlabels  = [FilePath
"tests", FilePath
"test-suites"]
    benchlabels :: [FilePath]
benchlabels = [FilePath
"benches", FilePath
"benchmarks"]

showComponentKind :: ComponentKind -> String
showComponentKind :: ComponentKind -> FilePath
showComponentKind ComponentKind
LibKind   = FilePath
"library"
showComponentKind ComponentKind
FLibKind  = FilePath
"foreign library"
showComponentKind ComponentKind
ExeKind   = FilePath
"executable"
showComponentKind ComponentKind
TestKind  = FilePath
"test-suite"
showComponentKind ComponentKind
BenchKind = FilePath
"benchmark"

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

showComponentKindFilterShort :: ComponentKind -> String
showComponentKindFilterShort :: ComponentKind -> FilePath
showComponentKindFilterShort ComponentKind
LibKind   = FilePath
"libs"
showComponentKindFilterShort ComponentKind
FLibKind  = FilePath
"flibs"
showComponentKindFilterShort ComponentKind
ExeKind   = FilePath
"exes"
showComponentKindFilterShort ComponentKind
TestKind  = FilePath
"tests"
showComponentKindFilterShort ComponentKind
BenchKind = FilePath
"benchmarks"


------------------------------
-- Matching package targets
--

guardPackage :: String -> FileStatus -> Match ()
guardPackage :: FilePath -> FileStatus -> Match ()
guardPackage FilePath
str FileStatus
fstatus =
      FilePath -> Match ()
guardPackageName FilePath
str
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FilePath -> FileStatus -> Match ()
guardPackageDir  FilePath
str FileStatus
fstatus
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FilePath -> FileStatus -> Match ()
guardPackageFile FilePath
str FileStatus
fstatus


guardPackageName :: String -> Match ()
guardPackageName :: FilePath -> Match ()
guardPackageName FilePath
s
  | FilePath -> Bool
validPackageName FilePath
s = Match ()
increaseConfidence
  | Bool
otherwise          = forall a. FilePath -> FilePath -> Match a
matchErrorExpected FilePath
"package name" FilePath
s

validPackageName :: String -> Bool
validPackageName :: FilePath -> Bool
validPackageName FilePath
s =
       forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
validPackageNameChar FilePath
s
    Bool -> Bool -> Bool
&& Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
s)
  where
    validPackageNameChar :: Char -> Bool
validPackageNameChar Char
c = Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'-'


guardPackageDir :: String -> FileStatus -> Match ()
guardPackageDir :: FilePath -> FileStatus -> Match ()
guardPackageDir FilePath
_ (FileStatusExistsDir FilePath
_) = Match ()
increaseConfidence
guardPackageDir FilePath
str FileStatus
_ = forall a. FilePath -> FilePath -> Match a
matchErrorExpected FilePath
"package directory" FilePath
str


guardPackageFile :: String -> FileStatus -> Match ()
guardPackageFile :: FilePath -> FileStatus -> Match ()
guardPackageFile FilePath
_ (FileStatusExistsFile FilePath
file)
                       | ShowS
takeExtension FilePath
file forall a. Eq a => a -> a -> Bool
== FilePath
".cabal"
                       = Match ()
increaseConfidence
guardPackageFile FilePath
str FileStatus
_ = forall a. FilePath -> FilePath -> Match a
matchErrorExpected FilePath
"package .cabal file" FilePath
str


matchPackage :: [KnownPackage] -> String -> FileStatus -> Match KnownPackage
matchPackage :: [KnownPackage] -> FilePath -> FileStatus -> Match KnownPackage
matchPackage [KnownPackage]
pinfo = \FilePath
str FileStatus
fstatus ->
    forall a. FilePath -> FilePath -> Match a -> Match a
orNoThingIn FilePath
"project" FilePath
"" forall a b. (a -> b) -> a -> b
$
          [KnownPackage] -> FilePath -> Match KnownPackage
matchPackageName [KnownPackage]
pinfo FilePath
str
    forall a. Match a -> Match a -> Match a
<//> (FilePath -> Match KnownPackage
matchPackageNameUnknown FilePath
str
     forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>  [KnownPackage] -> FilePath -> FileStatus -> Match KnownPackage
matchPackageDir  [KnownPackage]
pinfo FilePath
str FileStatus
fstatus
     forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>  [KnownPackage] -> FilePath -> FileStatus -> Match KnownPackage
matchPackageFile [KnownPackage]
pinfo FilePath
str FileStatus
fstatus)


matchPackageName :: [KnownPackage] -> String -> Match KnownPackage
matchPackageName :: [KnownPackage] -> FilePath -> Match KnownPackage
matchPackageName [KnownPackage]
ps = \FilePath
str -> do
    forall (f :: * -> *). Alternative f => Bool -> f ()
guard (FilePath -> Bool
validPackageName FilePath
str)
    forall a. FilePath -> FilePath -> [FilePath] -> Match a -> Match a
orNoSuchThing FilePath
"package" FilePath
str
                  (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Pretty a => a -> FilePath
prettyShow forall b c a. (b -> c) -> (a -> b) -> a -> c
. KnownPackage -> PackageName
knownPackageName) [KnownPackage]
ps) forall a b. (a -> b) -> a -> b
$
      forall a. Match a -> Match a
increaseConfidenceFor forall a b. (a -> b) -> a -> b
$
        forall k k' a.
(Ord k, Ord k') =>
(k -> k') -> (a -> k) -> [a] -> k -> Match a
matchInexactly ShowS
caseFold (forall a. Pretty a => a -> FilePath
prettyShow forall b c a. (b -> c) -> (a -> b) -> a -> c
. KnownPackage -> PackageName
knownPackageName) [KnownPackage]
ps FilePath
str


matchPackageNameUnknown :: String -> Match KnownPackage
matchPackageNameUnknown :: FilePath -> Match KnownPackage
matchPackageNameUnknown FilePath
str = do
    PackageName
pn <- forall a. Parsec a => FilePath -> Match a
matchParse FilePath
str
    forall a. a -> Match a
unknownMatch (PackageName -> KnownPackage
KnownPackageName PackageName
pn)


matchPackageDir :: [KnownPackage]
                -> String -> FileStatus -> Match KnownPackage
matchPackageDir :: [KnownPackage] -> FilePath -> FileStatus -> Match KnownPackage
matchPackageDir [KnownPackage]
ps = \FilePath
str FileStatus
fstatus ->
    case FileStatus
fstatus of
      FileStatusExistsDir FilePath
canondir ->
        forall a. FilePath -> FilePath -> [FilePath] -> Match a -> Match a
orNoSuchThing FilePath
"package directory" FilePath
str (forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [((FilePath, FilePath), KnownPackage)]
dirs) forall a b. (a -> b) -> a -> b
$
          forall a. Match a -> Match a
increaseConfidenceFor forall a b. (a -> b) -> a -> b
$
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => (a -> k) -> [a] -> k -> Match a
matchExactly (forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [((FilePath, FilePath), KnownPackage)]
dirs FilePath
canondir
      FileStatus
_ -> forall (m :: * -> *) a. MonadPlus m => m a
mzero
  where
    dirs :: [((FilePath, FilePath), KnownPackage)]
dirs = [ ((FilePath
dabs,FilePath
drel),KnownPackage
p)
           | p :: KnownPackage
p@KnownPackage{ pinfoDirectory :: KnownPackage -> Maybe (FilePath, FilePath)
pinfoDirectory = Just (FilePath
dabs,FilePath
drel) } <- [KnownPackage]
ps ]


matchPackageFile :: [KnownPackage] -> String -> FileStatus -> Match KnownPackage
matchPackageFile :: [KnownPackage] -> FilePath -> FileStatus -> Match KnownPackage
matchPackageFile [KnownPackage]
ps = \FilePath
str FileStatus
fstatus -> do
    case FileStatus
fstatus of
      FileStatusExistsFile FilePath
canonfile ->
        forall a. FilePath -> FilePath -> [FilePath] -> Match a -> Match a
orNoSuchThing FilePath
"package .cabal file" FilePath
str (forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [((FilePath, FilePath), KnownPackage)]
files) forall a b. (a -> b) -> a -> b
$
          forall a. Match a -> Match a
increaseConfidenceFor forall a b. (a -> b) -> a -> b
$
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => (a -> k) -> [a] -> k -> Match a
matchExactly (forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [((FilePath, FilePath), KnownPackage)]
files FilePath
canonfile
      FileStatus
_ -> forall (m :: * -> *) a. MonadPlus m => m a
mzero
  where
    files :: [((FilePath, FilePath), KnownPackage)]
files = [ ((FilePath
fabs,FilePath
frel),KnownPackage
p)
            | p :: KnownPackage
p@KnownPackage{ pinfoPackageFile :: KnownPackage -> Maybe (FilePath, FilePath)
pinfoPackageFile = Just (FilePath
fabs,FilePath
frel) } <- [KnownPackage]
ps ]

--TODO: test outcome when dir exists but doesn't match any known one

--TODO: perhaps need another distinction, vs no such thing, point is the
--      thing is not known, within the project, but could be outside project


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


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


matchComponentName :: [KnownComponent] -> String -> Match KnownComponent
matchComponentName :: [KnownComponent] -> FilePath -> Match KnownComponent
matchComponentName [KnownComponent]
cs FilePath
str =
    forall a. FilePath -> FilePath -> [FilePath] -> Match a -> Match a
orNoSuchThing FilePath
"component" FilePath
str (forall a b. (a -> b) -> [a] -> [b]
map KnownComponent -> FilePath
cinfoStrName [KnownComponent]
cs)
  forall a b. (a -> b) -> a -> b
$ forall a. Match a -> Match a
increaseConfidenceFor
  forall a b. (a -> b) -> a -> b
$ forall k k' a.
(Ord k, Ord k') =>
(k -> k') -> (a -> k) -> [a] -> k -> Match a
matchInexactly ShowS
caseFold KnownComponent -> FilePath
cinfoStrName [KnownComponent]
cs FilePath
str


matchComponentKindAndName :: [KnownComponent] -> ComponentKind -> String
                          -> Match KnownComponent
matchComponentKindAndName :: [KnownComponent]
-> ComponentKind -> FilePath -> Match KnownComponent
matchComponentKindAndName [KnownComponent]
cs ComponentKind
ckind FilePath
str =
    forall a. FilePath -> FilePath -> [FilePath] -> Match a -> Match a
orNoSuchThing (ComponentKind -> FilePath
showComponentKind ComponentKind
ckind forall a. [a] -> [a] -> [a]
++ FilePath
" component") FilePath
str
                  (forall a b. (a -> b) -> [a] -> [b]
map KnownComponent -> FilePath
render [KnownComponent]
cs)
  forall a b. (a -> b) -> a -> b
$ forall a. Match a -> Match a
increaseConfidenceFor
  forall a b. (a -> b) -> a -> b
$ forall k k' a.
(Ord k, Ord k') =>
(k -> k') -> (a -> k) -> [a] -> k -> Match a
matchInexactly (\(ComponentKind
ck, FilePath
cn) -> (ComponentKind
ck, ShowS
caseFold FilePath
cn))
                   (\KnownComponent
c -> (KnownComponent -> ComponentKind
cinfoKind KnownComponent
c, KnownComponent -> FilePath
cinfoStrName KnownComponent
c))
                   [KnownComponent]
cs
                   (ComponentKind
ckind, FilePath
str)
  where
    render :: KnownComponent -> FilePath
render KnownComponent
c = ComponentKind -> FilePath
showComponentKindShort (KnownComponent -> ComponentKind
cinfoKind KnownComponent
c) forall a. [a] -> [a] -> [a]
++ FilePath
":" forall a. [a] -> [a] -> [a]
++ KnownComponent -> FilePath
cinfoStrName KnownComponent
c


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

guardModuleName :: String -> Match ()
guardModuleName :: FilePath -> Match ()
guardModuleName FilePath
s =
  case forall a. Parsec a => FilePath -> Maybe a
simpleParsec FilePath
s :: Maybe ModuleName of
    Just ModuleName
_                   -> Match ()
increaseConfidence
    Maybe ModuleName
_ | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
validModuleChar FilePath
s
        Bool -> Bool -> Bool
&& Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
s)      -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
      | Bool
otherwise            -> forall a. FilePath -> FilePath -> Match a
matchErrorExpected FilePath
"module name" FilePath
s
    where
      validModuleChar :: Char -> Bool
validModuleChar Char
c = Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'.' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'\''


matchModuleName :: [ModuleName] -> String -> Match ModuleName
matchModuleName :: [ModuleName] -> FilePath -> Match ModuleName
matchModuleName [ModuleName]
ms FilePath
str =
    forall a. FilePath -> FilePath -> [FilePath] -> Match a -> Match a
orNoSuchThing FilePath
"module" FilePath
str (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> FilePath
prettyShow [ModuleName]
ms)
  forall a b. (a -> b) -> a -> b
$ forall a. Match a -> Match a
increaseConfidenceFor
  forall a b. (a -> b) -> a -> b
$ forall k k' a.
(Ord k, Ord k') =>
(k -> k') -> (a -> k) -> [a] -> k -> Match a
matchInexactly ShowS
caseFold forall a. Pretty a => a -> FilePath
prettyShow [ModuleName]
ms FilePath
str


matchModuleNameAnd :: [(ModuleName, a)] -> String -> Match (ModuleName, a)
matchModuleNameAnd :: forall a. [(ModuleName, a)] -> FilePath -> Match (ModuleName, a)
matchModuleNameAnd [(ModuleName, a)]
ms FilePath
str =
    forall a. FilePath -> FilePath -> [FilePath] -> Match a -> Match a
orNoSuchThing FilePath
"module" FilePath
str (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Pretty a => a -> FilePath
prettyShow forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(ModuleName, a)]
ms)
  forall a b. (a -> b) -> a -> b
$ forall a. Match a -> Match a
increaseConfidenceFor
  forall a b. (a -> b) -> a -> b
$ forall k k' a.
(Ord k, Ord k') =>
(k -> k') -> (a -> k) -> [a] -> k -> Match a
matchInexactly ShowS
caseFold (forall a. Pretty a => a -> FilePath
prettyShow forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(ModuleName, a)]
ms FilePath
str


matchModuleNameUnknown :: String -> Match ModuleName
matchModuleNameUnknown :: FilePath -> Match ModuleName
matchModuleNameUnknown FilePath
str =
    forall a. FilePath -> FilePath -> Match a -> Match a
expecting FilePath
"module" FilePath
str
  forall a b. (a -> b) -> a -> b
$ forall a. Match a -> Match a
increaseConfidenceFor
  forall a b. (a -> b) -> a -> b
$ forall a. Parsec a => FilePath -> Match a
matchParse FilePath
str


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

matchPackageDirectoryPrefix :: [KnownPackage] -> FileStatus
                            -> Match (FilePath, KnownPackage)
matchPackageDirectoryPrefix :: [KnownPackage] -> FileStatus -> Match (FilePath, KnownPackage)
matchPackageDirectoryPrefix [KnownPackage]
ps (FileStatusExistsFile FilePath
filepath) =
    forall a. Match a -> Match a
increaseConfidenceFor forall a b. (a -> b) -> a -> b
$
      forall a. [(FilePath, a)] -> FilePath -> Match (FilePath, a)
matchDirectoryPrefix [(FilePath, KnownPackage)]
pkgdirs FilePath
filepath
  where
    pkgdirs :: [(FilePath, KnownPackage)]
pkgdirs = [ (FilePath
dir, KnownPackage
p)
              | p :: KnownPackage
p@KnownPackage { pinfoDirectory :: KnownPackage -> Maybe (FilePath, FilePath)
pinfoDirectory = Just (FilePath
dir,FilePath
_) } <- [KnownPackage]
ps ]
matchPackageDirectoryPrefix [KnownPackage]
_ FileStatus
_ = forall (m :: * -> *) a. MonadPlus m => m a
mzero


matchComponentFile :: [KnownComponent] -> String
                   -> Match (FilePath, KnownComponent)
matchComponentFile :: [KnownComponent] -> FilePath -> Match (FilePath, KnownComponent)
matchComponentFile [KnownComponent]
cs FilePath
str =
    forall a. FilePath -> FilePath -> [FilePath] -> Match a -> Match a
orNoSuchThing FilePath
"file" FilePath
str [] forall a b. (a -> b) -> a -> b
$
        [KnownComponent] -> FilePath -> Match (FilePath, KnownComponent)
matchComponentModuleFile [KnownComponent]
cs FilePath
str
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [KnownComponent] -> FilePath -> Match (FilePath, KnownComponent)
matchComponentOtherFile  [KnownComponent]
cs FilePath
str


matchComponentOtherFile :: [KnownComponent] -> String
                        -> Match (FilePath, KnownComponent)
matchComponentOtherFile :: [KnownComponent] -> FilePath -> Match (FilePath, KnownComponent)
matchComponentOtherFile [KnownComponent]
cs =
    forall a. [(FilePath, a)] -> FilePath -> Match (FilePath, a)
matchFile
      [ (ShowS
normalise (FilePath
srcdir FilePath -> ShowS
</> FilePath
file), KnownComponent
c)
      | KnownComponent
c      <- [KnownComponent]
cs
      , FilePath
srcdir <- KnownComponent -> [FilePath]
cinfoSrcDirs KnownComponent
c
      , FilePath
file   <- KnownComponent -> [FilePath]
cinfoHsFiles KnownComponent
c
               forall a. [a] -> [a] -> [a]
++ KnownComponent -> [FilePath]
cinfoCFiles  KnownComponent
c
               forall a. [a] -> [a] -> [a]
++ KnownComponent -> [FilePath]
cinfoJsFiles KnownComponent
c
      ]
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
normalise


matchComponentModuleFile :: [KnownComponent] -> String
                         -> Match (FilePath, KnownComponent)
matchComponentModuleFile :: [KnownComponent] -> FilePath -> Match (FilePath, KnownComponent)
matchComponentModuleFile [KnownComponent]
cs FilePath
str = do
    forall a. [(FilePath, a)] -> FilePath -> Match (FilePath, a)
matchFile
      [ (ShowS
normalise (FilePath
d FilePath -> ShowS
</> ModuleName -> FilePath
toFilePath ModuleName
m), KnownComponent
c)
      | KnownComponent
c <- [KnownComponent]
cs
      , FilePath
d <- KnownComponent -> [FilePath]
cinfoSrcDirs KnownComponent
c
      , ModuleName
m <- KnownComponent -> [ModuleName]
cinfoModules KnownComponent
c
      ]
      (ShowS
dropExtension (ShowS
normalise FilePath
str)) -- Drop the extension because FileTarget
                                      -- is stored without the extension

-- utils

-- | Compare two filepaths for equality using DirActions' canonicalizePath
-- to normalize AND canonicalize filepaths before comparison.
compareFilePath :: (Applicative m, Monad m) => DirActions m
                -> FilePath -> FilePath -> m Bool
compareFilePath :: forall (m :: * -> *).
(Applicative m, Monad m) =>
DirActions m -> FilePath -> FilePath -> m Bool
compareFilePath DirActions{m FilePath
FilePath -> m Bool
FilePath -> m FilePath
getCurrentDirectory :: m FilePath
canonicalizePath :: FilePath -> m FilePath
doesDirectoryExist :: FilePath -> m Bool
doesFileExist :: FilePath -> m Bool
getCurrentDirectory :: forall (m :: * -> *). DirActions m -> m FilePath
canonicalizePath :: forall (m :: * -> *). DirActions m -> FilePath -> m FilePath
doesDirectoryExist :: forall (m :: * -> *). DirActions m -> FilePath -> m Bool
doesFileExist :: forall (m :: * -> *). DirActions m -> FilePath -> m Bool
..} FilePath
fp1 FilePath
fp2
  | FilePath -> FilePath -> Bool
equalFilePath FilePath
fp1 FilePath
fp2 = forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True -- avoid unnecessary IO if we can match earlier
  | Bool
otherwise = do
    FilePath
c1 <- FilePath -> m FilePath
canonicalizePath FilePath
fp1
    FilePath
c2 <- FilePath -> m FilePath
canonicalizePath FilePath
fp2
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> Bool
equalFilePath FilePath
c1 FilePath
c2


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

matchDirectoryPrefix :: [(FilePath, a)] -> FilePath -> Match (FilePath, a)
matchDirectoryPrefix :: forall a. [(FilePath, a)] -> FilePath -> Match (FilePath, a)
matchDirectoryPrefix [(FilePath, a)]
dirs FilePath
filepath =
    forall a. [a] -> Match a
tryEach forall a b. (a -> b) -> a -> b
$
      [ (FilePath
file, a
x)
      | (FilePath
dir,a
x) <- [(FilePath, a)]
dirs
      , FilePath
file <- forall a. Maybe a -> [a]
maybeToList (FilePath -> Maybe FilePath
stripDirectory FilePath
dir) ]
  where
    stripDirectory :: FilePath -> Maybe FilePath
    stripDirectory :: FilePath -> Maybe FilePath
stripDirectory FilePath
dir =
      [FilePath] -> FilePath
joinPath forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix (FilePath -> [FilePath]
splitDirectories FilePath
dir) [FilePath]
filepathsplit

    filepathsplit :: [FilePath]
filepathsplit = FilePath -> [FilePath]
splitDirectories FilePath
filepath


------------------------------
-- 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 ('matchPlus', 'matchPlusShadowing') and finally we
-- can run a matcher against an input using 'findMatch'.
--
data Match a = NoMatch           !Confidence [MatchError]
             | Match !MatchClass !Confidence [a]
  deriving Int -> Match a -> ShowS
forall a. Show a => Int -> Match a -> ShowS
forall a. Show a => [Match a] -> ShowS
forall a. Show a => Match a -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Match a] -> ShowS
$cshowList :: forall a. Show a => [Match a] -> ShowS
show :: Match a -> FilePath
$cshow :: forall a. Show a => Match a -> FilePath
showsPrec :: Int -> Match a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Match a -> ShowS
Show

-- | The kind of match, inexact or exact. We keep track of this so we can
-- prefer exact over inexact matches. The 'Ord' here is important: we try
-- to maximise this, so 'Exact' is the top value and 'Inexact' the bottom.
--
data MatchClass = Unknown -- ^ Matches an unknown thing e.g. parses as a package
                          --   name without it being a specific known package
                | Inexact -- ^ Matches a known thing inexactly
                          --   e.g. matches a known package case insensitively
                | Exact   -- ^ Exactly matches a known thing,
                          --   e.g. matches a known package case sensitively
  deriving (Int -> MatchClass -> ShowS
[MatchClass] -> ShowS
MatchClass -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [MatchClass] -> ShowS
$cshowList :: [MatchClass] -> ShowS
show :: MatchClass -> FilePath
$cshow :: MatchClass -> FilePath
showsPrec :: Int -> MatchClass -> ShowS
$cshowsPrec :: Int -> MatchClass -> ShowS
Show, MatchClass -> MatchClass -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MatchClass -> MatchClass -> Bool
$c/= :: MatchClass -> MatchClass -> Bool
== :: MatchClass -> MatchClass -> Bool
$c== :: MatchClass -> MatchClass -> Bool
Eq, Eq MatchClass
MatchClass -> MatchClass -> Bool
MatchClass -> MatchClass -> Ordering
MatchClass -> MatchClass -> MatchClass
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 :: MatchClass -> MatchClass -> MatchClass
$cmin :: MatchClass -> MatchClass -> MatchClass
max :: MatchClass -> MatchClass -> MatchClass
$cmax :: MatchClass -> MatchClass -> MatchClass
>= :: MatchClass -> MatchClass -> Bool
$c>= :: MatchClass -> MatchClass -> Bool
> :: MatchClass -> MatchClass -> Bool
$c> :: MatchClass -> MatchClass -> Bool
<= :: MatchClass -> MatchClass -> Bool
$c<= :: MatchClass -> MatchClass -> Bool
< :: MatchClass -> MatchClass -> Bool
$c< :: MatchClass -> MatchClass -> Bool
compare :: MatchClass -> MatchClass -> Ordering
$ccompare :: MatchClass -> MatchClass -> Ordering
Ord)

type Confidence = Int

data MatchError = MatchErrorExpected String String            -- thing got
                | MatchErrorNoSuch   String String [String]   -- thing got alts
                | MatchErrorIn       String String MatchError -- kind  thing
  deriving (Int -> MatchError -> ShowS
[MatchError] -> ShowS
MatchError -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [MatchError] -> ShowS
$cshowList :: [MatchError] -> ShowS
show :: MatchError -> FilePath
$cshow :: MatchError -> FilePath
showsPrec :: Int -> MatchError -> ShowS
$cshowsPrec :: Int -> MatchError -> ShowS
Show, MatchError -> MatchError -> Bool
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 Functor Match where
    fmap :: forall a b. (a -> b) -> Match a -> Match b
fmap a -> b
_ (NoMatch Int
d [MatchError]
ms) = forall a. Int -> [MatchError] -> Match a
NoMatch Int
d [MatchError]
ms
    fmap a -> b
f (Match MatchClass
m Int
d [a]
xs) = forall a. MatchClass -> Int -> [a] -> Match a
Match MatchClass
m Int
d (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f [a]
xs)

instance Applicative Match where
    pure :: forall a. a -> Match a
pure a
a = forall a. MatchClass -> Int -> [a] -> Match a
Match MatchClass
Exact Int
0 [a
a]
    <*> :: forall a b. Match (a -> b) -> Match a -> Match b
(<*>)  = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Alternative Match where
    empty :: forall a. Match a
empty = forall a. Int -> [MatchError] -> Match a
NoMatch Int
0 []
    <|> :: forall a. Match a -> Match a -> Match a
(<|>) = forall a. Match a -> Match a -> Match a
matchPlus

instance Monad Match where
    return :: forall a. a -> Match a
return             = forall (f :: * -> *) a. Applicative f => a -> f a
pure
    NoMatch Int
d [MatchError]
ms >>= :: forall a b. Match a -> (a -> Match b) -> Match b
>>= a -> Match b
_ = forall a. Int -> [MatchError] -> Match a
NoMatch Int
d [MatchError]
ms
    Match MatchClass
m Int
d [a]
xs >>= a -> Match b
f =
      -- To understand this, it needs to be read in context with the
      -- implementation of 'matchPlus' below
      case forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum (forall a b. (a -> b) -> [a] -> [b]
map a -> Match b
f [a]
xs) of
        Match MatchClass
m' Int
d' [b]
xs' -> forall a. MatchClass -> Int -> [a] -> Match a
Match (forall a. Ord a => a -> a -> a
min MatchClass
m MatchClass
m') (Int
d forall a. Num a => a -> a -> a
+ Int
d') [b]
xs'
        -- The minimum match class is the one we keep. The match depth is
        -- tracked but not used in the Match case.

        NoMatch  Int
d' [MatchError]
ms  -> forall a. Int -> [MatchError] -> Match a
NoMatch          (Int
d forall a. Num a => a -> a -> a
+ Int
d') [MatchError]
ms
        -- Here is where we transfer the depth we were keeping track of in
        -- the Match case over to the NoMatch case where it finally gets used.

instance MonadPlus Match where
    mzero :: forall a. Match a
mzero = forall (f :: * -> *) a. Alternative f => f a
empty
    mplus :: forall a. Match a -> Match a -> Match a
mplus = forall a. Match a -> Match a -> Match a
matchPlus

(<//>) :: Match a -> Match a -> Match a
<//> :: forall a. Match a -> Match a -> Match a
(<//>) = forall a. Match a -> Match a -> Match a
matchPlusShadowing

infixl 3 <//>

-- | 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.
--
-- This operator is associative, has unit 'mzero' and is also commutative.
--
matchPlus :: Match a -> Match a -> Match a
matchPlus :: forall a. Match a -> Match a -> Match a
matchPlus a :: Match a
a@(Match MatchClass
_ Int
_ [a]
_ )   (NoMatch Int
_ [MatchError]
_) = Match a
a
matchPlus   (NoMatch Int
_ [MatchError]
_ ) b :: Match a
b@(Match MatchClass
_ Int
_ [a]
_) = Match a
b
matchPlus a :: Match a
a@(NoMatch Int
d_a [MatchError]
ms_a) b :: Match a
b@(NoMatch Int
d_b [MatchError]
ms_b)
  | Int
d_a forall a. Ord a => a -> a -> Bool
> Int
d_b = Match a
a  -- We only really make use of the depth in the NoMatch case.
  | Int
d_a forall a. Ord a => a -> a -> Bool
< Int
d_b = Match a
b
  | Bool
otherwise = forall a. Int -> [MatchError] -> Match a
NoMatch Int
d_a ([MatchError]
ms_a forall a. [a] -> [a] -> [a]
++ [MatchError]
ms_b)
matchPlus a :: Match a
a@(Match MatchClass
m_a Int
d_a [a]
xs_a) b :: Match a
b@(Match MatchClass
m_b Int
d_b [a]
xs_b)
  | MatchClass
m_a forall a. Ord a => a -> a -> Bool
> MatchClass
m_b = Match a
a  -- exact over inexact
  | MatchClass
m_a forall a. Ord a => a -> a -> Bool
< MatchClass
m_b = Match a
b  -- exact over inexact
  | Bool
otherwise = forall a. MatchClass -> Int -> [a] -> Match a
Match MatchClass
m_a (forall a. Ord a => a -> a -> a
max Int
d_a Int
d_b) ([a]
xs_a forall a. [a] -> [a] -> [a]
++ [a]
xs_b)

-- | Combine two matchers. This is similar to 'matchPlus' with the
-- difference that an exact match from the left matcher shadows any exact
-- match on the right. Inexact matches are still collected however.
--
-- This operator is associative, has unit 'mzero' and is not commutative.
--
matchPlusShadowing :: Match a -> Match a -> Match a
matchPlusShadowing :: forall a. Match a -> Match a -> Match a
matchPlusShadowing a :: Match a
a@(Match MatchClass
Exact Int
_ [a]
_) Match a
_ = Match a
a
matchPlusShadowing Match a
a                   Match a
b = forall a. Match a -> Match a -> Match a
matchPlus Match a
a Match a
b


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

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

matchErrorNoSuch :: String -> String -> [String] -> Match a
matchErrorNoSuch :: forall a. FilePath -> FilePath -> [FilePath] -> Match a
matchErrorNoSuch FilePath
thing FilePath
got [FilePath]
alts = forall a. Int -> [MatchError] -> Match a
NoMatch Int
0 [FilePath -> FilePath -> [FilePath] -> MatchError
MatchErrorNoSuch FilePath
thing FilePath
got [FilePath]
alts]

expecting :: String -> String -> Match a -> Match a
expecting :: forall a. FilePath -> FilePath -> Match a -> Match a
expecting FilePath
thing FilePath
got (NoMatch Int
0 [MatchError]
_) = forall a. FilePath -> FilePath -> Match a
matchErrorExpected FilePath
thing FilePath
got
expecting FilePath
_     FilePath
_   Match a
m             = Match a
m

orNoSuchThing :: String -> String -> [String] -> Match a -> Match a
orNoSuchThing :: forall a. FilePath -> FilePath -> [FilePath] -> Match a -> Match a
orNoSuchThing FilePath
thing FilePath
got [FilePath]
alts (NoMatch Int
0 [MatchError]
_) = forall a. FilePath -> FilePath -> [FilePath] -> Match a
matchErrorNoSuch FilePath
thing FilePath
got [FilePath]
alts
orNoSuchThing FilePath
_     FilePath
_   [FilePath]
_    Match a
m             = Match a
m

orNoThingIn :: String -> String -> Match a -> Match a
orNoThingIn :: forall a. FilePath -> FilePath -> Match a -> Match a
orNoThingIn FilePath
kind FilePath
name (NoMatch Int
n [MatchError]
ms) =
    forall a. Int -> [MatchError] -> Match a
NoMatch Int
n [ FilePath -> FilePath -> MatchError -> MatchError
MatchErrorIn FilePath
kind FilePath
name MatchError
m | MatchError
m <- [MatchError]
ms ]
orNoThingIn FilePath
_ FilePath
_ Match a
m = Match a
m

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

increaseConfidenceFor :: Match a -> Match a
increaseConfidenceFor :: forall a. Match a -> Match a
increaseConfidenceFor Match a
m = Match a
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
r -> Match ()
increaseConfidence forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return a
r

nubMatchesBy :: (a -> a -> Bool) -> Match a -> Match a
nubMatchesBy :: forall a. (a -> a -> Bool) -> Match a -> Match a
nubMatchesBy a -> a -> Bool
_  (NoMatch Int
d [MatchError]
msgs) = forall a. Int -> [MatchError] -> Match a
NoMatch Int
d [MatchError]
msgs
nubMatchesBy a -> a -> Bool
eq (Match MatchClass
m Int
d [a]
xs)   = forall a. MatchClass -> Int -> [a] -> Match a
Match MatchClass
m Int
d (forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy a -> a -> Bool
eq [a]
xs)

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

exactMatches :: forall a. [a] -> Match a
exactMatches [] = forall (m :: * -> *) a. MonadPlus m => m a
mzero
exactMatches [a]
xs = forall a. MatchClass -> Int -> [a] -> Match a
Match MatchClass
Exact Int
0 [a]
xs

inexactMatches :: forall a. [a] -> Match a
inexactMatches [] = forall (m :: * -> *) a. MonadPlus m => m a
mzero
inexactMatches [a]
xs = forall a. MatchClass -> Int -> [a] -> Match a
Match MatchClass
Inexact Int
0 [a]
xs

unknownMatch :: a -> Match a
unknownMatch :: forall a. a -> Match a
unknownMatch a
x = forall a. MatchClass -> Int -> [a] -> Match a
Match MatchClass
Unknown Int
0 [a
x]

tryEach :: [a] -> Match a
tryEach :: forall a. [a] -> Match a
tryEach = 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 :: Match a -> MaybeAmbiguous a
findMatch :: forall a. Match a -> MaybeAmbiguous a
findMatch Match a
match = case Match a
match of
  NoMatch Int
_ [MatchError]
msgs -> forall a. [MatchError] -> MaybeAmbiguous a
None [MatchError]
msgs
  Match MatchClass
_ Int
_  [a
x] -> forall a. a -> MaybeAmbiguous a
Unambiguous a
x
  Match MatchClass
m Int
d   [] -> forall a. HasCallStack => FilePath -> a
error forall a b. (a -> b) -> a -> b
$ FilePath
"findMatch: impossible: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show Match ()
match'
                      where match' :: Match ()
match' = forall a. MatchClass -> Int -> [a] -> Match a
Match MatchClass
m Int
d [] :: Match ()
                    -- TODO: Maybe use Data.List.NonEmpty inside
                    -- Match so that this case would be correct
                    -- by construction?
  Match MatchClass
m Int
_   [a]
xs -> forall a. MatchClass -> [a] -> MaybeAmbiguous a
Ambiguous MatchClass
m [a]
xs

data MaybeAmbiguous a = None [MatchError]
                      | Unambiguous a
                      | Ambiguous MatchClass [a]
  deriving Int -> MaybeAmbiguous a -> ShowS
forall a. Show a => Int -> MaybeAmbiguous a -> ShowS
forall a. Show a => [MaybeAmbiguous a] -> ShowS
forall a. Show a => MaybeAmbiguous a -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [MaybeAmbiguous a] -> ShowS
$cshowList :: forall a. Show a => [MaybeAmbiguous a] -> ShowS
show :: MaybeAmbiguous a -> FilePath
$cshow :: forall a. Show a => MaybeAmbiguous a -> FilePath
showsPrec :: Int -> MaybeAmbiguous a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> MaybeAmbiguous a -> ShowS
Show


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

-- | A primitive matcher that looks up a value in a finite 'Map'. The
-- value must match exactly.
--
matchExactly :: Ord k => (a -> k) -> [a] -> (k -> Match a)
matchExactly :: forall k a. Ord k => (a -> k) -> [a] -> k -> Match a
matchExactly a -> k
key [a]
xs =
    \k
k -> case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
k Map k [a]
m of
            Maybe [a]
Nothing -> forall (m :: * -> *) a. MonadPlus m => m a
mzero
            Just [a]
ys -> forall a. [a] -> Match a
exactMatches [a]
ys
  where
    m :: Map k [a]
m = forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith forall a. [a] -> [a] -> [a]
(++) [ (a -> k
key a
x, [a
x]) | a
x <- [a]
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 k, Ord k') => (k -> k') -> (a -> k)
               -> [a] -> (k -> Match a)
matchInexactly :: forall k k' a.
(Ord k, Ord k') =>
(k -> k') -> (a -> k) -> [a] -> k -> Match a
matchInexactly k -> k'
cannonicalise a -> k
key [a]
xs =
    \k
k -> case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
k Map k [a]
m of
            Just [a]
ys -> forall a. [a] -> Match a
exactMatches [a]
ys
            Maybe [a]
Nothing -> case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (k -> k'
cannonicalise k
k) Map k' [a]
m' of
                         Just [a]
ys -> forall a. [a] -> Match a
inexactMatches [a]
ys
                         Maybe [a]
Nothing -> forall (m :: * -> *) a. MonadPlus m => m a
mzero
  where
    m :: Map k [a]
m = forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith forall a. [a] -> [a] -> [a]
(++) [ (a -> k
key a
x, [a
x]) | a
x <- [a]
xs ]

    -- the map of canonicalised keys to groups of inexact matches
    m' :: Map k' [a]
m' = forall k2 a k1.
Ord k2 =>
(a -> a -> a) -> (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeysWith forall a. [a] -> [a] -> [a]
(++) k -> k'
cannonicalise Map k [a]
m

matchParse :: Parsec a => String -> Match a
matchParse :: forall a. Parsec a => FilePath -> Match a
matchParse = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall (m :: * -> *) a. MonadPlus m => m a
mzero forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parsec a => FilePath -> Maybe a
simpleParsec


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

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

-- | Make a 'ComponentName' given an 'UnqualComponentName' and knowing the
-- 'ComponentKind'. We also need the 'PackageName' to distinguish the package's
-- primary library from named private libraries.
--
mkComponentName :: PackageName
                -> ComponentKind
                -> UnqualComponentName
                -> ComponentName
mkComponentName :: PackageName
-> ComponentKind -> UnqualComponentName -> ComponentName
mkComponentName PackageName
pkgname ComponentKind
ckind UnqualComponentName
ucname =
  case ComponentKind
ckind of
    ComponentKind
LibKind
      | PackageName -> UnqualComponentName
packageNameToUnqualComponentName PackageName
pkgname forall a. Eq a => a -> a -> Bool
== UnqualComponentName
ucname
                  -> LibraryName -> ComponentName
CLibName LibraryName
LMainLibName
      | Bool
otherwise -> LibraryName -> ComponentName
CLibName forall a b. (a -> b) -> a -> b
$ UnqualComponentName -> LibraryName
LSubLibName UnqualComponentName
ucname
    ComponentKind
FLibKind      -> UnqualComponentName -> ComponentName
CFLibName   UnqualComponentName
ucname
    ComponentKind
ExeKind       -> UnqualComponentName -> ComponentName
CExeName    UnqualComponentName
ucname
    ComponentKind
TestKind      -> UnqualComponentName -> ComponentName
CTestName   UnqualComponentName
ucname
    ComponentKind
BenchKind     -> UnqualComponentName -> ComponentName
CBenchName  UnqualComponentName
ucname


------------------------------
-- Example inputs
--

{-
ex1pinfo :: [KnownPackage]
ex1pinfo =
  [ addComponent (CExeName (mkUnqualComponentName "foo-exe")) [] ["Data.Foo"] $
    KnownPackage {
      pinfoId          = PackageIdentifier (mkPackageName "foo") (mkVersion [1]),
      pinfoDirectory   = Just ("/the/foo", "foo"),
      pinfoPackageFile = Just ("/the/foo/foo.cabal", "foo/foo.cabal"),
      pinfoComponents  = []
    }
  , KnownPackage {
      pinfoId          = PackageIdentifier (mkPackageName "bar") (mkVersion [1]),
      pinfoDirectory   = Just ("/the/bar", "bar"),
      pinfoPackageFile = Just ("/the/bar/bar.cabal", "bar/bar.cabal"),
      pinfoComponents  = []
    }
  ]
  where
    addComponent n ds ms p =
      p {
        pinfoComponents =
            KnownComponent n (componentStringName (pinfoId p) n)
                          p ds (map mkMn ms)
                          [] [] []
          : pinfoComponents p
      }

    mkMn :: String -> ModuleName
    mkMn  = ModuleName.fromString
-}
{-
stargets =
  [ TargetComponent (CExeName "foo")  WholeComponent
  , TargetComponent (CExeName "foo") (ModuleTarget (mkMn "Foo"))
  , TargetComponent (CExeName "tst") (ModuleTarget (mkMn "Foo"))
  ]
    where
    mkMn :: String -> ModuleName
    mkMn  = fromJust . simpleParse

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

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