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

module Stack.Types.BuildConfig
  ( BuildConfig (..)
  , HasBuildConfig (..)
  , configFileL
  , configFileRootL
  , getWorkDir
  , wantedCompilerVersionL
  ) where

import qualified Data.Either.Extra as EE
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 -> Either (Path Abs File) (Path Abs File)
configFile :: !(Either (Path Abs File) (Path Abs File))
    -- ^ Either (Left) the location of the user-specific global configuration

    -- file or, in most cases, (Right) the location of the project-level

    -- coniguration file (stack.yaml, by default).

    --

    -- Note: if the STACK_YAML environment variable is used, the location of the

    -- project-level configuration file 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 #-}

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

-- | Directory containing the configuration file.

configFileRootL :: HasBuildConfig env => Getting r env (Path Abs Dir)
configFileRootL :: forall env r. HasBuildConfig env => Getting r env (Path Abs Dir)
configFileRootL = (Either (Path Abs File) (Path Abs File)
 -> Const r (Either (Path Abs File) (Path Abs File)))
-> env -> Const r env
forall env.
HasBuildConfig env =>
Lens' env (Either (Path Abs File) (Path Abs File))
Lens' env (Either (Path Abs File) (Path Abs File))
configFileL ((Either (Path Abs File) (Path Abs File)
  -> Const r (Either (Path Abs File) (Path Abs File)))
 -> env -> Const r env)
-> ((Path Abs Dir -> Const r (Path Abs Dir))
    -> Either (Path Abs File) (Path Abs File)
    -> Const r (Either (Path Abs File) (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
. (Either (Path Abs File) (Path Abs File) -> Path Abs File)
-> SimpleGetter
     (Either (Path Abs File) (Path Abs File)) (Path Abs File)
forall s a. (s -> a) -> SimpleGetter s a
to Either (Path Abs File) (Path Abs File) -> Path Abs File
forall a. Either a a -> a
EE.fromEither Getting r (Either (Path Abs File) (Path Abs File)) (Path Abs File)
-> ((Path Abs Dir -> Const r (Path Abs Dir))
    -> Path Abs File -> Const r (Path Abs File))
-> (Path Abs Dir -> Const r (Path Abs Dir))
-> Either (Path Abs File) (Path Abs File)
-> Const r (Either (Path Abs File) (Path Abs File))
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

-- | Work directory in the directory of the configuration file (global or

-- project-level).

getWorkDir :: (HasBuildConfig env, MonadReader env m) => m (Path Abs Dir)
getWorkDir :: forall env (m :: * -> *).
(HasBuildConfig env, MonadReader env m) =>
m (Path Abs Dir)
getWorkDir = do
  Path Abs Dir
configFileRoot <- 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)
configFileRootL
  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
configFileRoot 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)