{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
{-|
Module      : Foreign.Nix.Shellout
Description : Interface to the nix package manager’s CLI
Copyright   : Profpatsch, 2016–2018
License     : GPL-3
Stability   : experimental
Portability : nix 1.11.x, nix 2.0

Calls to the nix command line to convert
textual nix expressions to derivations & realized storepaths.
-}
module Foreign.Nix.Shellout
( -- * Calling nix
  -- ** Parse
  parseNixExpr, ParseError(..)
  -- ** Instantiate
, instantiate, InstantiateError(..)
, eval
  -- ** Realize
, realize, RealizeError(..)
  -- ** Helpers
, addToStore
, parseInstRealize
, NixError(..)
  -- * Types
, NixExpr
, module Foreign.Nix.Shellout.Types
) where

import Control.Error ( throwE, tryLast )
import Data.Text (stripPrefix, lines, isPrefixOf, Text)

import qualified Foreign.Nix.Shellout.Helpers as Helpers
import Foreign.Nix.Shellout.Types
import qualified Data.Text as Text
import System.Exit (ExitCode(ExitFailure, ExitSuccess))
import Control.Monad ((>=>))
import qualified System.FilePath as FilePath
import Data.Function ((&))
import qualified Data.List as List
import Control.Monad.IO.Class (MonadIO)
import Control.Monad.Except (throwError)

------------------------------------------------------------------------------
-- Parsing

-- | A sucessfully parsed nix expression.
newtype NixExpr = NixExpr Text deriving (Int -> NixExpr -> ShowS
[NixExpr] -> ShowS
NixExpr -> String
(Int -> NixExpr -> ShowS)
-> (NixExpr -> String) -> ([NixExpr] -> ShowS) -> Show NixExpr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NixExpr] -> ShowS
$cshowList :: [NixExpr] -> ShowS
show :: NixExpr -> String
$cshow :: NixExpr -> String
showsPrec :: Int -> NixExpr -> ShowS
$cshowsPrec :: Int -> NixExpr -> ShowS
Show)

data ParseError
  = SyntaxError Text
    -- ^ the input string was not a syntactically valid nix expression
  | UnknownParseError
    -- ^ catch-all error
  deriving (Int -> ParseError -> ShowS
[ParseError] -> ShowS
ParseError -> String
(Int -> ParseError -> ShowS)
-> (ParseError -> String)
-> ([ParseError] -> ShowS)
-> Show ParseError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParseError] -> ShowS
$cshowList :: [ParseError] -> ShowS
show :: ParseError -> String
$cshow :: ParseError -> String
showsPrec :: Int -> ParseError -> ShowS
$cshowsPrec :: Int -> ParseError -> ShowS
Show, ParseError -> ParseError -> Bool
(ParseError -> ParseError -> Bool)
-> (ParseError -> ParseError -> Bool) -> Eq ParseError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParseError -> ParseError -> Bool
$c/= :: ParseError -> ParseError -> Bool
== :: ParseError -> ParseError -> Bool
$c== :: ParseError -> ParseError -> Bool
Eq)

-- | Parse a nix expression and check for syntactic validity.

-- Runs @nix-instantiate@.
parseNixExpr :: MonadIO m => Text -> NixAction ParseError m NixExpr
parseNixExpr :: Text -> NixAction ParseError m NixExpr
parseNixExpr Text
e = do
  Executable
exec <- (Executables -> Maybe String)
-> Text -> NixAction ParseError m Executable
forall (m :: * -> *) e.
Monad m =>
(Executables -> Maybe String) -> Text -> NixAction e m Executable
Helpers.getExecOr Executables -> Maybe String
exeNixInstantiate Text
"nix-instantiate"
  (Text -> ParseError)
-> NixAction Text m NixExpr -> NixAction ParseError m NixExpr
forall (m :: * -> *) a1 e a2.
Functor m =>
(a1 -> e) -> NixAction a1 m a2 -> NixAction e m a2
mapActionError Text -> ParseError
parseParseError
    (NixAction Text m NixExpr -> NixAction ParseError m NixExpr)
-> NixAction Text m NixExpr -> NixAction ParseError m NixExpr
forall a b. (a -> b) -> a -> b
$ Text -> NixExpr
NixExpr
    (Text -> NixExpr)
-> NixAction Text m Text -> NixAction Text m NixExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Executable -> [Text] -> NixAction Text m Text
forall (m :: * -> *).
MonadIO m =>
Executable -> [Text] -> NixAction Text m Text
evalNixOutput Executable
exec [ Text
"--parse", Text
"-E", Text
e ]


parseParseError :: Text -> ParseError
parseParseError :: Text -> ParseError
parseParseError
  (Text -> Text -> Maybe Text
stripPrefix Text
"error: syntax error, "
               -> Just Text
mes) = Text -> ParseError
SyntaxError Text
mes
parseParseError Text
_           = ParseError
UnknownParseError

------------------------------------------------------------------------------
-- Instantiating

data InstantiateError
  = NotADerivation
    -- ^ the given expression does not evaluate to a derivaton
  | UnknownInstantiateError
    -- ^ catch-all error
  deriving (Int -> InstantiateError -> ShowS
[InstantiateError] -> ShowS
InstantiateError -> String
(Int -> InstantiateError -> ShowS)
-> (InstantiateError -> String)
-> ([InstantiateError] -> ShowS)
-> Show InstantiateError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InstantiateError] -> ShowS
$cshowList :: [InstantiateError] -> ShowS
show :: InstantiateError -> String
$cshow :: InstantiateError -> String
showsPrec :: Int -> InstantiateError -> ShowS
$cshowsPrec :: Int -> InstantiateError -> ShowS
Show, InstantiateError -> InstantiateError -> Bool
(InstantiateError -> InstantiateError -> Bool)
-> (InstantiateError -> InstantiateError -> Bool)
-> Eq InstantiateError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InstantiateError -> InstantiateError -> Bool
$c/= :: InstantiateError -> InstantiateError -> Bool
== :: InstantiateError -> InstantiateError -> Bool
$c== :: InstantiateError -> InstantiateError -> Bool
Eq)

-- | Instantiate a parsed expression into a derivation.
--
-- Runs @nix-instantiate@.
instantiate :: (MonadIO m) => NixExpr -> NixAction InstantiateError m (StorePath Derivation)
instantiate :: NixExpr -> NixAction InstantiateError m (StorePath Derivation)
instantiate (NixExpr Text
e) = do
  Executable
exec <- (Executables -> Maybe String)
-> Text -> NixAction InstantiateError m Executable
forall (m :: * -> *) e.
Monad m =>
(Executables -> Maybe String) -> Text -> NixAction e m Executable
Helpers.getExecOr Executables -> Maybe String
exeNixInstantiate Text
"nix-instantiate"
  (Text -> InstantiateError)
-> NixAction Text m (StorePath Derivation)
-> NixAction InstantiateError m (StorePath Derivation)
forall (m :: * -> *) a1 e a2.
Functor m =>
(a1 -> e) -> NixAction a1 m a2 -> NixAction e m a2
mapActionError Text -> InstantiateError
parseInstantiateError
    (NixAction Text m (StorePath Derivation)
 -> NixAction InstantiateError m (StorePath Derivation))
-> NixAction Text m (StorePath Derivation)
-> NixAction InstantiateError m (StorePath Derivation)
forall a b. (a -> b) -> a -> b
$ Executable -> [Text] -> NixAction Text m Text
forall (m :: * -> *).
MonadIO m =>
Executable -> [Text] -> NixAction Text m Text
evalNixOutput Executable
exec [ Text
"-E", Text
e ]
      NixAction Text m Text
-> (Text -> NixAction Text m (StorePath Derivation))
-> NixAction Text m (StorePath Derivation)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> StorePath Derivation)
-> Text -> NixAction Text m (StorePath Derivation)
forall (m :: * -> *) a.
Monad m =>
(String -> a) -> Text -> NixAction Text m a
toNixFilePath String -> StorePath Derivation
forall a. String -> StorePath a
StorePath

-- | Just tests if the expression can be evaluated.
-- That doesn’t mean it has to instantiate however.
--
-- Runs @nix-instantiate@.
eval :: MonadIO m => NixExpr -> NixAction InstantiateError m ()
eval :: NixExpr -> NixAction InstantiateError m ()
eval (NixExpr Text
e) = do
  Executable
exec <- (Executables -> Maybe String)
-> Text -> NixAction InstantiateError m Executable
forall (m :: * -> *) e.
Monad m =>
(Executables -> Maybe String) -> Text -> NixAction e m Executable
Helpers.getExecOr Executables -> Maybe String
exeNixInstantiate Text
"nix-instantiate"

  Text
_instantiateOutput <- (Text -> InstantiateError)
-> NixAction Text m Text -> NixAction InstantiateError m Text
forall (m :: * -> *) a1 e a2.
Functor m =>
(a1 -> e) -> NixAction a1 m a2 -> NixAction e m a2
mapActionError Text -> InstantiateError
parseInstantiateError
       (NixAction Text m Text -> NixAction InstantiateError m Text)
-> NixAction Text m Text -> NixAction InstantiateError m Text
forall a b. (a -> b) -> a -> b
$ Executable -> [Text] -> NixAction Text m Text
forall (m :: * -> *).
MonadIO m =>
Executable -> [Text] -> NixAction Text m Text
evalNixOutput Executable
exec [ Text
"--eval", Text
"-E", Text
e ]
  () -> NixAction InstantiateError m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

parseInstantiateError :: Text -> InstantiateError
parseInstantiateError :: Text -> InstantiateError
parseInstantiateError
  (Text -> Text -> Maybe Text
stripPrefix Text
"error: expression does not evaluate to a derivation"
               -> Just Text
_) = InstantiateError
NotADerivation
parseInstantiateError Text
_   = InstantiateError
UnknownInstantiateError


------------------------------------------------------------------------------
-- Realizing

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

-- | Finally derivations are realized into full store outputs.
-- This will typically take a while so it should be executed asynchronously.
--
-- Runs @nix-store@.
realize :: MonadIO m => StorePath Derivation -> NixAction RealizeError m (StorePath Realized)
realize :: StorePath Derivation
-> NixAction RealizeError m (StorePath Realized)
realize (StorePath String
d) =
     [Text] -> NixAction RealizeError m (StorePath Realized)
forall (m :: * -> *).
MonadIO m =>
[Text] -> NixAction RealizeError m (StorePath Realized)
storeOp [ Text
"-r", String -> Text
Text.pack String
d ]

-- | Copy the given file or folder to the nix store and return it’s path.
--
-- Runs @nix-store@.
addToStore :: MonadIO m => FilePath -> NixAction RealizeError m (StorePath Realized)
addToStore :: String -> NixAction RealizeError m (StorePath Realized)
addToStore String
fp = [Text] -> NixAction RealizeError m (StorePath Realized)
forall (m :: * -> *).
MonadIO m =>
[Text] -> NixAction RealizeError m (StorePath Realized)
storeOp [ Text
"--add", String -> Text
Text.pack String
fp ]

storeOp :: (MonadIO m) => [Text] -> NixAction RealizeError m (StorePath Realized)
storeOp :: [Text] -> NixAction RealizeError m (StorePath Realized)
storeOp [Text]
op = do
  Executable
exec <- (Executables -> Maybe String)
-> Text -> NixAction RealizeError m Executable
forall (m :: * -> *) e.
Monad m =>
(Executables -> Maybe String) -> Text -> NixAction e m Executable
Helpers.getExecOr Executables -> Maybe String
exeNixInstantiate Text
"nix-store"
  (Text -> RealizeError)
-> NixAction Text m (StorePath Realized)
-> NixAction RealizeError m (StorePath Realized)
forall (m :: * -> *) a1 e a2.
Functor m =>
(a1 -> e) -> NixAction a1 m a2 -> NixAction e m a2
mapActionError (RealizeError -> Text -> RealizeError
forall a b. a -> b -> a
const RealizeError
UnknownRealizeError)
    (NixAction Text m (StorePath Realized)
 -> NixAction RealizeError m (StorePath Realized))
-> NixAction Text m (StorePath Realized)
-> NixAction RealizeError m (StorePath Realized)
forall a b. (a -> b) -> a -> b
$ Executable -> [Text] -> NixAction Text m Text
forall (m :: * -> *).
MonadIO m =>
Executable -> [Text] -> NixAction Text m Text
evalNixOutput Executable
exec [Text]
op
      NixAction Text m Text
-> (Text -> NixAction Text m (StorePath Realized))
-> NixAction Text m (StorePath Realized)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> StorePath Realized)
-> Text -> NixAction Text m (StorePath Realized)
forall (m :: * -> *) a.
Monad m =>
(String -> a) -> Text -> NixAction Text m a
toNixFilePath String -> StorePath Realized
forall a. String -> StorePath a
StorePath

------------------------------------------------------------------------------
-- Convenience

-- | Combines all error types that could happen.
data NixError
  = ParseError ParseError
  | InstantiateError InstantiateError
  | RealizeError RealizeError deriving (Int -> NixError -> ShowS
[NixError] -> ShowS
NixError -> String
(Int -> NixError -> ShowS)
-> (NixError -> String) -> ([NixError] -> ShowS) -> Show NixError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NixError] -> ShowS
$cshowList :: [NixError] -> ShowS
show :: NixError -> String
$cshow :: NixError -> String
showsPrec :: Int -> NixError -> ShowS
$cshowsPrec :: Int -> NixError -> ShowS
Show, NixError -> NixError -> Bool
(NixError -> NixError -> Bool)
-> (NixError -> NixError -> Bool) -> Eq NixError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NixError -> NixError -> Bool
$c/= :: NixError -> NixError -> Bool
== :: NixError -> NixError -> Bool
$c== :: NixError -> NixError -> Bool
Eq)

-- | A convenience function to directly realize a nix expression.
-- Any errors are put into a combined error type.
parseInstRealize :: (MonadIO m) => Text -> NixAction NixError m (StorePath Realized)
parseInstRealize :: Text -> NixAction NixError m (StorePath Realized)
parseInstRealize = (ParseError -> NixError)
-> NixAction ParseError m NixExpr -> NixAction NixError m NixExpr
forall (m :: * -> *) a1 e a2.
Functor m =>
(a1 -> e) -> NixAction a1 m a2 -> NixAction e m a2
mapActionError ParseError -> NixError
ParseError (NixAction ParseError m NixExpr -> NixAction NixError m NixExpr)
-> (Text -> NixAction ParseError m NixExpr)
-> Text
-> NixAction NixError m NixExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> NixAction ParseError m NixExpr
forall (m :: * -> *).
MonadIO m =>
Text -> NixAction ParseError m NixExpr
parseNixExpr
               (Text -> NixAction NixError m NixExpr)
-> (NixExpr -> NixAction NixError m (StorePath Realized))
-> Text
-> NixAction NixError m (StorePath Realized)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (InstantiateError -> NixError)
-> NixAction InstantiateError m (StorePath Derivation)
-> NixAction NixError m (StorePath Derivation)
forall (m :: * -> *) a1 e a2.
Functor m =>
(a1 -> e) -> NixAction a1 m a2 -> NixAction e m a2
mapActionError InstantiateError -> NixError
InstantiateError (NixAction InstantiateError m (StorePath Derivation)
 -> NixAction NixError m (StorePath Derivation))
-> (NixExpr -> NixAction InstantiateError m (StorePath Derivation))
-> NixExpr
-> NixAction NixError m (StorePath Derivation)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NixExpr -> NixAction InstantiateError m (StorePath Derivation)
forall (m :: * -> *).
MonadIO m =>
NixExpr -> NixAction InstantiateError m (StorePath Derivation)
instantiate
               (NixExpr -> NixAction NixError m (StorePath Derivation))
-> (StorePath Derivation
    -> NixAction NixError m (StorePath Realized))
-> NixExpr
-> NixAction NixError m (StorePath Realized)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (RealizeError -> NixError)
-> NixAction RealizeError m (StorePath Realized)
-> NixAction NixError m (StorePath Realized)
forall (m :: * -> *) a1 e a2.
Functor m =>
(a1 -> e) -> NixAction a1 m a2 -> NixAction e m a2
mapActionError RealizeError -> NixError
RealizeError (NixAction RealizeError m (StorePath Realized)
 -> NixAction NixError m (StorePath Realized))
-> (StorePath Derivation
    -> NixAction RealizeError m (StorePath Realized))
-> StorePath Derivation
-> NixAction NixError m (StorePath Realized)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorePath Derivation
-> NixAction RealizeError m (StorePath Realized)
forall (m :: * -> *).
MonadIO m =>
StorePath Derivation
-> NixAction RealizeError m (StorePath Realized)
realize

------------------------------------------------------------------------------
-- Helpers

-- | Take args and return either error message or output path
evalNixOutput :: (MonadIO m)
              => Helpers.Executable
              -- ^ name of executable
              -> [Text]
              -- ^ arguments
              -> NixAction Text m Text
              -- ^ error: (stderr, errormsg), success: path
evalNixOutput :: Executable -> [Text] -> NixAction Text m Text
evalNixOutput = ((Text, Text) -> ExitCode -> ExceptT Text m Text)
-> Executable -> [Text] -> NixAction Text m Text
forall (m :: * -> *) e a.
MonadIO m =>
((Text, Text) -> ExitCode -> ExceptT e m a)
-> Executable -> [Text] -> NixAction e m a
Helpers.readProcess (\(Text
out, Text
err) -> \case
  ExitFailure Int
_ -> Text -> ExceptT Text m Text
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (Text -> ExceptT Text m Text) -> Text -> ExceptT Text m Text
forall a b. (a -> b) -> a -> b
$
    case
      Text
err
        Text -> (Text -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& Text -> [Text]
Text.lines
        [Text] -> ([Text] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Bool
isPrefixOf Text
"error: ")
        [Text] -> ([Text] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
List.intersperse Text
"\n"
        [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat of
      Text
"" -> Text
"nix didn’t output any error message"
      Text
s  -> Text
s
  ExitCode
ExitSuccess -> Text -> [Text] -> ExceptT Text m Text
forall (m :: * -> *) e a. Monad m => e -> [a] -> ExceptT e m a
tryLast
      Text
"nix didn’t output a store path" (Text -> [Text]
Data.Text.lines Text
out))


-- | Apply filePath p to constructor a if it’s a valid filepath
toNixFilePath :: Monad m => (String -> a) -> Text -> NixAction Text m a
toNixFilePath :: (String -> a) -> Text -> NixAction Text m a
toNixFilePath String -> a
a Text
p = ReaderT (RunOptions m) (ExceptT (NixActionError Text) m) a
-> NixAction Text m a
forall e (m :: * -> *) a.
ReaderT (RunOptions m) (ExceptT (NixActionError e) m) a
-> NixAction e m a
NixAction (ReaderT (RunOptions m) (ExceptT (NixActionError Text) m) a
 -> NixAction Text m a)
-> ReaderT (RunOptions m) (ExceptT (NixActionError Text) m) a
-> NixAction Text m a
forall a b. (a -> b) -> a -> b
$
  if String -> Bool
FilePath.isValid (Text -> String
Text.unpack Text
p) then a -> ReaderT (RunOptions m) (ExceptT (NixActionError Text) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> ReaderT (RunOptions m) (ExceptT (NixActionError Text) m) a)
-> a -> ReaderT (RunOptions m) (ExceptT (NixActionError Text) m) a
forall a b. (a -> b) -> a -> b
$ String -> a
a (Text -> String
Text.unpack Text
p)
  else NixActionError Text
-> ReaderT (RunOptions m) (ExceptT (NixActionError Text) m) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (NixActionError Text
 -> ReaderT (RunOptions m) (ExceptT (NixActionError Text) m) a)
-> NixActionError Text
-> ReaderT (RunOptions m) (ExceptT (NixActionError Text) m) a
forall a b. (a -> b) -> a -> b
$ NixActionError :: forall e. Text -> e -> NixActionError e
NixActionError
          { actionStderr :: Text
actionStderr = Text
nostderr
          , actionError :: Text
actionError = Text
p Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is not a filepath!" }
  where nostderr :: Text
nostderr = Text
forall a. Monoid a => a
mempty