module Distribution.Deprecated.ViewAsFieldDescr (
viewAsFieldDescr
) where
import Distribution.Client.Compat.Prelude hiding (get)
import Prelude ()
import qualified Data.List.NonEmpty as NE
import Distribution.ReadE (parsecToReadE)
import Distribution.Simple.Command
import Text.PrettyPrint (cat, comma, punctuate, text)
import Text.PrettyPrint as PP (empty)
import Distribution.Deprecated.ParseUtils (FieldDescr (..), runE, syntaxError)
viewAsFieldDescr :: OptionField a -> FieldDescr a
viewAsFieldDescr :: forall a. OptionField a -> FieldDescr a
viewAsFieldDescr (OptionField Name
_n []) =
forall a. HasCallStack => Name -> a
error Name
"Distribution.command.viewAsFieldDescr: unexpected"
viewAsFieldDescr (OptionField Name
n (OptDescr a
d:[OptDescr a]
dd)) = forall a.
Name
-> (a -> Doc)
-> (LineNo -> Name -> a -> ParseResult a)
-> FieldDescr a
FieldDescr Name
n a -> Doc
get LineNo -> Name -> a -> ParseResult a
set
where
optDescr :: OptDescr a
optDescr = forall a. NonEmpty a -> a
head forall a b. (a -> b) -> a -> b
$ forall a. (a -> a -> Ordering) -> NonEmpty a -> NonEmpty a
NE.sortBy forall a. OptDescr a -> OptDescr a -> Ordering
cmp (OptDescr a
dforall a. a -> [a] -> NonEmpty a
:|[OptDescr a]
dd)
cmp :: OptDescr a -> OptDescr a -> Ordering
ReqArg{} cmp :: forall a. OptDescr a -> OptDescr a -> Ordering
`cmp` ReqArg{} = Ordering
EQ
ReqArg{} `cmp` OptDescr a
_ = Ordering
GT
BoolOpt{} `cmp` ReqArg{} = Ordering
LT
BoolOpt{} `cmp` BoolOpt{} = Ordering
EQ
BoolOpt{} `cmp` OptDescr a
_ = Ordering
GT
ChoiceOpt{} `cmp` ReqArg{} = Ordering
LT
ChoiceOpt{} `cmp` BoolOpt{} = Ordering
LT
ChoiceOpt{} `cmp` ChoiceOpt{} = Ordering
EQ
ChoiceOpt{} `cmp` OptDescr a
_ = Ordering
GT
OptArg{} `cmp` OptArg{} = Ordering
EQ
OptArg{} `cmp` OptDescr a
_ = Ordering
LT
get :: a -> Doc
get a
t = case OptDescr a
optDescr of
ReqArg Name
_ OptFlags
_ Name
_ ReadE (a -> a)
_ a -> [Name]
ppr ->
([Doc] -> Doc
cat forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Name -> Doc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Name]
ppr) a
t
OptArg Name
_ OptFlags
_ Name
_ ReadE (a -> a)
_ a -> a
_ a -> [Maybe Name]
ppr ->
case a -> [Maybe Name]
ppr a
t of [] -> Doc
PP.empty
(Maybe Name
Nothing : [Maybe Name]
_) -> Name -> Doc
text Name
"True"
(Just Name
a : [Maybe Name]
_) -> Name -> Doc
text Name
a
ChoiceOpt [(Name, OptFlags, a -> a, a -> Bool)]
alts ->
forall a. a -> Maybe a -> a
fromMaybe Doc
PP.empty forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Maybe a
listToMaybe
[ Name -> Doc
text Name
lf | (Name
_,(Name
_,Name
lf:[Name]
_), a -> a
_,a -> Bool
enabled) <- [(Name, OptFlags, a -> a, a -> Bool)]
alts, a -> Bool
enabled a
t]
BoolOpt Name
_ OptFlags
_ OptFlags
_ Bool -> a -> a
_ a -> Maybe Bool
enabled -> (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
PP.empty forall a. Pretty a => a -> Doc
pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe Bool
enabled) a
t
set :: LineNo -> Name -> a -> ParseResult a
set LineNo
line Name
val a
a =
case OptDescr a
optDescr of
ReqArg Name
_ OptFlags
_ Name
_ ReadE (a -> a)
readE a -> [Name]
_ -> (forall a b. (a -> b) -> a -> b
$ a
a) forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` forall a. LineNo -> Name -> ReadE a -> Name -> ParseResult a
runE LineNo
line Name
n ReadE (a -> a)
readE Name
val
ChoiceOpt{} ->
case forall a. OptDescr a -> Name -> Maybe (a -> a)
getChoiceByLongFlag OptDescr a
optDescr Name
val of
Just a -> a
f -> forall (m :: * -> *) a. Monad m => a -> m a
return (a -> a
f a
a)
Maybe (a -> a)
_ -> forall a. LineNo -> Name -> ParseResult a
syntaxError LineNo
line Name
val
BoolOpt Name
_ OptFlags
_ OptFlags
_ Bool -> a -> a
setV a -> Maybe Bool
_ -> (Bool -> a -> a
`setV` a
a) forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` forall a. LineNo -> Name -> ReadE a -> Name -> ParseResult a
runE LineNo
line Name
n (forall a. (Name -> Name) -> ParsecParser a -> ReadE a
parsecToReadE (Name
"<viewAsFieldDescr>" forall a. [a] -> [a] -> [a]
++) forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec) Name
val
OptArg Name
_ OptFlags
_ Name
_ ReadE (a -> a)
readE a -> a
_ a -> [Maybe Name]
_ -> (forall a b. (a -> b) -> a -> b
$ a
a) forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` forall a. LineNo -> Name -> ReadE a -> Name -> ParseResult a
runE LineNo
line Name
n ReadE (a -> a)
readE Name
val
getChoiceByLongFlag :: OptDescr a -> String -> Maybe (a -> a)
getChoiceByLongFlag :: forall a. OptDescr a -> Name -> Maybe (a -> a)
getChoiceByLongFlag (ChoiceOpt [(Name, OptFlags, a -> a, a -> Bool)]
alts) Name
val = forall a. [a] -> Maybe a
listToMaybe
[ a -> a
set | (Name
_,(Name
_sf,Name
lf:[Name]
_), a -> a
set, a -> Bool
_) <- [(Name, OptFlags, a -> a, a -> Bool)]
alts
, Name
lf forall a. Eq a => a -> a -> Bool
== Name
val]
getChoiceByLongFlag OptDescr a
_ Name
_ =
forall a. HasCallStack => Name -> a
error Name
"Distribution.command.getChoiceByLongFlag: expected a choice option"