{-# LANGUAGE NoImplicitPrelude     #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedRecordDot   #-}
{-# LANGUAGE OverloadedStrings     #-}

-- | Nix configuration

module Stack.Config.Nix
  ( nixCompiler
  , nixCompilerVersion
  , nixOptsFromMonoid
  ) where

import           Control.Monad.Extra ( ifM )
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import           Distribution.System ( OS (..) )
import           Stack.Constants ( osIsWindows )
import           Stack.Prelude
import           Stack.Types.Runner ( HasRunner )
import           Stack.Types.Nix ( NixOpts (..), NixOptsMonoid (..) )
import           System.Directory ( doesFileExist )

-- | Type representing exceptions thrown by functions exported by the

-- "Stack.Config.Nix" module.

data ConfigNixException
  = NixCannotUseShellFileAndPackagesException
    -- ^ Nix can't be given packages and a shell file at the same time

  | GHCMajorVersionUnspecified
  | OnlyGHCSupported
  deriving (Int -> ConfigNixException -> ShowS
[ConfigNixException] -> ShowS
ConfigNixException -> String
(Int -> ConfigNixException -> ShowS)
-> (ConfigNixException -> String)
-> ([ConfigNixException] -> ShowS)
-> Show ConfigNixException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConfigNixException -> ShowS
showsPrec :: Int -> ConfigNixException -> ShowS
$cshow :: ConfigNixException -> String
show :: ConfigNixException -> String
$cshowList :: [ConfigNixException] -> ShowS
showList :: [ConfigNixException] -> ShowS
Show, Typeable)

instance Exception ConfigNixException where
  displayException :: ConfigNixException -> String
displayException ConfigNixException
NixCannotUseShellFileAndPackagesException =
    String
"Error: [S-2726]\n"
    String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"You cannot have packages and a shell-file filled at the same time \
       \in your nix-shell configuration."
  displayException ConfigNixException
GHCMajorVersionUnspecified =
    String
"Error: [S-9317]\n"
    String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"GHC major version not specified."
  displayException ConfigNixException
OnlyGHCSupported =
    String
"Error: [S-8605]\n"
    String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"Only GHC is supported by 'stack --nix'."

-- | Interprets NixOptsMonoid options.

nixOptsFromMonoid ::
     (HasRunner env, HasTerm env)
  => NixOptsMonoid
  -> OS
  -> RIO env NixOpts
nixOptsFromMonoid :: forall env.
(HasRunner env, HasTerm env) =>
NixOptsMonoid -> OS -> RIO env NixOpts
nixOptsFromMonoid NixOptsMonoid
nixMonoid OS
os = do
  let defaultPure :: Bool
defaultPure = case OS
os of
        OS
OSX -> Bool
False
        OS
_ -> Bool
True
      pureShell :: Bool
pureShell = Bool -> First Bool -> Bool
forall a. a -> First a -> a
fromFirst Bool
defaultPure NixOptsMonoid
nixMonoid.pureShell
      packages :: [Text]
packages = [Text] -> First [Text] -> [Text]
forall a. a -> First a -> a
fromFirst [] NixOptsMonoid
nixMonoid.packages
      initFile :: Maybe String
initFile = First String -> Maybe String
forall a. First a -> Maybe a
getFirst NixOptsMonoid
nixMonoid.initFile
      shellOptions :: [Text]
shellOptions =
           [Text] -> First [Text] -> [Text]
forall a. a -> First a -> a
fromFirst [] NixOptsMonoid
nixMonoid.shellOptions
        [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ Text -> [Text] -> [Text]
forall {t}. t -> [t] -> [t]
prefixAll (String -> Text
T.pack String
"-I") ([Text] -> First [Text] -> [Text]
forall a. a -> First a -> a
fromFirst [] NixOptsMonoid
nixMonoid.path)
      addGCRoots :: Bool
addGCRoots   = FirstFalse -> Bool
fromFirstFalse NixOptsMonoid
nixMonoid.addGCRoots

  -- Enable Nix-mode by default on NixOS, unless Docker-mode was specified

  Bool
osIsNixOS <- RIO env Bool
forall (m :: * -> *). MonadIO m => m Bool
isNixOS
  let nixEnable0 :: Bool
nixEnable0 = Bool -> First Bool -> Bool
forall a. a -> First a -> a
fromFirst Bool
osIsNixOS NixOptsMonoid
nixMonoid.enable

  Bool
enable <-
    if Bool
nixEnable0 Bool -> Bool -> Bool
&& Bool
osIsWindows
      then do
        String -> RIO env ()
forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
String -> m ()
prettyNoteS
          String
"Disabling Nix integration, since this is being run in Windows."
        Bool -> RIO env Bool
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
      else Bool -> RIO env Bool
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
nixEnable0

  Bool -> RIO env () -> RIO env ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not ([Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
packages) Bool -> Bool -> Bool
&& Maybe String -> Bool
forall a. Maybe a -> Bool
isJust Maybe String
initFile) (RIO env () -> RIO env ()) -> RIO env () -> RIO env ()
forall a b. (a -> b) -> a -> b
$
    ConfigNixException -> RIO env ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO ConfigNixException
NixCannotUseShellFileAndPackagesException
  NixOpts -> RIO env NixOpts
forall a. a -> RIO env a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NixOpts
    { Bool
enable :: Bool
$sel:enable:NixOpts :: Bool
enable
    , Bool
pureShell :: Bool
$sel:pureShell:NixOpts :: Bool
pureShell
    , [Text]
packages :: [Text]
$sel:packages:NixOpts :: [Text]
packages
    , Maybe String
initFile :: Maybe String
$sel:initFile:NixOpts :: Maybe String
initFile
    , [Text]
shellOptions :: [Text]
$sel:shellOptions:NixOpts :: [Text]
shellOptions
    , Bool
addGCRoots :: Bool
$sel:addGCRoots:NixOpts :: Bool
addGCRoots
    }
 where
  prefixAll :: t -> [t] -> [t]
prefixAll t
p (t
x:[t]
xs) = t
p t -> [t] -> [t]
forall {t}. t -> [t] -> [t]
: t
x t -> [t] -> [t]
forall {t}. t -> [t] -> [t]
: t -> [t] -> [t]
prefixAll t
p [t]
xs
  prefixAll t
_ [t]
_      = []

nixCompiler :: WantedCompiler -> Either ConfigNixException T.Text
nixCompiler :: WantedCompiler -> Either ConfigNixException Text
nixCompiler WantedCompiler
compilerVersion =
  case WantedCompiler
compilerVersion of
    WCGhc Version
version ->
      case (Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') (String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Version -> String
versionString Version
version) of
        Text
x : Text
y : [Text]
minor ->
          Text -> Either ConfigNixException Text
forall a b. b -> Either a b
Right (Text -> Either ConfigNixException Text)
-> Text -> Either ConfigNixException Text
forall a b. (a -> b) -> a -> b
$
          case [Text]
minor of
            [] ->
              -- The minor version is not specified. Select the latest minor

              -- version in Nixpkgs corresponding to the requested major

              -- version.

              let major :: Text
major = [Text] -> Text
T.concat [Text
x, Text
y] in
              Text
"(let compilers = builtins.filter \
              \(name: builtins.match \
              \\"ghc" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
major Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"[[:digit:]]*\" name != null) \
              \(lib.attrNames haskell.compiler); in \
              \if compilers == [] \
              \then abort \"No compiler found for GHC "
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Version -> String
versionString Version
version) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\"\
              \else haskell.compiler.${builtins.head compilers})"
            [Text]
_ -> Text
"haskell.compiler.ghc" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.concat (Text
x Text -> [Text] -> [Text]
forall {t}. t -> [t] -> [t]
: Text
y Text -> [Text] -> [Text]
forall {t}. t -> [t] -> [t]
: [Text]
minor)
        [Text]
_ -> ConfigNixException -> Either ConfigNixException Text
forall a b. a -> Either a b
Left ConfigNixException
GHCMajorVersionUnspecified
    WCGhcjs{} -> ConfigNixException -> Either ConfigNixException Text
forall a b. a -> Either a b
Left ConfigNixException
OnlyGHCSupported
    WCGhcGit{} -> ConfigNixException -> Either ConfigNixException Text
forall a b. a -> Either a b
Left ConfigNixException
OnlyGHCSupported

nixCompilerVersion :: WantedCompiler -> Either ConfigNixException T.Text
nixCompilerVersion :: WantedCompiler -> Either ConfigNixException Text
nixCompilerVersion WantedCompiler
compilerVersion =
  case WantedCompiler
compilerVersion of
    WCGhc Version
version ->
      case (Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') (String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Version -> String
versionString Version
version) of
        Text
x : Text
y : [Text]
minor -> Text -> Either ConfigNixException Text
forall a b. b -> Either a b
Right (Text -> Either ConfigNixException Text)
-> Text -> Either ConfigNixException Text
forall a b. (a -> b) -> a -> b
$ Text
"ghc" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.concat (Text
x Text -> [Text] -> [Text]
forall {t}. t -> [t] -> [t]
: Text
y Text -> [Text] -> [Text]
forall {t}. t -> [t] -> [t]
: [Text]
minor)
        [Text]
_ -> ConfigNixException -> Either ConfigNixException Text
forall a b. a -> Either a b
Left ConfigNixException
GHCMajorVersionUnspecified
    WCGhcjs{} -> ConfigNixException -> Either ConfigNixException Text
forall a b. a -> Either a b
Left ConfigNixException
OnlyGHCSupported
    WCGhcGit{} -> ConfigNixException -> Either ConfigNixException Text
forall a b. a -> Either a b
Left ConfigNixException
OnlyGHCSupported

isNixOS :: MonadIO m => m Bool
isNixOS :: forall (m :: * -> *). MonadIO m => m Bool
isNixOS = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
  let fp :: String
fp = String
"/etc/os-release"
  IO Bool -> IO Bool -> IO Bool -> IO Bool
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (String -> IO Bool
doesFileExist String
fp)
      (Text -> Text -> Bool
T.isInfixOf Text
"ID=nixos" (Text -> Bool) -> IO Text -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Text
TIO.readFile String
fp)
      (Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False)