{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
module Bindings.Cli.Nix
  ( Arg (..)
  , NixBuildConfig (..)
  , nixBuildConfig_common
  , nixBuildConfig_outLink
  , NixCmd (..)
  , nixCmdConfig_args
  , nixCmdConfig_builders
  , nixCmdConfig_target
  , NixCommonConfig (..)
  , NixInstantiateConfig (..)
  , nixInstantiateConfig_eval
  , NixShellConfig (..)
  , nixShellConfig_common
  , nixShellConfig_pure
  , nixShellConfig_run
  , OutLink (..)
  , Target (..)
  , target_attr
  , target_expr
  , target_path

  , boolArg
  , nixCmd
  , nixCmdProc
  , nixCmdProc'
  , rawArg
  , runNixShellConfig
  , strArg

  , nixPrefetchGitPath
  , nixPrefetchUrlPath
  ) where

import Control.Lens
import Control.Monad (guard)
import Control.Monad.Catch (MonadMask)
import Control.Monad.Except (MonadError)
import Control.Monad.Fail
import Control.Monad.IO.Class (MonadIO)
import Control.Monad.Log (MonadLog)

import Data.Bool (bool)
import Data.Default
import Data.List (intercalate)
import Data.Maybe
import Data.Monoid ((<>))
import qualified Data.Text as T

import System.Which (staticWhich)

import Cli.Extras

-- | What to build
data Target = Target
  { Target -> Maybe String
_target_path :: Maybe FilePath
  , Target -> Maybe String
_target_attr :: Maybe String
  , Target -> Maybe String
_target_expr :: Maybe String
  }
makeClassy ''Target

instance Default Target where
  def :: Target
def = Target
    { _target_path :: Maybe String
_target_path = String -> Maybe String
forall a. a -> Maybe a
Just String
"."
    , _target_attr :: Maybe String
_target_attr = Maybe String
forall a. Maybe a
Nothing
    , _target_expr :: Maybe String
_target_expr = Maybe String
forall a. Maybe a
Nothing
    }

data Arg
  = Arg_Str String String
  | Arg_Expr String String
  deriving (Arg -> Arg -> Bool
(Arg -> Arg -> Bool) -> (Arg -> Arg -> Bool) -> Eq Arg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Arg -> Arg -> Bool
== :: Arg -> Arg -> Bool
$c/= :: Arg -> Arg -> Bool
/= :: Arg -> Arg -> Bool
Eq, Int -> Arg -> String -> String
[Arg] -> String -> String
Arg -> String
(Int -> Arg -> String -> String)
-> (Arg -> String) -> ([Arg] -> String -> String) -> Show Arg
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Arg -> String -> String
showsPrec :: Int -> Arg -> String -> String
$cshow :: Arg -> String
show :: Arg -> String
$cshowList :: [Arg] -> String -> String
showList :: [Arg] -> String -> String
Show)

strArg :: String -> String -> Arg
strArg :: String -> String -> Arg
strArg = String -> String -> Arg
Arg_Str

rawArg :: String -> String -> Arg
rawArg :: String -> String -> Arg
rawArg = String -> String -> Arg
Arg_Expr

boolArg :: String -> Bool -> Arg
boolArg :: String -> Bool -> Arg
boolArg String
k = String -> String -> Arg
Arg_Expr String
k (String -> Arg) -> (Bool -> String) -> Bool -> Arg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> Bool -> String
forall a. a -> a -> Bool -> a
bool String
"false" String
"true"

cliFromArgs :: [Arg] -> [String]
cliFromArgs :: [Arg] -> [String]
cliFromArgs = (Arg -> [String]) -> [Arg] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Arg -> [String]) -> [Arg] -> [String])
-> (Arg -> [String]) -> [Arg] -> [String]
forall a b. (a -> b) -> a -> b
$ \case
  Arg_Str String
k String
v -> [String
"--argstr", String
k, String
v]
  Arg_Expr String
k String
v -> [String
"--arg", String
k, String
v]

data NixCommonConfig = NixCommonConfig
  { NixCommonConfig -> Target
_nixCmdConfig_target :: Target
  , NixCommonConfig -> [Arg]
_nixCmdConfig_args :: [Arg]
  , NixCommonConfig -> [String]
_nixCmdConfig_builders :: [String]
  }
makeClassy ''NixCommonConfig

instance Default NixCommonConfig where
  def :: NixCommonConfig
def = Target -> [Arg] -> [String] -> NixCommonConfig
NixCommonConfig Target
forall a. Default a => a
def [Arg]
forall a. Monoid a => a
mempty [String]
forall a. Monoid a => a
mempty

runNixCommonConfig :: NixCommonConfig -> [String]
runNixCommonConfig :: NixCommonConfig -> [String]
runNixCommonConfig NixCommonConfig
cfg = [[String]] -> [String]
forall a. Monoid a => [a] -> a
mconcat [Maybe String -> [String]
forall a. Maybe a -> [a]
maybeToList Maybe String
path, [String]
attrArg, [String]
exprArg, [String]
args, [String]
buildersArg]
  where
    path :: Maybe String
path = Target -> Maybe String
_target_path (Target -> Maybe String) -> Target -> Maybe String
forall a b. (a -> b) -> a -> b
$ NixCommonConfig -> Target
_nixCmdConfig_target NixCommonConfig
cfg
    attr :: Maybe String
attr = Target -> Maybe String
_target_attr (Target -> Maybe String) -> Target -> Maybe String
forall a b. (a -> b) -> a -> b
$ NixCommonConfig -> Target
_nixCmdConfig_target NixCommonConfig
cfg
    expr :: Maybe String
expr = Target -> Maybe String
_target_expr (Target -> Maybe String) -> Target -> Maybe String
forall a b. (a -> b) -> a -> b
$ NixCommonConfig -> Target
_nixCmdConfig_target NixCommonConfig
cfg
    attrArg :: [String]
attrArg = case Maybe String
attr of
      Maybe String
Nothing -> []
      Just String
a -> [String
"-A", String
a]
    exprArg :: [String]
exprArg = case Maybe String
expr of
      Maybe String
Nothing -> []
      Just String
a -> [String
"-E", String
a]
    args :: [String]
args = [Arg] -> [String]
cliFromArgs ([Arg] -> [String]) -> [Arg] -> [String]
forall a b. (a -> b) -> a -> b
$ NixCommonConfig -> [Arg]
_nixCmdConfig_args NixCommonConfig
cfg
    buildersArg :: [String]
buildersArg = case NixCommonConfig -> [String]
_nixCmdConfig_builders NixCommonConfig
cfg of
      [] -> []
      [String]
builders -> [String
"--builders", String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
";" [String]
builders]

-- | Where to put nix-build output
data OutLink
  = OutLink_Default
  | OutLink_None
  | OutLink_IndirectRoot FilePath

instance Default OutLink where
  def :: OutLink
def = OutLink
OutLink_Default

data NixBuildConfig = NixBuildConfig
  { NixBuildConfig -> NixCommonConfig
_nixBuildConfig_common :: NixCommonConfig
  , NixBuildConfig -> OutLink
_nixBuildConfig_outLink :: OutLink
  }
makeLenses ''NixBuildConfig

instance HasNixCommonConfig NixBuildConfig where
  nixCommonConfig :: Lens' NixBuildConfig NixCommonConfig
nixCommonConfig = (NixCommonConfig -> f NixCommonConfig)
-> NixBuildConfig -> f NixBuildConfig
Lens' NixBuildConfig NixCommonConfig
nixBuildConfig_common

instance Default NixBuildConfig where
  def :: NixBuildConfig
def = NixCommonConfig -> OutLink -> NixBuildConfig
NixBuildConfig NixCommonConfig
forall a. Default a => a
def OutLink
forall a. Default a => a
def

runNixBuildConfig :: NixBuildConfig -> [String]
runNixBuildConfig :: NixBuildConfig -> [String]
runNixBuildConfig NixBuildConfig
cfg = [[String]] -> [String]
forall a. Monoid a => [a] -> a
mconcat
  [ NixCommonConfig -> [String]
runNixCommonConfig (NixCommonConfig -> [String]) -> NixCommonConfig -> [String]
forall a b. (a -> b) -> a -> b
$ NixBuildConfig
cfg NixBuildConfig
-> Getting NixCommonConfig NixBuildConfig NixCommonConfig
-> NixCommonConfig
forall s a. s -> Getting a s a -> a
^. Getting NixCommonConfig NixBuildConfig NixCommonConfig
forall c. HasNixCommonConfig c => Lens' c NixCommonConfig
Lens' NixBuildConfig NixCommonConfig
nixCommonConfig
  , case NixBuildConfig -> OutLink
_nixBuildConfig_outLink NixBuildConfig
cfg of
      OutLink
OutLink_Default -> []
      OutLink
OutLink_None -> [String
"--no-out-link"]
      OutLink_IndirectRoot String
l -> [String
"--out-link", String
l]
  ]

data NixInstantiateConfig = NixInstantiateConfig
  { NixInstantiateConfig -> NixCommonConfig
_nixInstantiateConfig_common :: NixCommonConfig
  , NixInstantiateConfig -> Bool
_nixInstantiateConfig_eval :: Bool
  }
makeLenses ''NixInstantiateConfig

instance HasNixCommonConfig NixInstantiateConfig where
  nixCommonConfig :: Lens' NixInstantiateConfig NixCommonConfig
nixCommonConfig = (NixCommonConfig -> f NixCommonConfig)
-> NixInstantiateConfig -> f NixInstantiateConfig
Lens' NixInstantiateConfig NixCommonConfig
nixInstantiateConfig_common

instance Default NixInstantiateConfig where
  def :: NixInstantiateConfig
def = NixCommonConfig -> Bool -> NixInstantiateConfig
NixInstantiateConfig NixCommonConfig
forall a. Default a => a
def Bool
False

runNixInstantiateConfig :: NixInstantiateConfig -> [String]
runNixInstantiateConfig :: NixInstantiateConfig -> [String]
runNixInstantiateConfig NixInstantiateConfig
cfg = [[String]] -> [String]
forall a. Monoid a => [a] -> a
mconcat
  [ NixCommonConfig -> [String]
runNixCommonConfig (NixCommonConfig -> [String]) -> NixCommonConfig -> [String]
forall a b. (a -> b) -> a -> b
$ NixInstantiateConfig
cfg NixInstantiateConfig
-> Getting NixCommonConfig NixInstantiateConfig NixCommonConfig
-> NixCommonConfig
forall s a. s -> Getting a s a -> a
^. Getting NixCommonConfig NixInstantiateConfig NixCommonConfig
forall c. HasNixCommonConfig c => Lens' c NixCommonConfig
Lens' NixInstantiateConfig NixCommonConfig
nixCommonConfig
  , String
"--eval" String -> [()] -> [String]
forall a b. a -> [b] -> [a]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (NixInstantiateConfig -> Bool
_nixInstantiateConfig_eval NixInstantiateConfig
cfg)
  ]

data NixShellConfig = NixShellConfig
  { NixShellConfig -> NixCommonConfig
_nixShellConfig_common :: NixCommonConfig
  , NixShellConfig -> Bool
_nixShellConfig_pure :: Bool
  , NixShellConfig -> Maybe String
_nixShellConfig_run :: Maybe String
  }

makeLenses ''NixShellConfig

instance HasNixCommonConfig NixShellConfig where
  nixCommonConfig :: Lens' NixShellConfig NixCommonConfig
nixCommonConfig = (NixCommonConfig -> f NixCommonConfig)
-> NixShellConfig -> f NixShellConfig
Lens' NixShellConfig NixCommonConfig
nixShellConfig_common

instance Default NixShellConfig where
  def :: NixShellConfig
def = NixCommonConfig -> Bool -> Maybe String -> NixShellConfig
NixShellConfig NixCommonConfig
forall a. Default a => a
def Bool
False Maybe String
forall a. Maybe a
Nothing

data NixCmd
  = NixCmd_Build NixBuildConfig
  | NixCmd_Instantiate NixInstantiateConfig

instance Default NixCmd where
  def :: NixCmd
def = NixBuildConfig -> NixCmd
NixCmd_Build NixBuildConfig
forall a. Default a => a
def

runNixShellConfig :: NixShellConfig -> [String]
runNixShellConfig :: NixShellConfig -> [String]
runNixShellConfig NixShellConfig
cfg = [[String]] -> [String]
forall a. Monoid a => [a] -> a
mconcat
  [ NixCommonConfig -> [String]
runNixCommonConfig (NixCommonConfig -> [String]) -> NixCommonConfig -> [String]
forall a b. (a -> b) -> a -> b
$ NixShellConfig
cfg NixShellConfig
-> Getting NixCommonConfig NixShellConfig NixCommonConfig
-> NixCommonConfig
forall s a. s -> Getting a s a -> a
^. Getting NixCommonConfig NixShellConfig NixCommonConfig
forall c. HasNixCommonConfig c => Lens' c NixCommonConfig
Lens' NixShellConfig NixCommonConfig
nixCommonConfig
  , [ String
"--pure" | NixShellConfig
cfg NixShellConfig -> Getting Bool NixShellConfig Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool NixShellConfig Bool
Lens' NixShellConfig Bool
nixShellConfig_pure ]
  ] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [[String]] -> [String]
forall a. Monoid a => [a] -> a
mconcat [
    [String
"--run", String
run] | String
run <- Maybe String -> [String]
forall a. Maybe a -> [a]
maybeToList (Maybe String -> [String]) -> Maybe String -> [String]
forall a b. (a -> b) -> a -> b
$ NixShellConfig
cfg NixShellConfig
-> Getting (Maybe String) NixShellConfig (Maybe String)
-> Maybe String
forall s a. s -> Getting a s a -> a
^. Getting (Maybe String) NixShellConfig (Maybe String)
Lens' NixShellConfig (Maybe String)
nixShellConfig_run
  ]

nixCmdProc :: NixCmd -> ProcessSpec
nixCmdProc :: NixCmd -> ProcessSpec
nixCmdProc = (ProcessSpec, Text) -> ProcessSpec
forall a b. (a, b) -> a
fst ((ProcessSpec, Text) -> ProcessSpec)
-> (NixCmd -> (ProcessSpec, Text)) -> NixCmd -> ProcessSpec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NixCmd -> (ProcessSpec, Text)
nixCmdProc'

nixCmdProc' :: NixCmd -> (ProcessSpec, T.Text)
nixCmdProc' :: NixCmd -> (ProcessSpec, Text)
nixCmdProc' NixCmd
cmdCfg = (String -> [String] -> ProcessSpec
proc (Text -> String
T.unpack Text
cmd) [String]
options, Text
cmd)
  where
    (Text
cmd, [String]
options) = case NixCmd
cmdCfg of
      NixCmd_Build NixBuildConfig
cfg' ->
        ( Text
"nix-build"
        , NixBuildConfig -> [String]
runNixBuildConfig NixBuildConfig
cfg'
        )
      NixCmd_Instantiate NixInstantiateConfig
cfg' ->
        ( Text
"nix-instantiate"
        , NixInstantiateConfig -> [String]
runNixInstantiateConfig NixInstantiateConfig
cfg'
        )

nixCmd
  :: ( MonadIO m
     , MonadMask m
     , MonadLog Output m
     , HasCliConfig e m
     , MonadError e m
     , AsProcessFailure e
     , MonadFail m
     )
  => NixCmd
  -> m FilePath
nixCmd :: forall (m :: * -> *) e.
(MonadIO m, MonadMask m, MonadLog Output m, HasCliConfig e m,
 MonadError e m, AsProcessFailure e, MonadFail m) =>
NixCmd -> m String
nixCmd NixCmd
cmdCfg = Text -> Maybe (String -> Text) -> m String -> m String
forall (m :: * -> *) e a.
(MonadIO m, MonadMask m, CliLog m, HasCliConfig e m) =>
Text -> Maybe (a -> Text) -> m a -> m a
withSpinner' ([Text] -> Text
T.unwords ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Text
"Running" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text
cmd Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
desc) ((String -> Text) -> Maybe (String -> Text)
forall a. a -> Maybe a
Just ((String -> Text) -> Maybe (String -> Text))
-> (String -> Text) -> Maybe (String -> Text)
forall a b. (a -> b) -> a -> b
$ Text -> String -> Text
forall a b. a -> b -> a
const (Text -> String -> Text) -> Text -> String -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unwords ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Text
"Built" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
desc) (m String -> m String) -> m String -> m String
forall a b. (a -> b) -> a -> b
$ do
  output <- Severity -> ProcessSpec -> m Text
forall (m :: * -> *) e.
(MonadIO m, CliLog m, CliThrow e m, AsProcessFailure e,
 MonadMask m) =>
Severity -> ProcessSpec -> m Text
readProcessAndLogStderr Severity
Debug ProcessSpec
cmdProc
  -- Remove final newline that Nix appends
  Just (outPath, '\n') <- pure $ T.unsnoc output
  pure $ T.unpack outPath
  where
    (ProcessSpec
cmdProc, Text
cmd) = NixCmd -> (ProcessSpec, Text)
nixCmdProc' NixCmd
cmdCfg
    commonCfg :: NixCommonConfig
commonCfg = case NixCmd
cmdCfg of
      NixCmd_Build NixBuildConfig
cfg' -> NixBuildConfig
cfg' NixBuildConfig
-> Getting NixCommonConfig NixBuildConfig NixCommonConfig
-> NixCommonConfig
forall s a. s -> Getting a s a -> a
^. Getting NixCommonConfig NixBuildConfig NixCommonConfig
forall c. HasNixCommonConfig c => Lens' c NixCommonConfig
Lens' NixBuildConfig NixCommonConfig
nixCommonConfig
      NixCmd_Instantiate NixInstantiateConfig
cfg' -> NixInstantiateConfig
cfg' NixInstantiateConfig
-> Getting NixCommonConfig NixInstantiateConfig NixCommonConfig
-> NixCommonConfig
forall s a. s -> Getting a s a -> a
^. Getting NixCommonConfig NixInstantiateConfig NixCommonConfig
forall c. HasNixCommonConfig c => Lens' c NixCommonConfig
Lens' NixInstantiateConfig NixCommonConfig
nixCommonConfig
    path :: Maybe String
path = NixCommonConfig
commonCfg NixCommonConfig
-> Getting (Maybe String) NixCommonConfig (Maybe String)
-> Maybe String
forall s a. s -> Getting a s a -> a
^. (Target -> Const (Maybe String) Target)
-> NixCommonConfig -> Const (Maybe String) NixCommonConfig
forall c. HasNixCommonConfig c => Lens' c Target
Lens' NixCommonConfig Target
nixCmdConfig_target ((Target -> Const (Maybe String) Target)
 -> NixCommonConfig -> Const (Maybe String) NixCommonConfig)
-> ((Maybe String -> Const (Maybe String) (Maybe String))
    -> Target -> Const (Maybe String) Target)
-> Getting (Maybe String) NixCommonConfig (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe String -> Const (Maybe String) (Maybe String))
-> Target -> Const (Maybe String) Target
forall c. HasTarget c => Lens' c (Maybe String)
Lens' Target (Maybe String)
target_path
    desc :: [Text]
desc = [[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Text]] -> [Text]) -> [[Text]] -> [Text]
forall a b. (a -> b) -> a -> b
$ [Maybe [Text]] -> [[Text]]
forall a. [Maybe a] -> [a]
catMaybes
      [ (\String
x -> [Text
"on", String -> Text
T.pack String
x]) (String -> [Text]) -> Maybe String -> Maybe [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
path
      , (\String
a -> [Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"]) (String -> [Text]) -> Maybe String -> Maybe [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (NixCommonConfig
commonCfg NixCommonConfig
-> Getting (Maybe String) NixCommonConfig (Maybe String)
-> Maybe String
forall s a. s -> Getting a s a -> a
^. (Target -> Const (Maybe String) Target)
-> NixCommonConfig -> Const (Maybe String) NixCommonConfig
forall c. HasNixCommonConfig c => Lens' c Target
Lens' NixCommonConfig Target
nixCmdConfig_target ((Target -> Const (Maybe String) Target)
 -> NixCommonConfig -> Const (Maybe String) NixCommonConfig)
-> ((Maybe String -> Const (Maybe String) (Maybe String))
    -> Target -> Const (Maybe String) Target)
-> Getting (Maybe String) NixCommonConfig (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe String -> Const (Maybe String) (Maybe String))
-> Target -> Const (Maybe String) Target
forall c. HasTarget c => Lens' c (Maybe String)
Lens' Target (Maybe String)
target_attr)
      ]

-- | Statically determined (at build-time) path to @nix-prefetch-git@.
nixPrefetchGitPath :: FilePath
nixPrefetchGitPath :: String
nixPrefetchGitPath = $(staticWhich "nix-prefetch-git")

-- | Statically determined (at build-time) path to @nix-prefetch-url@.
nixPrefetchUrlPath :: FilePath
nixPrefetchUrlPath :: String
nixPrefetchUrlPath = $(staticWhich "nix-prefetch-url")