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

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

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

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

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

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

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

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

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

import qualified Prelude (foldr1)

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

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

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

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

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

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

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

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

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

type ComponentKindFilter = ComponentKind

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

     -- | The component as a whole
     WholeComponent

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

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

instance Binary SubComponentTarget
instance Structured SubComponentTarget


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


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

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


data DirActions m = DirActions {
       DirActions m -> String -> m Bool
doesFileExist       :: FilePath -> m Bool,
       DirActions m -> String -> m Bool
doesDirectoryExist  :: FilePath -> m Bool,
       DirActions m -> String -> m String
canonicalizePath    :: FilePath -> m FilePath,
       DirActions m -> m String
getCurrentDirectory :: m FilePath
     }

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

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


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

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

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

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

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


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

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

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


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

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

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

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

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

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

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

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

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

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


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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            maxResults :: Int
maxResults = Int
3

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

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

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

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

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

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

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

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

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

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

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

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

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

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


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

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

    case [ (TargetString
t, TargetSelector
m, [(TargetString, [TargetSelector])]
ms) | MatchingInternalError TargetString
t TargetSelector
m [(TargetString, [TargetSelector])]
ms <- [TargetSelectorProblem]
problems ] of
      [] -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      ((TargetString
target, TargetSelector
originalMatch, [(TargetString, [TargetSelector])]
renderingsAndMatches):[(TargetString, TargetSelector,
  [(TargetString, [TargetSelector])])]
_) ->
        Verbosity -> String -> IO ()
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Internal error in target matching. It should always "
           String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"be possible to find a syntax that's sufficiently qualified to "
           String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"give an unambiguous match. However when matching '"
           String -> ShowS
forall a. [a] -> [a] -> [a]
++ TargetString -> String
showTargetString TargetString
target String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'  we found "
           String -> ShowS
forall a. [a] -> [a] -> [a]
++ TargetSelector -> String
showTargetSelector TargetSelector
originalMatch
           String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ TargetSelector -> String
showTargetSelectorKind TargetSelector
originalMatch String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") which does "
           String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"not have an unambiguous syntax. The possible syntax and the "
           String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"targets they match are as follows:\n"
           String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
unlines
                [ String
"'" String -> ShowS
forall a. [a] -> [a] -> [a]
++ TargetString -> String
showTargetString TargetString
rendering String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' which matches "
                  String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", "
                       [ TargetSelector -> String
showTargetSelector TargetSelector
match String -> ShowS
forall a. [a] -> [a] -> [a]
++
                         String
" (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ TargetSelector -> String
showTargetSelectorKind TargetSelector
match String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
                       | TargetSelector
match <- [TargetSelector]
matches ]
                | (TargetString
rendering, [TargetSelector]
matches) <- [(TargetString, [TargetSelector])]
renderingsAndMatches ]

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

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

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

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

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

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

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

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

    String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"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 :: (a -> a -> a)
-> (a -> a -> a)
-> (QualLevel
    -> (TargetStringFileStatus -> Match TargetSelector)
    -> (TargetSelector -> [TargetStringFileStatus])
    -> a)
-> Syntax
-> a
foldSyntax a -> a -> a
ambiguous a -> a -> a
unambiguous QualLevel
-> (TargetStringFileStatus -> Match TargetSelector)
-> (TargetSelector -> [TargetStringFileStatus])
-> a
syntax = Syntax -> a
go
  where
    go :: Syntax -> a
go (Syntax QualLevel
ql TargetStringFileStatus -> Match TargetSelector
match TargetSelector -> [TargetStringFileStatus]
render)    = QualLevel
-> (TargetStringFileStatus -> Match TargetSelector)
-> (TargetSelector -> [TargetStringFileStatus])
-> a
syntax QualLevel
ql TargetStringFileStatus -> Match TargetSelector
match TargetSelector -> [TargetStringFileStatus]
render
    go (AmbiguousAlternatives Syntax
a Syntax
b) = a -> a -> a
ambiguous   (Syntax -> a
go Syntax
a) (Syntax -> a
go Syntax
b)
    go (ShadowingAlternatives Syntax
a Syntax
b) = a -> a -> a
unambiguous (Syntax -> a
go Syntax
a) (Syntax -> a
go Syntax
b)


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

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

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

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

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


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

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

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

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

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

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

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

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


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

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


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

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

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

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

---

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

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

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

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

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

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

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

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

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

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

---

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

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

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

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

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

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

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

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

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

--

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

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

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

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


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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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


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

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

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

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

type ComponentStringName = String

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

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

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

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

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


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


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


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

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

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


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

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

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

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

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

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

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

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


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

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

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

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

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

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

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

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


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

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


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

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


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


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


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


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


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


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


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

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

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


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


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


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


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


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

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


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


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


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


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

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


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


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


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

-- utils

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


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

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

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


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

-- | A matcher embodies a way to match some input as being some recognised
-- value. In particular it deals with multiple and ambiguous matches.
--
-- There are various matcher primitives ('matchExactly', 'matchInexactly'),
-- ways to combine matchers ('matchPlus', 'matchPlusShadowing') and finally we
-- can run a matcher against an input using 'findMatch'.
--
data Match a = NoMatch           !Confidence [MatchError]
             | Match !MatchClass !Confidence [a]
  deriving Int -> Match a -> ShowS
[Match a] -> ShowS
Match a -> String
(Int -> Match a -> ShowS)
-> (Match a -> String) -> ([Match a] -> ShowS) -> Show (Match a)
forall a. Show a => Int -> Match a -> ShowS
forall a. Show a => [Match a] -> ShowS
forall a. Show a => Match a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Match a] -> ShowS
$cshowList :: forall a. Show a => [Match a] -> ShowS
show :: Match a -> String
$cshow :: forall a. Show a => Match a -> String
showsPrec :: Int -> Match a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Match a -> ShowS
Show

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

type Confidence = Int

data MatchError = MatchErrorExpected String String            -- thing got
                | MatchErrorNoSuch   String String [String]   -- thing got alts
                | MatchErrorIn       String String MatchError -- kind  thing
  deriving (Int -> MatchError -> ShowS
[MatchError] -> ShowS
MatchError -> String
(Int -> MatchError -> ShowS)
-> (MatchError -> String)
-> ([MatchError] -> ShowS)
-> Show MatchError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MatchError] -> ShowS
$cshowList :: [MatchError] -> ShowS
show :: MatchError -> String
$cshow :: MatchError -> String
showsPrec :: Int -> MatchError -> ShowS
$cshowsPrec :: Int -> MatchError -> ShowS
Show, MatchError -> MatchError -> Bool
(MatchError -> MatchError -> Bool)
-> (MatchError -> MatchError -> Bool) -> Eq MatchError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MatchError -> MatchError -> Bool
$c/= :: MatchError -> MatchError -> Bool
== :: MatchError -> MatchError -> Bool
$c== :: MatchError -> MatchError -> Bool
Eq)


instance Functor Match where
    fmap :: (a -> b) -> Match a -> Match b
fmap a -> b
_ (NoMatch Int
d [MatchError]
ms) = Int -> [MatchError] -> Match b
forall a. Int -> [MatchError] -> Match a
NoMatch Int
d [MatchError]
ms
    fmap a -> b
f (Match MatchClass
m Int
d [a]
xs) = MatchClass -> Int -> [b] -> Match b
forall a. MatchClass -> Int -> [a] -> Match a
Match MatchClass
m Int
d ((a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f [a]
xs)

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

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

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

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

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

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

infixl 3 <//>

-- | Combine two matchers. Exact matches are used over inexact matches
-- but if we have multiple exact, or inexact then the we collect all the
-- ambiguous matches.
--
-- This operator is associative, has unit 'mzero' and is also commutative.
--
matchPlus :: Match a -> Match a -> Match a
matchPlus :: Match a -> Match a -> Match a
matchPlus a :: Match a
a@(Match MatchClass
_ Int
_ [a]
_ )   (NoMatch Int
_ [MatchError]
_) = Match a
a
matchPlus   (NoMatch Int
_ [MatchError]
_ ) b :: Match a
b@(Match MatchClass
_ Int
_ [a]
_) = Match a
b
matchPlus a :: Match a
a@(NoMatch Int
d_a [MatchError]
ms_a) b :: Match a
b@(NoMatch Int
d_b [MatchError]
ms_b)
  | Int
d_a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
d_b = Match a
a  -- We only really make use of the depth in the NoMatch case.
  | Int
d_a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
d_b = Match a
b
  | Bool
otherwise = Int -> [MatchError] -> Match a
forall a. Int -> [MatchError] -> Match a
NoMatch Int
d_a ([MatchError]
ms_a [MatchError] -> [MatchError] -> [MatchError]
forall a. [a] -> [a] -> [a]
++ [MatchError]
ms_b)
matchPlus a :: Match a
a@(Match MatchClass
m_a Int
d_a [a]
xs_a) b :: Match a
b@(Match MatchClass
m_b Int
d_b [a]
xs_b)
  | MatchClass
m_a MatchClass -> MatchClass -> Bool
forall a. Ord a => a -> a -> Bool
> MatchClass
m_b = Match a
a  -- exact over inexact
  | MatchClass
m_a MatchClass -> MatchClass -> Bool
forall a. Ord a => a -> a -> Bool
< MatchClass
m_b = Match a
b  -- exact over inexact
  | Bool
otherwise = MatchClass -> Int -> [a] -> Match a
forall a. MatchClass -> Int -> [a] -> Match a
Match MatchClass
m_a (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
d_a Int
d_b) ([a]
xs_a [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
xs_b)

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


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

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

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

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

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

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

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

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

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

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

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

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

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

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


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

-- | Given a matcher and a key to look up, use the matcher to find all the
-- possible matches. There may be 'None', a single 'Unambiguous' match or
-- you may have an 'Ambiguous' match with several possibilities.
--
findMatch :: Match a -> MaybeAmbiguous a
findMatch :: Match a -> MaybeAmbiguous a
findMatch Match a
match = case Match a
match of
  NoMatch Int
_ [MatchError]
msgs -> [MatchError] -> MaybeAmbiguous a
forall a. [MatchError] -> MaybeAmbiguous a
None [MatchError]
msgs
  Match MatchClass
_ Int
_  [a
x] -> a -> MaybeAmbiguous a
forall a. a -> MaybeAmbiguous a
Unambiguous a
x
  Match MatchClass
m Int
d   [] -> String -> MaybeAmbiguous a
forall a. HasCallStack => String -> a
error (String -> MaybeAmbiguous a) -> String -> MaybeAmbiguous a
forall a b. (a -> b) -> a -> b
$ String
"findMatch: impossible: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Match () -> String
forall a. Show a => a -> String
show Match ()
match'
                      where match' :: Match ()
match' = MatchClass -> Int -> [()] -> Match ()
forall a. MatchClass -> Int -> [a] -> Match a
Match MatchClass
m Int
d [] :: Match ()
                    -- TODO: Maybe use Data.List.NonEmpty inside
                    -- Match so that this case would be correct
                    -- by construction?
  Match MatchClass
m Int
_   [a]
xs -> MatchClass -> [a] -> MaybeAmbiguous a
forall a. MatchClass -> [a] -> MaybeAmbiguous a
Ambiguous MatchClass
m [a]
xs

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


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

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

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

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

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


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

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

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


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

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

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

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

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