{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} module Nix.Thunk.Command where import Cli.Extras (HasCliConfig, Output) import Control.Monad.Catch (MonadMask) import Control.Monad.Error.Class (MonadError) import Control.Monad.Fail (MonadFail) import Control.Monad.IO.Class (MonadIO) import Control.Monad.Log (MonadLog) import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.Text as T import Nix.Thunk import Options.Applicative import System.FilePath thunkConfig :: Parser ThunkConfig thunkConfig :: Parser ThunkConfig thunkConfig = Maybe Bool -> ThunkConfig ThunkConfig (Maybe Bool -> ThunkConfig) -> Parser (Maybe Bool) -> Parser ThunkConfig forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> ( Maybe Bool -> Mod FlagFields (Maybe Bool) -> Parser (Maybe Bool) forall a. a -> Mod FlagFields a -> Parser a flag' (Bool -> Maybe Bool forall a. a -> Maybe a Just Bool True) (String -> Mod FlagFields (Maybe Bool) forall (f :: * -> *) a. HasName f => String -> Mod f a long "private" Mod FlagFields (Maybe Bool) -> Mod FlagFields (Maybe Bool) -> Mod FlagFields (Maybe Bool) forall a. Semigroup a => a -> a -> a <> String -> Mod FlagFields (Maybe Bool) forall (f :: * -> *) a. String -> Mod f a help "Mark thunks as pointing to a private repository") Parser (Maybe Bool) -> Parser (Maybe Bool) -> Parser (Maybe Bool) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> Maybe Bool -> Mod FlagFields (Maybe Bool) -> Parser (Maybe Bool) forall a. a -> Mod FlagFields a -> Parser a flag' (Bool -> Maybe Bool forall a. a -> Maybe a Just Bool False) (String -> Mod FlagFields (Maybe Bool) forall (f :: * -> *) a. HasName f => String -> Mod f a long "public" Mod FlagFields (Maybe Bool) -> Mod FlagFields (Maybe Bool) -> Mod FlagFields (Maybe Bool) forall a. Semigroup a => a -> a -> a <> String -> Mod FlagFields (Maybe Bool) forall (f :: * -> *) a. String -> Mod f a help "Mark thunks as pointing to a public repository") Parser (Maybe Bool) -> Parser (Maybe Bool) -> Parser (Maybe Bool) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> Maybe Bool -> Parser (Maybe Bool) forall (f :: * -> *) a. Applicative f => a -> f a pure Maybe Bool forall a. Maybe a Nothing ) thunkUpdateConfig :: Parser ThunkUpdateConfig thunkUpdateConfig :: Parser ThunkUpdateConfig thunkUpdateConfig = Maybe String -> ThunkConfig -> ThunkUpdateConfig ThunkUpdateConfig (Maybe String -> ThunkConfig -> ThunkUpdateConfig) -> Parser (Maybe String) -> Parser (ThunkConfig -> ThunkUpdateConfig) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Parser String -> Parser (Maybe String) forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a) optional (Mod OptionFields String -> Parser String forall s. IsString s => Mod OptionFields s -> Parser s strOption (Char -> Mod OptionFields String forall (f :: * -> *) a. HasName f => Char -> Mod f a short 'b' Mod OptionFields String -> Mod OptionFields String -> Mod OptionFields String forall a. Semigroup a => a -> a -> a <> String -> Mod OptionFields String forall (f :: * -> *) a. HasName f => String -> Mod f a long "branch" Mod OptionFields String -> Mod OptionFields String -> Mod OptionFields String forall a. Semigroup a => a -> a -> a <> String -> Mod OptionFields String forall (f :: * -> *) a. HasMetavar f => String -> Mod f a metavar "BRANCH" Mod OptionFields String -> Mod OptionFields String -> Mod OptionFields String forall a. Semigroup a => a -> a -> a <> String -> Mod OptionFields String forall (f :: * -> *) a. String -> Mod f a help "Use the given branch when looking for the latest revision")) Parser (ThunkConfig -> ThunkUpdateConfig) -> Parser ThunkConfig -> Parser ThunkUpdateConfig forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Parser ThunkConfig thunkConfig thunkPackConfig :: Parser ThunkPackConfig thunkPackConfig :: Parser ThunkPackConfig thunkPackConfig = Bool -> ThunkConfig -> ThunkPackConfig ThunkPackConfig (Bool -> ThunkConfig -> ThunkPackConfig) -> Parser Bool -> Parser (ThunkConfig -> ThunkPackConfig) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Mod FlagFields Bool -> Parser Bool switch (String -> Mod FlagFields Bool forall (f :: * -> *) a. HasName f => String -> Mod f a long "force" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool forall a. Semigroup a => a -> a -> a <> Char -> Mod FlagFields Bool forall (f :: * -> *) a. HasName f => Char -> Mod f a short 'f' Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool forall a. Semigroup a => a -> a -> a <> String -> Mod FlagFields Bool forall (f :: * -> *) a. String -> Mod f a 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.") Parser (ThunkConfig -> ThunkPackConfig) -> Parser ThunkConfig -> Parser ThunkPackConfig forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Parser ThunkConfig thunkConfig thunkCreateConfig :: Parser ThunkCreateConfig thunkCreateConfig :: Parser ThunkCreateConfig thunkCreateConfig = GitUri -> Maybe (Name Branch) -> Maybe (Ref SHA1) -> ThunkConfig -> Maybe String -> ThunkCreateConfig ThunkCreateConfig (GitUri -> Maybe (Name Branch) -> Maybe (Ref SHA1) -> ThunkConfig -> Maybe String -> ThunkCreateConfig) -> Parser GitUri -> Parser (Maybe (Name Branch) -> Maybe (Ref SHA1) -> ThunkConfig -> Maybe String -> ThunkCreateConfig) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> ReadM GitUri -> Mod ArgumentFields GitUri -> Parser GitUri forall a. ReadM a -> Mod ArgumentFields a -> Parser a argument ((String -> Maybe GitUri) -> ReadM GitUri forall a. (String -> Maybe a) -> ReadM a maybeReader (Text -> Maybe GitUri parseGitUri (Text -> Maybe GitUri) -> (String -> Text) -> String -> Maybe GitUri forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> Text T.pack)) (String -> Mod ArgumentFields GitUri forall (f :: * -> *) a. HasMetavar f => String -> Mod f a metavar "URI" Mod ArgumentFields GitUri -> Mod ArgumentFields GitUri -> Mod ArgumentFields GitUri forall a. Semigroup a => a -> a -> a <> String -> Mod ArgumentFields GitUri forall (f :: * -> *) a. String -> Mod f a help "Address of the target repository") Parser (Maybe (Name Branch) -> Maybe (Ref SHA1) -> ThunkConfig -> Maybe String -> ThunkCreateConfig) -> Parser (Maybe (Name Branch)) -> Parser (Maybe (Ref SHA1) -> ThunkConfig -> Maybe String -> ThunkCreateConfig) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Parser (Name Branch) -> Parser (Maybe (Name Branch)) forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a) optional (Mod OptionFields (Name Branch) -> Parser (Name Branch) forall s. IsString s => Mod OptionFields s -> Parser s strOption (Char -> Mod OptionFields (Name Branch) forall (f :: * -> *) a. HasName f => Char -> Mod f a short 'b' Mod OptionFields (Name Branch) -> Mod OptionFields (Name Branch) -> Mod OptionFields (Name Branch) forall a. Semigroup a => a -> a -> a <> String -> Mod OptionFields (Name Branch) forall (f :: * -> *) a. HasName f => String -> Mod f a long "branch" Mod OptionFields (Name Branch) -> Mod OptionFields (Name Branch) -> Mod OptionFields (Name Branch) forall a. Semigroup a => a -> a -> a <> String -> Mod OptionFields (Name Branch) forall (f :: * -> *) a. HasMetavar f => String -> Mod f a metavar "BRANCH" Mod OptionFields (Name Branch) -> Mod OptionFields (Name Branch) -> Mod OptionFields (Name Branch) forall a. Semigroup a => a -> a -> a <> String -> Mod OptionFields (Name Branch) forall (f :: * -> *) a. String -> Mod f a help "Point the new thunk at the given branch")) Parser (Maybe (Ref SHA1) -> ThunkConfig -> Maybe String -> ThunkCreateConfig) -> Parser (Maybe (Ref SHA1)) -> Parser (ThunkConfig -> Maybe String -> ThunkCreateConfig) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Parser (Ref SHA1) -> Parser (Maybe (Ref SHA1)) forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a) optional (ReadM (Ref SHA1) -> Mod OptionFields (Ref SHA1) -> Parser (Ref SHA1) forall a. ReadM a -> Mod OptionFields a -> Parser a option (String -> Ref SHA1 forall hash. HashAlgorithm hash => String -> Ref hash refFromHexString (String -> Ref SHA1) -> ReadM String -> ReadM (Ref SHA1) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> ReadM String forall s. IsString s => ReadM s str) (String -> Mod OptionFields (Ref SHA1) forall (f :: * -> *) a. HasName f => String -> Mod f a long "rev" Mod OptionFields (Ref SHA1) -> Mod OptionFields (Ref SHA1) -> Mod OptionFields (Ref SHA1) forall a. Semigroup a => a -> a -> a <> String -> Mod OptionFields (Ref SHA1) forall (f :: * -> *) a. HasName f => String -> Mod f a long "revision" Mod OptionFields (Ref SHA1) -> Mod OptionFields (Ref SHA1) -> Mod OptionFields (Ref SHA1) forall a. Semigroup a => a -> a -> a <> String -> Mod OptionFields (Ref SHA1) forall (f :: * -> *) a. HasMetavar f => String -> Mod f a metavar "REVISION" Mod OptionFields (Ref SHA1) -> Mod OptionFields (Ref SHA1) -> Mod OptionFields (Ref SHA1) forall a. Semigroup a => a -> a -> a <> String -> Mod OptionFields (Ref SHA1) forall (f :: * -> *) a. String -> Mod f a help "Point the new thunk at the given revision")) Parser (ThunkConfig -> Maybe String -> ThunkCreateConfig) -> Parser ThunkConfig -> Parser (Maybe String -> ThunkCreateConfig) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Parser ThunkConfig thunkConfig Parser (Maybe String -> ThunkCreateConfig) -> Parser (Maybe String) -> Parser ThunkCreateConfig forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Parser String -> Parser (Maybe String) forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a) optional (Mod ArgumentFields String -> Parser String forall s. IsString s => Mod ArgumentFields s -> Parser s strArgument (String -> Mod ArgumentFields String forall (f :: * -> *) a. HasCompleter f => String -> Mod f a action "directory" Mod ArgumentFields String -> Mod ArgumentFields String -> Mod ArgumentFields String forall a. Semigroup a => a -> a -> a <> String -> Mod ArgumentFields String forall (f :: * -> *) a. HasMetavar f => String -> Mod f a metavar "DESTINATION" Mod ArgumentFields String -> Mod ArgumentFields String -> Mod ArgumentFields String forall a. Semigroup a => a -> a -> a <> String -> Mod ArgumentFields String forall (f :: * -> *) a. String -> Mod f a help "The name of a new directory to create for the thunk")) data ThunkCommand = ThunkCommand_Update ThunkUpdateConfig (NonEmpty FilePath) | ThunkCommand_Unpack (NonEmpty FilePath) | ThunkCommand_Pack ThunkPackConfig (NonEmpty FilePath) | ThunkCommand_Create ThunkCreateConfig deriving Int -> ThunkCommand -> ShowS [ThunkCommand] -> ShowS ThunkCommand -> String (Int -> ThunkCommand -> ShowS) -> (ThunkCommand -> String) -> ([ThunkCommand] -> ShowS) -> Show ThunkCommand forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [ThunkCommand] -> ShowS $cshowList :: [ThunkCommand] -> ShowS show :: ThunkCommand -> String $cshow :: ThunkCommand -> String showsPrec :: Int -> ThunkCommand -> ShowS $cshowsPrec :: Int -> ThunkCommand -> ShowS Show thunkDirList :: Parser (NonEmpty FilePath) thunkDirList :: Parser (NonEmpty String) thunkDirList = String -> [String] -> NonEmpty String forall a. a -> [a] -> NonEmpty a (:|) (String -> [String] -> NonEmpty String) -> Parser String -> Parser ([String] -> NonEmpty String) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Mod ArgumentFields String -> Parser String thunkDirArg (String -> Mod ArgumentFields String forall (f :: * -> *) a. HasMetavar f => String -> Mod f a metavar "THUNKDIRS..." Mod ArgumentFields String -> Mod ArgumentFields String -> Mod ArgumentFields String forall a. Semigroup a => a -> a -> a <> String -> Mod ArgumentFields String forall (f :: * -> *) a. String -> Mod f a help "Paths to directories containing thunk data") Parser ([String] -> NonEmpty String) -> Parser [String] -> Parser (NonEmpty String) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Parser String -> Parser [String] forall (f :: * -> *) a. Alternative f => f a -> f [a] many (Mod ArgumentFields String -> Parser String thunkDirArg Mod ArgumentFields String forall a. Monoid a => a mempty) where thunkDirArg :: Mod ArgumentFields String -> Parser String thunkDirArg opts :: Mod ArgumentFields String opts = ShowS -> Parser String -> Parser String forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (ShowS dropTrailingPathSeparator ShowS -> ShowS -> ShowS forall b c a. (b -> c) -> (a -> b) -> a -> c . ShowS normalise) (Parser String -> Parser String) -> Parser String -> Parser String forall a b. (a -> b) -> a -> b $ Mod ArgumentFields String -> Parser String forall s. IsString s => Mod ArgumentFields s -> Parser s strArgument (Mod ArgumentFields String -> Parser String) -> Mod ArgumentFields String -> Parser String forall a b. (a -> b) -> a -> b $ String -> Mod ArgumentFields String forall (f :: * -> *) a. HasCompleter f => String -> Mod f a action "directory" Mod ArgumentFields String -> Mod ArgumentFields String -> Mod ArgumentFields String forall a. Semigroup a => a -> a -> a <> Mod ArgumentFields String opts thunkCommand :: Parser ThunkCommand thunkCommand :: Parser ThunkCommand thunkCommand = Mod CommandFields ThunkCommand -> Parser ThunkCommand forall a. Mod CommandFields a -> Parser a hsubparser (Mod CommandFields ThunkCommand -> Parser ThunkCommand) -> Mod CommandFields ThunkCommand -> Parser ThunkCommand forall a b. (a -> b) -> a -> b $ [Mod CommandFields ThunkCommand] -> Mod CommandFields ThunkCommand forall a. Monoid a => [a] -> a mconcat [ String -> ParserInfo ThunkCommand -> Mod CommandFields ThunkCommand forall a. String -> ParserInfo a -> Mod CommandFields a command "update" (ParserInfo ThunkCommand -> Mod CommandFields ThunkCommand) -> ParserInfo ThunkCommand -> Mod CommandFields ThunkCommand forall a b. (a -> b) -> a -> b $ Parser ThunkCommand -> InfoMod ThunkCommand -> ParserInfo ThunkCommand forall a. Parser a -> InfoMod a -> ParserInfo a info (ThunkUpdateConfig -> NonEmpty String -> ThunkCommand ThunkCommand_Update (ThunkUpdateConfig -> NonEmpty String -> ThunkCommand) -> Parser ThunkUpdateConfig -> Parser (NonEmpty String -> ThunkCommand) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Parser ThunkUpdateConfig thunkUpdateConfig Parser (NonEmpty String -> ThunkCommand) -> Parser (NonEmpty String) -> Parser ThunkCommand forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Parser (NonEmpty String) thunkDirList) (InfoMod ThunkCommand -> ParserInfo ThunkCommand) -> InfoMod ThunkCommand -> ParserInfo ThunkCommand forall a b. (a -> b) -> a -> b $ String -> InfoMod ThunkCommand forall a. String -> InfoMod a progDesc "Update packed thunk to latest revision available on the tracked branch" , String -> ParserInfo ThunkCommand -> Mod CommandFields ThunkCommand forall a. String -> ParserInfo a -> Mod CommandFields a command "unpack" (ParserInfo ThunkCommand -> Mod CommandFields ThunkCommand) -> ParserInfo ThunkCommand -> Mod CommandFields ThunkCommand forall a b. (a -> b) -> a -> b $ Parser ThunkCommand -> InfoMod ThunkCommand -> ParserInfo ThunkCommand forall a. Parser a -> InfoMod a -> ParserInfo a info (NonEmpty String -> ThunkCommand ThunkCommand_Unpack (NonEmpty String -> ThunkCommand) -> Parser (NonEmpty String) -> Parser ThunkCommand forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Parser (NonEmpty String) thunkDirList) (InfoMod ThunkCommand -> ParserInfo ThunkCommand) -> InfoMod ThunkCommand -> ParserInfo ThunkCommand forall a b. (a -> b) -> a -> b $ String -> InfoMod ThunkCommand forall a. String -> InfoMod a progDesc "Unpack thunk into git checkout of revision it points to" , String -> ParserInfo ThunkCommand -> Mod CommandFields ThunkCommand forall a. String -> ParserInfo a -> Mod CommandFields a command "pack" (ParserInfo ThunkCommand -> Mod CommandFields ThunkCommand) -> ParserInfo ThunkCommand -> Mod CommandFields ThunkCommand forall a b. (a -> b) -> a -> b $ Parser ThunkCommand -> InfoMod ThunkCommand -> ParserInfo ThunkCommand forall a. Parser a -> InfoMod a -> ParserInfo a info (ThunkPackConfig -> NonEmpty String -> ThunkCommand ThunkCommand_Pack (ThunkPackConfig -> NonEmpty String -> ThunkCommand) -> Parser ThunkPackConfig -> Parser (NonEmpty String -> ThunkCommand) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Parser ThunkPackConfig thunkPackConfig Parser (NonEmpty String -> ThunkCommand) -> Parser (NonEmpty String) -> Parser ThunkCommand forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Parser (NonEmpty String) thunkDirList) (InfoMod ThunkCommand -> ParserInfo ThunkCommand) -> InfoMod ThunkCommand -> ParserInfo ThunkCommand forall a b. (a -> b) -> a -> b $ String -> InfoMod ThunkCommand forall a. String -> InfoMod a progDesc "Pack git checkout or unpacked thunk into thunk that points at the current branch's upstream" , String -> ParserInfo ThunkCommand -> Mod CommandFields ThunkCommand forall a. String -> ParserInfo a -> Mod CommandFields a command "create" (ParserInfo ThunkCommand -> Mod CommandFields ThunkCommand) -> ParserInfo ThunkCommand -> Mod CommandFields ThunkCommand forall a b. (a -> b) -> a -> b $ Parser ThunkCommand -> InfoMod ThunkCommand -> ParserInfo ThunkCommand forall a. Parser a -> InfoMod a -> ParserInfo a info (ThunkCreateConfig -> ThunkCommand ThunkCommand_Create (ThunkCreateConfig -> ThunkCommand) -> Parser ThunkCreateConfig -> Parser ThunkCommand forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Parser ThunkCreateConfig thunkCreateConfig) (InfoMod ThunkCommand -> ParserInfo ThunkCommand) -> InfoMod ThunkCommand -> ParserInfo ThunkCommand forall a b. (a -> b) -> a -> b $ String -> InfoMod ThunkCommand forall a. String -> InfoMod a progDesc "Create a packed thunk without cloning the repository first" ] runThunkCommand :: ( MonadLog Output m , HasCliConfig m , MonadIO m , MonadMask m , MonadError NixThunkError m , MonadFail m ) => ThunkCommand -> m () runThunkCommand :: ThunkCommand -> m () runThunkCommand = \case ThunkCommand_Update config :: ThunkUpdateConfig config dirs :: NonEmpty String dirs -> (String -> m ()) -> NonEmpty String -> m () forall (t :: * -> *) (m :: * -> *) a b. (Foldable t, Monad m) => (a -> m b) -> t a -> m () mapM_ (ThunkUpdateConfig -> String -> m () forall (m :: * -> *). MonadNixThunk m => ThunkUpdateConfig -> String -> m () updateThunkToLatest ThunkUpdateConfig config) NonEmpty String dirs ThunkCommand_Unpack dirs :: NonEmpty String dirs -> (String -> m ()) -> NonEmpty String -> m () forall (t :: * -> *) (m :: * -> *) a b. (Foldable t, Monad m) => (a -> m b) -> t a -> m () mapM_ String -> m () forall (m :: * -> *). MonadNixThunk m => String -> m () unpackThunk NonEmpty String dirs ThunkCommand_Pack config :: ThunkPackConfig config dirs :: NonEmpty String dirs -> (String -> m ThunkPtr) -> NonEmpty String -> m () forall (t :: * -> *) (m :: * -> *) a b. (Foldable t, Monad m) => (a -> m b) -> t a -> m () mapM_ (ThunkPackConfig -> String -> m ThunkPtr forall (m :: * -> *). MonadNixThunk m => ThunkPackConfig -> String -> m ThunkPtr packThunk ThunkPackConfig config) NonEmpty String dirs ThunkCommand_Create config :: ThunkCreateConfig config -> ThunkCreateConfig -> m () forall (m :: * -> *). MonadNixThunk m => ThunkCreateConfig -> m () createThunk' ThunkCreateConfig config