{-# 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 Options.Applicative
import System.FilePath

import Nix.Thunk

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) (FilePath -> Mod FlagFields (Maybe Bool)
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"private" Mod FlagFields (Maybe Bool)
-> Mod FlagFields (Maybe Bool) -> Mod FlagFields (Maybe Bool)
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields (Maybe Bool)
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Mark thunks as pointing to a private repository")
    Parser (Maybe Bool) -> Parser (Maybe Bool) -> Parser (Maybe Bool)
forall a. Parser a -> Parser a -> Parser a
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) (FilePath -> Mod FlagFields (Maybe Bool)
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"public" Mod FlagFields (Maybe Bool)
-> Mod FlagFields (Maybe Bool) -> Mod FlagFields (Maybe Bool)
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields (Maybe Bool)
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Mark thunks as pointing to a public repository")
    Parser (Maybe Bool) -> Parser (Maybe Bool) -> Parser (Maybe Bool)
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Bool -> Parser (Maybe Bool)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Bool
forall a. Maybe a
Nothing
    )

thunkUpdateConfig :: Parser ThunkUpdateConfig
thunkUpdateConfig :: Parser ThunkUpdateConfig
thunkUpdateConfig = Maybe Text -> Maybe Text -> ThunkConfig -> ThunkUpdateConfig
ThunkUpdateConfig
  (Maybe Text -> Maybe Text -> ThunkConfig -> ThunkUpdateConfig)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> ThunkConfig -> ThunkUpdateConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text -> Parser (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Mod OptionFields Text -> Parser Text
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (Char -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'b' Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"branch" Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Text
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"BRANCH" Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Text
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Use the given branch when looking for the latest revision"))
  Parser (Maybe Text -> ThunkConfig -> ThunkUpdateConfig)
-> Parser (Maybe Text) -> Parser (ThunkConfig -> ThunkUpdateConfig)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text -> Parser (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Mod OptionFields Text -> Parser Text
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (Char -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'r' Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"rev" Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Text
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"REVISION" Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Text
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Update to this specific revision"))
  Parser (ThunkConfig -> ThunkUpdateConfig)
-> Parser ThunkConfig -> Parser ThunkUpdateConfig
forall a b. Parser (a -> b) -> Parser a -> Parser b
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 (FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"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 Char
'f' Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"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 a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ThunkConfig
thunkConfig

thunkCreateConfig :: Parser ThunkCreateConfig
thunkCreateConfig :: Parser ThunkCreateConfig
thunkCreateConfig = ThunkCreateSource
-> Maybe (Name Branch)
-> Maybe (Ref SHA1)
-> ThunkConfig
-> Maybe FilePath
-> ThunkCreateConfig
ThunkCreateConfig
  (ThunkCreateSource
 -> Maybe (Name Branch)
 -> Maybe (Ref SHA1)
 -> ThunkConfig
 -> Maybe FilePath
 -> ThunkCreateConfig)
-> Parser ThunkCreateSource
-> Parser
     (Maybe (Name Branch)
      -> Maybe (Ref SHA1)
      -> ThunkConfig
      -> Maybe FilePath
      -> ThunkCreateConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM ThunkCreateSource
-> Mod ArgumentFields ThunkCreateSource -> Parser ThunkCreateSource
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument ReadM ThunkCreateSource
source (FilePath -> Mod ArgumentFields ThunkCreateSource
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"URI" Mod ArgumentFields ThunkCreateSource
-> Mod ArgumentFields ThunkCreateSource
-> Mod ArgumentFields ThunkCreateSource
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod ArgumentFields ThunkCreateSource
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Address of the target repository")
  Parser
  (Maybe (Name Branch)
   -> Maybe (Ref SHA1)
   -> ThunkConfig
   -> Maybe FilePath
   -> ThunkCreateConfig)
-> Parser (Maybe (Name Branch))
-> Parser
     (Maybe (Ref SHA1)
      -> ThunkConfig -> Maybe FilePath -> ThunkCreateConfig)
forall a b. Parser (a -> b) -> Parser a -> Parser b
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 Char
'b' Mod OptionFields (Name Branch)
-> Mod OptionFields (Name Branch) -> Mod OptionFields (Name Branch)
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields (Name Branch)
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"branch" Mod OptionFields (Name Branch)
-> Mod OptionFields (Name Branch) -> Mod OptionFields (Name Branch)
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields (Name Branch)
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"BRANCH" Mod OptionFields (Name Branch)
-> Mod OptionFields (Name Branch) -> Mod OptionFields (Name Branch)
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields (Name Branch)
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Point the new thunk at the given branch"))
  Parser
  (Maybe (Ref SHA1)
   -> ThunkConfig -> Maybe FilePath -> ThunkCreateConfig)
-> Parser (Maybe (Ref SHA1))
-> Parser (ThunkConfig -> Maybe FilePath -> ThunkCreateConfig)
forall a b. Parser (a -> b) -> Parser a -> Parser b
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 (FilePath -> Ref SHA1
forall hash. HashAlgorithm hash => FilePath -> Ref hash
refFromHexString (FilePath -> Ref SHA1) -> ReadM FilePath -> ReadM (Ref SHA1)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM FilePath
forall s. IsString s => ReadM s
str) (FilePath -> Mod OptionFields (Ref SHA1)
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"rev" Mod OptionFields (Ref SHA1)
-> Mod OptionFields (Ref SHA1) -> Mod OptionFields (Ref SHA1)
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields (Ref SHA1)
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"revision" Mod OptionFields (Ref SHA1)
-> Mod OptionFields (Ref SHA1) -> Mod OptionFields (Ref SHA1)
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields (Ref SHA1)
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"REVISION" Mod OptionFields (Ref SHA1)
-> Mod OptionFields (Ref SHA1) -> Mod OptionFields (Ref SHA1)
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields (Ref SHA1)
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Point the new thunk at the given revision"))
  Parser (ThunkConfig -> Maybe FilePath -> ThunkCreateConfig)
-> Parser ThunkConfig
-> Parser (Maybe FilePath -> ThunkCreateConfig)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ThunkConfig
thunkConfig
  Parser (Maybe FilePath -> ThunkCreateConfig)
-> Parser (Maybe FilePath) -> Parser ThunkCreateConfig
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser FilePath -> Parser (Maybe FilePath)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Mod ArgumentFields FilePath -> Parser FilePath
forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument (FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. HasCompleter f => FilePath -> Mod f a
action FilePath
"directory" Mod ArgumentFields FilePath
-> Mod ArgumentFields FilePath -> Mod ArgumentFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"DESTINATION" Mod ArgumentFields FilePath
-> Mod ArgumentFields FilePath -> Mod ArgumentFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"The name of a new directory to create for the thunk"))
  where
    source :: ReadM ThunkCreateSource
source = (GitUri -> ThunkCreateSource
ThunkCreateSource_Absolute (GitUri -> ThunkCreateSource)
-> ReadM GitUri -> ReadM ThunkCreateSource
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> Maybe GitUri) -> ReadM GitUri
forall a. (FilePath -> Maybe a) -> ReadM a
maybeReader (Text -> Maybe GitUri
parseGitUri (Text -> Maybe GitUri)
-> (FilePath -> Text) -> FilePath -> Maybe GitUri
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack))
         ReadM ThunkCreateSource
-> ReadM ThunkCreateSource -> ReadM ThunkCreateSource
forall a. ReadM a -> ReadM a -> ReadM a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (FilePath -> ThunkCreateSource
ThunkCreateSource_Relative (FilePath -> ThunkCreateSource)
-> ReadM FilePath -> ReadM ThunkCreateSource
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM FilePath
forall s. IsString s => ReadM s
str)

createWorktreeConfig :: Parser CreateWorktreeConfig
createWorktreeConfig :: Parser CreateWorktreeConfig
createWorktreeConfig = Maybe FilePath -> Bool -> CreateWorktreeConfig
CreateWorktreeConfig
  (Maybe FilePath -> Bool -> CreateWorktreeConfig)
-> Parser (Maybe FilePath) -> Parser (Bool -> CreateWorktreeConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser FilePath -> Parser (Maybe FilePath)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (Char -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'b' Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"branch" Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"BRANCH" Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"create a new branch"))
  Parser (Bool -> CreateWorktreeConfig)
-> Parser Bool -> Parser CreateWorktreeConfig
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch (FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"detach" 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 Char
'd' Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"detach HEAD at the commit specified in thunk")

data ThunkCommand
  = ThunkCommand_Update ThunkUpdateConfig (NonEmpty FilePath)
  | ThunkCommand_Unpack (NonEmpty FilePath)
  | ThunkCommand_Worktree CreateWorktreeConfig (FilePath, FilePath)
  | ThunkCommand_Pack ThunkPackConfig (NonEmpty FilePath)
  | ThunkCommand_Create ThunkCreateConfig
  deriving Int -> ThunkCommand -> ShowS
[ThunkCommand] -> ShowS
ThunkCommand -> FilePath
(Int -> ThunkCommand -> ShowS)
-> (ThunkCommand -> FilePath)
-> ([ThunkCommand] -> ShowS)
-> Show ThunkCommand
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ThunkCommand -> ShowS
showsPrec :: Int -> ThunkCommand -> ShowS
$cshow :: ThunkCommand -> FilePath
show :: ThunkCommand -> FilePath
$cshowList :: [ThunkCommand] -> ShowS
showList :: [ThunkCommand] -> ShowS
Show

thunkDirList :: Parser (NonEmpty FilePath)
thunkDirList :: Parser (NonEmpty FilePath)
thunkDirList = FilePath -> [FilePath] -> NonEmpty FilePath
forall a. a -> [a] -> NonEmpty a
(:|)
  (FilePath -> [FilePath] -> NonEmpty FilePath)
-> Parser FilePath -> Parser ([FilePath] -> NonEmpty FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod ArgumentFields FilePath -> Parser FilePath
dirArg (FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"THUNKDIRS..." Mod ArgumentFields FilePath
-> Mod ArgumentFields FilePath -> Mod ArgumentFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Paths to directories containing thunk data")
  Parser ([FilePath] -> NonEmpty FilePath)
-> Parser [FilePath] -> Parser (NonEmpty FilePath)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser FilePath -> Parser [FilePath]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Mod ArgumentFields FilePath -> Parser FilePath
dirArg Mod ArgumentFields FilePath
forall a. Monoid a => a
mempty)

createWorktreeArgs :: Parser (FilePath, FilePath)
createWorktreeArgs :: Parser (FilePath, FilePath)
createWorktreeArgs = (,)
  (FilePath -> FilePath -> (FilePath, FilePath))
-> Parser FilePath -> Parser (FilePath -> (FilePath, FilePath))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod ArgumentFields FilePath -> Parser FilePath
dirArg (FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"THUNKDIR" Mod ArgumentFields FilePath
-> Mod ArgumentFields FilePath -> Mod ArgumentFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Path to directory containing thunk data")
  Parser (FilePath -> (FilePath, FilePath))
-> Parser FilePath -> Parser (FilePath, FilePath)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod ArgumentFields FilePath -> Parser FilePath
dirArg (FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"GITDIR" Mod ArgumentFields FilePath
-> Mod ArgumentFields FilePath -> Mod ArgumentFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Path to local git repo")

dirArg :: Mod ArgumentFields FilePath -> Parser FilePath
dirArg :: Mod ArgumentFields FilePath -> Parser FilePath
dirArg Mod ArgumentFields FilePath
opts = ShowS -> Parser FilePath -> Parser FilePath
forall a b. (a -> b) -> Parser a -> Parser b
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 FilePath -> Parser FilePath)
-> Parser FilePath -> Parser FilePath
forall a b. (a -> b) -> a -> b
$ Mod ArgumentFields FilePath -> Parser FilePath
forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument (Mod ArgumentFields FilePath -> Parser FilePath)
-> Mod ArgumentFields FilePath -> Parser FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. HasCompleter f => FilePath -> Mod f a
action FilePath
"directory" Mod ArgumentFields FilePath
-> Mod ArgumentFields FilePath -> Mod ArgumentFields FilePath
forall a. Semigroup a => a -> a -> a
<> Mod ArgumentFields FilePath
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
  [ FilePath
-> ParserInfo ThunkCommand -> Mod CommandFields ThunkCommand
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"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 FilePath -> ThunkCommand
ThunkCommand_Update (ThunkUpdateConfig -> NonEmpty FilePath -> ThunkCommand)
-> Parser ThunkUpdateConfig
-> Parser (NonEmpty FilePath -> ThunkCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ThunkUpdateConfig
thunkUpdateConfig Parser (NonEmpty FilePath -> ThunkCommand)
-> Parser (NonEmpty FilePath) -> Parser ThunkCommand
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (NonEmpty FilePath)
thunkDirList) (InfoMod ThunkCommand -> ParserInfo ThunkCommand)
-> InfoMod ThunkCommand -> ParserInfo ThunkCommand
forall a b. (a -> b) -> a -> b
$ FilePath -> InfoMod ThunkCommand
forall a. FilePath -> InfoMod a
progDesc FilePath
"Update packed thunk to latest revision available on the tracked branch"
  , FilePath
-> ParserInfo ThunkCommand -> Mod CommandFields ThunkCommand
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"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 FilePath -> ThunkCommand
ThunkCommand_Unpack (NonEmpty FilePath -> ThunkCommand)
-> Parser (NonEmpty FilePath) -> Parser ThunkCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (NonEmpty FilePath)
thunkDirList) (InfoMod ThunkCommand -> ParserInfo ThunkCommand)
-> InfoMod ThunkCommand -> ParserInfo ThunkCommand
forall a b. (a -> b) -> a -> b
$ FilePath -> InfoMod ThunkCommand
forall a. FilePath -> InfoMod a
progDesc FilePath
"Unpack thunk into git checkout of revision it points to"
  , FilePath
-> ParserInfo ThunkCommand -> Mod CommandFields ThunkCommand
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"worktree" (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 (CreateWorktreeConfig -> (FilePath, FilePath) -> ThunkCommand
ThunkCommand_Worktree (CreateWorktreeConfig -> (FilePath, FilePath) -> ThunkCommand)
-> Parser CreateWorktreeConfig
-> Parser ((FilePath, FilePath) -> ThunkCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser CreateWorktreeConfig
createWorktreeConfig Parser ((FilePath, FilePath) -> ThunkCommand)
-> Parser (FilePath, FilePath) -> Parser ThunkCommand
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (FilePath, FilePath)
createWorktreeArgs) (InfoMod ThunkCommand -> ParserInfo ThunkCommand)
-> InfoMod ThunkCommand -> ParserInfo ThunkCommand
forall a b. (a -> b) -> a -> b
$ FilePath -> InfoMod ThunkCommand
forall a. FilePath -> InfoMod a
progDesc FilePath
"Create a git worktree of the thunk using the specified local git repo"
  , FilePath
-> ParserInfo ThunkCommand -> Mod CommandFields ThunkCommand
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"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 FilePath -> ThunkCommand
ThunkCommand_Pack (ThunkPackConfig -> NonEmpty FilePath -> ThunkCommand)
-> Parser ThunkPackConfig
-> Parser (NonEmpty FilePath -> ThunkCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ThunkPackConfig
thunkPackConfig Parser (NonEmpty FilePath -> ThunkCommand)
-> Parser (NonEmpty FilePath) -> Parser ThunkCommand
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (NonEmpty FilePath)
thunkDirList) (InfoMod ThunkCommand -> ParserInfo ThunkCommand)
-> InfoMod ThunkCommand -> ParserInfo ThunkCommand
forall a b. (a -> b) -> a -> b
$ FilePath -> InfoMod ThunkCommand
forall a. FilePath -> InfoMod a
progDesc FilePath
"Pack git checkout or unpacked thunk into thunk that points at the current branch's upstream"
  , FilePath
-> ParserInfo ThunkCommand -> Mod CommandFields ThunkCommand
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"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
$ FilePath -> InfoMod ThunkCommand
forall a. FilePath -> InfoMod a
progDesc FilePath
"Create a packed thunk without cloning the repository first"
  ]

runThunkCommand
  :: ( MonadLog Output m
     , HasCliConfig NixThunkError m
     , MonadIO m
     , MonadMask m
     , MonadError NixThunkError m
     , MonadFail m
     )
  => ThunkCommand -> m ()
runThunkCommand :: forall (m :: * -> *).
(MonadLog Output m, HasCliConfig NixThunkError m, MonadIO m,
 MonadMask m, MonadError NixThunkError m, MonadFail m) =>
ThunkCommand -> m ()
runThunkCommand = \case
  ThunkCommand_Update ThunkUpdateConfig
config NonEmpty FilePath
dirs -> (FilePath -> m ()) -> NonEmpty FilePath -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (ThunkUpdateConfig -> FilePath -> m ()
forall (m :: * -> *).
MonadNixThunk m =>
ThunkUpdateConfig -> FilePath -> m ()
updateThunkToLatest ThunkUpdateConfig
config) NonEmpty FilePath
dirs
  ThunkCommand_Unpack NonEmpty FilePath
dirs -> (FilePath -> m ()) -> NonEmpty FilePath -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ FilePath -> m ()
forall (m :: * -> *). MonadNixThunk m => FilePath -> m ()
unpackThunk NonEmpty FilePath
dirs
  ThunkCommand_Worktree CreateWorktreeConfig
config (FilePath
thunkDir, FilePath
gitDir) -> FilePath -> FilePath -> CreateWorktreeConfig -> m ()
forall (m :: * -> *).
MonadNixThunk m =>
FilePath -> FilePath -> CreateWorktreeConfig -> m ()
createWorktree FilePath
thunkDir FilePath
gitDir CreateWorktreeConfig
config
  ThunkCommand_Pack ThunkPackConfig
config NonEmpty FilePath
dirs -> (FilePath -> m ThunkPtr) -> NonEmpty FilePath -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (ThunkPackConfig -> FilePath -> m ThunkPtr
forall (m :: * -> *).
MonadNixThunk m =>
ThunkPackConfig -> FilePath -> m ThunkPtr
packThunk ThunkPackConfig
config) NonEmpty FilePath
dirs
  ThunkCommand_Create ThunkCreateConfig
config -> ThunkCreateConfig -> m ()
forall (m :: * -> *). MonadNixThunk m => ThunkCreateConfig -> m ()
createThunk' ThunkCreateConfig
config