{-# LANGUAGE NoImplicitPrelude   #-}
{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE NoFieldSelectors    #-}
{-# LANGUAGE OverloadedRecordDot #-}

-- | The facility for retrieving all files from the main Stack

-- 'Stack.Types.Package' type. This was moved into its own module to allow

-- component-level file-gathering without circular dependency at the Package

-- level.

module Stack.Types.PackageFile
  ( GetPackageFileContext (..)
  , DotCabalPath (..)
  , DotCabalDescriptor (..)
  , PackageWarning (..)
  , StackPackageFile (..)
  , PackageComponentFile (..)
  ) where

import           Distribution.ModuleName ( ModuleName )
import           RIO.Process ( HasProcessContext (..) )
import           Stack.Prelude
import           Stack.Types.BuildConfig
                   ( BuildConfig (..), HasBuildConfig (..) )
import           Stack.Types.Config ( HasConfig (..) )
import           Stack.Types.GHCVariant ( HasGHCVariant (..) )
import           Stack.Types.NamedComponent ( NamedComponent )
import           Stack.Types.Platform ( HasPlatform (..) )
import           Stack.Types.Runner ( HasRunner (..) )

data GetPackageFileContext = GetPackageFileContext
  { GetPackageFileContext -> Path Abs File
file :: !(Path Abs File)
  , GetPackageFileContext -> Path Abs Dir
distDir :: !(Path Abs Dir)
  , GetPackageFileContext -> BuildConfig
buildConfig :: !BuildConfig
  , GetPackageFileContext -> Version
cabalVer :: !Version
  }

instance HasPlatform GetPackageFileContext where
  platformL :: Lens' GetPackageFileContext Platform
platformL = (Config -> f Config)
-> GetPackageFileContext -> f GetPackageFileContext
forall env. HasConfig env => Lens' env Config
Lens' GetPackageFileContext Config
configL ((Config -> f Config)
 -> GetPackageFileContext -> f GetPackageFileContext)
-> ((Platform -> f Platform) -> Config -> f Config)
-> (Platform -> f Platform)
-> GetPackageFileContext
-> f GetPackageFileContext
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Platform -> f Platform) -> Config -> f Config
forall env. HasPlatform env => Lens' env Platform
Lens' Config Platform
platformL
  {-# INLINE platformL #-}
  platformVariantL :: Lens' GetPackageFileContext PlatformVariant
platformVariantL = (Config -> f Config)
-> GetPackageFileContext -> f GetPackageFileContext
forall env. HasConfig env => Lens' env Config
Lens' GetPackageFileContext Config
configL ((Config -> f Config)
 -> GetPackageFileContext -> f GetPackageFileContext)
-> ((PlatformVariant -> f PlatformVariant) -> Config -> f Config)
-> (PlatformVariant -> f PlatformVariant)
-> GetPackageFileContext
-> f GetPackageFileContext
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PlatformVariant -> f PlatformVariant) -> Config -> f Config
forall env. HasPlatform env => Lens' env PlatformVariant
Lens' Config PlatformVariant
platformVariantL
  {-# INLINE platformVariantL #-}

instance HasGHCVariant GetPackageFileContext where
  ghcVariantL :: SimpleGetter GetPackageFileContext GHCVariant
ghcVariantL = (Config -> Const r Config)
-> GetPackageFileContext -> Const r GetPackageFileContext
forall env. HasConfig env => Lens' env Config
Lens' GetPackageFileContext Config
configL ((Config -> Const r Config)
 -> GetPackageFileContext -> Const r GetPackageFileContext)
-> ((GHCVariant -> Const r GHCVariant) -> Config -> Const r Config)
-> (GHCVariant -> Const r GHCVariant)
-> GetPackageFileContext
-> Const r GetPackageFileContext
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GHCVariant -> Const r GHCVariant) -> Config -> Const r Config
forall env. HasGHCVariant env => SimpleGetter env GHCVariant
SimpleGetter Config GHCVariant
ghcVariantL
  {-# INLINE ghcVariantL #-}

instance HasLogFunc GetPackageFileContext where
  logFuncL :: Lens' GetPackageFileContext LogFunc
logFuncL = (Config -> f Config)
-> GetPackageFileContext -> f GetPackageFileContext
forall env. HasConfig env => Lens' env Config
Lens' GetPackageFileContext Config
configL ((Config -> f Config)
 -> GetPackageFileContext -> f GetPackageFileContext)
-> ((LogFunc -> f LogFunc) -> Config -> f Config)
-> (LogFunc -> f LogFunc)
-> GetPackageFileContext
-> f GetPackageFileContext
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LogFunc -> f LogFunc) -> Config -> f Config
forall env. HasLogFunc env => Lens' env LogFunc
Lens' Config LogFunc
logFuncL

instance HasRunner GetPackageFileContext where
  runnerL :: Lens' GetPackageFileContext Runner
runnerL = (Config -> f Config)
-> GetPackageFileContext -> f GetPackageFileContext
forall env. HasConfig env => Lens' env Config
Lens' GetPackageFileContext Config
configL ((Config -> f Config)
 -> GetPackageFileContext -> f GetPackageFileContext)
-> ((Runner -> f Runner) -> Config -> f Config)
-> (Runner -> f Runner)
-> GetPackageFileContext
-> f GetPackageFileContext
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Runner -> f Runner) -> Config -> f Config
forall env. HasRunner env => Lens' env Runner
Lens' Config Runner
runnerL

instance HasStylesUpdate GetPackageFileContext where
  stylesUpdateL :: Lens' GetPackageFileContext StylesUpdate
stylesUpdateL = (Runner -> f Runner)
-> GetPackageFileContext -> f GetPackageFileContext
forall env. HasRunner env => Lens' env Runner
Lens' GetPackageFileContext Runner
runnerL ((Runner -> f Runner)
 -> GetPackageFileContext -> f GetPackageFileContext)
-> ((StylesUpdate -> f StylesUpdate) -> Runner -> f Runner)
-> (StylesUpdate -> f StylesUpdate)
-> GetPackageFileContext
-> f GetPackageFileContext
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StylesUpdate -> f StylesUpdate) -> Runner -> f Runner
forall env. HasStylesUpdate env => Lens' env StylesUpdate
Lens' Runner StylesUpdate
stylesUpdateL

instance HasTerm GetPackageFileContext where
  useColorL :: Lens' GetPackageFileContext Bool
useColorL = (Runner -> f Runner)
-> GetPackageFileContext -> f GetPackageFileContext
forall env. HasRunner env => Lens' env Runner
Lens' GetPackageFileContext Runner
runnerL ((Runner -> f Runner)
 -> GetPackageFileContext -> f GetPackageFileContext)
-> ((Bool -> f Bool) -> Runner -> f Runner)
-> (Bool -> f Bool)
-> GetPackageFileContext
-> f GetPackageFileContext
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> f Bool) -> Runner -> f Runner
forall env. HasTerm env => Lens' env Bool
Lens' Runner Bool
useColorL
  termWidthL :: Lens' GetPackageFileContext Int
termWidthL = (Runner -> f Runner)
-> GetPackageFileContext -> f GetPackageFileContext
forall env. HasRunner env => Lens' env Runner
Lens' GetPackageFileContext Runner
runnerL ((Runner -> f Runner)
 -> GetPackageFileContext -> f GetPackageFileContext)
-> ((Int -> f Int) -> Runner -> f Runner)
-> (Int -> f Int)
-> GetPackageFileContext
-> f GetPackageFileContext
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> f Int) -> Runner -> f Runner
forall env. HasTerm env => Lens' env Int
Lens' Runner Int
termWidthL

instance HasConfig GetPackageFileContext where
  configL :: Lens' GetPackageFileContext Config
configL = (BuildConfig -> f BuildConfig)
-> GetPackageFileContext -> f GetPackageFileContext
forall env. HasBuildConfig env => Lens' env BuildConfig
Lens' GetPackageFileContext BuildConfig
buildConfigL ((BuildConfig -> f BuildConfig)
 -> GetPackageFileContext -> f GetPackageFileContext)
-> ((Config -> f Config) -> BuildConfig -> f BuildConfig)
-> (Config -> f Config)
-> GetPackageFileContext
-> f GetPackageFileContext
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BuildConfig -> Config)
-> (BuildConfig -> Config -> BuildConfig)
-> Lens BuildConfig BuildConfig Config Config
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (.config) (\BuildConfig
x Config
y -> BuildConfig
x { config = y })
  {-# INLINE configL #-}

instance HasBuildConfig GetPackageFileContext where
  buildConfigL :: Lens' GetPackageFileContext BuildConfig
buildConfigL = (GetPackageFileContext -> BuildConfig)
-> (GetPackageFileContext -> BuildConfig -> GetPackageFileContext)
-> Lens' GetPackageFileContext BuildConfig
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (.buildConfig) (\GetPackageFileContext
x BuildConfig
y -> GetPackageFileContext
x { buildConfig = y })

instance HasPantryConfig GetPackageFileContext where
  pantryConfigL :: Lens' GetPackageFileContext PantryConfig
pantryConfigL = (Config -> f Config)
-> GetPackageFileContext -> f GetPackageFileContext
forall env. HasConfig env => Lens' env Config
Lens' GetPackageFileContext Config
configL ((Config -> f Config)
 -> GetPackageFileContext -> f GetPackageFileContext)
-> ((PantryConfig -> f PantryConfig) -> Config -> f Config)
-> (PantryConfig -> f PantryConfig)
-> GetPackageFileContext
-> f GetPackageFileContext
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PantryConfig -> f PantryConfig) -> Config -> f Config
forall env. HasPantryConfig env => Lens' env PantryConfig
Lens' Config PantryConfig
pantryConfigL

instance HasProcessContext GetPackageFileContext where
  processContextL :: Lens' GetPackageFileContext ProcessContext
processContextL = (Config -> f Config)
-> GetPackageFileContext -> f GetPackageFileContext
forall env. HasConfig env => Lens' env Config
Lens' GetPackageFileContext Config
configL ((Config -> f Config)
 -> GetPackageFileContext -> f GetPackageFileContext)
-> ((ProcessContext -> f ProcessContext) -> Config -> f Config)
-> (ProcessContext -> f ProcessContext)
-> GetPackageFileContext
-> f GetPackageFileContext
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProcessContext -> f ProcessContext) -> Config -> f Config
forall env. HasProcessContext env => Lens' env ProcessContext
Lens' Config ProcessContext
processContextL

-- | A path resolved from the Cabal file, which is either main-is or

-- an exposed/internal/referenced module.

data DotCabalPath
  = DotCabalModulePath !(Path Abs File)
  | DotCabalMainPath !(Path Abs File)
  | DotCabalFilePath !(Path Abs File)
  | DotCabalCFilePath !(Path Abs File)
  deriving (DotCabalPath -> DotCabalPath -> Bool
(DotCabalPath -> DotCabalPath -> Bool)
-> (DotCabalPath -> DotCabalPath -> Bool) -> Eq DotCabalPath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DotCabalPath -> DotCabalPath -> Bool
== :: DotCabalPath -> DotCabalPath -> Bool
$c/= :: DotCabalPath -> DotCabalPath -> Bool
/= :: DotCabalPath -> DotCabalPath -> Bool
Eq, Eq DotCabalPath
Eq DotCabalPath =>
(DotCabalPath -> DotCabalPath -> Ordering)
-> (DotCabalPath -> DotCabalPath -> Bool)
-> (DotCabalPath -> DotCabalPath -> Bool)
-> (DotCabalPath -> DotCabalPath -> Bool)
-> (DotCabalPath -> DotCabalPath -> Bool)
-> (DotCabalPath -> DotCabalPath -> DotCabalPath)
-> (DotCabalPath -> DotCabalPath -> DotCabalPath)
-> Ord DotCabalPath
DotCabalPath -> DotCabalPath -> Bool
DotCabalPath -> DotCabalPath -> Ordering
DotCabalPath -> DotCabalPath -> DotCabalPath
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
$ccompare :: DotCabalPath -> DotCabalPath -> Ordering
compare :: DotCabalPath -> DotCabalPath -> Ordering
$c< :: DotCabalPath -> DotCabalPath -> Bool
< :: DotCabalPath -> DotCabalPath -> Bool
$c<= :: DotCabalPath -> DotCabalPath -> Bool
<= :: DotCabalPath -> DotCabalPath -> Bool
$c> :: DotCabalPath -> DotCabalPath -> Bool
> :: DotCabalPath -> DotCabalPath -> Bool
$c>= :: DotCabalPath -> DotCabalPath -> Bool
>= :: DotCabalPath -> DotCabalPath -> Bool
$cmax :: DotCabalPath -> DotCabalPath -> DotCabalPath
max :: DotCabalPath -> DotCabalPath -> DotCabalPath
$cmin :: DotCabalPath -> DotCabalPath -> DotCabalPath
min :: DotCabalPath -> DotCabalPath -> DotCabalPath
Ord, Int -> DotCabalPath -> ShowS
[DotCabalPath] -> ShowS
DotCabalPath -> String
(Int -> DotCabalPath -> ShowS)
-> (DotCabalPath -> String)
-> ([DotCabalPath] -> ShowS)
-> Show DotCabalPath
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DotCabalPath -> ShowS
showsPrec :: Int -> DotCabalPath -> ShowS
$cshow :: DotCabalPath -> String
show :: DotCabalPath -> String
$cshowList :: [DotCabalPath] -> ShowS
showList :: [DotCabalPath] -> ShowS
Show)

-- | A descriptor from a Cabal file indicating one of the following:

--

-- exposed-modules: Foo

-- other-modules: Foo

-- or

-- main-is: Foo.hs

--

data DotCabalDescriptor
  = DotCabalModule !ModuleName
  | DotCabalMain !FilePath
  | DotCabalFile !FilePath
  | DotCabalCFile !FilePath
  deriving (DotCabalDescriptor -> DotCabalDescriptor -> Bool
(DotCabalDescriptor -> DotCabalDescriptor -> Bool)
-> (DotCabalDescriptor -> DotCabalDescriptor -> Bool)
-> Eq DotCabalDescriptor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DotCabalDescriptor -> DotCabalDescriptor -> Bool
== :: DotCabalDescriptor -> DotCabalDescriptor -> Bool
$c/= :: DotCabalDescriptor -> DotCabalDescriptor -> Bool
/= :: DotCabalDescriptor -> DotCabalDescriptor -> Bool
Eq, Eq DotCabalDescriptor
Eq DotCabalDescriptor =>
(DotCabalDescriptor -> DotCabalDescriptor -> Ordering)
-> (DotCabalDescriptor -> DotCabalDescriptor -> Bool)
-> (DotCabalDescriptor -> DotCabalDescriptor -> Bool)
-> (DotCabalDescriptor -> DotCabalDescriptor -> Bool)
-> (DotCabalDescriptor -> DotCabalDescriptor -> Bool)
-> (DotCabalDescriptor -> DotCabalDescriptor -> DotCabalDescriptor)
-> (DotCabalDescriptor -> DotCabalDescriptor -> DotCabalDescriptor)
-> Ord DotCabalDescriptor
DotCabalDescriptor -> DotCabalDescriptor -> Bool
DotCabalDescriptor -> DotCabalDescriptor -> Ordering
DotCabalDescriptor -> DotCabalDescriptor -> DotCabalDescriptor
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
$ccompare :: DotCabalDescriptor -> DotCabalDescriptor -> Ordering
compare :: DotCabalDescriptor -> DotCabalDescriptor -> Ordering
$c< :: DotCabalDescriptor -> DotCabalDescriptor -> Bool
< :: DotCabalDescriptor -> DotCabalDescriptor -> Bool
$c<= :: DotCabalDescriptor -> DotCabalDescriptor -> Bool
<= :: DotCabalDescriptor -> DotCabalDescriptor -> Bool
$c> :: DotCabalDescriptor -> DotCabalDescriptor -> Bool
> :: DotCabalDescriptor -> DotCabalDescriptor -> Bool
$c>= :: DotCabalDescriptor -> DotCabalDescriptor -> Bool
>= :: DotCabalDescriptor -> DotCabalDescriptor -> Bool
$cmax :: DotCabalDescriptor -> DotCabalDescriptor -> DotCabalDescriptor
max :: DotCabalDescriptor -> DotCabalDescriptor -> DotCabalDescriptor
$cmin :: DotCabalDescriptor -> DotCabalDescriptor -> DotCabalDescriptor
min :: DotCabalDescriptor -> DotCabalDescriptor -> DotCabalDescriptor
Ord, Int -> DotCabalDescriptor -> ShowS
[DotCabalDescriptor] -> ShowS
DotCabalDescriptor -> String
(Int -> DotCabalDescriptor -> ShowS)
-> (DotCabalDescriptor -> String)
-> ([DotCabalDescriptor] -> ShowS)
-> Show DotCabalDescriptor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DotCabalDescriptor -> ShowS
showsPrec :: Int -> DotCabalDescriptor -> ShowS
$cshow :: DotCabalDescriptor -> String
show :: DotCabalDescriptor -> String
$cshowList :: [DotCabalDescriptor] -> ShowS
showList :: [DotCabalDescriptor] -> ShowS
Show)

-- | Warning generated when reading a package

data PackageWarning
  = UnlistedModulesWarning NamedComponent [ModuleName]
    -- ^ Modules found that are not listed in Cabal file

  -- TODO: bring this back - see

  -- https://github.com/commercialhaskell/stack/issues/2649

  {-
  | MissingModulesWarning (Path Abs File) (Maybe String) [ModuleName]
    -- ^ Modules not found in file system, which are listed in Cabal file
  -}

-- | This is the information from Cabal we need at the package level to track

-- files.

data StackPackageFile = StackPackageFile
  { StackPackageFile -> [String]
extraSrcFiles :: [FilePath]
  , StackPackageFile -> String
dataDir :: FilePath
  , StackPackageFile -> [String]
dataFiles :: [FilePath]
  }
  deriving (Int -> StackPackageFile -> ShowS
[StackPackageFile] -> ShowS
StackPackageFile -> String
(Int -> StackPackageFile -> ShowS)
-> (StackPackageFile -> String)
-> ([StackPackageFile] -> ShowS)
-> Show StackPackageFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StackPackageFile -> ShowS
showsPrec :: Int -> StackPackageFile -> ShowS
$cshow :: StackPackageFile -> String
show :: StackPackageFile -> String
$cshowList :: [StackPackageFile] -> ShowS
showList :: [StackPackageFile] -> ShowS
Show, Typeable)

-- | Files that the package depends on, relative to package directory.

data PackageComponentFile = PackageComponentFile
  { PackageComponentFile
-> Map NamedComponent (Map ModuleName (Path Abs File))
modulePathMap :: Map NamedComponent (Map ModuleName (Path Abs File))
  , PackageComponentFile -> Map NamedComponent [DotCabalPath]
cabalFileMap :: !(Map NamedComponent [DotCabalPath])
  , PackageComponentFile -> Set (Path Abs File)
packageExtraFile :: Set (Path Abs File)
  , PackageComponentFile -> [PackageWarning]
warnings :: [PackageWarning]
  }

instance Semigroup PackageComponentFile where
  PackageComponentFile Map NamedComponent (Map ModuleName (Path Abs File))
x1 Map NamedComponent [DotCabalPath]
x2 Set (Path Abs File)
x3 [PackageWarning]
x4 <> :: PackageComponentFile
-> PackageComponentFile -> PackageComponentFile
<> PackageComponentFile Map NamedComponent (Map ModuleName (Path Abs File))
y1 Map NamedComponent [DotCabalPath]
y2 Set (Path Abs File)
y3 [PackageWarning]
y4 =
    Map NamedComponent (Map ModuleName (Path Abs File))
-> Map NamedComponent [DotCabalPath]
-> Set (Path Abs File)
-> [PackageWarning]
-> PackageComponentFile
PackageComponentFile (Map NamedComponent (Map ModuleName (Path Abs File))
x1 Map NamedComponent (Map ModuleName (Path Abs File))
-> Map NamedComponent (Map ModuleName (Path Abs File))
-> Map NamedComponent (Map ModuleName (Path Abs File))
forall a. Semigroup a => a -> a -> a
<> Map NamedComponent (Map ModuleName (Path Abs File))
y1) (Map NamedComponent [DotCabalPath]
x2 Map NamedComponent [DotCabalPath]
-> Map NamedComponent [DotCabalPath]
-> Map NamedComponent [DotCabalPath]
forall a. Semigroup a => a -> a -> a
<> Map NamedComponent [DotCabalPath]
y2) (Set (Path Abs File)
x3 Set (Path Abs File) -> Set (Path Abs File) -> Set (Path Abs File)
forall a. Semigroup a => a -> a -> a
<> Set (Path Abs File)
y3) ([PackageWarning]
x4 [PackageWarning] -> [PackageWarning] -> [PackageWarning]
forall a. Semigroup a => a -> a -> a
<> [PackageWarning]
y4)

instance Monoid PackageComponentFile where
  mempty :: PackageComponentFile
mempty = Map NamedComponent (Map ModuleName (Path Abs File))
-> Map NamedComponent [DotCabalPath]
-> Set (Path Abs File)
-> [PackageWarning]
-> PackageComponentFile
PackageComponentFile Map NamedComponent (Map ModuleName (Path Abs File))
forall a. Monoid a => a
mempty Map NamedComponent [DotCabalPath]
forall a. Monoid a => a
mempty Set (Path Abs File)
forall a. Monoid a => a
mempty [PackageWarning]
forall a. Monoid a => a
mempty