content: {-# LANGUAGE NoImplicitPrelude     #-}
  {-# LANGUAGE DuplicateRecordFields #-}
  {-# LANGUAGE NoFieldSelectors      #-}
  {-# LANGUAGE OverloadedRecordDot   #-}
  {-# LANGUAGE OverloadedStrings     #-}
  
  {-|
  Module      : Stack.Types.Package
  License     : BSD-3-Clause
  -}
  
  module Stack.Types.Package
    ( BioInput (..)
    , BuildInfoOpts (..)
    , ExeName (..)
    , InstallLocation (..)
    , Installed (..)
    , InstalledLibraryInfo (..)
    , InstalledPackageLocation (..)
    , LocalPackage (..)
    , MemoizedWith (..)
    , Package (..)
    , PackageConfig (..)
    , PackageDatabase (..)
    , PackageDbVariety (..)
    , PackageException (..)
    , PackageSource (..)
    , dotCabalCFilePath
    , dotCabalGetPath
    , dotCabalMain
    , dotCabalMainPath
    , dotCabalModule
    , dotCabalModulePath
    , installedMapGhcPkgId
    , installedPackageToGhcPkgId
    , lpFiles
    , lpFilesForComponents
    , memoizeRefWith
    , packageDefinedFlags
    , packageIdentifier
    , psVersion
    , runMemoizedWith
    , simpleInstalledLib
    , toCabalMungedPackageName
    , toPackageDbVariety
    ) where
  
  import qualified Data.Map as M
  import qualified Data.Set as Set
  import           Distribution.CabalSpecVersion
  import           Distribution.Parsec ( PError (..), PWarning (..), showPos )
  import qualified Distribution.SPDX.License as SPDX
  import           Distribution.License ( License )
  import           Distribution.ModuleName ( ModuleName )
  import           Distribution.PackageDescription ( BuildType )
  import           Distribution.System ( Platform (..) )
  import           Distribution.Types.MungedPackageName
                     ( encodeCompatPackageName )
  import qualified RIO.Text as T
  import           Stack.Prelude
  import           Stack.Types.Cache ( FileCache )
  import           Stack.Types.CompCollection ( CompCollection )
  import           Stack.Types.Compiler ( ActualCompiler )
  import           Stack.Types.Component
                     ( StackBenchmark, StackBuildInfo, StackExecutable
                     , StackForeignLibrary, StackLibrary, StackTestSuite
                     , StackUnqualCompName
                     )
  import           Stack.Types.ComponentUtils (toCabalName)
  import           Stack.Types.Dependency ( DepValue )
  import           Stack.Types.EnvConfig ( EnvConfig, HasEnvConfig (..) )
  import           Stack.Types.GhcPkgId ( GhcPkgId )
  import           Stack.Types.Installed
                     ( InstallLocation (..), InstallMap, Installed (..)
                     , InstalledLibraryInfo (..), InstalledMap
                     , InstalledPackageLocation (..), PackageDatabase (..)
                     , PackageDbVariety(..), simpleInstalledLib
                     , toPackageDbVariety
                     )
  import           Stack.Types.NamedComponent ( NamedComponent )
  import           Stack.Types.PackageFile
                     ( DotCabalDescriptor (..), DotCabalPath (..)
                     , StackPackageFile
                     )
  import           Stack.Types.SourceMap ( CommonPackage, FromSnapshot )
  
  -- | Type representing exceptions thrown by functions exported by the
  -- "Stack.Package" module.
  data PackageException
    = PackageInvalidCabalFile
        !(Either PackageIdentifierRevision (Path Abs File))
        !(Maybe Version)
        ![PError]
        ![PWarning]
    | MismatchedCabalIdentifier !PackageIdentifierRevision !PackageIdentifier
    | CabalFileNameParseFail FilePath
    | CabalFileNameInvalidPackageName FilePath
    | ComponentNotParsedBug String
    deriving Show
  
  instance Exception PackageException where
    displayException (PackageInvalidCabalFile loc _mversion errs warnings) = concat
      [ "Error: [S-8072]\n"
      , "Unable to parse Cabal file "
      , case loc of
          Left pir -> "for " ++ T.unpack (utf8BuilderToText (display pir))
          Right fp -> toFilePath fp
      {-
       Not actually needed, the errors will indicate if a newer version exists.
       Also, it seems that this is set to Just the version even if we support it.
      , case mversion of
          Nothing -> ""
          Just version -> "\nRequires newer Cabal file parser version: " ++
                          versionString version
      -}
      , "\n\n"
      , unlines $ map
          (\(PError pos msg) -> concat
              [ "- "
              , showPos pos
              , ": "
              , msg
              ])
          errs
      , unlines $ map
          (\(PWarning _ pos msg) -> concat
              [ "- "
              , showPos pos
              , ": "
              , msg
              ])
          warnings
      ]
    displayException (MismatchedCabalIdentifier pir ident) = concat
      [ "Error: [S-5394]\n"
      , "Mismatched package identifier."
      , "\nFound:    "
      , packageIdentifierString ident
      , "\nExpected: "
      , T.unpack $ utf8BuilderToText $ display pir
      ]
    displayException (CabalFileNameParseFail fp) = concat
      [ "Error: [S-2203]\n"
      , "Invalid file path for Cabal file, must have a .cabal extension: "
      , fp
      ]
    displayException (CabalFileNameInvalidPackageName fp) = concat
      [ "Error: [S-8854]\n"
      , "Cabal file names must use valid package names followed by a .cabal \
        \extension, the following is invalid: "
      , fp
      ]
    displayException (ComponentNotParsedBug name) = bugReport "[S-4623]"
      (  "Component names should always parse as directory names. The component \
         \name without a directory is '"
      <> name
      <> "'."
      )
  
  -- | Name of an executable.
  newtype ExeName
    = ExeName { exeName :: Text }
    deriving (Data, Eq, Generic, Hashable, IsString, NFData, Ord, Show)
  
  -- | Some package info.
  data Package = Package
    { name :: !PackageName
      -- ^ Name of the package.
    , version :: !Version
      -- ^ Version of the package
    , license :: !(Either SPDX.License License)
      -- ^ The license the package was released under.
    , ghcOptions :: ![Text]
      -- ^ Ghc options used on package.
    , cabalConfigOpts :: ![Text]
      -- ^ Additional options passed to ./Setup.hs configure
    , flags :: !(Map FlagName Bool)
      -- ^ Flags used on package.
    , defaultFlags :: !(Map FlagName Bool)
      -- ^ Defaults for unspecified flags.
    , library :: !(Maybe StackLibrary)
      -- ^ Does the package have a buildable main library stanza?
    , subLibraries :: !(CompCollection StackLibrary)
      -- ^ The sub-libraries of the package.
    , foreignLibraries :: !(CompCollection StackForeignLibrary)
      -- ^ The foreign libraries of the package.
    , testSuites :: !(CompCollection StackTestSuite)
      -- ^ The test suites of the package.
    , benchmarks :: !(CompCollection StackBenchmark)
      -- ^ The benchmarks of the package.
    , executables :: !(CompCollection StackExecutable)
      -- ^ The executables of the package.
    , buildType :: !BuildType
      -- ^ Package build-type.
    , setupDeps :: !(Maybe (Map PackageName DepValue))
      -- ^ If present: custom-setup dependencies
    , cabalSpec :: !CabalSpecVersion
      -- ^ Cabal spec range
    , file :: StackPackageFile
      -- ^ The Cabal sourced files related to the package at the package level
      -- The components may have file information in their own types
    , testEnabled :: Bool
      -- ^ This is a requirement because when tests are not enabled, Stack's
      -- package dependencies should ignore test dependencies. Directly set from
      -- 'enableTests'.
    , benchmarkEnabled :: Bool
      -- ^ This is a requirement because when benchmark are not enabled, Stack's
      -- package dependencies should ignore benchmark dependencies. Directly set
      -- from 'enableBenchmarks'.
    }
    deriving Show
  
  packageIdentifier :: Package -> PackageIdentifier
  packageIdentifier p = PackageIdentifier p.name p.version
  
  packageDefinedFlags :: Package -> Set FlagName
  packageDefinedFlags = M.keysSet . (.defaultFlags)
  
  -- | GHC options based on cabal information and ghc-options.
  data BuildInfoOpts = BuildInfoOpts
    { opts :: [String]
    , oneWordOpts :: [String]
    , packageFlags :: [String]
      -- ^ These options can safely have 'nubOrd' applied to them, as there are no
      -- multi-word options (see
      -- https://github.com/commercialhaskell/stack/issues/1255)
    , cabalMacros :: Path Abs File
    }
    deriving Show
  
  -- | Package build configuration
  data PackageConfig = PackageConfig
    { enableTests :: !Bool
      -- ^ Are tests enabled?
    , enableBenchmarks :: !Bool
      -- ^ Are benchmarks enabled?
    , flags :: !(Map FlagName Bool)
      -- ^ Configured flags.
    , ghcOptions :: ![Text]
      -- ^ Configured ghc options.
    , cabalConfigOpts :: ![Text]
      -- ^ ./Setup.hs configure options
    , compilerVersion :: ActualCompiler
      -- ^ GHC version
    , platform :: !Platform
      -- ^ host platform
    }
   deriving Show
  
  -- | Compares the package name.
  instance Ord Package where
    compare = on compare (.name)
  
  -- | Compares the package name.
  instance Eq Package where
    (==) = on (==) (.name)
  
  -- | Where the package's source is located: local directory or package index
  data PackageSource
    = PSFilePath LocalPackage
      -- ^ Package which exist on the filesystem
    | PSRemote PackageLocationImmutable Version FromSnapshot CommonPackage
      -- ^ Package which is downloaded remotely.
  
  instance Show PackageSource where
    show (PSFilePath lp) = concat ["PSFilePath (", show lp, ")"]
    show (PSRemote pli v fromSnapshot _) =
      concat
        [ "PSRemote"
        , "(", show pli, ")"
        , "(", show v, ")"
        , show fromSnapshot
        , "<CommonPackage>"
        ]
  
  psVersion :: PackageSource -> Version
  psVersion (PSFilePath lp) = lp.package.version
  psVersion (PSRemote _ v _ _) = v
  
  -- | Information on a locally available package of source code.
  data LocalPackage = LocalPackage
    { package        :: !Package
       -- ^ The @Package@ info itself, after resolution with package flags, with
       -- tests and benchmarks disabled
    , components     :: !(Set NamedComponent)
      -- ^ Components to build, not including the library component.
    , unbuildable    :: !(Set NamedComponent)
      -- ^ Components explicitly requested for build, that are marked
      -- "buildable: false".
    , wanted         :: !Bool
      -- ^ Whether this package is wanted as a target.
  
      -- FIXME Should completely drop this "wanted" terminology, it's unclear.
    , testBench      :: !(Maybe Package)
      -- ^ This stores the t'Package' with tests and benchmarks enabled, if either
      -- is asked for by the user.
    , cabalFP        :: !(Path Abs File)
      -- ^ Absolute path to the Cabal file.
    , buildHaddocks  :: !Bool
      -- ^ Is Haddock documentation being built for this package?
    , forceDirty     :: !Bool
    , dirtyFiles     :: !(MemoizedWith EnvConfig (Maybe (Set FilePath)))
      -- ^ Nothing == not dirty, Just == dirty. Note that the Set may be empty if
      -- we forced the build to treat packages as dirty. Also, the Set may not
      -- include all modified files.
    , newBuildCaches :: !(MemoizedWith EnvConfig (Map NamedComponent FileCache))
      -- ^ Current state of the files.
    , componentFiles :: !( MemoizedWith
                             EnvConfig
                             (Map NamedComponent (Set (Path Abs File)))
                         )
      -- ^ All files used by this package.
    }
    deriving Show
  
  newtype MemoizedWith env a
    = MemoizedWith { memoizedWith :: RIO env a }
    deriving (Applicative, Functor, Monad)
  
  memoizeRefWith :: MonadIO m => RIO env a -> m (MemoizedWith env a)
  memoizeRefWith action = do
    ref <- newIORef Nothing
    pure $ MemoizedWith $ do
      res <- readIORef ref >>= \case
          Just res -> pure res
          Nothing -> do
            res <- tryAny action
            writeIORef ref $ Just res
            pure res
      either throwIO pure res
  
  runMemoizedWith ::
       (HasEnvConfig env, MonadReader env m, MonadIO m)
    => MemoizedWith EnvConfig a
    -> m a
  runMemoizedWith (MemoizedWith action) = do
    envConfig <- view envConfigL
    runRIO envConfig action
  
  instance Show (MemoizedWith env a) where
    show _ = "<<MemoizedWith>>"
  
  lpFiles :: HasEnvConfig env => LocalPackage -> RIO env (Set.Set (Path Abs File))
  lpFiles = runMemoizedWith . fmap (Set.unions . M.elems) . (.componentFiles)
  
  lpFilesForComponents ::
       HasEnvConfig env
    => Set NamedComponent
    -> LocalPackage
    -> RIO env (Set.Set (Path Abs File))
  lpFilesForComponents components lp = runMemoizedWith $ do
    componentFiles <- lp.componentFiles
    pure $ mconcat (M.elems (M.restrictKeys componentFiles components))
  
  -- | Maybe get the module name from the .cabal descriptor.
  dotCabalModule :: DotCabalDescriptor -> Maybe ModuleName
  dotCabalModule (DotCabalModule m) = Just m
  dotCabalModule _ = Nothing
  
  -- | Maybe get the main name from the .cabal descriptor.
  dotCabalMain :: DotCabalDescriptor -> Maybe FilePath
  dotCabalMain (DotCabalMain m) = Just m
  dotCabalMain _ = Nothing
  
  -- | Get the module path.
  dotCabalModulePath :: DotCabalPath -> Maybe (Path Abs File)
  dotCabalModulePath (DotCabalModulePath fp) = Just fp
  dotCabalModulePath _ = Nothing
  
  -- | Get the main path.
  dotCabalMainPath :: DotCabalPath -> Maybe (Path Abs File)
  dotCabalMainPath (DotCabalMainPath fp) = Just fp
  dotCabalMainPath _ = Nothing
  
  -- | Get the c file path.
  dotCabalCFilePath :: DotCabalPath -> Maybe (Path Abs File)
  dotCabalCFilePath (DotCabalCFilePath fp) = Just fp
  dotCabalCFilePath _ = Nothing
  
  -- | Get the path.
  dotCabalGetPath :: DotCabalPath -> Path Abs File
  dotCabalGetPath dcp =
    case dcp of
      DotCabalModulePath fp -> fp
      DotCabalMainPath fp -> fp
      DotCabalFilePath fp -> fp
      DotCabalCFilePath fp -> fp
  
  -- | Gathers all the GhcPkgId provided by a library into a map
  installedMapGhcPkgId ::
       PackageIdentifier
    -> InstalledLibraryInfo
    -> Map PackageIdentifier GhcPkgId
  installedMapGhcPkgId pkgId@(PackageIdentifier pkgName version) installedLib =
    finalMap
   where
    finalMap = M.insert pkgId installedLib.ghcPkgId baseMap
    baseMap =
      M.mapKeysMonotonic
        (toCabalMungedPackageIdentifier pkgName version)
        installedLib.subLib
  
  installedPackageToGhcPkgId ::
       PackageIdentifier
    -> Installed
    -> Map PackageIdentifier GhcPkgId
  installedPackageToGhcPkgId ident (Library ident' libInfo) =
    assert (ident == ident') (installedMapGhcPkgId ident libInfo)
  installedPackageToGhcPkgId _ (Executable _) = mempty
  
  -- | Creates a t'MungedPackageName' identifier.
  toCabalMungedPackageIdentifier ::
       PackageName
    -> Version
    -> StackUnqualCompName
    -> PackageIdentifier
  toCabalMungedPackageIdentifier pkgName version = flip PackageIdentifier version
    . encodeCompatPackageName . toCabalMungedPackageName pkgName
  
  toCabalMungedPackageName ::
       PackageName
    -> StackUnqualCompName
    -> MungedPackageName
  toCabalMungedPackageName pkgName =
    MungedPackageName pkgName . LSubLibName . toCabalName
  
  -- | Type representing inputs to 'Stack.Package.generateBuildInfoOpts'.
  data BioInput = BioInput
    { installMap :: !InstallMap
    , installedMap :: !InstalledMap
    , cabalDir :: !(Path Abs Dir)
    , distDir :: !(Path Abs Dir)
    , omitPackages :: ![PackageName]
    , addPackages :: ![PackageName]
    , buildInfo :: !StackBuildInfo
    , dotCabalPaths :: ![DotCabalPath]
    , configLibDirs :: ![FilePath]
    , configIncludeDirs :: ![FilePath]
    , componentName :: !NamedComponent
    , cabalVersion :: !Version
    }
  