{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}

-- | Constants used throughout the project.

module Stack.Constants
    (buildPlanDir
    ,buildPlanCacheDir
    ,haskellModuleExts
    ,stackDotYaml
    ,stackWorkEnvVar
    ,stackRootEnvVar
    ,stackRootOptionName
    ,deprecatedStackRootOptionName
    ,inContainerEnvVar
    ,inNixShellEnvVar
    ,stackProgName
    ,stackProgNameUpper
    ,wiredInPackages
    ,ghcjsBootPackages
    ,cabalPackageName
    ,implicitGlobalProjectDirDeprecated
    ,implicitGlobalProjectDir
    ,defaultUserConfigPathDeprecated
    ,defaultUserConfigPath
    ,defaultGlobalConfigPathDeprecated
    ,defaultGlobalConfigPath
    ,platformVariantEnvVar
    ,compilerOptionsCabalFlag
    ,ghcColorForceFlag
    ,minTerminalWidth
    ,maxTerminalWidth
    ,defaultTerminalWidth
    )
    where

import           Data.Char (toUpper)
import qualified Data.HashSet as HashSet
import           Path as FL
import           Stack.Prelude
import           Stack.Types.Compiler
import           Stack.Types.PackageName

-- | Extensions for anything that can be a Haskell module.
haskellModuleExts :: [Text]
haskellModuleExts = haskellFileExts ++ haskellPreprocessorExts

-- | Extensions used for Haskell modules. Excludes preprocessor ones.
haskellFileExts :: [Text]
haskellFileExts = ["hs", "hsc", "lhs"]

-- | Extensions for modules that are preprocessed by common preprocessors.
haskellPreprocessorExts :: [Text]
haskellPreprocessorExts = ["gc", "chs", "hsc", "x", "y", "ly", "cpphs"]

-- | Name of the 'stack' program, uppercased
stackProgNameUpper :: String
stackProgNameUpper = map toUpper stackProgName

-- | Name of the 'stack' program.
stackProgName :: String
stackProgName = "stack"

-- | The filename used for the stack config file.
stackDotYaml :: Path Rel File
stackDotYaml = $(mkRelFile "stack.yaml")

-- | Environment variable used to override the '.stack-work' relative dir.
stackWorkEnvVar :: String
stackWorkEnvVar = "STACK_WORK"

-- | Environment variable used to override the '~/.stack' location.
stackRootEnvVar :: String
stackRootEnvVar = "STACK_ROOT"

-- | Option name for the global stack root.
stackRootOptionName :: String
stackRootOptionName = "stack-root"

-- | Deprecated option name for the global stack root.
--
-- Deprecated since stack-1.1.0.
--
-- TODO: Remove occurences of this variable and use 'stackRootOptionName' only
-- after an appropriate deprecation period.
deprecatedStackRootOptionName :: String
deprecatedStackRootOptionName = "global-stack-root"

-- | Environment variable used to indicate stack is running in container.
inContainerEnvVar :: String
inContainerEnvVar = stackProgNameUpper ++ "_IN_CONTAINER"

-- | Environment variable used to indicate stack is running in container.
-- although we already have STACK_IN_NIX_EXTRA_ARGS that is set in the same conditions,
-- it can happen that STACK_IN_NIX_EXTRA_ARGS is set to empty.
inNixShellEnvVar :: String
inNixShellEnvVar = map toUpper stackProgName ++ "_IN_NIX_SHELL"

-- See https://downloads.haskell.org/~ghc/7.10.1/docs/html/libraries/ghc/src/Module.html#integerPackageKey
wiredInPackages :: HashSet PackageName
wiredInPackages =
    maybe (error "Parse error in wiredInPackages") HashSet.fromList mparsed
  where
    mparsed = mapM parsePackageName
      [ "ghc-prim"
      , "integer-gmp"
      , "integer-simple"
      , "base"
      , "rts"
      , "template-haskell"
      , "dph-seq"
      , "dph-par"
      , "ghc"
      , "interactive"
      ]

-- TODO: Get this unwieldy list out of here and into a datafile
-- generated by GHCJS! See https://github.com/ghcjs/ghcjs/issues/434
ghcjsBootPackages :: HashSet PackageName
ghcjsBootPackages =
    maybe (error "Parse error in ghcjsBootPackages") HashSet.fromList mparsed
  where
    mparsed = mapM parsePackageName
      -- stage1a
      [ "array"
      , "base"
      , "binary"
      , "bytestring"
      , "containers"
      , "deepseq"
      , "integer-gmp"
      , "pretty"
      , "primitive"
      , "integer-gmp"
      , "pretty"
      , "primitive"
      , "template-haskell"
      , "transformers"
      -- stage1b
      , "directory"
      , "filepath"
      , "old-locale"
      , "process"
      , "time"
      -- stage2
      , "async"
      , "aeson"
      , "attoparsec"
      , "case-insensitive"
      , "dlist"
      , "extensible-exceptions"
      , "hashable"
      , "mtl"
      , "old-time"
      , "parallel"
      , "scientific"
      , "stm"
      , "syb"
      , "text"
      , "unordered-containers"
      , "vector"
      ]

-- | Just to avoid repetition and magic strings.
cabalPackageName :: PackageName
cabalPackageName =
    $(mkPackageName "Cabal")

-- | Deprecated implicit global project directory used when outside of a project.
implicitGlobalProjectDirDeprecated :: Path Abs Dir -- ^ Stack root.
                                   -> Path Abs Dir
implicitGlobalProjectDirDeprecated p =
    p </>
    $(mkRelDir "global")

-- | Implicit global project directory used when outside of a project.
-- Normally, @getImplicitGlobalProjectDir@ should be used instead.
implicitGlobalProjectDir :: Path Abs Dir -- ^ Stack root.
                         -> Path Abs Dir
implicitGlobalProjectDir p =
    p </>
    $(mkRelDir "global-project")

-- | Deprecated default global config path.
defaultUserConfigPathDeprecated :: Path Abs Dir -> Path Abs File
defaultUserConfigPathDeprecated = (</> $(mkRelFile "stack.yaml"))

-- | Default global config path.
-- Normally, @getDefaultUserConfigPath@ should be used instead.
defaultUserConfigPath :: Path Abs Dir -> Path Abs File
defaultUserConfigPath = (</> $(mkRelFile "config.yaml"))

-- | Deprecated default global config path.
-- Note that this will be @Nothing@ on Windows, which is by design.
defaultGlobalConfigPathDeprecated :: Maybe (Path Abs File)
defaultGlobalConfigPathDeprecated = parseAbsFile "/etc/stack/config"

-- | Default global config path.
-- Normally, @getDefaultGlobalConfigPath@ should be used instead.
-- Note that this will be @Nothing@ on Windows, which is by design.
defaultGlobalConfigPath :: Maybe (Path Abs File)
defaultGlobalConfigPath = parseAbsFile "/etc/stack/config.yaml"

-- | Path where build plans are stored.
buildPlanDir :: Path Abs Dir -- ^ Stack root
             -> Path Abs Dir
buildPlanDir = (</> $(mkRelDir "build-plan"))

-- | Path where binary caches of the build plans are stored.
buildPlanCacheDir
  :: Path Abs Dir -- ^ Stack root
  -> Path Abs Dir
buildPlanCacheDir = (</> $(mkRelDir "build-plan-cache"))

-- | Environment variable that stores a variant to append to platform-specific directory
-- names.  Used to ensure incompatible binaries aren't shared between Docker builds and host
platformVariantEnvVar :: String
platformVariantEnvVar = stackProgNameUpper ++ "_PLATFORM_VARIANT"

-- | Provides --ghc-options for 'Ghc', and similarly, --ghcjs-options
-- for 'Ghcjs'.
compilerOptionsCabalFlag :: WhichCompiler -> String
compilerOptionsCabalFlag Ghc = "--ghc-options"
compilerOptionsCabalFlag Ghcjs = "--ghcjs-options"

-- | The flag to pass to GHC when we want to force its output to be
-- colorized.
ghcColorForceFlag :: String
ghcColorForceFlag = "-fdiagnostics-color=always"

-- | The minimum allowed terminal width. Used for pretty-printing.
minTerminalWidth :: Int
minTerminalWidth = 40

-- | The maximum allowed terminal width. Used for pretty-printing.
maxTerminalWidth :: Int
maxTerminalWidth = 200

-- | The default terminal width. Used for pretty-printing when we can't
-- automatically detect it and when the user doesn't supply one.
defaultTerminalWidth :: Int
defaultTerminalWidth = 100