{-# LANGUAGE OverloadedStrings #-}
module Arion.Nix
( evaluateComposition
, withEvaluatedComposition
, buildComposition
, withBuiltComposition
, replForComposition
, EvaluationArgs(..)
, EvaluationMode(..)
) where
import Prelude ( )
import Protolude
import Arion.Aeson ( pretty )
import Data.Aeson
import qualified Data.String
import qualified System.Directory as Directory
import System.Process
import qualified Data.ByteString.Lazy as BL
import Paths_arion_compose
import qualified Data.Text.IO as T
import qualified Data.List.NonEmpty as NE
import Control.Arrow ( (>>>) )
import System.IO.Temp ( withTempFile )
import System.IO ( hClose )
data EvaluationMode =
ReadWrite | ReadOnly
data EvaluationArgs = EvaluationArgs
{ evalUid :: Int
, evalModules :: NonEmpty FilePath
, evalPkgs :: Text
, evalWorkDir :: Maybe FilePath
, evalMode :: EvaluationMode
, evalUserArgs :: [Text]
}
evaluateComposition :: EvaluationArgs -> IO Value
evaluateComposition ea = do
evalComposition <- getEvalCompositionFile
let commandArgs =
[ "--eval"
, "--strict"
, "--json"
, "--attr"
, "config.out.dockerComposeYamlAttrs"
]
args =
[ evalComposition ]
++ commandArgs
++ modeArguments (evalMode ea)
++ argArgs ea
++ map toS (evalUserArgs ea)
procSpec = (proc "nix-instantiate" args)
{ cwd = evalWorkDir ea
, std_out = CreatePipe
}
withCreateProcess procSpec $ \_in outHM _err procHandle -> do
let outHandle = fromMaybe (panic "stdout missing") outHM
out <- BL.hGetContents outHandle
v <- Protolude.evaluate (eitherDecode out)
exitCode <- waitForProcess procHandle
case exitCode of
ExitSuccess -> pass
ExitFailure 1 -> exitFailure
ExitFailure {} -> do
throwIO $ FatalError $ "evaluation failed with " <> show exitCode
case v of
Right r -> pure r
Left e -> throwIO $ FatalError ("Couldn't parse nix-instantiate output" <> show e)
withEvaluatedComposition :: EvaluationArgs -> (FilePath -> IO r) -> IO r
withEvaluatedComposition ea f = do
v <- evaluateComposition ea
withTempFile "." ".tmp-arion-docker-compose.yaml" $ \path yamlHandle -> do
T.hPutStrLn yamlHandle (pretty v)
hClose yamlHandle
f path
buildComposition :: FilePath -> EvaluationArgs -> IO ()
buildComposition outLink ea = do
evalComposition <- getEvalCompositionFile
let commandArgs =
[ "--attr"
, "config.out.dockerComposeYaml"
, "--out-link"
, outLink
]
args =
[ evalComposition ]
++ commandArgs
++ argArgs ea
++ map toS (evalUserArgs ea)
procSpec = (proc "nix-build" args) { cwd = evalWorkDir ea }
withCreateProcess procSpec $ \_in _out _err procHandle -> do
exitCode <- waitForProcess procHandle
case exitCode of
ExitSuccess -> pass
ExitFailure 1 -> exitFailure
ExitFailure {} -> do
throwIO $ FatalError $ "nix-build failed with " <> show exitCode
withBuiltComposition :: EvaluationArgs -> (FilePath -> IO r) -> IO r
withBuiltComposition ea f = do
withTempFile "." ".tmp-arion-docker-compose.yaml" $ \path emptyYamlHandle -> do
hClose emptyYamlHandle
Directory.removeFile path
buildComposition path ea
f path
replForComposition :: EvaluationArgs -> IO ()
replForComposition ea = do
evalComposition <- getEvalCompositionFile
let args =
[ "repl", evalComposition ]
++ argArgs ea
++ map toS (evalUserArgs ea)
procSpec = (proc "nix" args) { cwd = evalWorkDir ea }
withCreateProcess procSpec $ \_in _out _err procHandle -> do
exitCode <- waitForProcess procHandle
case exitCode of
ExitSuccess -> pass
ExitFailure 1 -> exitFailure
ExitFailure {} -> do
throwIO $ FatalError $ "nix repl failed with " <> show exitCode
argArgs :: EvaluationArgs -> [[Char]]
argArgs ea =
[ "--argstr"
, "uid"
, show $ evalUid ea
, "--arg"
, "modules"
, modulesNixExpr $ evalModules ea
, "--arg"
, "pkgs"
, toS $ evalPkgs ea
]
getEvalCompositionFile :: IO FilePath
getEvalCompositionFile = getDataFileName "nix/eval-composition.nix"
modeArguments :: EvaluationMode -> [[Char]]
modeArguments ReadWrite = [ "--read-write-mode" ]
modeArguments ReadOnly = [ "--readonly-mode" ]
modulesNixExpr :: NonEmpty FilePath -> [Char]
modulesNixExpr =
NE.toList >>> fmap pathExpr >>> Data.String.unwords >>> wrapList
where
pathExpr :: FilePath -> [Char]
pathExpr path | isAbsolute path = "(/. + \"/${" <> toNixStringLiteral path <> "}\")"
| otherwise = "(./. + \"/${" <> toNixStringLiteral path <> "}\")"
isAbsolute ('/' : _) = True
isAbsolute _ = False
wrapList s = "[ " <> s <> " ]"
toNixStringLiteral :: [Char] -> [Char]
toNixStringLiteral = show