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

module Stack.Types.BuildConfig
  ( BuildConfig (..)
  , HasBuildConfig (..)
  , stackYamlL
  , projectRootL
  , getProjectWorkDir
  , wantedCompilerVersionL
  ) where

import           Path ( (</>), parent )
import           RIO.Process ( HasProcessContext (..) )
import           Stack.Prelude
import           Stack.Types.Config ( Config, HasConfig (..), workDirL )
import           Stack.Types.Curator ( Curator )
import           Stack.Types.GHCVariant ( HasGHCVariant (..) )
import           Stack.Types.Platform ( HasPlatform (..) )
import           Stack.Types.Runner ( HasRunner (..) )
import           Stack.Types.SourceMap ( SMWanted (..) )
import           Stack.Types.Storage ( ProjectStorage )

-- | A superset of 'Config' adding information on how to build code. The reason

-- for this breakdown is because we will need some of the information from

-- 'Config' in order to determine the values here.

--

-- These are the components which know nothing about local configuration.

data BuildConfig = BuildConfig
  { BuildConfig -> Config
config     :: !Config
  , BuildConfig -> SMWanted
smWanted :: !SMWanted
  , BuildConfig -> [Path Abs Dir]
extraPackageDBs :: ![Path Abs Dir]
    -- ^ Extra package databases

  , BuildConfig -> Path Abs File
stackYaml  :: !(Path Abs File)
    -- ^ Location of the stack.yaml file.

    --

    -- Note: if the STACK_YAML environment variable is used, this may be

    -- different from projectRootL </> "stack.yaml" if a different file

    -- name is used.

  , BuildConfig -> ProjectStorage
projectStorage :: !ProjectStorage
  -- ^ Database connection pool for project Stack database

  , BuildConfig -> Maybe Curator
curator :: !(Maybe Curator)
  }

instance HasPlatform BuildConfig where
  platformL :: Lens' BuildConfig Platform
platformL = (Config -> f Config) -> BuildConfig -> f BuildConfig
forall env. HasConfig env => Lens' env Config
Lens' BuildConfig Config
configL ((Config -> f Config) -> BuildConfig -> f BuildConfig)
-> ((Platform -> f Platform) -> Config -> f Config)
-> (Platform -> f Platform)
-> BuildConfig
-> f BuildConfig
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' BuildConfig PlatformVariant
platformVariantL = (Config -> f Config) -> BuildConfig -> f BuildConfig
forall env. HasConfig env => Lens' env Config
Lens' BuildConfig Config
configL ((Config -> f Config) -> BuildConfig -> f BuildConfig)
-> ((PlatformVariant -> f PlatformVariant) -> Config -> f Config)
-> (PlatformVariant -> f PlatformVariant)
-> BuildConfig
-> f BuildConfig
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 BuildConfig where
  ghcVariantL :: SimpleGetter BuildConfig GHCVariant
ghcVariantL = (Config -> Const r Config) -> BuildConfig -> Const r BuildConfig
forall env. HasConfig env => Lens' env Config
Lens' BuildConfig Config
configL ((Config -> Const r Config) -> BuildConfig -> Const r BuildConfig)
-> ((GHCVariant -> Const r GHCVariant) -> Config -> Const r Config)
-> (GHCVariant -> Const r GHCVariant)
-> BuildConfig
-> Const r BuildConfig
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 HasProcessContext BuildConfig where
  processContextL :: Lens' BuildConfig ProcessContext
processContextL = (Config -> f Config) -> BuildConfig -> f BuildConfig
forall env. HasConfig env => Lens' env Config
Lens' BuildConfig Config
configL ((Config -> f Config) -> BuildConfig -> f BuildConfig)
-> ((ProcessContext -> f ProcessContext) -> Config -> f Config)
-> (ProcessContext -> f ProcessContext)
-> BuildConfig
-> f BuildConfig
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

instance HasPantryConfig BuildConfig where
  pantryConfigL :: Lens' BuildConfig PantryConfig
pantryConfigL = (Config -> f Config) -> BuildConfig -> f BuildConfig
forall env. HasConfig env => Lens' env Config
Lens' BuildConfig Config
configL ((Config -> f Config) -> BuildConfig -> f BuildConfig)
-> ((PantryConfig -> f PantryConfig) -> Config -> f Config)
-> (PantryConfig -> f PantryConfig)
-> BuildConfig
-> f BuildConfig
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 HasConfig BuildConfig where
  configL :: Lens' BuildConfig Config
configL = (BuildConfig -> Config)
-> (BuildConfig -> Config -> BuildConfig)
-> Lens' BuildConfig 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 })

instance HasRunner BuildConfig where
  runnerL :: Lens' BuildConfig Runner
runnerL = (Config -> f Config) -> BuildConfig -> f BuildConfig
forall env. HasConfig env => Lens' env Config
Lens' BuildConfig Config
configL ((Config -> f Config) -> BuildConfig -> f BuildConfig)
-> ((Runner -> f Runner) -> Config -> f Config)
-> (Runner -> f Runner)
-> BuildConfig
-> f BuildConfig
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 HasLogFunc BuildConfig where
  logFuncL :: Lens' BuildConfig LogFunc
logFuncL = (Runner -> f Runner) -> BuildConfig -> f BuildConfig
forall env. HasRunner env => Lens' env Runner
Lens' BuildConfig Runner
runnerL ((Runner -> f Runner) -> BuildConfig -> f BuildConfig)
-> ((LogFunc -> f LogFunc) -> Runner -> f Runner)
-> (LogFunc -> f LogFunc)
-> BuildConfig
-> f BuildConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LogFunc -> f LogFunc) -> Runner -> f Runner
forall env. HasLogFunc env => Lens' env LogFunc
Lens' Runner LogFunc
logFuncL

instance HasStylesUpdate BuildConfig where
  stylesUpdateL :: Lens' BuildConfig StylesUpdate
stylesUpdateL = (Runner -> f Runner) -> BuildConfig -> f BuildConfig
forall env. HasRunner env => Lens' env Runner
Lens' BuildConfig Runner
runnerL ((Runner -> f Runner) -> BuildConfig -> f BuildConfig)
-> ((StylesUpdate -> f StylesUpdate) -> Runner -> f Runner)
-> (StylesUpdate -> f StylesUpdate)
-> BuildConfig
-> f BuildConfig
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 BuildConfig where
  useColorL :: Lens' BuildConfig Bool
useColorL = (Runner -> f Runner) -> BuildConfig -> f BuildConfig
forall env. HasRunner env => Lens' env Runner
Lens' BuildConfig Runner
runnerL ((Runner -> f Runner) -> BuildConfig -> f BuildConfig)
-> ((Bool -> f Bool) -> Runner -> f Runner)
-> (Bool -> f Bool)
-> BuildConfig
-> f BuildConfig
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' BuildConfig Int
termWidthL = (Runner -> f Runner) -> BuildConfig -> f BuildConfig
forall env. HasRunner env => Lens' env Runner
Lens' BuildConfig Runner
runnerL ((Runner -> f Runner) -> BuildConfig -> f BuildConfig)
-> ((Int -> f Int) -> Runner -> f Runner)
-> (Int -> f Int)
-> BuildConfig
-> f BuildConfig
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

class HasConfig env => HasBuildConfig env where
  buildConfigL :: Lens' env BuildConfig

instance HasBuildConfig BuildConfig where
  buildConfigL :: Lens' BuildConfig BuildConfig
buildConfigL = (BuildConfig -> f BuildConfig) -> BuildConfig -> f BuildConfig
forall a. a -> a
id
  {-# INLINE buildConfigL #-}

stackYamlL :: HasBuildConfig env => Lens' env (Path Abs File)
stackYamlL :: forall env. HasBuildConfig env => Lens' env (Path Abs File)
stackYamlL = (BuildConfig -> f BuildConfig) -> env -> f env
forall env. HasBuildConfig env => Lens' env BuildConfig
Lens' env BuildConfig
buildConfigL ((BuildConfig -> f BuildConfig) -> env -> f env)
-> ((Path Abs File -> f (Path Abs File))
    -> BuildConfig -> f BuildConfig)
-> (Path Abs File -> f (Path Abs File))
-> env
-> f env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BuildConfig -> Path Abs File)
-> (BuildConfig -> Path Abs File -> BuildConfig)
-> Lens BuildConfig BuildConfig (Path Abs File) (Path Abs File)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (.stackYaml) (\BuildConfig
x Path Abs File
y -> BuildConfig
x { stackYaml = y })

-- | Directory containing the project's stack.yaml file

projectRootL :: HasBuildConfig env => Getting r env (Path Abs Dir)
projectRootL :: forall env r. HasBuildConfig env => Getting r env (Path Abs Dir)
projectRootL = (Path Abs File -> Const r (Path Abs File)) -> env -> Const r env
forall env. HasBuildConfig env => Lens' env (Path Abs File)
Lens' env (Path Abs File)
stackYamlL ((Path Abs File -> Const r (Path Abs File)) -> env -> Const r env)
-> ((Path Abs Dir -> Const r (Path Abs Dir))
    -> Path Abs File -> Const r (Path Abs File))
-> (Path Abs Dir -> Const r (Path Abs Dir))
-> env
-> Const r env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path Abs File -> Path Abs Dir)
-> SimpleGetter (Path Abs File) (Path Abs Dir)
forall s a. (s -> a) -> SimpleGetter s a
to Path Abs File -> Path Abs Dir
forall b t. Path b t -> Path b Dir
parent

-- | Per-project work dir

getProjectWorkDir :: (HasBuildConfig env, MonadReader env m) => m (Path Abs Dir)
getProjectWorkDir :: forall env (m :: * -> *).
(HasBuildConfig env, MonadReader env m) =>
m (Path Abs Dir)
getProjectWorkDir = do
  Path Abs Dir
root    <- Getting (Path Abs Dir) env (Path Abs Dir) -> m (Path Abs Dir)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Path Abs Dir) env (Path Abs Dir)
forall env r. HasBuildConfig env => Getting r env (Path Abs Dir)
projectRootL
  Path Rel Dir
workDir <- Getting (Path Rel Dir) env (Path Rel Dir) -> m (Path Rel Dir)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Path Rel Dir) env (Path Rel Dir)
forall env. HasConfig env => Lens' env (Path Rel Dir)
Lens' env (Path Rel Dir)
workDirL
  Path Abs Dir -> m (Path Abs Dir)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path Abs Dir
root Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
workDir)

-- | The compiler specified by the @SnapshotDef@. This may be different from the

-- actual compiler used!

wantedCompilerVersionL :: HasBuildConfig s => Getting r s WantedCompiler
wantedCompilerVersionL :: forall s r. HasBuildConfig s => Getting r s WantedCompiler
wantedCompilerVersionL = (BuildConfig -> Const r BuildConfig) -> s -> Const r s
forall env. HasBuildConfig env => Lens' env BuildConfig
Lens' s BuildConfig
buildConfigL ((BuildConfig -> Const r BuildConfig) -> s -> Const r s)
-> ((WantedCompiler -> Const r WantedCompiler)
    -> BuildConfig -> Const r BuildConfig)
-> (WantedCompiler -> Const r WantedCompiler)
-> s
-> Const r s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BuildConfig -> WantedCompiler)
-> SimpleGetter BuildConfig WantedCompiler
forall s a. (s -> a) -> SimpleGetter s a
to (.smWanted.compiler)