nix-thunk 0.1.0.0 → 0.2.0.0
raw patch · 5 files changed
+94/−55 lines, 5 files
Files
- CHANGELOG.md +3/−0
- nix-thunk.cabal +2/−2
- src-bin/nix-thunk.hs +3/−3
- src/Nix/Thunk.hs +52/−22
- src/Nix/Thunk/Command.hs +34/−28
CHANGELOG.md view
@@ -1,4 +1,7 @@ # Revision history for nix-thunk +## 0.2.0.0+* Add nix-thunk create. This caused some minor breakage to the Haskell library API, but not the Nix or command line interfaces.+ ## 0.1.0.0 * Initial release. Extracted the Nix part of this code from https://github.com/obsidiansystems/reflex-platform and the Haskell part from https://github.com/obsidiansystems/obelisk
nix-thunk.cabal view
@@ -1,13 +1,13 @@ cabal-version: >=1.10 name: nix-thunk-version: 0.1.0.0+version: 0.2.0.0 license: BSD3 license-file: LICENSE copyright: Obsidian Systems LLC 2020 maintainer: maintainer@obsidian.systems author: Obsidian Systems LLC bug-reports: https://github.com/obsidiansystems/nix-thunk-synopsis: Virtual vendorization with Nix+synopsis: Lightweight dependency management with Nix description: nix-thunk lets you manage source code depencies in a lightweight and reproducible way, using Nix. Each source repository is represented by a stub directory, which refers to the original Git repository. nix-thunk can easily update these dependencies. .
src-bin/nix-thunk.hs view
@@ -11,7 +11,7 @@ data Args = Args { _args_verbose :: Bool- , _args_command :: ThunkOption+ , _args_command :: ThunkCommand } verbose :: Parser Bool@@ -22,7 +22,7 @@ ] args :: Parser Args-args = Args <$> verbose <*> thunkOption+args = Args <$> verbose <*> thunkCommand argsInfo :: ParserInfo Args argsInfo = info (args <**> helper) $ mconcat@@ -40,7 +40,7 @@ args <- getArgs args' <- handleParseResult $ execParserPure parserPrefs argsInfo args cliConf <- mkDefaultCliConfig args- runCli cliConf (runThunkOption (_args_command args')) >>= \case+ runCli cliConf (runThunkCommand (_args_command args')) >>= \case Right () -> exitWith ExitSuccess Left e -> do T.putStrLn $ prettyNixThunkError e
src/Nix/Thunk.hs view
@@ -1,14 +1,15 @@ {-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternGuards #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-} module Nix.Thunk ( ThunkSource (..)@@ -24,6 +25,7 @@ , getThunkPtr , packThunk , createThunk+ , createThunk' , ThunkPackConfig (..) , ThunkConfig (..) , updateThunkToLatest@@ -35,6 +37,10 @@ , nixBuildAttrWithCache , attrCacheFileName , prettyNixThunkError+ , ThunkCreateConfig (..)+ , parseGitUri+ , GitUri (..)+ , uriThunkPtr ) where import Control.Applicative@@ -91,6 +97,7 @@ import Bindings.Cli.Git import Bindings.Cli.Coreutils (cp) import Bindings.Cli.Nix+import Data.List (stripPrefix) -------------------------------------------------------------------------------- -- Hacks@@ -205,6 +212,14 @@ , _thunkPackConfig_config :: ThunkConfig } deriving Show +data ThunkCreateConfig = ThunkCreateConfig+ { _thunkCreateConfig_uri :: GitUri+ , _thunkCreateConfig_branch :: Maybe (Name Branch)+ , _thunkCreateConfig_rev :: Maybe (Ref Ref.SHA1)+ , _thunkCreateConfig_config :: ThunkConfig+ , _thunkCreateConfig_destination :: Maybe FilePath+ } deriving Show+ -- | Convert a GitHub source to a regular Git source. Assumes no submodules. forgetGithub :: Bool -> GitHubSource -> GitSource forgetGithub useSsh s = GitSource@@ -477,6 +492,22 @@ , confTrailingNewline = True } +createThunk' :: MonadNixThunk m => ThunkCreateConfig -> m ()+createThunk' config = do+ newThunkPtr <- uriThunkPtr+ (_thunkCreateConfig_uri config)+ (_thunkConfig_private $ _thunkCreateConfig_config config)+ (untagName <$> _thunkCreateConfig_branch config)+ (T.pack . show <$> _thunkCreateConfig_rev config)+ let trailingDirectoryName = reverse . takeWhile (/= '/') . dropWhile (=='/') . reverse+ stripSuffix s = fmap reverse . stripPrefix s . reverse+ dropDotGit :: FilePath -> FilePath+ dropDotGit origName = fromMaybe origName $ stripSuffix ".git" origName+ defaultDestinationForGitUri :: GitUri -> FilePath+ defaultDestinationForGitUri = dropDotGit . trailingDirectoryName . T.unpack . URI.render . unGitUri+ destination = fromMaybe (defaultDestinationForGitUri $ _thunkCreateConfig_uri config) $ _thunkCreateConfig_destination config+ createThunk destination $ Right newThunkPtr+ createThunk :: MonadNixThunk m => FilePath -> Either ThunkSpec ThunkPtr -> m () createThunk target ptrInfo = ifor_ (_thunkSpec_files spec) $ \path -> \case@@ -502,29 +533,28 @@ } updateThunkToLatest :: MonadNixThunk m => ThunkUpdateConfig -> FilePath -> m ()-updateThunkToLatest (ThunkUpdateConfig mBranch thunkConfig) target = spinner $ do- checkThunkDirectory target- -- check to see if thunk should be updated to a specific branch or just update it's current branch- case mBranch of- Nothing -> do- (overwrite, ptr) <- readThunk target >>= \case+updateThunkToLatest (ThunkUpdateConfig mBranch thunkConfig) target = do+ withSpinner' ("Updating thunk " <> T.pack target <> " to latest") (pure $ const $ "Thunk " <> T.pack target <> " updated to latest") $ do+ checkThunkDirectory target+ -- check to see if thunk should be updated to a specific branch or just update it's current branch+ case mBranch of+ Nothing -> do+ (overwrite, ptr) <- readThunk target >>= \case+ Left err -> failWith [i|Thunk update: ${err}|]+ Right c -> case c of+ ThunkData_Packed _ t -> return (target, t)+ ThunkData_Checkout -> failWith "cannot update an unpacked thunk"+ let src = _thunkPtr_source ptr+ rev <- getLatestRev src+ overwriteThunk overwrite $ modifyThunkPtrByConfig thunkConfig $ ThunkPtr+ { _thunkPtr_source = src+ , _thunkPtr_rev = rev+ }+ Just branch -> readThunk target >>= \case Left err -> failWith [i|Thunk update: ${err}|] Right c -> case c of- ThunkData_Packed _ t -> return (target, t)- ThunkData_Checkout -> failWith "cannot update an unpacked thunk"- let src = _thunkPtr_source ptr- rev <- getLatestRev src- overwriteThunk overwrite $ modifyThunkPtrByConfig thunkConfig $ ThunkPtr- { _thunkPtr_source = src- , _thunkPtr_rev = rev- }- Just branch -> readThunk target >>= \case- Left err -> failWith [i|Thunk update: ${err}|]- Right c -> case c of- ThunkData_Packed _ t -> setThunk thunkConfig target (thunkSourceToGitSource $ _thunkPtr_source t) branch- ThunkData_Checkout -> failWith [i|Thunk located at ${target} is unpacked. Use 'ob thunk pack' on the desired directory and then try 'ob thunk update' again.|]- where- spinner = withSpinner' ("Updating thunk " <> T.pack target <> " to latest") (pure $ const $ "Thunk " <> T.pack target <> " updated to latest")+ ThunkData_Packed _ t -> setThunk thunkConfig target (thunkSourceToGitSource $ _thunkPtr_source t) branch+ ThunkData_Checkout -> failWith [i|Thunk located at ${target} is unpacked. Use 'ob thunk pack' on the desired directory and then try 'ob thunk update' again.|] setThunk :: MonadNixThunk m => ThunkConfig -> FilePath -> GitSource -> String -> m () setThunk thunkConfig target gs branch = do
src/Nix/Thunk/Command.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE LambdaCase #-} module Nix.Thunk.Command where import Control.Monad.Catch (MonadMask)@@ -6,12 +7,13 @@ import Control.Monad.Fail (MonadFail) import Control.Monad.IO.Class (MonadIO) import Control.Monad.Log (MonadLog)-import Data.Foldable (for_) import Data.List.NonEmpty (NonEmpty (..)) import Nix.Thunk import Cli.Extras (HasCliConfig, Output) import Options.Applicative import System.FilePath+import Data.Git.Ref+import qualified Data.Text as T thunkConfig :: Parser ThunkConfig thunkConfig = ThunkConfig@@ -23,7 +25,7 @@ thunkUpdateConfig :: Parser ThunkUpdateConfig thunkUpdateConfig = ThunkUpdateConfig- <$> optional (strOption (long "branch" <> metavar "BRANCH" <> help "Use the given branch when looking for the latest revision"))+ <$> optional (strOption (short 'b' <> long "branch" <> metavar "BRANCH" <> help "Use the given branch when looking for the latest revision")) <*> thunkConfig thunkPackConfig :: Parser ThunkPackConfig@@ -31,33 +33,37 @@ <$> switch (long "force" <> short 'f' <> help "Force packing thunks even if there are branches not pushed upstream, uncommitted changes, stashes. This will cause changes that have not been pushed upstream to be lost; use with care.") <*> thunkConfig -data ThunkOption = ThunkOption- { _thunkOption_thunks :: NonEmpty FilePath- , _thunkOption_command :: ThunkCommand- } deriving Show+thunkCreateConfig :: Parser ThunkCreateConfig+thunkCreateConfig = ThunkCreateConfig+ <$> argument (maybeReader (parseGitUri . T.pack)) (metavar "URI" <> help "Address of the target repository")+ <*> optional (strOption (short 'b' <> long "branch" <> metavar "BRANCH" <> help "Point the new thunk at the given branch"))+ <*> optional (option (fromHexString <$> auto) (long "rev" <> long "revision" <> metavar "REVISION" <> help "Point the new thunk at the given revision"))+ <*> thunkConfig+ <*> optional (strArgument (action "directory" <> metavar "DESTINATION" <> help "The name of a new directory to create for the thunk")) data ThunkCommand- = ThunkCommand_Update ThunkUpdateConfig- | ThunkCommand_Unpack- | ThunkCommand_Pack ThunkPackConfig+ = ThunkCommand_Update ThunkUpdateConfig (NonEmpty FilePath)+ | ThunkCommand_Unpack (NonEmpty FilePath)+ | ThunkCommand_Pack ThunkPackConfig (NonEmpty FilePath)+ | ThunkCommand_Create ThunkCreateConfig deriving Show -thunkOption :: Parser ThunkOption-thunkOption = hsubparser $ mconcat- [ command "update" $ info (thunkOptionWith $ ThunkCommand_Update <$> thunkUpdateConfig) $ progDesc "Update packed thunk to latest revision available on the tracked branch"- , command "unpack" $ info (thunkOptionWith $ pure ThunkCommand_Unpack) $ progDesc "Unpack thunk into git checkout of revision it points to"- , command "pack" $ info (thunkOptionWith $ ThunkCommand_Pack <$> thunkPackConfig) $ progDesc "Pack git checkout or unpacked thunk into thunk that points at the current branch's upstream"- ]+thunkDirList :: Parser (NonEmpty FilePath)+thunkDirList = (:|)+ <$> thunkDirArg (metavar "THUNKDIRS..." <> help "Paths to directories containing thunk data")+ <*> many (thunkDirArg mempty) where- thunkOptionWith f = ThunkOption- <$> ((:|)- <$> thunkDirArg (metavar "THUNKDIRS..." <> help "Paths to directories containing thunk data")- <*> many (thunkDirArg mempty)- )- <*> f thunkDirArg opts = fmap (dropTrailingPathSeparator . normalise) $ strArgument $ action "directory" <> opts -runThunkOption+thunkCommand :: Parser ThunkCommand+thunkCommand = hsubparser $ mconcat+ [ command "update" $ info (ThunkCommand_Update <$> thunkUpdateConfig <*> thunkDirList) $ progDesc "Update packed thunk to latest revision available on the tracked branch"+ , command "unpack" $ info (ThunkCommand_Unpack <$> thunkDirList) $ progDesc "Unpack thunk into git checkout of revision it points to"+ , command "pack" $ info (ThunkCommand_Pack <$> thunkPackConfig <*> thunkDirList) $ progDesc "Pack git checkout or unpacked thunk into thunk that points at the current branch's upstream"+ , command "create" $ info (ThunkCommand_Create <$> thunkCreateConfig) $ progDesc "Create a packed thunk without cloning the repository first"+ ]++runThunkCommand :: ( MonadLog Output m , HasCliConfig m , MonadIO m@@ -65,9 +71,9 @@ , MonadError NixThunkError m , MonadFail m )- => ThunkOption -> m ()-runThunkOption to = case _thunkOption_command to of- ThunkCommand_Update config -> for_ thunks (updateThunkToLatest config)- ThunkCommand_Unpack -> for_ thunks unpackThunk- ThunkCommand_Pack config -> for_ thunks (packThunk config)- where thunks = _thunkOption_thunks to+ => ThunkCommand -> m ()+runThunkCommand = \case+ ThunkCommand_Update config dirs -> mapM_ (updateThunkToLatest config) dirs+ ThunkCommand_Unpack dirs -> mapM_ unpackThunk dirs+ ThunkCommand_Pack config dirs -> mapM_ (packThunk config) dirs+ ThunkCommand_Create config -> createThunk' config