nix-freeze-tree 0.1.0.1 → 0.1.1.0
raw patch · 9 files changed
+322/−258 lines, 9 filesdep ~basedep ~cryptonitedep ~hnix
Dependency ranges changed: base, cryptonite, hnix, hnix-store-core, optparse-applicative, path-io, prettyprinter, tasty-discover, text
Files
- CHANGELOG.md +5/−0
- README.md +27/−6
- nix-freeze-tree.cabal +25/−25
- src/BuilderDirs.hs +4/−4
- src/Config.hs +91/−70
- src/NixBuilder.hs +61/−62
- src/NixFreezeTree.hs +50/−49
- src/NixHash.hs +35/−26
- test/ConfigTest.hs +24/−16
CHANGELOG.md view
@@ -1,5 +1,10 @@ # Revision history for nix-freeze-tree +## 0.1.1.0 -- 2023-12-05++* Bump a lot of versions+* Support more illegal characters in filenames ([~jack/nix-freeze-tree#8](https://todo.sr.ht/~jack/nix-freeze-tree/8))+ ## 0.1.0.1 -- 2021-11-01 * Support `hnix-store-core ^>=0.14.0.1` and `hnix ^>=0.5`
README.md view
@@ -31,7 +31,9 @@ ### Nix If you use Nix, you can install the command into your local-environment by running `nix-env -f+environment by running `nix profile install+sourcehut:~jack/nix-freeze-tree`. If you're not using flakes, you can+instead try `nix-env -f https://git.sr.ht/~jack/nix-freeze-tree/archive/master.tar.gz -iA command`. @@ -64,11 +66,31 @@ ## Calling from Nix -This repository's `default.nix` gives access to a function `freeze`,-which can be used to freeze the output of an existing derivation.+This repository's flake defines a function `lib.${system}.freeze`,+which can be used to freeze the output of an existing derivation. You+can use it like this: -You can use it with Nix code that looks a bit like:+```nix+{+ inputs = {+ flake-utils.url = "github:numtide/flake-utils";+ nix-freeze-tree = "git+https://git.sr.ht/~jack/nix-freeze-tree"+ }; + outputs = inputs@{ ... }:+ inputs.flake-utils.lib.eachDefaultSystem (system:+ {+ defaultPackage = (import nix-freeze-tree { }).lib.${system}.freeze+ some-derivation-to-be-frozen;+ }+ );+}+```++The `freeze` function corresponding to `builtins.currentSystem` is+also exposed in `default.nix`, so you can use it with Nix code that looks+a bit like:+ ```nix let # Some nixpkgs from somewhere@@ -111,8 +133,7 @@ ## Other Resources * Questions should go to the- [nix-freeze-tree-discuss](https://lists.sr.ht/~jack/nix-freeze-tree-discuss)- mailing list.+ [public-inbox](https://lists.sr.ht/~jack/public-inbox) mailing list. * Bug reports should go to the [bug tracker](https://todo.sr.ht/~jack/nix-freeze-tree).
nix-freeze-tree.cabal view
@@ -1,27 +1,27 @@-cabal-version: 2.2-name: nix-freeze-tree-version: 0.1.0.1-synopsis: Convert a tree of files into fixed-output derivations+cabal-version: 2.2+name: nix-freeze-tree+version: 0.1.1.0+synopsis: Convert a tree of files into fixed-output derivations description: @nix-freeze-tree@ walks a directory tree and generates a tree of Nix expressions that recreate the tree from fixed-output derivations, one derivation per file in the source tree. See @README.md@ to get started. -homepage: https://git.sr.ht/~jack/nix-freeze-tree-bug-reports: https://todo.sr.ht/~jack/nix-freeze-tree-license: AGPL-3.0-or-later-license-file: LICENSE-author: Jack Kelly-maintainer: jack@jackkelly.name-copyright: (c) 2020 Jack Kelly-category: Application, Nix-build-type: Simple-extra-source-files:+homepage: https://git.sr.ht/~jack/nix-freeze-tree+bug-reports: https://todo.sr.ht/~jack/nix-freeze-tree+license: AGPL-3.0-or-later+license-file: LICENSE+author: Jack Kelly+maintainer: jack@jackkelly.name+copyright: (c) 2020, 2023 Jack Kelly+category: Application, Nix+build-type: Simple+extra-doc-files: CHANGELOG.md README.md -tested-with: GHC ==8.10.2+tested-with: GHC ==9.4.8 executable nix-freeze-tree hs-source-dirs: bin@@ -46,20 +46,20 @@ default-language: Haskell2010 ghc-options: -Wall build-depends:- , base >=4.9 && <4.17+ , base >=4.9 && <4.18 , bytestring >=0.10.8.2 && <0.12- , cryptonite >=0.28 && <0.30+ , cryptonite >=0.28 && <0.31 , data-fix >=0.2.0 && <0.4 , directory ^>=1.3.3.0 , directory-tree ^>=0.12.1- , hnix ^>=0.14.0.1- , hnix-store-core ^>=0.5- , optparse-applicative >=0.14.3.0 && <0.17+ , hnix ^>=0.16.0+ , hnix-store-core ^>=0.5.0.0+ , optparse-applicative >=0.14.3.0 && <0.18 , path >=0.6.1 && <0.10- , path-io ^>=1.6- , prettyprinter >=1.2.1.1 && <1.8+ , path-io >=1.6 && <1.9+ , prettyprinter ^>=1.7.0 , raw-strings-qq ^>=1.1- , text ^>=1.2.3.1+ , text ^>=1.2.3.1 || ^>=2.0 , transformers >=0.5.6.2 && <0.7 test-suite nix-freeze-tree-tests@@ -72,8 +72,8 @@ , HUnit ^>=1.6.0.0 , nix-freeze-tree-internal , optparse-applicative- , tasty >=1.2.3 && <1.5- , tasty-discover ^>=4.2.1+ , tasty >=1.2.3 && <1.5+ , tasty-discover ^>=4.2.1 || ^>=5.0.0 , tasty-hunit ^>=0.10.0.2 hs-source-dirs: test
src/BuilderDirs.hs view
@@ -1,12 +1,12 @@-module BuilderDirs (BuilderDirs(..), currentDir) where+module BuilderDirs (BuilderDirs (..), currentDir) where import Control.Applicative (liftA2)-import Path (Abs, Dir, Path, Rel, (</>)) import Control.Monad.Trans.Reader (ReaderT, asks)+import Path (Abs, Dir, Path, Rel, (</>)) data BuilderDirs = BuilderDirs- { _root :: Path Abs Dir- , _subdir :: Path Rel Dir+ { _root :: Path Abs Dir,+ _subdir :: Path Rel Dir } currentDir :: ReaderT BuilderDirs IO (Path Abs Dir)
src/Config.hs view
@@ -1,42 +1,50 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE QuasiQuotes #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE StandaloneDeriving #-} module Config- ( Config(..)- , configParserInfo- , checkConfig- ) where+ ( Config (..),+ configParserInfo,+ checkConfig,+ )+where -import Data.Functor.Identity (Identity(..))-import Data.Version (showVersion)-import Options.Applicative+import Data.Functor.Identity (Identity (..))+import Data.Version (showVersion)+import Options.Applicative import qualified Paths_nix_freeze_tree as NixFreezeTree-import Text.RawString.QQ (r)+import Text.RawString.QQ (r) data Config f = Config- { _force :: f Bool- , _verbose :: f Bool- , _outputRoot :: f FilePath- , _inDir :: f FilePath+ { _force :: f Bool,+ _verbose :: f Bool,+ _outputRoot :: f FilePath,+ _inDir :: f FilePath } deriving instance Eq (Config Identity)+ deriving instance Eq (Config Maybe)+ deriving instance Show (Config Identity)+ deriving instance Show (Config Maybe) version :: Parser (a -> a)-version = abortOption (InfoMsg message) $ mconcat- [ long "version"- , help "Display version information and exit."- ]+version =+ abortOption (InfoMsg message) $+ mconcat+ [ long "version",+ help "Display version information and exit."+ ] where- message = "nix-freeze-tree " <> showVersion NixFreezeTree.version <> "\n"- <> [r|Copyright (C) 2020 Jack Kelly+ message =+ "nix-freeze-tree "+ <> showVersion NixFreezeTree.version+ <> "\n"+ <> [r|Copyright (C) 2020 Jack Kelly License AGPLv3+: GNU Affero General Public License version 3 or later <https://www.gnu.org/licenses/agpl-3.0.html>@@ -46,57 +54,70 @@ |] configParser :: Parser (Config Maybe)-configParser = Config- <$> do fmap Just . switch $ mconcat- [ long "force"- , short 'f'- , help- $ "If any default.nix exist in the output directory, "- <> "remove them and generate anyway"- ]- <*> do fmap Just . switch $ mconcat- [ long "verbose"- , short 'v'- , help "Display messages while working."- ]- <*> do option (Just <$> str) $ mconcat- [ long "out-root"- , short 'o'- , metavar "OUT_ROOT"- , help "Where to write the nix files"- , showDefaultWith $ const "IN_DIR"- , value Nothing- ]- <*> do argument (Just <$> str) $ mconcat- [ metavar "IN_DIR"- , help "Directory to freeze"- , showDefaultWith $ const "."- , value (Just ".")- ]+configParser =+ Config+ <$> do+ fmap Just . switch $+ mconcat+ [ long "force",+ short 'f',+ help $+ "If any default.nix exist in the output directory, "+ <> "remove them and generate anyway"+ ]+ <*> do+ fmap Just . switch $+ mconcat+ [ long "verbose",+ short 'v',+ help "Display messages while working."+ ]+ <*> do+ option (Just <$> str) $+ mconcat+ [ long "out-root",+ short 'o',+ metavar "OUT_ROOT",+ help "Where to write the nix files",+ showDefaultWith $ const "IN_DIR",+ value Nothing+ ]+ <*> do+ argument (Just <$> str) $+ mconcat+ [ metavar "IN_DIR",+ help "Directory to freeze",+ showDefaultWith $ const ".",+ value (Just ".")+ ] configParserInfo :: ParserInfo (Config Maybe)-configParserInfo = info (version <*> helper <*> configParser) $ mconcat- [ header- $ "nix-freeze-tree - "- <> "Create fixed-output derivations for each file in a tree"- , progDesc- $ "Write a tree of nix expressions to OUT_ROOT that build a "- <> "derivation, symlinking every file in IN_DIR as a separate "- <> "fixed-output derivation."- , fullDesc- ]+configParserInfo =+ info (version <*> helper <*> configParser) $+ mconcat+ [ header $+ "nix-freeze-tree - "+ <> "Create fixed-output derivations for each file in a tree",+ progDesc $+ "Write a tree of nix expressions to OUT_ROOT that build a "+ <> "derivation, symlinking every file in IN_DIR as a separate "+ <> "fixed-output derivation.",+ fullDesc+ ] checkConfig :: Config Maybe -> Maybe (Config Identity) checkConfig = collectMaybes . applyDefaults where- collectMaybes (Config f v o i) = Config- <$> (Identity <$> f)- <*> (Identity <$> v)- <*> (Identity <$> o)- <*> (Identity <$> i)+ collectMaybes (Config f v o i) =+ Config+ <$> (Identity <$> f)+ <*> (Identity <$> v)+ <*> (Identity <$> o)+ <*> (Identity <$> i) - applyDefaults c = Config- (_force c)- (_verbose c <|> Just False)- (_outputRoot c <|> _inDir c)- (_inDir c)+ applyDefaults c =+ Config+ (_force c)+ (_verbose c <|> Just False)+ (_outputRoot c <|> _inDir c)+ (_inDir c)
src/NixBuilder.hs view
@@ -1,21 +1,20 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} -module NixBuilder (BuilderDirs(..), mkBuildExpr) where+module NixBuilder (BuilderDirs (..), mkBuildExpr) where -import BuilderDirs (BuilderDirs(..), currentDir)-import Control.Monad.Trans.Reader (ReaderT)-import Data.Fix (Fix(..))-import Data.Functor ((<&>))-import Data.List (dropWhileEnd)-import Data.List.NonEmpty (NonEmpty(..))+import BuilderDirs (BuilderDirs (..), currentDir)+import Control.Monad.Trans.Reader (ReaderT)+import Data.Fix (Fix (..))+import Data.List (dropWhileEnd)+import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as NE-import Data.Text (Text)+import Data.Text (Text) import qualified Data.Text as T-import Nix-import NixHash (mkFileAttrs, replaceLeadingDot)-import Path (Abs, Dir, File, Path, Rel)+import Nix+import NixHash (mkFileAttrs, replaceUnsafeChars)+import Path (Abs, Dir, File, Path, Rel) import qualified Path as P -- | Given a list of directory contents, construct a Nix expression@@ -30,27 +29,25 @@ mkBuildExpr files dirs = do fileAttrs <- mkFileAttrs files - let- dirAttrs = mkDirAttr <$> dirs- mSrcs = NE.nonEmpty $ dirAttrs ++ fileAttrs+ let dirAttrs = mkDirAttr <$> dirs+ mSrcs = NE.nonEmpty $ dirAttrs ++ fileAttrs - drv <- currentDir <&> case mSrcs of- Nothing -> mkEmptyDerivation- Just srcs -> mkDirectoryDerivation srcs+ drv <- maybe mkEmptyDerivation mkDirectoryDerivation mSrcs <$> currentDir pure $ mkParamset [stdenvArg] False ==> drv- where mkDirAttr :: Path Rel Dir -> (Text, NExpr) mkDirAttr d =- ( T.pack $ nixSafeFilePath d- , "import" @@ mkPath False (nixSafeFilePath d) @@ mkNonRecSet- [ inherit ["stdenv"] nullPos ]+ ( T.pack $ nixSafeFilePath d,+ "import (./. + "+ @@ mkStr (T.pack ("/" ++ nixSafeFilePath d))+ @@ ")"+ @@ mkNonRecSet [inherit ["stdenv"]] ) stdenvArg =- ( "stdenv"- , Just $ ("import" @@ mkEnvPath "nixpkgs" @@ mkNonRecSet []) @. "stdenv"+ ( "stdenv",+ Just $ ("import" @@ mkEnvPath "nixpkgs" @@ mkNonRecSet []) @. "stdenv" ) -- | Construct the @mkDerivation@ call for a directory. It builds a@@ -59,57 +56,59 @@ mkDirectoryDerivation :: NonEmpty (Text, NExpr) -> Path Abs Dir -> NExpr mkDirectoryDerivation srcs d = mkLets ["paths" $= mkNonRecSet (NE.toList $ mkBinding <$> srcs)] $- "stdenv" @. "mkDerivation" @@ mkNonRecSet- [ "name" $= abspathToDerivationName d- , "allowSubstitutes" $= mkBool False- , "preferLocalBuild" $= mkBool True- , "phases" $= mkList [mkStr "installPhase"]- , "installPhase" $= installCmds- ]-+ "stdenv"+ @. "mkDerivation"+ @@ mkNonRecSet+ [ "name" $= abspathToDerivationName d,+ "allowSubstitutes" $= mkBool False,+ "preferLocalBuild" $= mkBool True,+ "phases" $= mkList [mkStr "installPhase"],+ "installPhase" $= installCmds+ ] where mkBinding :: (Text, NExpr) -> Binding NExpr mkBinding (t, e) = NamedVar (DynamicKey (Plain (DoubleQuoted [Plain t])) :| []) e nullPos installCmds :: NExpr- installCmds = Fix . NStr . Indented 2 $- [ Plain "mkdir -p $out;"- , Plain "cd $out;"- ] ++ foldMap (mkLinkCmd . fst) srcs+ installCmds =+ Fix . NStr . Indented 2 $+ [ Plain "mkdir -p $out;",+ Plain "cd $out;"+ ]+ ++ foldMap (mkLinkCmd . fst) srcs where mkLinkCmd :: Text -> [Antiquoted Text NExpr] mkLinkCmd name =- let- -- Use double-quoted selections from "paths".- -- This works on files that start with a leading '.'.- sourcePath :: NonEmpty (NKeyName r)- sourcePath = pure . DynamicKey . Plain $ DoubleQuoted [Plain name]-- in- [ Plain "ln -sv "- , Antiquoted . Fix $ NSelect "paths" sourcePath Nothing- , Plain $ " " <> name <> ";"- ]-+ let -- Use double-quoted selections from "paths".+ -- This works on files that start with a leading '.'.+ sourcePath :: NonEmpty (NKeyName r)+ sourcePath = pure . DynamicKey . Plain $ DoubleQuoted [Plain name]+ in [ Plain "ln -sv ",+ Antiquoted . Fix $ NSelect Nothing "paths" sourcePath,+ Plain $ " '" <> name <> "';"+ ] -- | Construct the @mkDerivation@ call for an empty directory. mkEmptyDerivation :: Path Abs Dir -> NExpr-mkEmptyDerivation d = "stdenv" @. "mkDerivation" @@ mkNonRecSet- [ "name" $= abspathToDerivationName d- , "allowSubstitutes" $= mkBool False- , "preferLocalBuild" $= mkBool True- , "phases" $= mkList [mkStr "installPhase"]- , "installPhase" $= mkStr "mkdir $out"- ]+mkEmptyDerivation d =+ "stdenv"+ @. "mkDerivation"+ @@ mkNonRecSet+ [ "name" $= abspathToDerivationName d,+ "allowSubstitutes" $= mkBool False,+ "preferLocalBuild" $= mkBool True,+ "phases" $= mkList [mkStr "installPhase"],+ "installPhase" $= mkStr "mkdir $out"+ ] abspathToDerivationName :: Path Abs Dir -> NExpr-abspathToDerivationName- = mkStr- . T.pack- . replaceLeadingDot- . nixSafeFilePath- . P.dirname+abspathToDerivationName =+ mkStr+ . T.pack+ . replaceUnsafeChars+ . nixSafeFilePath+ . P.dirname -- | Nix doesn't like trailing slashes in derivation names or paths. nixSafeFilePath :: Path b t -> FilePath
src/NixFreezeTree.hs view
@@ -1,45 +1,45 @@-{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE ScopedTypeVariables #-} module NixFreezeTree (main) where -import BuilderDirs (BuilderDirs(..))-import Config (Config(..))+import BuilderDirs (BuilderDirs (..))+import Config (Config (..)) import qualified Config as C-import Control.Exception (catch)-import Control.Monad (when)-import Control.Monad.IO.Class (MonadIO(..))-import Control.Monad.Trans.Reader (ReaderT(..), asks, local)-import Data.Bool (bool)-import Data.Functor (void)-import Data.Functor.Identity (Identity(..))-import Data.List (isSuffixOf)-import Data.Text (Text)+import Control.Exception (catch)+import Control.Monad (when)+import Control.Monad.IO.Class (MonadIO (..))+import Control.Monad.Trans.Reader (ReaderT (..), asks, local)+import Data.Bool (bool)+import Data.Functor (void)+import Data.Functor.Identity (Identity (..))+import Data.List (isSuffixOf)+import Data.Text (Text) import qualified Data.Text.IO as T-import Data.Text.Prettyprint.Doc (defaultLayoutOptions, layoutPretty)-import Data.Text.Prettyprint.Doc.Render.Text (renderStrict)-import Nix.Pretty (prettyNix)-import NixBuilder (mkBuildExpr)-import Options.Applicative (execParser)-import Path (Abs, Dir, Path, Rel, (</>))+import Nix.Pretty (prettyNix)+import NixBuilder (mkBuildExpr)+import Options.Applicative (execParser)+import Path (Abs, Dir, Path, PathException, (</>)) import qualified Path as P+import Prettyprinter (defaultLayoutOptions, layoutPretty)+import Prettyprinter.Render.Text (renderStrict) import qualified System.Directory as D-import System.Directory.Tree- ( AnchoredDirTree(..)- , DirTree(..)- , FileName+import System.Directory.Tree+ ( AnchoredDirTree (..),+ DirTree (..),+ FileName, ) import qualified System.Directory.Tree as DT-import System.Exit (exitFailure)-import System.IO (hPutStrLn, stderr)+import System.Exit (exitFailure)+import System.IO (hPutStrLn, stderr) buildExprTree :: Path Abs Dir -> IO (DirTree Text) buildExprTree p = flip runReaderT (BuilderDirs p [P.reldir|.|]) $ do- (_ :/ inDirTree) <- P.toFilePath <$> asks _root >>= liftIO . DT.build+ (_ :/ inDirTree) <- asks _root >>= liftIO . DT.build . P.toFilePath case inDirTree of Dir _ fs -> go (".", fs) -- Use "." to avoid the root in output paths _ -> fail "Should never happen"- where -- Walk the directory tree, building the @default.nix@ files, and -- keeping an absolute path to where we are in the ReaderT@@ -47,13 +47,13 @@ go :: (FileName, [DirTree a]) -> ReaderT BuilderDirs IO (DirTree Text) go (dirName, dirFiles) = do relDirName <- P.parseRelDir dirName- local (\b -> b { _subdir = _subdir b </> relDirName }) $ do- files <- traverse P.parseRelFile [ f | File f _ <- dirFiles ]- dirs <- traverse P.parseRelDir [ d | Dir d _ <- dirFiles ]+ local (\b -> b {_subdir = _subdir b </> relDirName}) $ do+ files <- traverse P.parseRelFile [f | File f _ <- dirFiles]+ dirs <- traverse P.parseRelDir [d | Dir d _ <- dirFiles] defaultNix <- renderNix <$> mkBuildExpr files dirs- subdirs <- traverse go [ (d, fs) | Dir d fs <- dirFiles ]- pure . Dir dirName $ File "default.nix" defaultNix:subdirs+ subdirs <- traverse go [(d, fs) | Dir d fs <- dirFiles]+ pure . Dir dirName $ File "default.nix" defaultNix : subdirs renderNix = renderStrict . layoutPretty defaultLayoutOptions . prettyNix @@ -61,17 +61,18 @@ toAbsDir :: DirConstraint -> FilePath -> IO (Path Abs Dir) toAbsDir constraint d = liftIO $ do- absD <- (D.canonicalizePath d >>= P.parseAbsDir) `catch`- \(P.InvalidAbsDir _) -> dieD "does not name a directory"+ absD <-+ (D.canonicalizePath d >>= P.parseAbsDir)+ `catch` \(_ :: PathException) -> dieD "does not name a directory" isDir <- D.doesDirectoryExist d if isDir then pure absD else case constraint of- MustNameDirectory -> dieD "does not name a directory"- MustNameDirectoryIfExists -> D.doesPathExist d >>=- bool (pure absD) (dieD "names something other than a directory")-+ MustNameDirectory -> dieD "does not name a directory"+ MustNameDirectoryIfExists ->+ D.doesPathExist d+ >>= bool (pure absD) (dieD "names something other than a directory") where dieD m = die $ show d <> " " <> m @@ -85,31 +86,31 @@ when (defaultNixExists outFiles) $ if get _force- then do- vPutStrLn "a default.nix exists somewhere in the output tree, cleaning"- void . liftIO $ flip DT.writeDirectoryWith outPathTree $ \fp _ ->- when ("default.nix" `isSuffixOf` fp) $ do- vPutStrLn $ "deleting " <> fp- D.removePathForcibly fp- else die "a default.nix exists somewhere in the output tree, cannot proceed"+ then do+ vPutStrLn "a default.nix exists somewhere in the output tree, cleaning"+ void . liftIO $ flip DT.writeDirectoryWith outPathTree $ \fp _ ->+ when ("default.nix" `isSuffixOf` fp) $ do+ vPutStrLn $ "deleting " <> fp+ D.removePathForcibly fp+ else die "a default.nix exists somewhere in the output tree, cannot proceed" outTree <- buildExprTree inDir void $ flip DT.writeDirectoryWith (outRootPath :/ outTree) $ \fp t -> do vPutStrLn . ("writing " <>) =<< D.canonicalizePath fp T.writeFile fp t- where get f = runIdentity $ f cfg defaultNixExists (File n _) = n == "default.nix" defaultNixExists (Dir _ cs) = any defaultNixExists cs- defaultNixExists Failed{} = False+ defaultNixExists Failed {} = False vPutStrLn msg = when (get _verbose) $ putStrLn msg main :: IO ()-main = C.checkConfig <$> execParser C.configParserInfo >>=- maybe (fail "Should be impossible") writeNixTree+main =+ execParser C.configParserInfo+ >>= maybe (fail "Should be impossible") writeNixTree . C.checkConfig -die :: MonadIO m => String -> m a+die :: (MonadIO m) => String -> m a die msg = liftIO $ hPutStrLn stderr ("FATAL: " <> msg) *> exitFailure
src/NixHash.hs view
@@ -1,22 +1,22 @@-{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeApplications #-} -module NixHash (mkFileAttrs, replaceLeadingDot) where+module NixHash (mkFileAttrs, replaceUnsafeChars) where -import BuilderDirs (BuilderDirs, currentDir)-import Control.Monad.IO.Class (MonadIO (..))-import Control.Monad.Trans.Reader-import Crypto.Hash (Digest, SHA256, hash)+import BuilderDirs (BuilderDirs, currentDir)+import Control.Monad.IO.Class (MonadIO (..))+import Control.Monad.Trans.Reader+import Crypto.Hash (Digest, SHA256, hash) import qualified Data.ByteString as B-import Data.Text (Text)+import Data.Char (isAsciiLower, isAsciiUpper, isDigit)+import Data.Text (Text) import qualified Data.Text as T-import Nix-import Path (Abs, File, Path, Rel, toFilePath, (</>))-import Path.IO (withSystemTempFile)-import System.IO-import System.Nix.Hash (BaseEncoding (..), encodeDigestWith)-import System.Nix.Nar (buildNarIO, narEffectsIO)+import Nix+import Path (Abs, File, Path, Rel, toFilePath, (</>))+import Path.IO (withSystemTempFile)+import System.IO+import System.Nix.Hash (BaseEncoding (..), encodeDigestWith)+import System.Nix.Nar (buildNarIO, narEffectsIO) -- | Build a set of @filename -> derivation@ attributes. mkFileAttrs :: [Path Rel File] -> ReaderT BuilderDirs IO [(Text, NExpr)]@@ -51,20 +51,20 @@ absF <- (</> f) <$> currentDir h <- recursiveHash absF - let bindings =- [ "path" $= mkPath False (toFilePath absF)- , "sha256" $= mkStr h- ] ++ [ "name" $= mkStr (T.pack . replaceLeadingDot $ toFilePath f)- | head (toFilePath f) == '.'- ]+ let name = toFilePath f+ sanitizedName = replaceUnsafeChars name+ bindings =+ [ "path" $= mkStr (T.pack (toFilePath absF)),+ "sha256" $= mkStr h+ ]+ ++ ["name" $= mkStr (T.pack sanitizedName) | name /= sanitizedName] pure $ "builtins" @. "path" @@ mkNonRecSet bindings - -- | Serialise as per -- https://gist.github.com/jbeda/5c79d2b1434f0018d693 , which is an -- extract from Figure 5.2 of http://nixos.org/~eelco/pubs/phd-thesis.pdf , -- which is the Nix thesis.-recursiveHash :: MonadIO m => Path Abs File -> m Text+recursiveHash :: (MonadIO m) => Path Abs File -> m Text recursiveHash absF = liftIO . withSystemTempFile "nix-freeze-tree.nar" $ \_ h -> do buildNarIO narEffectsIO (toFilePath absF) h@@ -72,7 +72,16 @@ contents <- B.hGetContents h pure $ encodeDigestWith NixBase32 (hash contents :: Digest SHA256) --- | A leading dot is illegal in Nix derivation names. Replace it with '_'.-replaceLeadingDot :: FilePath -> FilePath-replaceLeadingDot ('.':f) = '_':f-replaceLeadingDot f = f+-- | Replace various characters which don't work in Nix derivation names+replaceUnsafeChars :: FilePath -> FilePath+replaceUnsafeChars = map replaceUnsafeChar . replaceLeadingDot+ where+ replaceLeadingDot ('.' : f) = '_' : f+ replaceLeadingDot f = f++ replaceUnsafeChar ch+ | isAsciiLower ch = ch+ | isAsciiUpper ch = ch+ | isDigit ch = ch+ | ch `elem` ['\'', '_', '-', '.'] = ch+ | otherwise = '_'
test/ConfigTest.hs view
@@ -1,25 +1,33 @@ module ConfigTest where import Config-import Data.Functor.Identity (Identity(..))+import Data.Functor.Identity (Identity (..))+import Options.Applicative (ParserResult (..), defaultPrefs, execParserPure) import Test.Tasty (TestTree, testGroup)-import Test.Tasty.HUnit (Assertion, (@?=), assertFailure, testCase)-import Options.Applicative (ParserResult(..), defaultPrefs, execParserPure)+import Test.Tasty.HUnit (Assertion, assertFailure, testCase, (@?=)) test_optionParser :: TestTree-test_optionParser = testGroup "Option Parser"- [ testCase "defaults" $ []- `shouldParseTo` Config (i False) (i False) (i ".") (i ".")- , testCase "dir only" $ ["here"]- `shouldParseTo` Config (i False) (i False) (i "here") (i "here")- , testCase "custom output dir" $ ["-o", "there", "here"]- `shouldParseTo` Config (i False) (i False) (i "there") (i "here")- , testCase "force" $ ["-f", "here"]- `shouldParseTo` Config (i True) (i False) (i "here") (i "here")- , testCase "verbose" $ ["-v"]- `shouldParseTo` Config (i False) (i True) (i ".") (i ".")- ]- where i = Identity+test_optionParser =+ testGroup+ "Option Parser"+ [ testCase "defaults" $+ []+ `shouldParseTo` Config (i False) (i False) (i ".") (i "."),+ testCase "dir only" $+ ["here"]+ `shouldParseTo` Config (i False) (i False) (i "here") (i "here"),+ testCase "custom output dir" $+ ["-o", "there", "here"]+ `shouldParseTo` Config (i False) (i False) (i "there") (i "here"),+ testCase "force" $+ ["-f", "here"]+ `shouldParseTo` Config (i True) (i False) (i "here") (i "here"),+ testCase "verbose" $+ ["-v"]+ `shouldParseTo` Config (i False) (i True) (i ".") (i ".")+ ]+ where+ i = Identity shouldParseTo :: [String] -> Config Identity -> Assertion args `shouldParseTo` c =