{-# LANGUAGE NoImplicitPrelude #-}
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)
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."