{-# LANGUAGE DeriveDataTypeable #-}

module Distribution.Client.SavedFlags
       ( readCommandFlags, writeCommandFlags
       , readSavedArgs, writeSavedArgs
       ) where

import Distribution.Client.Compat.Prelude
import Prelude ()

import Distribution.Simple.Command
import Distribution.Simple.UserHooks ( Args )
import Distribution.Simple.Utils
       ( createDirectoryIfMissingVerbose, unintersperse )
import Distribution.Verbosity

import System.Directory ( doesFileExist )
import System.FilePath ( takeDirectory )


writeSavedArgs :: Verbosity -> FilePath -> [String] -> IO ()
writeSavedArgs :: Verbosity -> FilePath -> [FilePath] -> IO ()
writeSavedArgs Verbosity
verbosity FilePath
path [FilePath]
args = do
  Verbosity -> Bool -> FilePath -> IO ()
createDirectoryIfMissingVerbose
    (Verbosity -> Verbosity
lessVerbose Verbosity
verbosity) Bool
True (FilePath -> FilePath
takeDirectory FilePath
path)
  FilePath -> FilePath -> IO ()
writeFile FilePath
path (forall a. [a] -> [[a]] -> [a]
intercalate FilePath
"\0" [FilePath]
args)


-- | Write command-line flags to a file, separated by null characters. This
-- format is also suitable for the @xargs -0@ command. Using the null
-- character also avoids the problem of escaping newlines or spaces,
-- because unlike other whitespace characters, the null character is
-- not valid in command-line arguments.
writeCommandFlags :: Verbosity -> FilePath -> CommandUI flags -> flags -> IO ()
writeCommandFlags :: forall flags.
Verbosity -> FilePath -> CommandUI flags -> flags -> IO ()
writeCommandFlags Verbosity
verbosity FilePath
path CommandUI flags
command flags
flags =
  Verbosity -> FilePath -> [FilePath] -> IO ()
writeSavedArgs Verbosity
verbosity FilePath
path (forall flags. CommandUI flags -> flags -> [FilePath]
commandShowOptions CommandUI flags
command flags
flags)


readSavedArgs :: FilePath -> IO (Maybe [String])
readSavedArgs :: FilePath -> IO (Maybe [FilePath])
readSavedArgs FilePath
path = do
  Bool
exists <- FilePath -> IO Bool
doesFileExist FilePath
path
  if Bool
exists
     then forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> FilePath -> [FilePath]
unintersperse Char
'\0') (FilePath -> IO FilePath
readFile FilePath
path)
    else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing


-- | Read command-line arguments, separated by null characters, from a file.
-- Returns the default flags if the file does not exist.
readCommandFlags :: FilePath -> CommandUI flags -> IO flags
readCommandFlags :: forall flags. FilePath -> CommandUI flags -> IO flags
readCommandFlags FilePath
path CommandUI flags
command = do
  [FilePath]
savedArgs <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> Maybe a -> a
fromMaybe []) (FilePath -> IO (Maybe [FilePath])
readSavedArgs FilePath
path)
  case (forall flags.
CommandUI flags
-> Bool -> [FilePath] -> CommandParse (flags -> flags, [FilePath])
commandParseArgs CommandUI flags
command Bool
True [FilePath]
savedArgs) of
    CommandHelp FilePath -> FilePath
_ -> forall e a. Exception e => e -> IO a
throwIO ([FilePath] -> SavedArgsError
SavedArgsErrorHelp [FilePath]
savedArgs)
    CommandList [FilePath]
_ -> forall e a. Exception e => e -> IO a
throwIO ([FilePath] -> SavedArgsError
SavedArgsErrorList [FilePath]
savedArgs)
    CommandErrors [FilePath]
errs -> forall e a. Exception e => e -> IO a
throwIO ([FilePath] -> [FilePath] -> SavedArgsError
SavedArgsErrorOther [FilePath]
savedArgs [FilePath]
errs)
    CommandReadyToGo (flags -> flags
mkFlags, [FilePath]
_) ->
      forall (m :: * -> *) a. Monad m => a -> m a
return (flags -> flags
mkFlags (forall flags. CommandUI flags -> flags
commandDefaultFlags CommandUI flags
command))

-- -----------------------------------------------------------------------------
-- * Exceptions
-- -----------------------------------------------------------------------------

data SavedArgsError
    = SavedArgsErrorHelp Args
    | SavedArgsErrorList Args
    | SavedArgsErrorOther Args [String]
  deriving (Typeable)

instance Show SavedArgsError where
  show :: SavedArgsError -> FilePath
show (SavedArgsErrorHelp [FilePath]
args) =
    FilePath
"unexpected flag '--help', saved command line was:\n"
    forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate FilePath
" " [FilePath]
args
  show (SavedArgsErrorList [FilePath]
args) =
    FilePath
"unexpected flag '--list-options', saved command line was:\n"
    forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate FilePath
" " [FilePath]
args
  show (SavedArgsErrorOther [FilePath]
args [FilePath]
errs) =
    FilePath
"saved command line was:\n"
    forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate FilePath
" " [FilePath]
args forall a. [a] -> [a] -> [a]
++ FilePath
"\n"
    forall a. [a] -> [a] -> [a]
++ FilePath
"encountered errors:\n"
    forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate FilePath
"\n" [FilePath]
errs

instance Exception SavedArgsError