{-# LANGUAGE NoImplicitPrelude     #-}
{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE GADTs                 #-}
{-# 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
bcConfig     :: !Config
  , BuildConfig -> SMWanted
bcSMWanted :: !SMWanted
  , BuildConfig -> [Path Abs Dir]
bcExtraPackageDBs :: ![Path Abs Dir]
    -- ^ Extra package databases

  , BuildConfig -> Path Abs File
bcStackYaml  :: !(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
bcProjectStorage :: !ProjectStorage
  -- ^ Database connection pool for project Stack database

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

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

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

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

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

instance HasConfig BuildConfig where
  configL :: Lens' BuildConfig Config
configL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens BuildConfig -> Config
bcConfig (\BuildConfig
x Config
y -> BuildConfig
x { bcConfig :: Config
bcConfig = Config
y })

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

instance HasLogFunc BuildConfig where
  logFuncL :: Lens' BuildConfig LogFunc
logFuncL = forall env. HasRunner env => Lens' env Runner
runnerLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall env. HasLogFunc env => Lens' env LogFunc
logFuncL

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

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

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

instance HasBuildConfig BuildConfig where
  buildConfigL :: Lens' BuildConfig BuildConfig
buildConfigL = 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 = forall env. HasBuildConfig env => Lens' env BuildConfig
buildConfigLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens BuildConfig -> Path Abs File
bcStackYaml (\BuildConfig
x Path Abs File
y -> BuildConfig
x { bcStackYaml :: Path Abs File
bcStackYaml = Path Abs File
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 = forall env. HasBuildConfig env => Lens' env (Path Abs File)
stackYamlLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to 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    <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env r. HasBuildConfig env => Getting r env (Path Abs Dir)
projectRootL
  Path Rel Dir
workDir <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasConfig env => Lens' env (Path Rel Dir)
workDirL
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path Abs Dir
root 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 = forall env. HasBuildConfig env => Lens' env BuildConfig
buildConfigLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to (SMWanted -> WantedCompiler
smwCompiler forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildConfig -> SMWanted
bcSMWanted)