{-# LANGUAGE NoImplicitPrelude #-}

{-|
Module      : Stack.Options.PackageParser
License     : BSD-3-Clause
-}

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.BuildOptsCLI ( ApplyCLIFlag (..) )

-- | Parser for package:[-]flag

readFlag :: ReadM (Map ApplyCLIFlag (Map FlagName Bool))
readFlag :: ReadM (Map ApplyCLIFlag (Map FlagName Bool))
readFlag = do
  s <- ReadM [Char]
readerAsk
  case break (== ':') s of
    ([Char]
pn, Char
':':[Char]
mflag) -> do
      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 (b, flagS) = case mflag of
                         Char
'-':[Char]
x -> (Bool
False, [Char]
x)
                         [Char]
_ -> (Bool
True, [Char]
mflag)
      flagN <- case parseFlagName 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
      pure $ Map.singleton pn' $ Map.singleton flagN b
    ([Char], [Char])
_ -> [Char] -> ReadM (Map ApplyCLIFlag (Map FlagName Bool))
forall a. [Char] -> ReadM a
readerError [Char]
"Must have a colon."