{-# LANGUAGE NoImplicitPrelude #-}
module Stack.Options.PackageParser where
import qualified Data.Map as Map
import Options.Applicative
import Options.Applicative.Types (readerAsk)
import Stack.Prelude
import Stack.Types.Config.Build (ApplyCLIFlag (..))
readFlag :: ReadM (Map ApplyCLIFlag (Map FlagName Bool))
readFlag :: ReadM (Map ApplyCLIFlag (Map FlagName Bool))
readFlag = do
String
s <- ReadM String
readerAsk
case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':') String
s of
(String
pn, Char
':':String
mflag) -> do
ApplyCLIFlag
pn' <-
case String -> Maybe PackageName
parsePackageName String
pn of
Maybe PackageName
Nothing
| String
pn String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"*" -> ApplyCLIFlag -> ReadM ApplyCLIFlag
forall (m :: * -> *) a. Monad m => a -> m a
return ApplyCLIFlag
ACFAllProjectPackages
| Bool
otherwise -> String -> ReadM ApplyCLIFlag
forall a. String -> ReadM a
readerError (String -> ReadM ApplyCLIFlag) -> String -> ReadM ApplyCLIFlag
forall a b. (a -> b) -> a -> b
$ String
"Invalid package name: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pn
Just PackageName
x -> ApplyCLIFlag -> ReadM ApplyCLIFlag
forall (m :: * -> *) a. Monad m => a -> m a
return (ApplyCLIFlag -> ReadM ApplyCLIFlag)
-> ApplyCLIFlag -> ReadM ApplyCLIFlag
forall a b. (a -> b) -> a -> b
$ PackageName -> ApplyCLIFlag
ACFByName PackageName
x
let (Bool
b, String
flagS) =
case String
mflag of
Char
'-':String
x -> (Bool
False, String
x)
String
_ -> (Bool
True, String
mflag)
FlagName
flagN <-
case String -> Maybe FlagName
parseFlagName String
flagS of
Maybe FlagName
Nothing -> String -> ReadM FlagName
forall a. String -> ReadM a
readerError (String -> ReadM FlagName) -> String -> ReadM FlagName
forall a b. (a -> b) -> a -> b
$ String
"Invalid flag name: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
flagS
Just FlagName
x -> FlagName -> ReadM FlagName
forall (m :: * -> *) a. Monad m => a -> m a
return FlagName
x
Map ApplyCLIFlag (Map FlagName Bool)
-> ReadM (Map ApplyCLIFlag (Map FlagName Bool))
forall (m :: * -> *) a. Monad m => a -> m a
return (Map ApplyCLIFlag (Map FlagName Bool)
-> ReadM (Map ApplyCLIFlag (Map FlagName Bool)))
-> Map ApplyCLIFlag (Map FlagName Bool)
-> ReadM (Map ApplyCLIFlag (Map FlagName Bool))
forall a b. (a -> b) -> a -> b
$ ApplyCLIFlag
-> Map FlagName Bool -> Map ApplyCLIFlag (Map FlagName Bool)
forall k a. k -> a -> Map k a
Map.singleton ApplyCLIFlag
pn' (Map FlagName Bool -> Map ApplyCLIFlag (Map FlagName Bool))
-> Map FlagName Bool -> Map ApplyCLIFlag (Map FlagName Bool)
forall a b. (a -> b) -> a -> b
$ FlagName -> Bool -> Map FlagName Bool
forall k a. k -> a -> Map k a
Map.singleton FlagName
flagN Bool
b
(String, String)
_ -> String -> ReadM (Map ApplyCLIFlag (Map FlagName Bool))
forall a. String -> ReadM a
readerError String
"Must have a colon"