diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,11 @@ +# libnix + +## 0.3.0.0 -- 2021-11-16 + +* Remove `Eq` instance from `NixExpr` (not sensible) +* Replace the `NixAction` tuple with a more semantic `NixActionError` +* Update to 2021 and remove dependency on protolude + +## 0.2.0.0 -- 2018-08-12 + +* First released version. diff --git a/Foreign/Nix/Shellout.hs b/Foreign/Nix/Shellout.hs --- a/Foreign/Nix/Shellout.hs +++ b/Foreign/Nix/Shellout.hs @@ -1,3 +1,6 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ViewPatterns #-} {-| Module : Foreign.Nix.Shellout Description : Interface to the nix package manager’s CLI @@ -23,26 +26,35 @@ , parseInstRealize , NixError(..) -- * Types -, StorePath(fromStorePath), Derivation, Realized +, StorePath(..), Derivation, Realized , NixExpr -, runNixAction, NixAction(..) +, runNixAction, NixAction(..), NixActionError(..) ) where -import Protolude hiding (show, isPrefixOf) -import Control.Error hiding (bool, err) -import Data.String (String) -import Data.Text (stripPrefix, lines, isPrefixOf) -import System.FilePath (isValid) -import Text.Show (Show(..)) +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 + ( Realized, + Derivation, + StorePath(..), + NixActionError(..), + NixAction(..), + runNixAction ) +import qualified Data.Text as Text +import System.Exit (ExitCode(ExitFailure, ExitSuccess)) +import Data.Bifunctor (bimap, Bifunctor (first)) +import Control.Monad ((>=>)) +import qualified System.FilePath as FilePath +import Data.Function ((&)) +import qualified Data.List as List ------------------------------------------------------------------------------ -- Parsing -- | A sucessfully parsed nix expression. -newtype NixExpr = NixExpr Text deriving (Show, Eq) +newtype NixExpr = NixExpr Text deriving (Show) data ParseError = SyntaxError Text @@ -84,9 +96,10 @@ -- | Just tests if the expression can be evaluated. -- That doesn’t mean it has to instantiate however. eval :: NixExpr -> NixAction InstantiateError () -eval (NixExpr e) = - void $ first parseInstantiateError +eval (NixExpr e) = do + _instantiateOutput <- first parseInstantiateError $ evalNixOutput "nix-instantiate" [ "--eval", "-E", e ] + pure () parseInstantiateError :: Text -> InstantiateError parseInstantiateError @@ -104,11 +117,11 @@ -- This will typically take a while so it should be executed asynchronously. realize :: StorePath Derivation -> NixAction RealizeError (StorePath Realized) realize (StorePath d) = - storeOp [ "-r", toS d ] + storeOp [ "-r", Text.pack d ] -- | Copy the given file or folder to the nix store and return it’s path. addToStore :: FilePath -> NixAction RealizeError (StorePath Realized) -addToStore fp = storeOp [ "--add", toS fp ] +addToStore fp = storeOp [ "--add", Text.pack fp ] storeOp :: [Text] -> NixAction RealizeError (StorePath Realized) storeOp op = @@ -144,18 +157,23 @@ -- ^ error: (stderr, errormsg), success: path evalNixOutput = Helpers.readProcess (\(out, err) -> \case ExitFailure _ -> throwE $ - case mconcat . intersperse "\n" - . dropWhile (not . isPrefixOf "error: ") - . lines $ toS err of + case + err + & Text.lines + & dropWhile (not . isPrefixOf "error: ") + & List.intersperse "\n" + & mconcat of "" -> "nix didn’t output any error message" s -> s ExitSuccess -> tryLast - "nix didn’t output a store path" (lines $ toS out)) + "nix didn’t output a store path" (Data.Text.lines out)) -- | Apply filePath p to constructor a if it’s a valid filepath toNixFilePath :: (String -> a) -> Text -> NixAction Text a -toNixFilePath a p@(toS -> ps) = NixAction $ - if isValid ps then (pure $ a ps) - else (throwE $ (nostderr, p <> " is not a filepath!")) +toNixFilePath a p = NixAction $ + if FilePath.isValid (Text.unpack p) then pure $ a (Text.unpack p) + else throwE $ NixActionError + { actionStderr = nostderr + , actionError = p <> " is not a filepath!" } where nostderr = mempty diff --git a/Foreign/Nix/Shellout/Helpers.hs b/Foreign/Nix/Shellout/Helpers.hs --- a/Foreign/Nix/Shellout/Helpers.hs +++ b/Foreign/Nix/Shellout/Helpers.hs @@ -1,6 +1,6 @@ +{-# LANGUAGE OverloadedStrings #-} module Foreign.Nix.Shellout.Helpers where -import Protolude hiding (async, wait) import Foreign.Nix.Shellout.Types import qualified System.Process as P import qualified Data.Text.IO as TIO @@ -8,9 +8,20 @@ import qualified System.IO as SIO -- needed for ignoreSigPipe -import GHC.IO.Exception (IOErrorType(..), IOException(..)) +-- needed for ignoreSigPipe +import GHC.IO.Exception (IOErrorType(..), IOException(..), ExitCode) import Foreign.C.Error (Errno(Errno), ePIPE) +import Data.Text (Text) +import Control.Error (ExceptT, withExceptT) +import Control.Concurrent (MVar, newEmptyMVar, forkIO, takeMVar, putMVar, killThread) +import Control.DeepSeq (rnf) +import Control.Exception (SomeException, throwIO, onException, try, mask, handle, evaluate) + +import Control.Monad (unless) +import Control.Monad.IO.Class (liftIO) +import qualified Data.Text as Text + -- | Read the output of a process into a NixAction. -- | Keeps stderr if process returns a failure exit code. -- | The text is decoded as @UTF-8@. @@ -25,8 +36,12 @@ readProcess with exec args = NixAction $ do (exc, out, err) <- liftIO $ readCreateProcessWithExitCodeAndEncoding - (P.proc (toS exec) (map toS args)) SIO.utf8 "" - withExceptT (err,) $ with (out, err) exc + (P.proc (Text.unpack exec) (map Text.unpack args)) SIO.utf8 "" + withExceptT + (\e -> NixActionError + { actionStderr = err + , actionError = e }) + $ with (out, err) exc -- Copied & modified from System.Process (process-1.6.4.0) @@ -62,7 +77,7 @@ -- now write any input unless (T.null input) $ - ignoreSigPipe $ hPutStr inh input + ignoreSigPipe $ TIO.hPutStr inh input -- hClose performs implicit hFlush, and thus may trigger a SIGPIPE ignoreSigPipe $ SIO.hClose inh diff --git a/Foreign/Nix/Shellout/Prefetch.hs b/Foreign/Nix/Shellout/Prefetch.hs --- a/Foreign/Nix/Shellout/Prefetch.hs +++ b/Foreign/Nix/Shellout/Prefetch.hs @@ -9,6 +9,8 @@ into nice reusable data types. -} {-# LANGUAGE RecordWildCards, GeneralizedNewtypeDeriving, ApplicativeDo #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} module Foreign.Nix.Shellout.Prefetch ( -- * nix-prefetch-url url, UrlOptions(..), defaultUrlOptions @@ -18,10 +20,9 @@ , PrefetchError(..) , Url(..), Sha256(..) -- * Reexports -, runNixAction, NixAction(..) +, runNixAction, NixAction(..), NixActionError(..) ) where -import Protolude import Control.Error hiding (bool, err) import qualified Data.Text as T @@ -30,6 +31,15 @@ import Foreign.Nix.Shellout.Types import qualified Foreign.Nix.Shellout.Helpers as Helpers +import Data.Text (Text) +import Data.String (IsString) +import GHC.IO.Exception (ExitCode(ExitFailure, ExitSuccess)) +import qualified Data.Text as Text +import Data.Bool (bool) +import Data.Bifunctor (first) +import qualified Data.Text.Lazy as Text.Lazy +import qualified Data.Text.Lazy.Encoding as Text.Lazy.Encoding +import qualified Data.List as List data PrefetchError = PrefetchOutputMalformed Text @@ -69,7 +79,7 @@ url UrlOptions{..} = Helpers.readProcess handler exec args where exec = "nix-prefetch-url" - args = bool [] ["--unpack"] urlUnpack + args = if urlUnpack then ["--unpack"] else [] <> maybe [] (\n -> ["--name", n]) urlName <> [ "--type", "sha256" , "--print-path" @@ -82,7 +92,7 @@ path <- tryLast (exec <> " didn’t output a store path") ls sha <- let errS = (exec <> " didn’t output a hash") in tryInit errS ls >>= tryLast errS - pure (Sha256 sha, StorePath $ toS path) + pure (Sha256 sha, StorePath $ Text.unpack path) ExitFailure _ -> throwE $ if "error: hash mismatch" `T.isPrefixOf` err then ExpectedHashError @@ -137,23 +147,23 @@ -- we need @url [rev [hash]]@, -- otherwise we can’t expect a hash , unUrl gitUrl - , maybe "" identity gitRev ] + , fromMaybe "" gitRev ] -- hash comes last <> maybe [] (\(Sha256 h) -> [h]) gitExpectedHash handler (out, err) = \case ExitSuccess -> withExceptT PrefetchOutputMalformed $ do - let error msg = exec <> " " <> msg + let error' msg = exec <> " " <> msg jsonError :: [Char] -> Text - jsonError = \msg -> error (T.intercalate "\n" + jsonError = \msg -> error' (T.intercalate "\n" [ "parsing json output failed:" - , toS msg + , Text.pack msg , "The output was:" , out ]) (gitOutputRev, gitOutputSha256) <- ExceptT . pure . first jsonError $ do - val <- Aeson.eitherDecode' (toS out) + val <- Aeson.eitherDecode' (Text.Lazy.Encoding.encodeUtf8 $ Text.Lazy.fromStrict out) flip AesonT.parseEither val $ Aeson.withObject "GitPrefetchOutput" $ \obj -> do (,) <$> obj Aeson..: "rev" @@ -162,11 +172,11 @@ -- The path isn’t output in the json, but on stderr. :( -- So this is a bit more hacky than necessary. gitOuputPath <- case - find ("path is /nix/store" `T.isPrefixOf`) (T.lines err) + List.find ("path is /nix/store" `T.isPrefixOf`) (T.lines err) >>= T.stripPrefix "path is " of Nothing -> throwE $ error "could not find nix store output path on stderr" - Just path -> pure $ StorePath $ toS path + Just path -> pure $ StorePath $ Text.unpack path pure GitOutput{..} diff --git a/Foreign/Nix/Shellout/Types.hs b/Foreign/Nix/Shellout/Types.hs --- a/Foreign/Nix/Shellout/Types.hs +++ b/Foreign/Nix/Shellout/Types.hs @@ -4,19 +4,29 @@ License : GPL-3 Stability : experimental -} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveFunctor #-} module Foreign.Nix.Shellout.Types where -import Protolude import Control.Error +import Control.Monad.IO.Class (MonadIO) +import Data.Text (Text) +import Data.Bifunctor (Bifunctor (bimap)) -- | Calls a command that returns an error and the whole stderr on failure. newtype NixAction e a = NixAction - { unNixAction :: ExceptT (Text, e) IO a } + { unNixAction :: ExceptT (NixActionError e) IO a } deriving (Functor, Applicative, Monad, MonadIO) +-- | Combines the standard error of running a command with a more semantic +-- error type one should match on first. +data NixActionError e = NixActionError + { actionStderr :: Text + , actionError :: e } + deriving (Show, Functor) + -- | Run a 'NixAction' without having to go through 'ExceptT' first. -runNixAction :: NixAction e a -> IO (Either (Text, e) a) +runNixAction :: NixAction e a + -> IO (Either (NixActionError e) a) runNixAction = runExceptT . unNixAction instance Bifunctor NixAction where @@ -25,7 +35,7 @@ -- | A path in the nix store. It carries a phantom @a@ to differentiate -- between 'Derivation' files and 'Realized' paths. newtype StorePath a = StorePath - { fromStorePath :: FilePath } + { unStorePath :: FilePath } deriving (Eq, Show) -- | A nix derivation is a complete build instruction that can be realized. diff --git a/Setup.hs b/Setup.hs deleted file mode 100644 --- a/Setup.hs +++ /dev/null @@ -1,2 +0,0 @@ -import Distribution.Simple -main = defaultMain diff --git a/libnix.cabal b/libnix.cabal --- a/libnix.cabal +++ b/libnix.cabal @@ -1,5 +1,5 @@ name: libnix -version: 0.2.0.1 +version: 0.3.0.0 synopsis: Bindings to the nix package manager description: Use the nix package manager from Haskell. All modules are designed to be imported qualified. category: Foreign, Nix @@ -12,11 +12,12 @@ build-type: Simple cabal-version: >=1.10 -extra-source-files: +extra-source-files: LICENSE + CHANGELOG.md README.md shell.nix - + source-repository head type: git location: https://github.com/Profpatsch/libnix-haskell @@ -26,20 +27,16 @@ , Foreign.Nix.Shellout.Prefetch , Foreign.Nix.Shellout.Types other-modules: Foreign.Nix.Shellout.Helpers - build-depends: base >=4.9 && <5 - , aeson >=1.0.0.0 && <1.5.0.0 - , errors >=2.2.0 && <2.4.0 + build-depends: base >=4.9 && <5.0 + , aeson >=1.0.0.0 + , bytestring + , deepseq + , errors >=2.2.0 , filepath - , protolude ==0.2.* , process , text - -- hs-source-dirs: + -- hs-source-dirs: ghc-options: -Wall - default-extensions: NoImplicitPrelude - , OverloadedStrings - , LambdaCase - , TupleSections - , ViewPatterns default-language: Haskell2010 test-suite tests @@ -52,12 +49,7 @@ , errors , text , libnix - , protolude , tasty , tasty-hunit ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall - default-extensions: NoImplicitPrelude - , OverloadedStrings - , LambdaCase - , TupleSections default-language: Haskell2010 diff --git a/shell.nix b/shell.nix --- a/shell.nix +++ b/shell.nix @@ -1,33 +1,11 @@ -((import {}).haskellPackages.override { - overrides = self: - super: - { - my-pkg = let - buildDepends = with self; - [ - aeson - errors - filepath - protolude - tasty - tasty-hunit - ]; - in super.mkDerivation { - pname = "pkg-env"; - src = "/dev/null"; - version = "none"; - license = "none"; - inherit buildDepends; - buildTools = with self; - [ - ghcid - cabal-install - hpack - hscolour - (hoogleLocal { - packages = buildDepends; - }) - ]; - }; - }; -}).my-pkg.env +{ pkgs ? import {}}: + +pkgs.haskellPackages.shellFor { + packages = hps: [ + (hps.callCabal2nix "libnix" (pkgs.nix-gitignore.gitignoreSource [".git"] ./.) {}) + ]; + buildInputs = [ + pkgs.cabal-install + pkgs.haskell-language-server + ]; +} diff --git a/tests/TestShellout.hs b/tests/TestShellout.hs --- a/tests/TestShellout.hs +++ b/tests/TestShellout.hs @@ -1,6 +1,7 @@ +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE OverloadedStrings #-} module TestShellout where -import Protolude hiding (check) import qualified Data.Text as T import System.IO (openTempFile, hClose) import System.Directory (getTemporaryDirectory) @@ -9,6 +10,10 @@ import Test.Tasty.HUnit import Foreign.Nix.Shellout +import Data.Text (Text) +import Control.Monad.IO.Class (liftIO) +import Data.Bifunctor (first) +import Control.Monad ((>=>)) shelloutTests :: TestTree @@ -30,17 +35,17 @@ nixpkgsExists, multilineErrors, helloWorld, copyTempfileToStore :: TestTree syntaxError = testCase "syntax error" - $ parseNixExpr ";" - `isE` (Left ("", SyntaxError "unexpected ';', at (string):1:1")) + $ parseNixExpr ";" `isENoFail` + Left ("", SyntaxError "unexpected ';', at (string):1:1") infiniteRecursion = testCase "infinite recursion" $ parseInst "let a = a; in a" - `isE` (Left ( "error: infinite recursion encountered, at (string):1:10" - , UnknownInstantiateError)) + `isE` Left ( "error: infinite recursion encountered, at (string):1:10" + , UnknownInstantiateError) notADerivation = testCase "not a derivation" $ parseInst "42" - `isE` (Left ("", NotADerivation)) + `isE` Left ("", NotADerivation) someDerivation = testCase "a basic derivation" $ assertNoFailure $ parseInst @@ -51,10 +56,10 @@ multilineErrors = testCase "nixpkgs multiline stderr it parsed" $ parseEval "builtins.abort ''wow\nsuch error''" - `isE` (Left + `isE` Left ( "error: evaluation aborted with the following error \ \message: 'wow\nsuch error'" - , UnknownInstantiateError)) + , UnknownInstantiateError) helloWorld = testCase "build the GNU hello package" $ assertNoFailure $ parseInstRealize "with import {}; hello" @@ -83,23 +88,42 @@ first (\_ -> UnknownInstantiateError) . parseNixExpr >=> like -isE :: (Eq e, Eq a, Show a, Show e) +isE :: (Eq a, Eq e, Show a, Show e) => NixAction e a -> Either (Text, e) a -- ^ Left (subset of stdout, error) -> Assertion -isE na match = runExceptT (unNixAction na) >>= check match - where - check (Left (outMatch, err)) (Left (out, err')) = do - assertBool "stderr not matched" (outMatch `T.isInfixOf` out) - err @=? err' - check (Right _) (Left _) = - assertFailure "output should have succeeded, but is failed" - check a b = a @=? b +isE na match = runNixAction na >>= \res -> + case (match, res) of + (Right a, Right b) -> a @=? b + (match', res') -> check match' res' +isENoFail :: (Eq e, Show a, Show e) + => NixAction e a + -> Either (Text, e) a + -- ^ Left (subset of stdout, error) + -> Assertion +isENoFail na match = runNixAction na >>= check match + +check :: (Eq a, Show a) + => Either (Text, a) _x + -> Either (NixActionError a) _x + -> Assertion +check (Left (outMatch, err)) + (Left NixActionError + { actionStderr = out + , actionError = err' }) = do + assertBool "stderr not matched" (outMatch `T.isInfixOf` out) + err @=? err' +check (Right _) (Left _) = + assertFailure "output should have succeeded, but it failed" +check (Left _) (Right _) = + assertFailure "output should have failed, but it succeeded" +check _ _ = error "handled by isE" + assertNoFailure :: Show e => NixAction e a -> Assertion assertNoFailure na = do - ei <- runExceptT (unNixAction na) + ei <- runNixAction na case ei of - (Left (_, e)) -> assertFailure $ show e + (Left naErr) -> assertFailure $ show $ actionError naErr (Right _) -> pure ()