{-# 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 (..))

-- | Parser for package:[-]flag
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"