Command.hs

{-# LANGUAGE FlexibleContexts #-}
module Nix.Thunk.Command where

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.Foldable (for_)
import Data.List.NonEmpty (NonEmpty (..))
import Nix.Thunk
import Cli.Extras (HasCliConfig, Output)
import Options.Applicative
import System.FilePath

thunkConfig :: Parser ThunkConfig
thunkConfig = ThunkConfig
  <$>
    (   flag' (Just True) (long "private" <> help "Mark thunks as pointing to a private repository")
    <|> flag' (Just False) (long "public" <> help "Mark thunks as pointing to a public repository")
    <|> pure Nothing
    )

thunkUpdateConfig :: Parser ThunkUpdateConfig
thunkUpdateConfig = ThunkUpdateConfig
  <$> optional (strOption (long "branch" <> metavar "BRANCH" <> help "Use the given branch when looking for the latest revision"))
  <*> thunkConfig

thunkPackConfig :: Parser ThunkPackConfig
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

data ThunkCommand
  = ThunkCommand_Update ThunkUpdateConfig
  | ThunkCommand_Unpack
  | ThunkCommand_Pack ThunkPackConfig
  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"
  ]
  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
  :: ( MonadLog Output m
     , HasCliConfig m
     , MonadIO m
     , MonadMask m
     , 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