content: {-# LANGUAGE CPP, DeriveGeneric, DeriveFunctor,
               RecordWildCards, NamedFieldPuns #-}
  -----------------------------------------------------------------------------
  -- |
  -- 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.Verbosity
  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(..)
           , pkgComponents, componentName, componentBuildInfo )
  import Distribution.Types.ForeignLib
  
  import Distribution.Text
           ( Text, display, simpleParse )
  import Distribution.Simple.Utils
           ( die', lowercase, ordNub )
  import Distribution.Client.Utils
           ( makeRelativeCanonical )
  
  import Data.Either
           ( partitionEithers )
  import Data.Function
           ( on )
  import Data.List
           ( stripPrefix, partition, groupBy )
  import Data.Ord
           ( comparing )
  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
  import qualified Distribution.Compat.ReadP as Parse
  import Distribution.Compat.ReadP
           ( (+++), (<++) )
  import Distribution.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 )
  import Text.EditDistance
           ( defaultEditCosts, restrictedDamerauLevenshteinDistance )
  
  
  -- ------------------------------------------------------------
  -- * 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 (Eq, Ord, Show, 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 (Eq, Ord, Show, Generic)
  
  data ComponentKind = LibKind | FLibKind | ExeKind | TestKind | BenchKind
    deriving (Eq, Ord, Enum, 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.
     | FileTarget   FilePath
    deriving (Eq, Ord, Show, Generic)
  
  instance Binary 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 ambiguitiy
                      --   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 = readTargetSelectorsWith defaultDirActions
  
  readTargetSelectorsWith :: (Applicative m, Monad m) => DirActions m
                          -> [PackageSpecifier (SourcePackage (PackageLocation a))]
                          -> Maybe ComponentKindFilter
                          -> [String]
                          -> m (Either [TargetSelectorProblem] [TargetSelector])
  readTargetSelectorsWith dirActions@DirActions{..} pkgs mfilter targetStrs =
      case parseTargetStrings targetStrs of
        ([], usertargets) -> do
          usertargets' <- mapM (getTargetStringFileStatus dirActions) usertargets
          knowntargets <- getKnownTargets dirActions pkgs
          case resolveTargetSelectors knowntargets usertargets' mfilter of
            ([], btargets) -> return (Right btargets)
            (problems, _)  -> return (Left problems)
        (strs, _)          -> return (Left (map TargetSelectorUnrecognised strs))
  
  
  data DirActions m = DirActions {
         doesFileExist       :: FilePath -> m Bool,
         doesDirectoryExist  :: FilePath -> m Bool,
         canonicalizePath    :: FilePath -> m FilePath,
         getCurrentDirectory :: m FilePath
       }
  
  defaultDirActions :: DirActions IO
  defaultDirActions =
      DirActions {
        doesFileExist       = IO.doesFileExist,
        doesDirectoryExist  = IO.doesDirectoryExist,
        -- Workaround for <https://github.com/haskell/directory/issues/63>
        canonicalizePath    = IO.canonicalizePath . dropTrailingPathSeparator,
        getCurrentDirectory = IO.getCurrentDirectory
      }
  
  makeRelativeToCwd :: Applicative m => DirActions m -> FilePath -> m FilePath
  makeRelativeToCwd DirActions{..} path =
      makeRelativeCanonical <$> canonicalizePath path <*> 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 (Show, Eq)
  
  -- | Parse a bunch of 'TargetString's (purely without throwing exceptions).
  --
  parseTargetStrings :: [String] -> ([String], [TargetString])
  parseTargetStrings =
      partitionEithers
    . map (\str -> maybe (Left str) Right (parseTargetString str))
  
  parseTargetString :: String -> Maybe TargetString
  parseTargetString =
      readPToMaybe parseTargetApprox
    where
      parseTargetApprox :: Parse.ReadP r TargetString
      parseTargetApprox =
            (do a <- tokenQ
                return (TargetString1 a))
        +++ (do a <- tokenQ0
                _ <- Parse.char ':'
                b <- tokenQ
                return (TargetString2 a b))
        +++ (do a <- tokenQ0
                _ <- Parse.char ':'
                b <- tokenQ
                _ <- Parse.char ':'
                c <- tokenQ
                return (TargetString3 a b c))
        +++ (do a <- tokenQ0
                _ <- Parse.char ':'
                b <- token
                _ <- Parse.char ':'
                c <- tokenQ
                _ <- Parse.char ':'
                d <- tokenQ
                return (TargetString4 a b c d))
        +++ (do a <- tokenQ0
                _ <- Parse.char ':'
                b <- token
                _ <- Parse.char ':'
                c <- tokenQ
                _ <- Parse.char ':'
                d <- tokenQ
                _ <- Parse.char ':'
                e <- tokenQ
                return (TargetString5 a b c d e))
        +++ (do a <- tokenQ0
                _ <- Parse.char ':'
                b <- token
                _ <- Parse.char ':'
                c <- tokenQ
                _ <- Parse.char ':'
                d <- tokenQ
                _ <- Parse.char ':'
                e <- tokenQ
                _ <- Parse.char ':'
                f <- tokenQ
                _ <- Parse.char ':'
                g <- tokenQ
                return (TargetString7 a b c d e f g))
  
      token  = Parse.munch1 (\x -> not (isSpace x) && x /= ':')
      tokenQ = parseHaskellString <++ token
      token0 = Parse.munch (\x -> not (isSpace x) && x /= ':')
      tokenQ0= parseHaskellString <++ token0
      parseHaskellString :: Parse.ReadP r String
      parseHaskellString = Parse.readS_to_P reads
  
  
  -- | Render a 'TargetString' back as the external syntax. This is mainly for
  -- error messages.
  --
  showTargetString :: TargetString -> String
  showTargetString = intercalate ":" . components
    where
      components (TargetString1 s1)          = [s1]
      components (TargetString2 s1 s2)       = [s1,s2]
      components (TargetString3 s1 s2 s3)    = [s1,s2,s3]
      components (TargetString4 s1 s2 s3 s4) = [s1,s2,s3,s4]
      components (TargetString5 s1 s2 s3 s4 s5)       = [s1,s2,s3,s4,s5]
      components (TargetString7 s1 s2 s3 s4 s5 s6 s7) = [s1,s2,s3,s4,s5,s6,s7]
  
  showTargetSelector :: TargetSelector -> String
  showTargetSelector ts =
    case [ t | ql <- [QL1 .. QLFull]
             , t  <- renderTargetSelector ql ts ]
    of (t':_) -> showTargetString (forgetFileStatus t')
       [] -> ""
  
  showTargetSelectorKind :: TargetSelector -> String
  showTargetSelectorKind bt = case bt of
    TargetPackage TargetExplicitNamed _ Nothing  -> "package"
    TargetPackage TargetExplicitNamed _ (Just _) -> "package:filter"
    TargetPackage TargetImplicitCwd   _ Nothing  -> "cwd-package"
    TargetPackage TargetImplicitCwd   _ (Just _) -> "cwd-package:filter"
    TargetPackageNamed                _ Nothing  -> "named-package"
    TargetPackageNamed                _ (Just _) -> "named-package:filter"
    TargetAllPackages Nothing                    -> "package *"
    TargetAllPackages (Just _)                   -> "package *:filter"
    TargetComponent        _ _ WholeComponent    -> "component"
    TargetComponent        _ _ ModuleTarget{}    -> "module"
    TargetComponent        _ _ FileTarget{}      -> "file"
    TargetComponentUnknown _ _ WholeComponent    -> "unknown-component"
    TargetComponentUnknown _ _ ModuleTarget{}    -> "unknown-module"
    TargetComponentUnknown _ _ FileTarget{}      -> "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 (Eq, Ord, Show)
  
  data FileStatus = FileStatusExistsFile FilePath -- the canonicalised filepath
                  | FileStatusExistsDir  FilePath -- the canonicalised filepath
                  | FileStatusNotExists  Bool -- does the parent dir exist even?
    deriving (Eq, Ord, Show)
  
  noFileStatus :: FileStatus
  noFileStatus = FileStatusNotExists False
  
  getTargetStringFileStatus :: (Applicative m, Monad m) => DirActions m
                            -> TargetString -> m TargetStringFileStatus
  getTargetStringFileStatus DirActions{..} t =
      case t of
        TargetString1 s1 ->
          (\f1 -> TargetStringFileStatus1 s1 f1)          <$> fileStatus s1
        TargetString2 s1 s2 ->
          (\f1 -> TargetStringFileStatus2 s1 f1 s2)       <$> fileStatus s1
        TargetString3 s1 s2 s3 ->
          (\f1 -> TargetStringFileStatus3 s1 f1 s2 s3)    <$> fileStatus s1
        TargetString4 s1 s2 s3 s4 ->
          return (TargetStringFileStatus4 s1 s2 s3 s4)
        TargetString5 s1 s2 s3 s4 s5 ->
          return (TargetStringFileStatus5 s1 s2 s3 s4 s5)
        TargetString7 s1 s2 s3 s4 s5 s6 s7 ->
          return (TargetStringFileStatus7 s1 s2 s3 s4 s5 s6 s7)
    where
      fileStatus f = do
        fexists <- doesFileExist f
        dexists <- doesDirectoryExist f
        case splitPath f of
          _ | fexists -> FileStatusExistsFile <$> canonicalizePath f
            | dexists -> FileStatusExistsDir  <$> canonicalizePath f
          (d:_)       -> FileStatusNotExists  <$> doesDirectoryExist d
          _           -> pure (FileStatusNotExists False)
  
  forgetFileStatus :: TargetStringFileStatus -> TargetString
  forgetFileStatus t = case t of
      TargetStringFileStatus1 s1 _          -> TargetString1 s1
      TargetStringFileStatus2 s1 _ s2       -> TargetString2 s1 s2
      TargetStringFileStatus3 s1 _ s2 s3    -> TargetString3 s1 s2 s3
      TargetStringFileStatus4 s1   s2 s3 s4 -> TargetString4 s1 s2 s3 s4
      TargetStringFileStatus5 s1   s2 s3 s4
                                         s5 -> TargetString5 s1 s2 s3 s4 s5
      TargetStringFileStatus7 s1   s2 s3 s4
                                   s5 s6 s7 -> TargetString7 s1 s2 s3 s4 s5 s6 s7
  
  
  -- ------------------------------------------------------------
  -- * 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{knownPackagesAll = []}) [] _ =
      ([TargetSelectorNoTargetsInProject], [])
  
  resolveTargetSelectors (KnownTargets{knownPackagesPrimary = []}) [] _ =
      ([TargetSelectorNoTargetsInCwd], [])
  
  resolveTargetSelectors (KnownTargets{knownPackagesPrimary}) [] _ =
      ([], [TargetPackage TargetImplicitCwd pkgids Nothing])
    where
      pkgids = [ pinfoId | KnownPackage{pinfoId} <- knownPackagesPrimary ]
  
  resolveTargetSelectors knowntargets targetStrs mfilter =
      partitionEithers
    . map (resolveTargetSelector knowntargets mfilter)
    $ targetStrs
  
  resolveTargetSelector :: KnownTargets
                        -> Maybe ComponentKindFilter
                        -> TargetStringFileStatus
                        -> Either TargetSelectorProblem TargetSelector
  resolveTargetSelector knowntargets@KnownTargets{..} mfilter targetStrStatus =
      case findMatch (matcher targetStrStatus) of
  
        Unambiguous _
          | projectIsEmpty -> Left TargetSelectorNoTargetsInProject
  
        Unambiguous (TargetPackage TargetImplicitCwd [] _)
                           -> Left (TargetSelectorNoCurrentPackage targetStr)
  
        Unambiguous target -> Right target
  
        None errs
          | projectIsEmpty       -> Left TargetSelectorNoTargetsInProject
          | otherwise            -> Left (classifyMatchErrors errs)
  
        Ambiguous _          targets
          | Just kfilter <- mfilter
          , [target] <- applyKindFilter kfilter targets -> Right target
  
        Ambiguous exactMatch targets ->
          case disambiguateTargetSelectors
                 matcher targetStrStatus exactMatch
                 targets of
            Right targets'   -> Left (TargetSelectorAmbiguous targetStr targets')
            Left ((m, ms):_) -> Left (MatchingInternalError targetStr m ms)
            Left []          -> internalError "resolveTargetSelector"
    where
      matcher = matchTargetSelector knowntargets
  
      targetStr = forgetFileStatus targetStrStatus
  
      projectIsEmpty = null knownPackagesAll
  
      classifyMatchErrors errs
        | not (null expected)
        = let (things, got:_) = unzip expected in
          TargetSelectorExpected targetStr things got
  
        | not (null nosuch)
        = TargetSelectorNoSuch targetStr nosuch
  
        | otherwise
        = internalError $ "classifyMatchErrors: " ++ show errs
        where
          expected = [ (thing, got)
                     | (_, MatchErrorExpected thing got)
                             <- map (innerErr Nothing) errs ]
          -- Trim the list of alternatives by dropping duplicates and
          -- retaining only at most three most similar (by edit distance) ones.
          nosuch   = Map.foldrWithKey genResults [] $ Map.fromListWith Set.union $
            [ ((inside, thing, got), Set.fromList alts)
            | (inside, MatchErrorNoSuch thing got alts)
              <- map (innerErr Nothing) errs
            ]
  
          genResults (inside, thing, got) alts acc = (
              inside
            , thing
            , got
            , take maxResults
              $ map fst
              $ takeWhile distanceLow
              $ sortBy (comparing snd)
              $ map addLevDist
              $ Set.toList alts
            ) : acc
            where
              addLevDist = id &&& restrictedDamerauLevenshteinDistance
                                  defaultEditCosts got
  
              distanceLow (_, dist) = dist < length got `div` 2
  
              maxResults = 3
  
          innerErr _ (MatchErrorIn kind thing m)
                       = innerErr (Just (kind,thing)) m
          innerErr c m = (c,m)
  
      applyKindFilter :: ComponentKindFilter -> [TargetSelector] -> [TargetSelector]
      applyKindFilter kfilter = filter go
        where
          go (TargetPackage      _ _ (Just filter')) = kfilter == filter'
          go (TargetPackageNamed _   (Just filter')) = kfilter == filter'
          go (TargetAllPackages      (Just filter')) = kfilter == filter'
          go (TargetComponent _ cname _)
            | CLibName      <- cname                 = kfilter == LibKind
            | CSubLibName _ <- cname                 = kfilter == LibKind
            | CFLibName   _ <- cname                 = kfilter == FLibKind
            | CExeName    _ <- cname                 = kfilter == ExeKind
            | CTestName   _ <- cname                 = kfilter == TestKind
            | CBenchName  _ <- cname                 = kfilter == BenchKind
          go _                                       = 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
     | TargetSelectorNoTargetsInProject
    deriving (Show, Eq)
  
  data QualLevel = QL1 | QL2 | QL3 | QLFull
    deriving (Eq, Enum, Show)
  
  disambiguateTargetSelectors
    :: (TargetStringFileStatus -> Match TargetSelector)
    -> TargetStringFileStatus -> MatchClass
    -> [TargetSelector]
    -> Either [(TargetSelector, [(TargetString, [TargetSelector])])]
              [(TargetString, TargetSelector)]
  disambiguateTargetSelectors matcher matchInput exactMatch matchResults =
      case partitionEithers results of
        (errs@(_:_), _) -> Left errs
        ([], ok)        -> Right 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.
      matchResultsRenderings :: [(TargetSelector, [TargetStringFileStatus])]
      matchResultsRenderings =
        [ (matchResult, matchRenderings)
        | matchResult <- matchResults
        , let matchRenderings =
                [ rendering
                | ql <- [QL1 .. QLFull]
                , rendering <- renderTargetSelector ql 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 =
          -- avoid recomputing the main one if it was an exact match
          (if exactMatch == Exact
             then Map.insert matchInput (Match Exact 0 matchResults)
             else id)
        $ Map.Lazy.fromList
            [ (rendering, matcher rendering)
            | rendering <- concatMap snd 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 =
        [ case findUnambiguous originalMatch matchRenderings of
            Just unambiguousRendering ->
              Right ( forgetFileStatus unambiguousRendering
                    , originalMatch)
  
            -- This case is an internal error, but we bubble it up and report it
            Nothing ->
              Left  ( originalMatch
                    , [ (forgetFileStatus rendering, matches)
                      | rendering <- matchRenderings
                      , let Match m _ matches =
                              memoisedMatches Map.! rendering
                      , m /= Inexact
                      ] )
  
        | (originalMatch, matchRenderings) <- matchResultsRenderings ]
  
      findUnambiguous :: TargetSelector
                      -> [TargetStringFileStatus]
                      -> Maybe TargetStringFileStatus
      findUnambiguous _ []     = Nothing
      findUnambiguous t (r:rs) =
        case memoisedMatches Map.! r of
          Match Exact _ [t'] | t == t'
                            -> Just r
          Match Exact   _ _ -> findUnambiguous t rs
          Match Unknown _ _ -> findUnambiguous t rs
          Match Inexact _ _ -> internalError "Match Inexact"
          NoMatch       _ _ -> internalError "NoMatch"
  
  internalError :: String -> a
  internalError msg =
    error $ "TargetSelector: internal error: " ++ msg
  
  
  -- | Throw an exception with a formatted message if there are any problems.
  --
  reportTargetSelectorProblems :: Verbosity -> [TargetSelectorProblem] -> IO a
  reportTargetSelectorProblems verbosity problems = do
  
      case [ str | TargetSelectorUnrecognised str <- problems ] of
        []      -> return ()
        targets ->
          die' verbosity $ unlines
            [ "Unrecognised target syntax for '" ++ name ++ "'."
            | name <- targets ]
  
      case [ (t, m, ms) | MatchingInternalError t m ms <- problems ] of
        [] -> return ()
        ((target, originalMatch, renderingsAndMatches):_) ->
          die' verbosity $ "Internal error in target matching. It should always "
             ++ "be possible to find a syntax that's sufficiently qualified to "
             ++ "give an unambiguous match. However when matching '"
             ++ showTargetString target ++ "'  we found "
             ++ showTargetSelector originalMatch
             ++ " (" ++ showTargetSelectorKind originalMatch ++ ") which does "
             ++ "not have an unambiguous syntax. The possible syntax and the "
             ++ "targets they match are as follows:\n"
             ++ unlines
                  [ "'" ++ showTargetString rendering ++ "' which matches "
                    ++ intercalate ", "
                         [ showTargetSelector match ++
                           " (" ++ showTargetSelectorKind match ++ ")"
                         | match <- matches ]
                  | (rendering, matches) <- renderingsAndMatches ]
  
      case [ (t, e, g) | TargetSelectorExpected t e g <- problems ] of
        []      -> return ()
        targets ->
          die' verbosity $ unlines
            [    "Unrecognised target '" ++ showTargetString target
              ++ "'.\n"
              ++ "Expected a " ++ intercalate " or " expected
              ++ ", rather than '" ++ got ++ "'."
            | (target, expected, got) <- targets ]
  
      case [ (t, e) | TargetSelectorNoSuch t e <- problems ] of
        []      -> return ()
        targets ->
          die' verbosity $ unlines
            [ "Unknown target '" ++ showTargetString target ++
              "'.\n" ++ unlines
              [    (case inside of
                      Just (kind, "")
                              -> "The " ++ kind ++ " has no "
                      Just (kind, thing)
                              -> "The " ++ kind ++ " " ++ thing ++ " has no "
                      Nothing -> "There is no ")
                ++ intercalate " or " [ mungeThing thing ++ " '" ++ got ++ "'"
                                      | (thing, got, _alts) <- nosuch' ] ++ "."
                ++ if null alternatives then "" else
                   "\nPerhaps you meant " ++ intercalate ";\nor "
                   [ "the " ++ thing ++ " '" ++ intercalate "' or '" alts ++ "'?"
                   | (thing, alts) <- alternatives ]
              | (inside, nosuch') <- groupByContainer nosuch
              , let alternatives =
                      [ (thing, alts)
                      | (thing,_got,alts@(_:_)) <- nosuch' ]
              ]
            | (target, nosuch) <- targets
            , let groupByContainer =
                      map (\g@((inside,_,_,_):_) ->
                              (inside, [   (thing,got,alts)
                                       | (_,thing,got,alts) <- g ]))
                    . groupBy ((==)    `on` (\(x,_,_,_) -> x))
                    . sortBy  (compare `on` (\(x,_,_,_) -> x))
            ]
          where
            mungeThing "file" = "file target"
            mungeThing thing  = thing
  
      case [ (t, ts) | TargetSelectorAmbiguous t ts <- problems ] of
        []      -> return ()
        targets ->
          die' verbosity $ unlines
            [    "Ambiguous target '" ++ showTargetString target
              ++ "'. It could be:\n "
              ++ unlines [ "   "++ showTargetString ut ++
                           " (" ++ showTargetSelectorKind bt ++ ")"
                         | (ut, bt) <- amb ]
            | (target, amb) <- targets ]
  
      case [ t | TargetSelectorNoCurrentPackage t <- problems ] of
        []       -> return ()
        target:_ ->
          die' verbosity $
              "The target '" ++ showTargetString target ++ "' refers to the "
           ++ "components in the package in the current directory, but there "
           ++ "is no package in the current directory (or at least not listed "
           ++ "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 <- problems ] of
        []  -> return ()
        _:_ ->
          die' verbosity $
              "No targets given and there is no package in the current "
           ++ "directory. Use the target 'all' for all packages in the "
           ++ "project or specify packages or components by name or location. "
           ++ "See 'etlas build --help' for more details on target options."
  
      case [ () | TargetSelectorNoTargetsInProject <- problems ] of
        []  -> return ()
        _:_ ->
          die' verbosity $
              "There is no etlas.dhall, <pkgname>.etlas, <pkgname>.cabal package file or cabal.project file. "
           ++ "To build packages locally you need at minimum an etlas.dhall, <pkgname>.etlas or <pkgname>.cabal "
           ++ "file. You can use 'etlas init' to create one.\n"
           ++ "\n"
           ++ "For non-trivial projects you will also want a cabal.project "
           ++ "file in the root directory of your project. This file lists the "
           ++ "packages in your project and all other build configuration. "
           ++ "See the Etlas user guide for full details."
  
      fail "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 ambiguous unambiguous syntax = go
    where
      go (Syntax ql match render)    = syntax ql match render
      go (AmbiguousAlternatives a b) = ambiguous   (go a) (go b)
      go (ShadowingAlternatives a b) = unambiguous (go a) (go b)
  
  
  ----------------------------------
  -- Top level renderer and matcher
  --
  
  renderTargetSelector :: QualLevel -> TargetSelector
                       -> [TargetStringFileStatus]
  renderTargetSelector ql ts =
      foldSyntax
        (++) (++)
        (\ql' _ render -> guard (ql == ql') >> render ts)
        syntax
    where
      syntax = syntaxForms emptyKnownTargets
                           -- don't need known targets for rendering
  
  matchTargetSelector :: KnownTargets
                      -> TargetStringFileStatus
                      -> Match TargetSelector
  matchTargetSelector knowntargets = \usertarget ->
      nubMatchesBy (==) $
  
      let ql = targetQualLevel usertarget in
      foldSyntax
        (<|>) (<//>)
        (\ql' match _ -> guard (ql == ql') >> match usertarget)
        syntax
    where
      syntax = syntaxForms knowntargets
  
      targetQualLevel TargetStringFileStatus1{} = QL1
      targetQualLevel TargetStringFileStatus2{} = QL2
      targetQualLevel TargetStringFileStatus3{} = QL3
      targetQualLevel TargetStringFileStatus4{} = QLFull
      targetQualLevel TargetStringFileStatus5{} = QLFull
      targetQualLevel TargetStringFileStatus7{} = QLFull
  
  
  ----------------------------------
  -- Syntax forms
  --
  
  -- | All the forms of syntax for 'TargetSelector'.
  --
  syntaxForms :: KnownTargets -> Syntax
  syntaxForms KnownTargets {
                knownPackagesAll       = pinfo,
                knownPackagesPrimary   = ppinfo,
                knownComponentsAll     = cinfo,
                knownComponentsPrimary = pcinfo,
                knownComponentsOther   = 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".
  
      ambiguousAlternatives
          -- convenient single-component forms
        [ shadowingAlternatives
            [ ambiguousAlternatives
                [ syntaxForm1All
                , syntaxForm1Filter        ppinfo
                , shadowingAlternatives
                    [ syntaxForm1Component pcinfo
                    , syntaxForm1Package   pinfo
                    ]
                ]
            , syntaxForm1Component ocinfo
            , syntaxForm1Module    cinfo
            , syntaxForm1File      pinfo
            ]
  
          -- two-component partially qualified forms
          -- fully qualified form for 'all'
        , syntaxForm2MetaAll
        , syntaxForm2AllFilter
        , syntaxForm2NamespacePackage pinfo
        , syntaxForm2PackageComponent pinfo
        , syntaxForm2PackageFilter    pinfo
        , syntaxForm2KindComponent    cinfo
        , shadowingAlternatives
            [ syntaxForm2PackageModule   pinfo
            , syntaxForm2PackageFile     pinfo
            ]
        , shadowingAlternatives
            [ syntaxForm2ComponentModule cinfo
            , syntaxForm2ComponentFile   cinfo
            ]
  
          -- rarely used partially qualified forms
        , syntaxForm3PackageKindComponent   pinfo
        , shadowingAlternatives
            [ syntaxForm3PackageComponentModule pinfo
            , syntaxForm3PackageComponentFile   pinfo
            ]
        , shadowingAlternatives
            [ syntaxForm3KindComponentModule    cinfo
            , syntaxForm3KindComponentFile      cinfo
            ]
        , syntaxForm3NamespacePackageFilter pinfo
  
          -- fully-qualified forms for all and cwd with filter
        , syntaxForm3MetaAllFilter
        , syntaxForm3MetaCwdFilter ppinfo
  
          -- fully-qualified form for package and package with filter
        , syntaxForm3MetaNamespacePackage       pinfo
        , syntaxForm4MetaNamespacePackageFilter pinfo
  
          -- fully-qualified forms for component, module and file
        , syntaxForm5MetaNamespacePackageKindComponent                pinfo
        , syntaxForm7MetaNamespacePackageKindComponentNamespaceModule pinfo
        , syntaxForm7MetaNamespacePackageKindComponentNamespaceFile   pinfo
        ]
    where
      ambiguousAlternatives = foldr1 AmbiguousAlternatives
      shadowingAlternatives = foldr1 ShadowingAlternatives
  
  
  -- | Syntax: "all" to select all packages in the project
  --
  -- > etlas build all
  --
  syntaxForm1All :: Syntax
  syntaxForm1All =
    syntaxForm1 render $ \str1 _fstatus1 -> do
      guardMetaAll str1
      return (TargetAllPackages Nothing)
    where
      render (TargetAllPackages Nothing) =
        [TargetStringFileStatus1 "all" noFileStatus]
      render _ = []
  
  -- | Syntax: filter
  --
  -- > etlas build tests
  --
  syntaxForm1Filter :: [KnownPackage] -> Syntax
  syntaxForm1Filter ps =
    syntaxForm1 render $ \str1 _fstatus1 -> do
      kfilter <- matchComponentKindFilter str1
      return (TargetPackage TargetImplicitCwd pids (Just kfilter))
    where
      pids = [ pinfoId | KnownPackage{pinfoId} <- ps ]
      render (TargetPackage TargetImplicitCwd _ (Just kfilter)) =
        [TargetStringFileStatus1 (dispF kfilter) noFileStatus]
      render _ = []
  
  
  -- | Syntax: package (name, dir or file)
  --
  -- > etlas build foo
  -- > etlas build ../bar ../bar/bar.cabal
  --
  syntaxForm1Package :: [KnownPackage] -> Syntax
  syntaxForm1Package pinfo =
    syntaxForm1 render $ \str1 fstatus1 -> do
      guardPackage            str1 fstatus1
      p <- matchPackage pinfo str1 fstatus1
      case p of
        KnownPackage{pinfoId} ->
          return (TargetPackage TargetExplicitNamed [pinfoId] Nothing)
        KnownPackageName pn ->
          return (TargetPackageNamed pn Nothing)
    where
      render (TargetPackage TargetExplicitNamed [p] Nothing) =
        [TargetStringFileStatus1 (dispP p) noFileStatus]
      render (TargetPackageNamed pn Nothing) =
        [TargetStringFileStatus1 (dispPN pn) noFileStatus]
      render _ = []
  
  -- | Syntax: component
  --
  -- > etlas build foo
  --
  syntaxForm1Component :: [KnownComponent] -> Syntax
  syntaxForm1Component cs =
    syntaxForm1 render $ \str1 _fstatus1 -> do
      guardComponentName str1
      c <- matchComponentName cs str1
      return (TargetComponent (cinfoPackageId c) (cinfoName c) WholeComponent)
    where
      render (TargetComponent p c WholeComponent) =
        [TargetStringFileStatus1 (dispC p c) noFileStatus]
      render _ = []
  
  -- | Syntax: module
  --
  -- > etlas build Data.Foo
  --
  syntaxForm1Module :: [KnownComponent] -> Syntax
  syntaxForm1Module cs =
    syntaxForm1 render $  \str1 _fstatus1 -> do
      guardModuleName str1
      let ms = [ (m,c) | c <- cs, m <- cinfoModules c ]
      (m,c) <- matchModuleNameAnd ms str1
      return (TargetComponent (cinfoPackageId c) (cinfoName c) (ModuleTarget m))
    where
      render (TargetComponent _p _c (ModuleTarget m)) =
        [TargetStringFileStatus1 (dispM m) noFileStatus]
      render _ = []
  
  -- | Syntax: file name
  --
  -- > etlas build Data/Foo.hs bar/Main.hsc
  --
  syntaxForm1File :: [KnownPackage] -> Syntax
  syntaxForm1File 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.
    syntaxForm1 render $ \str1 fstatus1 ->
      expecting "file" str1 $ do
      (pkgfile, ~KnownPackage{pinfoId, pinfoComponents})
        -- always returns the KnownPackage case
        <- matchPackageDirectoryPrefix ps fstatus1
      orNoThingIn "package" (display (packageName pinfoId)) $ do
        (filepath, c) <- matchComponentFile pinfoComponents pkgfile
        return (TargetComponent pinfoId (cinfoName c) (FileTarget filepath))
    where
      render (TargetComponent _p _c (FileTarget f)) =
        [TargetStringFileStatus1 f noFileStatus]
      render _ = []
  
  ---
  
  -- | Syntax:  :all
  --
  -- > etlas build :all
  --
  syntaxForm2MetaAll :: Syntax
  syntaxForm2MetaAll =
    syntaxForm2 render $ \str1 _fstatus1 str2 -> do
      guardNamespaceMeta str1
      guardMetaAll str2
      return (TargetAllPackages Nothing)
    where
      render (TargetAllPackages Nothing) =
        [TargetStringFileStatus2 "" noFileStatus "all"]
      render _ = []
  
  -- | Syntax:  all : filer
  --
  -- > etlas build all:tests
  --
  syntaxForm2AllFilter :: Syntax
  syntaxForm2AllFilter =
    syntaxForm2 render $ \str1 _fstatus1 str2 -> do
      guardMetaAll str1
      kfilter <- matchComponentKindFilter str2
      return (TargetAllPackages (Just kfilter))
    where
      render (TargetAllPackages (Just kfilter)) =
        [TargetStringFileStatus2 "all" noFileStatus (dispF kfilter)]
      render _ = []
  
  -- | Syntax:  package : filer
  --
  -- > etlas build foo:tests
  --
  syntaxForm2PackageFilter :: [KnownPackage] -> Syntax
  syntaxForm2PackageFilter ps =
    syntaxForm2 render $ \str1 fstatus1 str2 -> do
      guardPackage         str1 fstatus1
      p <- matchPackage ps str1 fstatus1
      kfilter <- matchComponentKindFilter str2
      case p of
        KnownPackage{pinfoId} ->
          return (TargetPackage TargetExplicitNamed [pinfoId] (Just kfilter))
        KnownPackageName pn ->
          return (TargetPackageNamed pn (Just kfilter))
    where
      render (TargetPackage TargetExplicitNamed [p] (Just kfilter)) =
        [TargetStringFileStatus2 (dispP p) noFileStatus (dispF kfilter)]
      render (TargetPackageNamed pn (Just kfilter)) =
        [TargetStringFileStatus2 (dispPN pn) noFileStatus (dispF kfilter)]
      render _ = []
  
  -- | Syntax: pkg : package name
  --
  -- > etlas build pkg:foo
  --
  syntaxForm2NamespacePackage :: [KnownPackage] -> Syntax
  syntaxForm2NamespacePackage pinfo =
    syntaxForm2 render $ \str1 _fstatus1 str2 -> do
      guardNamespacePackage   str1
      guardPackageName        str2
      p <- matchPackage pinfo str2 noFileStatus
      case p of
        KnownPackage{pinfoId} ->
          return (TargetPackage TargetExplicitNamed [pinfoId] Nothing)
        KnownPackageName pn ->
          return (TargetPackageNamed pn Nothing)
    where
      render (TargetPackage TargetExplicitNamed [p] Nothing) =
        [TargetStringFileStatus2 "pkg" noFileStatus (dispP p)]
      render (TargetPackageNamed pn Nothing) =
        [TargetStringFileStatus2 "pkg" noFileStatus (dispPN pn)]
      render _ = []
  
  -- | Syntax: package : component
  --
  -- > etlas build foo:foo
  -- > etlas build ./foo:foo
  -- > etlas build ./foo.cabal:foo
  --
  syntaxForm2PackageComponent :: [KnownPackage] -> Syntax
  syntaxForm2PackageComponent ps =
    syntaxForm2 render $ \str1 fstatus1 str2 -> do
      guardPackage         str1 fstatus1
      guardComponentName   str2
      p <- matchPackage ps str1 fstatus1
      case p of
        KnownPackage{pinfoId, pinfoComponents} ->
          orNoThingIn "package" (display (packageName pinfoId)) $ do
            c <- matchComponentName pinfoComponents str2
            return (TargetComponent pinfoId (cinfoName c) WholeComponent)
          --TODO: the error here ought to say there's no component by that name in
          -- this package, and name the package
        KnownPackageName pn ->
          let cn = mkUnqualComponentName str2 in
          return (TargetComponentUnknown pn (Left cn) WholeComponent)
    where
      render (TargetComponent p c WholeComponent) =
        [TargetStringFileStatus2 (dispP p) noFileStatus (dispC p c)]
      render (TargetComponentUnknown pn (Left cn) WholeComponent) =
        [TargetStringFileStatus2 (dispPN pn) noFileStatus (display cn)]
      render _ = []
  
  -- | Syntax: namespace : component
  --
  -- > etlas build lib:foo exe:foo
  --
  syntaxForm2KindComponent :: [KnownComponent] -> Syntax
  syntaxForm2KindComponent cs =
    syntaxForm2 render $ \str1 _fstatus1 str2 -> do
      ckind <- matchComponentKind str1
      guardComponentName str2
      c <- matchComponentKindAndName cs ckind str2
      return (TargetComponent (cinfoPackageId c) (cinfoName c) WholeComponent)
    where
      render (TargetComponent p c WholeComponent) =
        [TargetStringFileStatus2 (dispCK c) noFileStatus (dispC p c)]
      render _ = []
  
  -- | Syntax: package : module
  --
  -- > etlas build foo:Data.Foo
  -- > etlas build ./foo:Data.Foo
  -- > etlas build ./foo.cabal:Data.Foo
  --
  syntaxForm2PackageModule :: [KnownPackage] -> Syntax
  syntaxForm2PackageModule ps =
    syntaxForm2 render $ \str1 fstatus1 str2 -> do
      guardPackage         str1 fstatus1
      guardModuleName      str2
      p <- matchPackage ps str1 fstatus1
      case p of
        KnownPackage{pinfoId, pinfoComponents} ->
          orNoThingIn "package" (display (packageName pinfoId)) $ do
            let ms = [ (m,c) | c <- pinfoComponents, m <- cinfoModules c ]
            (m,c) <- matchModuleNameAnd ms str2
            return (TargetComponent pinfoId (cinfoName c) (ModuleTarget m))
        KnownPackageName pn -> do
          m <- matchModuleNameUnknown str2
          -- We assume the primary library component of the package:
          return (TargetComponentUnknown pn (Right CLibName) (ModuleTarget m))
    where
      render (TargetComponent p _c (ModuleTarget m)) =
        [TargetStringFileStatus2 (dispP p) noFileStatus (dispM m)]
      render _ = []
  
  -- | Syntax: component : module
  --
  -- > etlas build foo:Data.Foo
  --
  syntaxForm2ComponentModule :: [KnownComponent] -> Syntax
  syntaxForm2ComponentModule cs =
    syntaxForm2 render $ \str1 _fstatus1 str2 -> do
      guardComponentName str1
      guardModuleName    str2
      c <- matchComponentName cs str1
      orNoThingIn "component" (cinfoStrName c) $ do
        let ms = cinfoModules c
        m <- matchModuleName ms str2
        return (TargetComponent (cinfoPackageId c) (cinfoName c)
                                (ModuleTarget m))
    where
      render (TargetComponent p c (ModuleTarget m)) =
        [TargetStringFileStatus2 (dispC p c) noFileStatus (dispM m)]
      render _ = []
  
  -- | Syntax: package : filename
  --
  -- > etlas build foo:Data/Foo.hs
  -- > etlas build ./foo:Data/Foo.hs
  -- > etlas build ./foo.cabal:Data/Foo.hs
  --
  syntaxForm2PackageFile :: [KnownPackage] -> Syntax
  syntaxForm2PackageFile ps =
    syntaxForm2 render $ \str1 fstatus1 str2 -> do
      guardPackage         str1 fstatus1
      p <- matchPackage ps str1 fstatus1
      case p of
        KnownPackage{pinfoId, pinfoComponents} ->
          orNoThingIn "package" (display (packageName pinfoId)) $ do
            (filepath, c) <- matchComponentFile pinfoComponents str2
            return (TargetComponent pinfoId (cinfoName c) (FileTarget filepath))
        KnownPackageName pn ->
          let filepath = str2 in
          -- We assume the primary library component of the package:
          return (TargetComponentUnknown pn (Right CLibName) (FileTarget filepath))
    where
      render (TargetComponent p _c (FileTarget f)) =
        [TargetStringFileStatus2 (dispP p) noFileStatus f]
      render _ = []
  
  -- | Syntax: component : filename
  --
  -- > etlas build foo:Data/Foo.hs
  --
  syntaxForm2ComponentFile :: [KnownComponent] -> Syntax
  syntaxForm2ComponentFile cs =
    syntaxForm2 render $ \str1 _fstatus1 str2 -> do
      guardComponentName str1
      c <- matchComponentName cs str1
      orNoThingIn "component" (cinfoStrName c) $ do
        (filepath, _) <- matchComponentFile [c] str2
        return (TargetComponent (cinfoPackageId c) (cinfoName c)
                                (FileTarget filepath))
    where
      render (TargetComponent p c (FileTarget f)) =
        [TargetStringFileStatus2 (dispC p c) noFileStatus f]
      render _ = []
  
  ---
  
  -- | Syntax: :all : filter
  --
  -- > etlas build :all:tests
  --
  syntaxForm3MetaAllFilter :: Syntax
  syntaxForm3MetaAllFilter =
    syntaxForm3 render $ \str1 _fstatus1 str2 str3 -> do
      guardNamespaceMeta str1
      guardMetaAll str2
      kfilter <- matchComponentKindFilter str3
      return (TargetAllPackages (Just kfilter))
    where
      render (TargetAllPackages (Just kfilter)) =
        [TargetStringFileStatus3 "" noFileStatus "all" (dispF kfilter)]
      render _ = []
  
  syntaxForm3MetaCwdFilter :: [KnownPackage] -> Syntax
  syntaxForm3MetaCwdFilter ps =
    syntaxForm3 render $ \str1 _fstatus1 str2 str3 -> do
      guardNamespaceMeta str1
      guardNamespaceCwd str2
      kfilter <- matchComponentKindFilter str3
      return (TargetPackage TargetImplicitCwd pids (Just kfilter))
    where
      pids = [ pinfoId | KnownPackage{pinfoId} <- ps ]
      render (TargetPackage TargetImplicitCwd _ (Just kfilter)) =
        [TargetStringFileStatus3 "" noFileStatus "cwd" (dispF kfilter)]
      render _ = []
  
  -- | Syntax: :pkg : package name
  --
  -- > etlas build :pkg:foo
  --
  syntaxForm3MetaNamespacePackage :: [KnownPackage] -> Syntax
  syntaxForm3MetaNamespacePackage pinfo =
    syntaxForm3 render $ \str1 _fstatus1 str2 str3 -> do
      guardNamespaceMeta      str1
      guardNamespacePackage   str2
      guardPackageName        str3
      p <- matchPackage pinfo str3 noFileStatus
      case p of
        KnownPackage{pinfoId} ->
          return (TargetPackage TargetExplicitNamed [pinfoId] Nothing)
        KnownPackageName pn ->
          return (TargetPackageNamed pn Nothing)
    where
      render (TargetPackage TargetExplicitNamed [p] Nothing) =
        [TargetStringFileStatus3 "" noFileStatus "pkg" (dispP p)]
      render (TargetPackageNamed pn Nothing) =
        [TargetStringFileStatus3 "" noFileStatus "pkg" (dispPN pn)]
      render _ = []
  
  -- | Syntax: package : namespace : component
  --
  -- > etlas build foo:lib:foo
  -- > etlas build foo/:lib:foo
  -- > etlas build foo.cabal:lib:foo
  --
  syntaxForm3PackageKindComponent :: [KnownPackage] -> Syntax
  syntaxForm3PackageKindComponent ps =
    syntaxForm3 render $ \str1 fstatus1 str2 str3 -> do
      guardPackage         str1 fstatus1
      ckind <- matchComponentKind str2
      guardComponentName   str3
      p <- matchPackage ps str1 fstatus1
      case p of
        KnownPackage{pinfoId, pinfoComponents} ->
          orNoThingIn "package" (display (packageName pinfoId)) $ do
            c <- matchComponentKindAndName pinfoComponents ckind str3
            return (TargetComponent pinfoId (cinfoName c) WholeComponent)
        KnownPackageName pn ->
          let cn = mkComponentName pn ckind (mkUnqualComponentName str3) in
          return (TargetComponentUnknown pn (Right cn) WholeComponent)
    where
      render (TargetComponent p c WholeComponent) =
        [TargetStringFileStatus3 (dispP p) noFileStatus (dispCK c) (dispC p c)]
      render (TargetComponentUnknown pn (Right c) WholeComponent) =
        [TargetStringFileStatus3 (dispPN pn) noFileStatus (dispCK c) (dispC' pn c)]
      render _ = []
  
  -- | Syntax: package : component : module
  --
  -- > etlas build foo:foo:Data.Foo
  -- > etlas build foo/:foo:Data.Foo
  -- > etlas build foo.cabal:foo:Data.Foo
  --
  syntaxForm3PackageComponentModule :: [KnownPackage] -> Syntax
  syntaxForm3PackageComponentModule ps =
    syntaxForm3 render $ \str1 fstatus1 str2 str3 -> do
      guardPackage str1 fstatus1
      guardComponentName str2
      guardModuleName    str3
      p <- matchPackage ps str1 fstatus1
      case p of
        KnownPackage{pinfoId, pinfoComponents} ->
          orNoThingIn "package" (display (packageName pinfoId)) $ do
            c <- matchComponentName pinfoComponents str2
            orNoThingIn "component" (cinfoStrName c) $ do
              let ms = cinfoModules c
              m <- matchModuleName ms str3
              return (TargetComponent pinfoId (cinfoName c) (ModuleTarget m))
        KnownPackageName pn -> do
          let cn = mkUnqualComponentName  str2
          m     <- matchModuleNameUnknown str3
          return (TargetComponentUnknown pn (Left cn) (ModuleTarget m))
    where
      render (TargetComponent p c (ModuleTarget m)) =
        [TargetStringFileStatus3 (dispP p) noFileStatus (dispC p c) (dispM m)]
      render (TargetComponentUnknown pn (Left c) (ModuleTarget m)) =
        [TargetStringFileStatus3 (dispPN pn) noFileStatus (dispCN c) (dispM m)]
      render _ = []
  
  -- | Syntax: namespace : component : module
  --
  -- > etlas build lib:foo:Data.Foo
  --
  syntaxForm3KindComponentModule :: [KnownComponent] -> Syntax
  syntaxForm3KindComponentModule cs =
    syntaxForm3 render $ \str1 _fstatus1 str2 str3 -> do
      ckind <- matchComponentKind str1
      guardComponentName str2
      guardModuleName    str3
      c <- matchComponentKindAndName cs ckind str2
      orNoThingIn "component" (cinfoStrName c) $ do
        let ms = cinfoModules c
        m <- matchModuleName ms str3
        return (TargetComponent (cinfoPackageId c) (cinfoName c)
                                (ModuleTarget m))
    where
      render (TargetComponent p c (ModuleTarget m)) =
        [TargetStringFileStatus3 (dispCK c) noFileStatus (dispC p c) (dispM m)]
      render _ = []
  
  -- | Syntax: package : component : filename
  --
  -- > etlas build foo:foo:Data/Foo.hs
  -- > etlas build foo/:foo:Data/Foo.hs
  -- > etlas build foo.cabal:foo:Data/Foo.hs
  --
  syntaxForm3PackageComponentFile :: [KnownPackage] -> Syntax
  syntaxForm3PackageComponentFile ps =
    syntaxForm3 render $ \str1 fstatus1 str2 str3 -> do
      guardPackage         str1 fstatus1
      guardComponentName   str2
      p <- matchPackage ps str1 fstatus1
      case p of
        KnownPackage{pinfoId, pinfoComponents} ->
          orNoThingIn "package" (display (packageName pinfoId)) $ do
            c <- matchComponentName pinfoComponents str2
            orNoThingIn "component" (cinfoStrName c) $ do
              (filepath, _) <- matchComponentFile [c] str3
              return (TargetComponent pinfoId (cinfoName c) (FileTarget filepath))
        KnownPackageName pn ->
          let cn = mkUnqualComponentName str2
              filepath = str3 in
          return (TargetComponentUnknown pn (Left cn) (FileTarget filepath))
    where
      render (TargetComponent p c (FileTarget f)) =
        [TargetStringFileStatus3 (dispP p) noFileStatus (dispC p c) f]
      render (TargetComponentUnknown pn (Left c) (FileTarget f)) =
        [TargetStringFileStatus3 (dispPN pn) noFileStatus (dispCN c) f]
      render _ = []
  
  -- | Syntax: namespace : component : filename
  --
  -- > etlas build lib:foo:Data/Foo.hs
  --
  syntaxForm3KindComponentFile :: [KnownComponent] -> Syntax
  syntaxForm3KindComponentFile cs =
    syntaxForm3 render $ \str1 _fstatus1 str2 str3 -> do
      ckind <- matchComponentKind str1
      guardComponentName str2
      c <- matchComponentKindAndName cs ckind str2
      orNoThingIn "component" (cinfoStrName c) $ do
        (filepath, _) <- matchComponentFile [c] str3
        return (TargetComponent (cinfoPackageId c) (cinfoName c)
                                (FileTarget filepath))
    where
      render (TargetComponent p c (FileTarget f)) =
        [TargetStringFileStatus3 (dispCK c) noFileStatus (dispC p c) f]
      render _ = []
  
  syntaxForm3NamespacePackageFilter :: [KnownPackage] -> Syntax
  syntaxForm3NamespacePackageFilter ps =
    syntaxForm3 render $ \str1 _fstatus1 str2 str3 -> do
      guardNamespacePackage str1
      guardPackageName      str2
      p <- matchPackage  ps str2 noFileStatus
      kfilter <- matchComponentKindFilter str3
      case p of
        KnownPackage{pinfoId} ->
          return (TargetPackage TargetExplicitNamed [pinfoId] (Just kfilter))
        KnownPackageName pn ->
          return (TargetPackageNamed pn (Just kfilter))
    where
      render (TargetPackage TargetExplicitNamed [p] (Just kfilter)) =
        [TargetStringFileStatus3 "pkg" noFileStatus (dispP p) (dispF kfilter)]
      render (TargetPackageNamed pn (Just kfilter)) =
        [TargetStringFileStatus3 "pkg" noFileStatus (dispPN pn) (dispF kfilter)]
      render _ = []
  
  --
  
  syntaxForm4MetaNamespacePackageFilter :: [KnownPackage] -> Syntax
  syntaxForm4MetaNamespacePackageFilter ps =
    syntaxForm4 render $ \str1 str2 str3 str4 -> do
      guardNamespaceMeta    str1
      guardNamespacePackage str2
      guardPackageName      str3
      p <- matchPackage  ps str3 noFileStatus
      kfilter <- matchComponentKindFilter str4
      case p of
        KnownPackage{pinfoId} ->
          return (TargetPackage TargetExplicitNamed [pinfoId] (Just kfilter))
        KnownPackageName pn ->
          return (TargetPackageNamed pn (Just kfilter))
    where
      render (TargetPackage TargetExplicitNamed [p] (Just kfilter)) =
        [TargetStringFileStatus4 "" "pkg" (dispP p) (dispF kfilter)]
      render (TargetPackageNamed pn (Just kfilter)) =
        [TargetStringFileStatus4 "" "pkg" (dispPN pn) (dispF kfilter)]
      render _ = []
  
  -- | Syntax: :pkg : package : namespace : component
  --
  -- > etlas build :pkg:foo:lib:foo
  --
  syntaxForm5MetaNamespacePackageKindComponent :: [KnownPackage] -> Syntax
  syntaxForm5MetaNamespacePackageKindComponent ps =
    syntaxForm5 render $ \str1 str2 str3 str4 str5 -> do
      guardNamespaceMeta    str1
      guardNamespacePackage str2
      guardPackageName      str3
      ckind <- matchComponentKind str4
      guardComponentName    str5
      p <- matchPackage  ps str3 noFileStatus
      case p of
        KnownPackage{pinfoId, pinfoComponents} ->
          orNoThingIn "package" (display (packageName pinfoId)) $ do
            c <- matchComponentKindAndName pinfoComponents ckind str5
            return (TargetComponent pinfoId (cinfoName c) WholeComponent)
        KnownPackageName pn ->
          let cn = mkComponentName pn ckind (mkUnqualComponentName str5) in
          return (TargetComponentUnknown pn (Right cn) WholeComponent)
    where
      render (TargetComponent p c WholeComponent) =
        [TargetStringFileStatus5 "" "pkg" (dispP p) (dispCK c) (dispC p c)]
      render (TargetComponentUnknown pn (Right c) WholeComponent) =
        [TargetStringFileStatus5 "" "pkg" (dispPN pn) (dispCK c) (dispC' pn c)]
      render _ = []
  
  -- | Syntax: :pkg : package : namespace : component : module : module
  --
  -- > etlas build :pkg:foo:lib:foo:module:Data.Foo
  --
  syntaxForm7MetaNamespacePackageKindComponentNamespaceModule
    :: [KnownPackage] -> Syntax
  syntaxForm7MetaNamespacePackageKindComponentNamespaceModule ps =
    syntaxForm7 render $ \str1 str2 str3 str4 str5 str6 str7 -> do
      guardNamespaceMeta    str1
      guardNamespacePackage str2
      guardPackageName      str3
      ckind <- matchComponentKind str4
      guardComponentName    str5
      guardNamespaceModule  str6
      p <- matchPackage  ps str3 noFileStatus
      case p of
        KnownPackage{pinfoId, pinfoComponents} ->
          orNoThingIn "package" (display (packageName pinfoId)) $ do
            c <- matchComponentKindAndName pinfoComponents ckind str5
            orNoThingIn "component" (cinfoStrName c) $ do
              let ms = cinfoModules c
              m <- matchModuleName ms str7
              return (TargetComponent pinfoId (cinfoName c) (ModuleTarget m))
        KnownPackageName pn -> do
          let cn = mkComponentName pn ckind (mkUnqualComponentName str2)
          m <- matchModuleNameUnknown str7
          return (TargetComponentUnknown pn (Right cn) (ModuleTarget m))
    where
      render (TargetComponent p c (ModuleTarget m)) =
        [TargetStringFileStatus7 "" "pkg" (dispP p)
                                 (dispCK c) (dispC p c)
                                 "module" (dispM m)]
      render (TargetComponentUnknown pn (Right c) (ModuleTarget m)) =
        [TargetStringFileStatus7 "" "pkg" (dispPN pn)
                                 (dispCK c) (dispC' pn c)
                                 "module" (dispM m)]
      render _ = []
  
  -- | Syntax: :pkg : package : namespace : component : file : filename
  --
  -- > etlas build :pkg:foo:lib:foo:file:Data/Foo.hs
  --
  syntaxForm7MetaNamespacePackageKindComponentNamespaceFile
    :: [KnownPackage] -> Syntax
  syntaxForm7MetaNamespacePackageKindComponentNamespaceFile ps =
    syntaxForm7 render $ \str1 str2 str3 str4 str5 str6 str7 -> do
      guardNamespaceMeta    str1
      guardNamespacePackage str2
      guardPackageName      str3
      ckind <- matchComponentKind str4
      guardComponentName    str5
      guardNamespaceFile    str6
      p <- matchPackage  ps str3 noFileStatus
      case p of
        KnownPackage{pinfoId, pinfoComponents} ->
          orNoThingIn "package" (display (packageName pinfoId)) $ do
            c <- matchComponentKindAndName pinfoComponents ckind str5
            orNoThingIn "component" (cinfoStrName c) $ do
              (filepath,_) <- matchComponentFile [c] str7
              return (TargetComponent pinfoId (cinfoName c) (FileTarget filepath))
        KnownPackageName pn ->
          let cn       = mkComponentName pn ckind (mkUnqualComponentName str5)
              filepath = str7 in
          return (TargetComponentUnknown pn (Right cn) (FileTarget filepath))
    where
      render (TargetComponent p c (FileTarget f)) =
        [TargetStringFileStatus7 "" "pkg" (dispP p)
                                 (dispCK c) (dispC p c)
                                 "file" f]
      render (TargetComponentUnknown pn (Right c) (FileTarget f)) =
        [TargetStringFileStatus7 "" "pkg" (dispPN pn)
                                 (dispCK c) (dispC' pn c)
                                 "file" f]
      render _ = []
  
  
  ---------------------------------------
  -- 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 render f =
      Syntax QL1 match render
    where
      match = \(TargetStringFileStatus1 str1 fstatus1) ->
                f str1 fstatus1
  
  syntaxForm2 render f =
      Syntax QL2 match render
    where
      match = \(TargetStringFileStatus2 str1 fstatus1 str2) ->
                f str1 fstatus1 str2
  
  syntaxForm3 render f =
      Syntax QL3 match render
    where
      match = \(TargetStringFileStatus3 str1 fstatus1 str2 str3) ->
                f str1 fstatus1 str2 str3
  
  syntaxForm4 render f =
      Syntax QLFull match render
    where
      match (TargetStringFileStatus4 str1 str2 str3 str4)
              = f str1 str2 str3 str4
      match _ = mzero
  
  syntaxForm5 render f =
      Syntax QLFull match render
    where
      match (TargetStringFileStatus5 str1 str2 str3 str4 str5)
              = f str1 str2 str3 str4 str5
      match _ = mzero
  
  syntaxForm7 render f =
      Syntax QLFull match render
    where
      match (TargetStringFileStatus7 str1 str2 str3 str4 str5 str6 str7)
              = f str1 str2 str3 str4 str5 str6 str7
      match _ = mzero
  
  dispP :: Package p => p -> String
  dispP = display . packageName
  
  dispPN :: PackageName -> String
  dispPN = display
  
  dispC :: PackageId -> ComponentName -> String
  dispC = componentStringName . packageName
  
  dispC' :: PackageName -> ComponentName -> String
  dispC' = componentStringName
  
  dispCN :: UnqualComponentName -> String
  dispCN = display
  
  dispK :: ComponentKind -> String
  dispK = showComponentKindShort
  
  dispCK :: ComponentName -> String
  dispCK = dispK . componentKind
  
  dispF :: ComponentKind -> String
  dispF = showComponentKindFilterShort
  
  dispM :: ModuleName -> String
  dispM = display
  
  
  -------------------------------
  -- Package and component info
  --
  
  data KnownTargets = KnownTargets {
         knownPackagesAll       :: [KnownPackage],
         knownPackagesPrimary   :: [KnownPackage],
         knownPackagesOther     :: [KnownPackage],
         knownComponentsAll     :: [KnownComponent],
         knownComponentsPrimary :: [KnownComponent],
         knownComponentsOther   :: [KnownComponent]
       }
    deriving Show
  
  data KnownPackage =
       KnownPackage {
         pinfoId          :: PackageId,
         pinfoDirectory   :: Maybe (FilePath, FilePath),
         pinfoPackageFile :: Maybe (FilePath, FilePath),
         pinfoComponents  :: [KnownComponent]
       }
     | KnownPackageName {
         pinfoName        :: PackageName
       }
    deriving Show
  
  data KnownComponent = KnownComponent {
         cinfoName      :: ComponentName,
         cinfoStrName   :: ComponentStringName,
         cinfoPackageId :: PackageId,
         cinfoSrcDirs   :: [FilePath],
         cinfoModules   :: [ModuleName],
         cinfoHsFiles   :: [FilePath],   -- other hs files (like main.hs)
         cinfoCFiles    :: [FilePath],
         cinfoJsFiles   :: [FilePath]
       }
    deriving Show
  
  type ComponentStringName = String
  
  knownPackageName :: KnownPackage -> PackageName
  knownPackageName KnownPackage{pinfoId}       = packageName pinfoId
  knownPackageName KnownPackageName{pinfoName} = pinfoName
  
  emptyKnownTargets :: KnownTargets
  emptyKnownTargets = KnownTargets [] [] [] [] [] []
  
  getKnownTargets :: (Applicative m, Monad m)
                  => DirActions m
                  -> [PackageSpecifier (SourcePackage (PackageLocation a))]
                  -> m KnownTargets
  getKnownTargets dirActions@DirActions{..} pkgs = do
      pinfo <- mapM (collectKnownPackageInfo dirActions) pkgs
      cwd   <- getCurrentDirectory
      let (ppinfo, opinfo) = selectPrimaryPackage cwd pinfo
      return KnownTargets {
        knownPackagesAll       = pinfo,
        knownPackagesPrimary   = ppinfo,
        knownPackagesOther     = opinfo,
        knownComponentsAll     = allComponentsIn pinfo,
        knownComponentsPrimary = allComponentsIn ppinfo,
        knownComponentsOther   = allComponentsIn opinfo
      }
    where
      selectPrimaryPackage :: FilePath
                           -> [KnownPackage]
                           -> ([KnownPackage], [KnownPackage])
      selectPrimaryPackage cwd = partition isPkgDirCwd
        where
          isPkgDirCwd KnownPackage { pinfoDirectory = Just (dir,_) }
            | dir == cwd = True
          isPkgDirCwd _  = False
      allComponentsIn ps =
        [ c | KnownPackage{pinfoComponents} <- ps, c <- pinfoComponents ]
  
  
  collectKnownPackageInfo :: (Applicative m, Monad m) => DirActions m
                          -> PackageSpecifier (SourcePackage (PackageLocation a))
                          -> m KnownPackage
  collectKnownPackageInfo _ (NamedPackage pkgname _props) =
      return (KnownPackageName pkgname)
  collectKnownPackageInfo dirActions@DirActions{..}
                    (SpecificSourcePackage SourcePackage {
                      packageDescription = pkg,
                      packageSource      = loc
                    }) = do
      (pkgdir, pkgfile) <-
        case loc of
          --TODO: local tarballs, remote tarballs etc
          LocalUnpackedPackage dir -> do
            dirabs <- canonicalizePath dir
            dirrel <- makeRelativeToCwd dirActions dirabs
            --TODO: ought to get this earlier in project reading
            let fileAbsRel ext = ( dirabs </> display (packageName pkg) <.> ext
                                 , dirrel </> display (packageName pkg) <.> ext
                                 )
                etlasDhallAbsRel = ( dirabs </> "etlas.dhall"
                                   , dirrel </> "etlas.dhall"
                                   )
                configFiles = [ etlasDhallAbsRel
                              , fileAbsRel "etlas"
                              , fileAbsRel "cabal"
                              ]
            knownCfgFiles <- filterM ( doesFileExist . fst ) configFiles 
            return ( Just (dirabs, dirrel) , listToMaybe knownCfgFiles )
          _ -> return (Nothing, Nothing)
      let pinfo =
            KnownPackage {
              pinfoId          = packageId pkg,
              pinfoDirectory   = pkgdir,
              pinfoPackageFile = pkgfile,
              pinfoComponents  = collectKnownComponentInfo
                                   (flattenPackageDescription pkg)
            }
      return pinfo
  
  
  collectKnownComponentInfo :: PackageDescription -> [KnownComponent]
  collectKnownComponentInfo pkg =
      [ KnownComponent {
          cinfoName      = componentName c,
          cinfoStrName   = componentStringName (packageName pkg) (componentName c),
          cinfoPackageId = packageId pkg,
          cinfoSrcDirs   = ordNub (hsSourceDirs bi),
          cinfoModules   = ordNub (componentModules c),
          cinfoHsFiles   = ordNub (componentHsFiles c),
          cinfoCFiles    = ordNub (cSources bi),
          cinfoJsFiles   = ordNub (jsSources bi)
        }
      | c <- pkgComponents pkg
      , let bi = componentBuildInfo c ]
  
  
  componentStringName :: PackageName -> ComponentName -> ComponentStringName
  componentStringName pkgname CLibName    = display pkgname
  componentStringName _ (CSubLibName name) = unUnqualComponentName name
  componentStringName _ (CFLibName name)  = unUnqualComponentName name
  componentStringName _ (CExeName   name) = unUnqualComponentName name
  componentStringName _ (CTestName  name) = unUnqualComponentName name
  componentStringName _ (CBenchName name) = unUnqualComponentName name
  
  componentModules :: Component -> [ModuleName]
  -- I think it's unlikely users will ask to build a requirement
  -- which is not mentioned locally.
  componentModules (CLib   lib)   = explicitLibModules lib
  componentModules (CFLib  flib)  = foreignLibModules flib
  componentModules (CExe   exe)   = exeModules exe
  componentModules (CTest  test)  = testModules test
  componentModules (CBench bench) = benchmarkModules bench
  
  componentHsFiles :: Component -> [FilePath]
  componentHsFiles (CExe exe) = [modulePath exe]
  componentHsFiles (CTest  TestSuite {
                             testInterface = TestSuiteExeV10 _ mainfile
                           }) = [mainfile]
  componentHsFiles (CBench Benchmark {
                             benchmarkInterface = BenchmarkExeV10 _ mainfile
                           }) = [mainfile]
  componentHsFiles _          = []
  
  
  ------------------------------
  -- Matching meta targets
  --
  
  guardNamespaceMeta :: String -> Match ()
  guardNamespaceMeta = guardToken [""] "meta namespace"
  
  guardMetaAll :: String -> Match ()
  guardMetaAll = guardToken ["all"] "meta-target 'all'"
  
  guardNamespacePackage :: String -> Match ()
  guardNamespacePackage = guardToken ["pkg", "package"] "'pkg' namespace"
  
  guardNamespaceCwd :: String -> Match ()
  guardNamespaceCwd = guardToken ["cwd"] "'cwd' namespace"
  
  guardNamespaceModule :: String -> Match ()
  guardNamespaceModule = guardToken ["mod", "module"] "'module' namespace"
  
  guardNamespaceFile :: String -> Match ()
  guardNamespaceFile = guardToken ["file"] "'file' namespace"
  
  guardToken :: [String] -> String -> String -> Match ()
  guardToken tokens msg s
    | caseFold s `elem` tokens = increaseConfidence
    | otherwise                = matchErrorExpected msg s
  
  
  ------------------------------
  -- Matching component kinds
  --
  
  componentKind :: ComponentName -> ComponentKind
  componentKind  CLibName      = LibKind
  componentKind (CSubLibName _) = LibKind
  componentKind (CFLibName _)  = FLibKind
  componentKind (CExeName   _) = ExeKind
  componentKind (CTestName  _) = TestKind
  componentKind (CBenchName _) = BenchKind
  
  cinfoKind :: KnownComponent -> ComponentKind
  cinfoKind = componentKind . cinfoName
  
  matchComponentKind :: String -> Match ComponentKind
  matchComponentKind s
    | s' `elem` liblabels   = increaseConfidence >> return LibKind
    | s' `elem` fliblabels  = increaseConfidence >> return FLibKind
    | s' `elem` exelabels   = increaseConfidence >> return ExeKind
    | s' `elem` testlabels  = increaseConfidence >> return TestKind
    | s' `elem` benchlabels = increaseConfidence >> return BenchKind
    | otherwise             = matchErrorExpected "component kind" s
    where
      s'         = caseFold s
      liblabels   = ["lib", "library"]
      fliblabels  = ["flib", "foreign-library"]
      exelabels   = ["exe", "executable"]
      testlabels  = ["tst", "test", "test-suite"]
      benchlabels = ["bench", "benchmark"]
  
  matchComponentKindFilter :: String -> Match ComponentKind
  matchComponentKindFilter s
    | s' `elem` liblabels   = increaseConfidence >> return LibKind
    | s' `elem` fliblabels  = increaseConfidence >> return FLibKind
    | s' `elem` exelabels   = increaseConfidence >> return ExeKind
    | s' `elem` testlabels  = increaseConfidence >> return TestKind
    | s' `elem` benchlabels = increaseConfidence >> return BenchKind
    | otherwise             = matchErrorExpected "component kind filter" s
    where
      s'          = caseFold s
      liblabels   = ["libs", "libraries"]
      fliblabels  = ["flibs", "foreign-libraries"]
      exelabels   = ["exes", "executables"]
      testlabels  = ["tests", "test-suites"]
      benchlabels = ["benches", "benchmarks"]
  
  showComponentKind :: ComponentKind -> String
  showComponentKind LibKind   = "library"
  showComponentKind FLibKind  = "foreign library"
  showComponentKind ExeKind   = "executable"
  showComponentKind TestKind  = "test-suite"
  showComponentKind BenchKind = "benchmark"
  
  showComponentKindShort :: ComponentKind -> String
  showComponentKindShort LibKind   = "lib"
  showComponentKindShort FLibKind  = "flib"
  showComponentKindShort ExeKind   = "exe"
  showComponentKindShort TestKind  = "test"
  showComponentKindShort BenchKind = "bench"
  
  showComponentKindFilterShort :: ComponentKind -> String
  showComponentKindFilterShort LibKind   = "libs"
  showComponentKindFilterShort FLibKind  = "flibs"
  showComponentKindFilterShort ExeKind   = "exes"
  showComponentKindFilterShort TestKind  = "tests"
  showComponentKindFilterShort BenchKind = "benchmarks"
  
  
  ------------------------------
  -- Matching package targets
  --
  
  guardPackage :: String -> FileStatus -> Match ()
  guardPackage str fstatus =
        guardPackageName str
    <|> guardPackageDir  str fstatus
    <|> guardPackageFile str fstatus
  
  
  guardPackageName :: String -> Match ()
  guardPackageName s
    | validPackageName s = increaseConfidence
    | otherwise          = matchErrorExpected "package name" s
  
  validPackageName :: String -> Bool
  validPackageName s =
         all validPackageNameChar s
      && not (null s)
    where
      validPackageNameChar c = isAlphaNum c || c == '-'
  
  
  guardPackageDir :: String -> FileStatus -> Match ()
  guardPackageDir _ (FileStatusExistsDir _) = increaseConfidence
  guardPackageDir str _ = matchErrorExpected "package directory" str
  
  
  guardPackageFile :: String -> FileStatus -> Match ()
  guardPackageFile _ (FileStatusExistsFile file)
                         | takeExtension file == ".cabal"
                         = increaseConfidence
  guardPackageFile str _ = matchErrorExpected "package .cabal file" str
  
  
  matchPackage :: [KnownPackage] -> String -> FileStatus -> Match KnownPackage
  matchPackage pinfo = \str fstatus ->
      orNoThingIn "project" "" $
            matchPackageName pinfo str
      <//> (matchPackageNameUnknown str
       <|>  matchPackageDir  pinfo str fstatus
       <|>  matchPackageFile pinfo str fstatus)
  
  
  matchPackageName :: [KnownPackage] -> String -> Match KnownPackage
  matchPackageName ps = \str -> do
      guard (validPackageName str)
      orNoSuchThing "package" str
                    (map (display . knownPackageName) ps) $
        increaseConfidenceFor $
          matchInexactly caseFold (display . knownPackageName) ps str
  
  
  matchPackageNameUnknown :: String -> Match KnownPackage
  matchPackageNameUnknown str = do
      pn <- matchParse str
      unknownMatch (KnownPackageName pn)
  
  
  matchPackageDir :: [KnownPackage]
                  -> String -> FileStatus -> Match KnownPackage
  matchPackageDir ps = \str fstatus ->
      case fstatus of
        FileStatusExistsDir canondir ->
          orNoSuchThing "package directory" str (map (snd . fst) dirs) $
            increaseConfidenceFor $
              fmap snd $ matchExactly (fst . fst) dirs canondir
        _ -> mzero
    where
      dirs = [ ((dabs,drel),p)
             | p@KnownPackage{ pinfoDirectory = Just (dabs,drel) } <- ps ]
  
  
  matchPackageFile :: [KnownPackage] -> String -> FileStatus -> Match KnownPackage
  matchPackageFile ps = \str fstatus -> do
      case fstatus of
        FileStatusExistsFile canonfile ->
          orNoSuchThing "package .cabal file" str (map (snd . fst) files) $
            increaseConfidenceFor $
              fmap snd $ matchExactly (fst . fst) files canonfile
        _ -> mzero
    where
      files = [ ((fabs,frel),p)
              | p@KnownPackage{ pinfoPackageFile = Just (fabs,frel) } <- 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 s
    | all validComponentChar s
      && not (null s)  = increaseConfidence
    | otherwise        = matchErrorExpected "component name" s
    where
      validComponentChar c = isAlphaNum c || c == '.'
                          || c == '_' || c == '-' || c == '\''
  
  
  matchComponentName :: [KnownComponent] -> String -> Match KnownComponent
  matchComponentName cs str =
      orNoSuchThing "component" str (map cinfoStrName cs)
    $ increaseConfidenceFor
    $ matchInexactly caseFold cinfoStrName cs str
  
  
  matchComponentKindAndName :: [KnownComponent] -> ComponentKind -> String
                            -> Match KnownComponent
  matchComponentKindAndName cs ckind str =
      orNoSuchThing (showComponentKind ckind ++ " component") str
                    (map render cs)
    $ increaseConfidenceFor
    $ matchInexactly (\(ck, cn) -> (ck, caseFold cn))
                     (\c -> (cinfoKind c, cinfoStrName c))
                     cs
                     (ckind, str)
    where
      render c = showComponentKindShort (cinfoKind c) ++ ":" ++ cinfoStrName c
  
  
  ------------------------------
  -- Matching module targets
  --
  
  guardModuleName :: String -> Match ()
  guardModuleName s =
    case simpleParse s :: Maybe ModuleName of
      Just _                   -> increaseConfidence
      _ | all validModuleChar s
          && not (null s)      -> return ()
        | otherwise            -> matchErrorExpected "module name" s
      where
        validModuleChar c = isAlphaNum c || c == '.' || c == '_' || c == '\''
  
  
  matchModuleName :: [ModuleName] -> String -> Match ModuleName
  matchModuleName ms str =
      orNoSuchThing "module" str (map display ms)
    $ increaseConfidenceFor
    $ matchInexactly caseFold display ms str
  
  
  matchModuleNameAnd :: [(ModuleName, a)] -> String -> Match (ModuleName, a)
  matchModuleNameAnd ms str =
      orNoSuchThing "module" str (map (display . fst) ms)
    $ increaseConfidenceFor
    $ matchInexactly caseFold (display . fst) ms str
  
  
  matchModuleNameUnknown :: String -> Match ModuleName
  matchModuleNameUnknown str =
      expecting "module" str
    $ increaseConfidenceFor
    $ matchParse str
  
  
  ------------------------------
  -- Matching file targets
  --
  
  matchPackageDirectoryPrefix :: [KnownPackage] -> FileStatus
                              -> Match (FilePath, KnownPackage)
  matchPackageDirectoryPrefix ps (FileStatusExistsFile filepath) =
      increaseConfidenceFor $
        matchDirectoryPrefix pkgdirs filepath
    where
      pkgdirs = [ (dir, p)
                | p@KnownPackage { pinfoDirectory = Just (dir,_) } <- ps ]
  matchPackageDirectoryPrefix _ _ = mzero
  
  
  matchComponentFile :: [KnownComponent] -> String
                     -> Match (FilePath, KnownComponent)
  matchComponentFile cs str =
      orNoSuchThing "file" str [] $
          matchComponentModuleFile cs str
      <|> matchComponentOtherFile  cs str
  
  
  matchComponentOtherFile :: [KnownComponent] -> String
                          -> Match (FilePath, KnownComponent)
  matchComponentOtherFile cs =
      matchFile
        [ (file, c)
        | c    <- cs
        , file <- cinfoHsFiles c
               ++ cinfoCFiles  c
               ++ cinfoJsFiles c
        ]
  
  
  matchComponentModuleFile :: [KnownComponent] -> String
                           -> Match (FilePath, KnownComponent)
  matchComponentModuleFile cs str = do
      matchFile
        [ (normalise (d </> toFilePath m), c)
        | c <- cs
        , d <- cinfoSrcDirs c
        , m <- cinfoModules c
        ]
        (dropExtension (normalise str))
  
  -- utils
  
  matchFile :: [(FilePath, a)] -> FilePath -> Match (FilePath, a)
  matchFile fs =
        increaseConfidenceFor
      . matchInexactly caseFold fst fs
  
  matchDirectoryPrefix :: [(FilePath, a)] -> FilePath -> Match (FilePath, a)
  matchDirectoryPrefix dirs filepath =
      tryEach $
        [ (file, x)
        | (dir,x) <- dirs
        , file <- maybeToList (stripDirectory dir) ]
    where
      stripDirectory :: FilePath -> Maybe FilePath
      stripDirectory dir =
        joinPath `fmap` stripPrefix (splitDirectories dir) filepathsplit
  
      filepathsplit = splitDirectories 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 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 (Show, Eq, 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 (Show, Eq)
  
  
  instance Functor Match where
      fmap _ (NoMatch      d ms) = NoMatch      d ms
      fmap f (Match m d xs) = Match m d (fmap f xs)
  
  instance Applicative Match where
      pure a = Match Exact 0 [a]
      (<*>)  = ap
  
  instance Alternative Match where
      empty = NoMatch 0 []
      (<|>) = matchPlus
  
  instance Monad Match where
      return             = pure
      NoMatch d ms >>= _ = NoMatch d ms
      Match m d xs >>= f =
        -- To understand this, it needs to be read in context with the
        -- implementation of 'matchPlus' below
        case msum (map f xs) of
          Match m' d' xs' -> Match (min m m') (d + d') xs'
          -- The minimum match class is the one we keep. The match depth is
          -- tracked but not used in the Match case.
  
          NoMatch  d' ms  -> NoMatch          (d + d') 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 = empty
      mplus = matchPlus
  
  (<//>) :: 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 a@(Match _ _ _ )   (NoMatch _ _) = a
  matchPlus   (NoMatch _ _ ) b@(Match _ _ _) = b
  matchPlus a@(NoMatch d_a ms_a) b@(NoMatch d_b ms_b)
    | d_a > d_b = a  -- We only really make use of the depth in the NoMatch case.
    | d_a < d_b = b
    | otherwise = NoMatch d_a (ms_a ++ ms_b)
  matchPlus a@(Match m_a d_a xs_a) b@(Match m_b d_b xs_b)
    | m_a > m_b = a  -- exact over inexact
    | m_a < m_b = b  -- exact over inexact
    | otherwise = Match m_a (max d_a d_b) (xs_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 a@(Match Exact _ _) _ = a
  matchPlusShadowing a                   b = matchPlus a b
  
  
  ------------------------------
  -- Various match primitives
  --
  
  matchErrorExpected :: String -> String -> Match a
  matchErrorExpected thing got      = NoMatch 0 [MatchErrorExpected thing got]
  
  matchErrorNoSuch :: String -> String -> [String] -> Match a
  matchErrorNoSuch thing got alts = NoMatch 0 [MatchErrorNoSuch thing got alts]
  
  expecting :: String -> String -> Match a -> Match a
  expecting thing got (NoMatch 0 _) = matchErrorExpected thing got
  expecting _     _   m             = m
  
  orNoSuchThing :: String -> String -> [String] -> Match a -> Match a
  orNoSuchThing thing got alts (NoMatch 0 _) = matchErrorNoSuch thing got alts
  orNoSuchThing _     _   _    m             = m
  
  orNoThingIn :: String -> String -> Match a -> Match a
  orNoThingIn kind name (NoMatch n ms) =
      NoMatch n [ MatchErrorIn kind name m | m <- ms ]
  orNoThingIn _ _ m = m
  
  increaseConfidence :: Match ()
  increaseConfidence = Match Exact 1 [()]
  
  increaseConfidenceFor :: Match a -> Match a
  increaseConfidenceFor m = m >>= \r -> increaseConfidence >> return r
  
  nubMatchesBy :: (a -> a -> Bool) -> Match a -> Match a
  nubMatchesBy _  (NoMatch      d msgs) = NoMatch      d msgs
  nubMatchesBy eq (Match m d xs)   = Match m d (nubBy eq xs)
  
  -- | Lift a list of matches to an exact match.
  --
  exactMatches, inexactMatches :: [a] -> Match a
  
  exactMatches [] = mzero
  exactMatches xs = Match Exact 0 xs
  
  inexactMatches [] = mzero
  inexactMatches xs = Match Inexact 0 xs
  
  unknownMatch :: a -> Match a
  unknownMatch x = Match Unknown 0 [x]
  
  tryEach :: [a] -> Match a
  tryEach = 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 match = case match of
    NoMatch    _ msgs  -> None msgs
    Match _ _  [x] -> Unambiguous x
    Match m d   [] -> error $ "findMatch: impossible: " ++ show match'
                        where match' = Match m d [] :: Match ()
                      -- TODO: Maybe use Data.List.NonEmpty inside
                      -- Match so that this case would be correct
                      -- by construction?
    Match m _   xs -> Ambiguous m xs
  
  data MaybeAmbiguous a = None [MatchError]
                        | Unambiguous a
                        | Ambiguous MatchClass [a]
    deriving 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 key xs =
      \k -> case Map.lookup k m of
              Nothing -> mzero
              Just ys -> exactMatches ys
    where
      m = Map.fromListWith (++) [ (key x, [x]) | x <- xs ]
  
  -- | A primitive matcher that looks up a value in a finite 'Map'. It checks
  -- for an exact or inexact match. We get an inexact match if the match
  -- is not exact, but the canonical forms match. It takes a canonicalisation
  -- function for this purpose.
  --
  -- So for example if we used string case fold as the canonicalisation
  -- function, then we would get case insensitive matching (but it will still
  -- report an exact match when the case matches too).
  --
  matchInexactly :: (Ord k, Ord k') => (k -> k') -> (a -> k)
                 -> [a] -> (k -> Match a)
  matchInexactly cannonicalise key xs =
      \k -> case Map.lookup k m of
              Just ys -> exactMatches ys
              Nothing -> case Map.lookup (cannonicalise k) m' of
                           Just ys -> inexactMatches ys
                           Nothing -> mzero
    where
      m = Map.fromListWith (++) [ (key x, [x]) | x <- xs ]
  
      -- the map of canonicalised keys to groups of inexact matches
      m' = Map.mapKeysWith (++) cannonicalise m
  
  matchParse :: Text a => String -> Match a
  matchParse = maybe mzero return . simpleParse
  
  
  ------------------------------
  -- Utils
  --
  
  caseFold :: String -> String
  caseFold = 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 pkgname ckind ucname =
    case ckind of
      LibKind
        | packageNameToUnqualComponentName pkgname == ucname
                    -> CLibName
        | otherwise -> CSubLibName ucname
      FLibKind      -> CFLibName   ucname
      ExeKind       -> CExeName    ucname
      TestKind      -> CTestName   ucname
      BenchKind     -> CBenchName  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"
  -}
  