{-# LANGUAGE NoImplicitPrelude #-}

-- | Functions to parse command line arguments for Stack's @unpack@ command.

module Stack.Options.UnpackParser
  ( unpackOptsParser
  ) where

import qualified Data.Text as T
import           Options.Applicative
                   ( Parser, ReadM, argument, eitherReader, help, long, metavar
                   , option, switch
                   )
import           Path ( SomeBase (..), parseSomeDir )
import           Stack.Prelude
import           Stack.Unpack ( UnpackOpts (..), UnpackTarget)

-- | Parse command line arguments for Stack's @unpack@ command.

unpackOptsParser :: Parser UnpackOpts
unpackOptsParser :: Parser UnpackOpts
unpackOptsParser = [UnpackTarget] -> Bool -> Maybe (SomeBase Dir) -> UnpackOpts
UnpackOpts
  ([UnpackTarget] -> Bool -> Maybe (SomeBase Dir) -> UnpackOpts)
-> Parser [UnpackTarget]
-> Parser (Bool -> Maybe (SomeBase Dir) -> UnpackOpts)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser UnpackTarget -> Parser [UnpackTarget]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Parser UnpackTarget
unpackTargetParser
  Parser (Bool -> Maybe (SomeBase Dir) -> UnpackOpts)
-> Parser Bool -> Parser (Maybe (SomeBase Dir) -> UnpackOpts)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
areCandidatesParser
  Parser (Maybe (SomeBase Dir) -> UnpackOpts)
-> Parser (Maybe (SomeBase Dir)) -> Parser UnpackOpts
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (SomeBase Dir) -> Parser (Maybe (SomeBase Dir))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser (SomeBase Dir)
dirParser

unpackTargetParser :: Parser UnpackTarget
unpackTargetParser :: Parser UnpackTarget
unpackTargetParser = ReadM UnpackTarget
-> Mod ArgumentFields UnpackTarget -> Parser UnpackTarget
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument ReadM UnpackTarget
unpackTargetReader
  (  String -> Mod ArgumentFields UnpackTarget
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"TARGET"
  Mod ArgumentFields UnpackTarget
-> Mod ArgumentFields UnpackTarget
-> Mod ArgumentFields UnpackTarget
forall a. Semigroup a => a -> a -> a
<> String -> Mod ArgumentFields UnpackTarget
forall (f :: * -> *) a. String -> Mod f a
help String
"A package or package candidate (can be specified multiple times). A \
          \package can be referred to by name only or by identifier \
          \(including, optionally, a revision as '@rev:<number>' or \
          \'@sha256:<sha>'). A package candidate is referred to by its \
          \identifier."
  )

unpackTargetReader :: ReadM UnpackTarget
unpackTargetReader :: ReadM UnpackTarget
unpackTargetReader = (String -> Either String UnpackTarget) -> ReadM UnpackTarget
forall a. (String -> Either String a) -> ReadM a
eitherReader ((String -> Either String UnpackTarget) -> ReadM UnpackTarget)
-> (String -> Either String UnpackTarget) -> ReadM UnpackTarget
forall a b. (a -> b) -> a -> b
$ \String
s ->
  case Text -> Either PantryException PackageIdentifierRevision
parsePackageIdentifierRevision (Text -> Either PantryException PackageIdentifierRevision)
-> Text -> Either PantryException PackageIdentifierRevision
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
s of
    Right PackageIdentifierRevision
pir -> UnpackTarget -> Either String UnpackTarget
forall a b. b -> Either a b
Right (PackageIdentifierRevision -> UnpackTarget
forall a b. b -> Either a b
Right PackageIdentifierRevision
pir)
    Left PantryException
_ -> case String -> Maybe PackageName
parsePackageName String
s of
      Just PackageName
pn -> UnpackTarget -> Either String UnpackTarget
forall a b. b -> Either a b
Right (PackageName -> UnpackTarget
forall a b. a -> Either a b
Left PackageName
pn)
      Maybe PackageName
Nothing ->
        String -> Either String UnpackTarget
forall a b. a -> Either a b
Left (String -> Either String UnpackTarget)
-> String -> Either String UnpackTarget
forall a b. (a -> b) -> a -> b
$ String
s String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" is an invalid way to refer to a package or package \
                    \candidate to be unpacked."

areCandidatesParser :: Parser Bool
areCandidatesParser :: Parser Bool
areCandidatesParser = Mod FlagFields Bool -> Parser Bool
switch
  (  String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"candidate"
  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 String
"Each target is a package candidate."
  )

dirParser :: Parser (SomeBase Dir)
dirParser :: Parser (SomeBase Dir)
dirParser = ReadM (SomeBase Dir)
-> Mod OptionFields (SomeBase Dir) -> Parser (SomeBase Dir)
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM (SomeBase Dir)
dirReader
  (  String -> Mod OptionFields (SomeBase Dir)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"to"
  Mod OptionFields (SomeBase Dir)
-> Mod OptionFields (SomeBase Dir)
-> Mod OptionFields (SomeBase Dir)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (SomeBase Dir)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"DIR"
  Mod OptionFields (SomeBase Dir)
-> Mod OptionFields (SomeBase Dir)
-> Mod OptionFields (SomeBase Dir)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (SomeBase Dir)
forall (f :: * -> *) a. String -> Mod f a
help String
"Optionally, a directory to unpack into. A target will be unpacked \
          \ into a subdirectory."
  )

dirReader :: ReadM (SomeBase Dir)
dirReader :: ReadM (SomeBase Dir)
dirReader = (String -> Either String (SomeBase Dir)) -> ReadM (SomeBase Dir)
forall a. (String -> Either String a) -> ReadM a
eitherReader ((String -> Either String (SomeBase Dir)) -> ReadM (SomeBase Dir))
-> (String -> Either String (SomeBase Dir)) -> ReadM (SomeBase Dir)
forall a b. (a -> b) -> a -> b
$ \String
s ->
  case String -> Maybe (SomeBase Dir)
forall (m :: * -> *). MonadThrow m => String -> m (SomeBase Dir)
parseSomeDir String
s of
    Just SomeBase Dir
dir -> SomeBase Dir -> Either String (SomeBase Dir)
forall a b. b -> Either a b
Right SomeBase Dir
dir
    Maybe (SomeBase Dir)
Nothing ->
      String -> Either String (SomeBase Dir)
forall a b. a -> Either a b
Left (String -> Either String (SomeBase Dir))
-> String -> Either String (SomeBase Dir)
forall a b. (a -> b) -> a -> b
$ String
s String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" is an invalid way to refer to a directory."