summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRyanTrinkle <>2020-10-17 13:16:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2020-10-17 13:16:00 (GMT)
commit4d245a5db35a77115b497ca96da91ab70384600f (patch)
treee6b810719aed8d39cce30e9e69df22749c5e0b2c
parentb30b85a065bac51205546b440fe5fc491ff78ba5 (diff)
version 0.2.0.0HEAD0.2.0.0master
-rw-r--r--CHANGELOG.md3
-rw-r--r--nix-thunk.cabal4
-rw-r--r--src-bin/nix-thunk.hs6
-rw-r--r--src/Nix/Thunk.hs74
-rw-r--r--src/Nix/Thunk/Command.hs62
5 files changed, 94 insertions, 55 deletions
diff --git a/CHANGELOG.md b/CHANGELOG.md
index c52e82d..d86a5d0 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -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
diff --git a/nix-thunk.cabal b/nix-thunk.cabal
index f16e04d..e88ec61 100644
--- a/nix-thunk.cabal
+++ b/nix-thunk.cabal
@@ -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.
.
diff --git a/src-bin/nix-thunk.hs b/src-bin/nix-thunk.hs
index 8a2a5a0..5e246c1 100644
--- a/src-bin/nix-thunk.hs
+++ b/src-bin/nix-thunk.hs
@@ -11,7 +11,7 @@ import Data.Void
data Args = Args
{ _args_verbose :: Bool
- , _args_command :: ThunkOption
+ , _args_command :: ThunkCommand
}
verbose :: Parser Bool
@@ -22,7 +22,7 @@ verbose = flag False True $ mconcat
]
args :: Parser Args
-args = Args <$> verbose <*> thunkOption
+args = Args <$> verbose <*> thunkCommand
argsInfo :: ParserInfo Args
argsInfo = info (args <**> helper) $ mconcat
@@ -40,7 +40,7 @@ main = do
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
diff --git a/src/Nix/Thunk.hs b/src/Nix/Thunk.hs
index 8d9ed74..a062225 100644
--- a/src/Nix/Thunk.hs
+++ b/src/Nix/Thunk.hs
@@ -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 @@ module Nix.Thunk
, getThunkPtr
, packThunk
, createThunk
+ , createThunk'
, ThunkPackConfig (..)
, ThunkConfig (..)
, updateThunkToLatest
@@ -35,6 +37,10 @@ module Nix.Thunk
, nixBuildAttrWithCache
, attrCacheFileName
, prettyNixThunkError
+ , ThunkCreateConfig (..)
+ , parseGitUri
+ , GitUri (..)
+ , uriThunkPtr
) where
import Control.Applicative
@@ -91,6 +97,7 @@ import Data.Function
import Bindings.Cli.Git
import Bindings.Cli.Coreutils (cp)
import Bindings.Cli.Nix
+import Data.List (stripPrefix)
--------------------------------------------------------------------------------
-- Hacks
@@ -205,6 +212,14 @@ data ThunkPackConfig = ThunkPackConfig
, _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 @@ encodeThunkPtrData (ThunkPtr rev src) = case src of
, 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 @@ createThunkWithLatest target s = do
}
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
diff --git a/src/Nix/Thunk/Command.hs b/src/Nix/Thunk/Command.hs
index 41fdac1..260e7c8 100644
--- a/src/Nix/Thunk/Command.hs
+++ b/src/Nix/Thunk/Command.hs
@@ -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.Error.Class (MonadError)
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 @@ thunkConfig = ThunkConfig
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 @@ thunkPackConfig = ThunkPackConfig
<$> 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 @@ runThunkOption
, 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