{-# LANGUAGE NoImplicitPrelude #-}

module Stack.Options.PackageParser
  ( readFlag
  ) where

import qualified Data.Map as Map
import           Options.Applicative ( ReadM, readerError )
import           Options.Applicative.Types ( readerAsk )
import           Stack.Prelude
import           Stack.Types.BuildOpts ( ApplyCLIFlag (..) )

-- | Parser for package:[-]flag

readFlag :: ReadM (Map ApplyCLIFlag (Map FlagName Bool))
readFlag :: ReadM (Map ApplyCLIFlag (Map FlagName Bool))
readFlag = do
  [Char]
s <- ReadM [Char]
readerAsk
  case (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':') [Char]
s of
    ([Char]
pn, Char
':':[Char]
mflag) -> do
      ApplyCLIFlag
pn' <- case [Char] -> Maybe PackageName
parsePackageName [Char]
pn of
               Maybe PackageName
Nothing
                 | [Char]
pn [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"*" -> ApplyCLIFlag -> ReadM ApplyCLIFlag
forall a. a -> ReadM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ApplyCLIFlag
ACFAllProjectPackages
                 | Bool
otherwise -> [Char] -> ReadM ApplyCLIFlag
forall a. [Char] -> ReadM a
readerError ([Char] -> ReadM ApplyCLIFlag) -> [Char] -> ReadM ApplyCLIFlag
forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid package name: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
pn
               Just PackageName
x -> ApplyCLIFlag -> ReadM ApplyCLIFlag
forall a. a -> ReadM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApplyCLIFlag -> ReadM ApplyCLIFlag)
-> ApplyCLIFlag -> ReadM ApplyCLIFlag
forall a b. (a -> b) -> a -> b
$ PackageName -> ApplyCLIFlag
ACFByName PackageName
x
      let (Bool
b, [Char]
flagS) = case [Char]
mflag of
                         Char
'-':[Char]
x -> (Bool
False, [Char]
x)
                         [Char]
_ -> (Bool
True, [Char]
mflag)
      FlagName
flagN <- case [Char] -> Maybe FlagName
parseFlagName [Char]
flagS of
                 Maybe FlagName
Nothing -> [Char] -> ReadM FlagName
forall a. [Char] -> ReadM a
readerError ([Char] -> ReadM FlagName) -> [Char] -> ReadM FlagName
forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid flag name: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
flagS
                 Just FlagName
x -> FlagName -> ReadM FlagName
forall a. a -> ReadM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FlagName
x
      Map ApplyCLIFlag (Map FlagName Bool)
-> ReadM (Map ApplyCLIFlag (Map FlagName Bool))
forall a. a -> ReadM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (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
    ([Char], [Char])
_ -> [Char] -> ReadM (Map ApplyCLIFlag (Map FlagName Bool))
forall a. [Char] -> ReadM a
readerError [Char]
"Must have a colon."